From git at git.haskell.org Fri Jun 1 12:10:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Jun 2018 12:10:52 +0000 (UTC) Subject: [commit: ghc] master: Cleanups [ci skip] (9921f5b) Message-ID: <20180601121052.BBD4E3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9921f5b0f04a5b7871a4852e4da368ea6a763ec3/ghc >--------------------------------------------------------------- commit 9921f5b0f04a5b7871a4852e4da368ea6a763ec3 Author: Gabor Greif Date: Fri Jun 1 13:16:24 2018 +0200 Cleanups [ci skip] >--------------------------------------------------------------- 9921f5b0f04a5b7871a4852e4da368ea6a763ec3 compiler/cmm/SMRep.hs | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/compiler/cmm/SMRep.hs b/compiler/cmm/SMRep.hs index 9f8a49b..7436315 100644 --- a/compiler/cmm/SMRep.hs +++ b/compiler/cmm/SMRep.hs @@ -279,10 +279,10 @@ isConRep (HeapRep _ _ _ Constr{}) = True isConRep _ = False isThunkRep :: SMRep -> Bool -isThunkRep (HeapRep _ _ _ Thunk{}) = True +isThunkRep (HeapRep _ _ _ Thunk) = True isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True -isThunkRep (HeapRep _ _ _ BlackHole{}) = True -isThunkRep (HeapRep _ _ _ IndStatic{}) = True +isThunkRep (HeapRep _ _ _ BlackHole) = True +isThunkRep (HeapRep _ _ _ IndStatic) = True isThunkRep _ = False isFunRep :: SMRep -> Bool @@ -386,10 +386,10 @@ heapClosureSizeW _ _ = panic "SMRep.heapClosureSize" closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff closureTypeHdrSize dflags ty = case ty of - Thunk{} -> thunkHdrSize dflags + Thunk -> thunkHdrSize dflags ThunkSelector{} -> thunkHdrSize dflags - BlackHole{} -> thunkHdrSize dflags - IndStatic{} -> thunkHdrSize dflags + BlackHole -> thunkHdrSize dflags + IndStatic -> thunkHdrSize dflags _ -> fixedHdrSizeW dflags -- All thunks use thunkHdrSize, even if they are non-updatable. -- this is because we don't have separate closure types for @@ -448,21 +448,19 @@ rtsClosureType rep HeapRep False 0 2 Fun{} -> FUN_0_2 HeapRep False _ _ Fun{} -> FUN - HeapRep False 1 0 Thunk{} -> THUNK_1_0 - HeapRep False 0 1 Thunk{} -> THUNK_0_1 - HeapRep False 2 0 Thunk{} -> THUNK_2_0 - HeapRep False 1 1 Thunk{} -> THUNK_1_1 - HeapRep False 0 2 Thunk{} -> THUNK_0_2 - HeapRep False _ _ Thunk{} -> THUNK + HeapRep False 1 0 Thunk -> THUNK_1_0 + HeapRep False 0 1 Thunk -> THUNK_0_1 + HeapRep False 2 0 Thunk -> THUNK_2_0 + HeapRep False 1 1 Thunk -> THUNK_1_1 + HeapRep False 0 2 Thunk -> THUNK_0_2 + HeapRep False _ _ Thunk -> THUNK HeapRep False _ _ ThunkSelector{} -> THUNK_SELECTOR - HeapRep True _ _ Fun{} -> FUN_STATIC - HeapRep True _ _ Thunk{} -> THUNK_STATIC - - HeapRep False _ _ BlackHole{} -> BLACKHOLE - - HeapRep False _ _ IndStatic{} -> IND_STATIC + HeapRep True _ _ Fun{} -> FUN_STATIC + HeapRep True _ _ Thunk -> THUNK_STATIC + HeapRep False _ _ BlackHole -> BLACKHOLE + HeapRep False _ _ IndStatic -> IND_STATIC _ -> panic "rtsClosureType" From git at git.haskell.org Fri Jun 1 14:53:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Jun 2018 14:53:13 +0000 (UTC) Subject: [commit: ghc] wip/T2893: Wibbles (mainly comments) (8308b2d) Message-ID: <20180601145313.5B2613ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T2893 Link : http://ghc.haskell.org/trac/ghc/changeset/8308b2dfc2fb1ab89e2c3449960cf577b43a1612/ghc >--------------------------------------------------------------- commit 8308b2dfc2fb1ab89e2c3449960cf577b43a1612 Author: Simon Peyton Jones Date: Fri Jun 1 12:06:40 2018 +0100 Wibbles (mainly comments) >--------------------------------------------------------------- 8308b2dfc2fb1ab89e2c3449960cf577b43a1612 compiler/typecheck/TcCanonical.hs | 7 ++++-- compiler/typecheck/TcInteract.hs | 1 - compiler/typecheck/TcValidity.hs | 27 ++++++++++++++++------ testsuite/tests/typecheck/should_fail/T7019.stderr | 2 +- .../tests/typecheck/should_fail/T7019a.stderr | 2 +- testsuite/tests/typecheck/should_fail/T9196.stderr | 4 ++-- 6 files changed, 29 insertions(+), 14 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 87749da..980154c 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -452,8 +452,11 @@ makeSuperClasses cts = concatMapM go cts (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) go ct = pprPanic "makeSuperClasses" (ppr ct) -mkStrictSuperClasses :: CtEvidence -> [TyVar] -> ThetaType - -> Class -> [Type] -> TcS [Ct] +mkStrictSuperClasses + :: CtEvidence + -> [TyVar] -> ThetaType -- These two args are non-empty only when taking + -- superclasses of a /quantified/ constraint + -> Class -> [Type] -> TcS [Ct] -- Return constraints for the strict superclasses of -- ev :: forall as. theta => cls tys mkStrictSuperClasses ev tvs theta cls tys diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 2c27e51..ec6ac0f 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -2041,7 +2041,6 @@ shortCutReduction old_ev fsk ax_co fam_tc tc_args where deeper_loc = bumpCtLocDepth (ctEvLoc old_ev) - {- Note [Top-level reductions for type functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c.f. Note [The flattening story] in TcFlatten diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index f9e7831..927690c 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -442,7 +442,7 @@ rankZeroMonoType = MonoType (text "Perhaps you intended to use RankNTypes or R tyConArgMonoType = MonoType (text "GHC doesn't yet support impredicative polymorphism") synArgMonoType = MonoType (text "Perhaps you intended to use LiberalTypeSynonyms") constraintMonoType = MonoType (vcat [ text "A constraint must be a monotype" - , text "Perhpas you intended to use QuantifiedConstraints" ]) + , text "Perhaps you intended to use QuantifiedConstraints" ]) funArgResRank :: Rank -> (Rank, Rank) -- Function argument and result funArgResRank (LimitedRank _ arg_rank) = (arg_rank, LimitedRank (forAllAllowed arg_rank) arg_rank) @@ -1409,6 +1409,7 @@ checkInstTermination theta head_pred -> check2 foralld_tvs pred bogus_size where bogus_size = 1 + sizeTypes (filterOutInvisibleTypes (classTyCon cls) tys) + -- See Note [Invisible arguments and termination] ForAllPred tvs theta pred -> do { check (foralld_tvs `extendVarSetList` binderVars tvs) pred @@ -1570,6 +1571,20 @@ Here the instance is kind-indexed and really looks like type F (k->k) (b::k->k) = Int But if the 'b' didn't scope, we would make F's instance too poly-kinded. + +Note [Invisible arguments and termination] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When checking the ​Paterson conditions for termination an instance +declaration, we check for the number of "constructors and variables" +in the instance head and constraints. Question: Do we look at + + * All the arguments, visible or invisible? + * Just the visible arguments? + +I think both will ensure termination, provided we are consistent. +Currently we are /not/ consistent, which is really a bug. It's +described in Trac #15177, which contains a number of examples. +The suspicious bits are the calls to filterOutInvisibleTypes. -} -- | Extra information about the parent instance declaration, needed @@ -2001,10 +2016,7 @@ sizeTypes = foldr ((+) . sizeType) 0 sizeTyConAppArgs :: TyCon -> [Type] -> Int sizeTyConAppArgs _tc tys = sizeTypes tys -- (filterOutInvisibleTypes tc tys) - --- instance (Category w, Prelude.Monad m) => Monad (WriterT w m) where --- Category * w_auL --- Monad (WriterT w_auL m_auM) + -- See Note [Invisible arguments and termination] -- Size of a predicate -- @@ -2020,10 +2032,11 @@ sizePred ty = goClass ty go (ClassPred cls tys') | isTerminatingClass cls = 0 | otherwise = sizeTypes (filterOutInvisibleTypes (classTyCon cls) tys') - -- The filtering looks bogus: see Trac #15177 + -- The filtering looks bogus + -- See Note [Invisible arguments and termination] go (EqPred {}) = 0 go (IrredPred ty) = sizeType ty - go (ForAllPred _ _ pred) = goClass pred -- Is this right? + go (ForAllPred _ _ pred) = goClass pred -- | When this says "True", ignore this class constraint during -- a termination check diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr index 98ceb6e..09827e4 100644 --- a/testsuite/tests/typecheck/should_fail/T7019.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019.stderr @@ -2,5 +2,5 @@ T7019.hs:11:1: error: • Illegal polymorphic type: forall a. c (Free c a) A constraint must be a monotype - Perhpas you intended to use QuantifiedConstraints + Perhaps you intended to use QuantifiedConstraints • In the type synonym declaration for ‘C’ diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr index 580496b..e0e0342 100644 --- a/testsuite/tests/typecheck/should_fail/T7019a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr @@ -2,7 +2,7 @@ T7019a.hs:11:1: error: • Illegal polymorphic type: forall b. Context (Associated a b) A constraint must be a monotype - Perhpas you intended to use QuantifiedConstraints + Perhaps you intended to use QuantifiedConstraints • In the context: forall b. Context (Associated a b) While checking the super-classes of class ‘Class’ In the class declaration for ‘Class’ diff --git a/testsuite/tests/typecheck/should_fail/T9196.stderr b/testsuite/tests/typecheck/should_fail/T9196.stderr index f417e6a..d6ca149 100644 --- a/testsuite/tests/typecheck/should_fail/T9196.stderr +++ b/testsuite/tests/typecheck/should_fail/T9196.stderr @@ -2,11 +2,11 @@ T9196.hs:4:6: error: • Illegal polymorphic type: forall a1. Eq a1 A constraint must be a monotype - Perhpas you intended to use QuantifiedConstraints + Perhaps you intended to use QuantifiedConstraints • In the type signature: f :: (forall a. Eq a) => a -> a T9196.hs:7:6: error: • Illegal qualified type: Eq a => Ord a A constraint must be a monotype - Perhpas you intended to use QuantifiedConstraints + Perhaps you intended to use QuantifiedConstraints • In the type signature: g :: (Eq a => Ord a) => a -> a From git at git.haskell.org Fri Jun 1 16:21:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 1 Jun 2018 16:21:59 +0000 (UTC) Subject: [commit: ghc] master: UNREG: mark SRT as writable in generated C code (9fd4ed9) Message-ID: <20180601162159.11CED3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9fd4ed90bcdb22fc0d71051644084b75a3e8a376/ghc >--------------------------------------------------------------- commit 9fd4ed90bcdb22fc0d71051644084b75a3e8a376 Author: Sergei Trofimovich Date: Fri Jun 1 08:35:23 2018 +0000 UNREG: mark SRT as writable in generated C code Noticed section mismatch on UNREG build failure: ``` HC [stage 1] libraries/integer-gmp/dist-install/build/GHC/Integer/Type.o error: conflicting types for 'ufu0_srt' static StgWord ufu0_srt[]__attribute__((aligned(8)))= { ^~~~~~~~ note: previous declaration of 'ufu0_srt' was here IRO_(ufu0_srt); ^~~~~~~~ ``` `IRO_` is a 'const' qualifier. The error is a leftover from commit 838b69032566ce6ab3918d70e8d5e098d0bcee02 "Merge FUN_STATIC closure with its SRT" where part of SRT was moved into closure itself and made SRTs writable. This change puts all SRTs into writable section. Signed-off-by: Sergei Trofimovich Reviewers: simonmar, bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4731 >--------------------------------------------------------------- 9fd4ed90bcdb22fc0d71051644084b75a3e8a376 compiler/cmm/CLabel.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 8f614ab..3553283 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -616,8 +616,6 @@ isSomeRODataLabel (IdLabel _ _ ConInfoTable) = True isSomeRODataLabel (IdLabel _ _ InfoTable) = True isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True --- static reference tables defined in haskell (.hs) -isSomeRODataLabel (SRTLabel _) = True -- info table defined in cmm (.cmm) isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True isSomeRODataLabel _lbl = False From git at git.haskell.org Sat Jun 2 20:13:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 20:13:25 +0000 (UTC) Subject: [commit: ghc] master: Optimizations for CmmBlockElim. (bd43378) Message-ID: <20180602201325.43A053ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bd43378dfba1d6c5f19246b972b761640eedb35c/ghc >--------------------------------------------------------------- commit bd43378dfba1d6c5f19246b972b761640eedb35c Author: klebinger.andreas at gmx.at Date: Wed May 30 20:49:18 2018 -0400 Optimizations for CmmBlockElim. * Use toBlockList instead of revPostorder. Block elimination works on a given Cmm graph by: * Getting a list of blocks. * Looking for duplicates in these blocks. * Removing all but one instance of duplicates. There are two (reasonable) ways to get the list of blocks. * The fast way: `toBlockList` This just flattens the underlying map into a list. * The convenient way: `revPostorder` Start at the entry label, scan for reachable blocks and return only these. This has the advantage of removing all dead code. If there is dead code the later is better. Work done on unreachable blocks is clearly wasted work. However by the point we run the common block elimination pass the input graph already had all dead code removed. This is done during control flow optimization in CmmContFlowOpt which is our first Cmm pass. This means common block elimination is free to use toBlockList because revPostorder would return the same blocks. (Although in a different order). * Change the triemap used for grouping by a label list from `(TM.ListMap UniqDFM)` to `ListMap (GenMap LabelMap)`. * Using GenMap offers leaf compression. Which is a trie optimization described by the Note [Compressed TrieMap] in CoreSyn/TrieMap.hs * Using LabelMap removes the overhead associated with UniqDFM. This is deterministic since if we have the same input keys the same LabelMap will be constructed. Test Plan: ci, profiling output Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: dfeuer, thomie, carter GHC Trac Issues: #15103 Differential Revision: https://phabricator.haskell.org/D4597 >--------------------------------------------------------------- bd43378dfba1d6c5f19246b972b761640eedb35c compiler/cmm/CmmCommonBlockElim.hs | 42 +++++++++++++++++++++++--------------- compiler/cmm/Hoopl/Label.hs | 10 +++++++++ compiler/coreSyn/CoreMap.hs | 2 ++ 3 files changed, 37 insertions(+), 17 deletions(-) diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index fc4fcab..1af9a84 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE GADTs, BangPatterns #-} +{-# LANGUAGE GADTs, BangPatterns, ScopedTypeVariables #-} + module CmmCommonBlockElim ( elimCommonBlocks ) @@ -24,9 +25,8 @@ import qualified Data.List as List import Data.Word import qualified Data.Map as M import Outputable -import UniqFM -import UniqDFM import qualified TrieMap as TM +import UniqFM import Unique import Control.Arrow (first, second) import Data.List (foldl') @@ -64,9 +64,11 @@ elimCommonBlocks :: CmmGraph -> CmmGraph elimCommonBlocks g = replaceLabels env $ copyTicks env g where env = iterate mapEmpty blocks_with_key - -- The order of blocks doesn't matter here, but revPostorder also drops any - -- unreachable blocks, which is useful. - groups = groupByInt hash_block (revPostorder g) + -- The order of blocks doesn't matter here. While we could use + -- revPostorder which drops unreachable blocks this is done in + -- ContFlowOpt already which runs before this pass. So we use + -- toBlockList since it is faster. + groups = groupByInt hash_block (toBlockList g) :: [[CmmBlock]] blocks_with_key = [ [ (successors b, [b]) | b <- bs] | bs <- groups] -- Invariant: The blocks in the list are pairwise distinct @@ -94,6 +96,8 @@ iterate subst blocks subst' = subst `mapUnion` new_substs updated_blocks = map (map (first (map (lookupBid subst')))) merged_blocks +-- Combine two lists of blocks. +-- While they are internally distinct they can still share common blocks. mergeBlocks :: Subst -> DistinctBlocks -> DistinctBlocks -> (Subst, DistinctBlocks) mergeBlocks subst existing new = go new where @@ -298,17 +302,21 @@ copyTicks env g foldr blockCons code (map CmmTick ticks) -- Group by [Label] -groupByLabel :: [(Key, a)] -> [(Key, [a])] -groupByLabel = go (TM.emptyTM :: TM.ListMap UniqDFM a) - where - go !m [] = TM.foldTM (:) m [] - go !m ((k,v) : entries) = go (TM.alterTM k' adjust m) entries - where k' = map getUnique k - adjust Nothing = Just (k,[v]) - adjust (Just (_,vs)) = Just (k,v:vs) - +-- See Note [Compressed TrieMap] in coreSyn/TrieMap about the usage of GenMap. +groupByLabel :: [(Key, DistinctBlocks)] -> [(Key, [DistinctBlocks])] +groupByLabel = + go (TM.emptyTM :: TM.ListMap (TM.GenMap LabelMap) (Key, [DistinctBlocks])) + where + go !m [] = TM.foldTM (:) m [] + go !m ((k,v) : entries) = go (TM.alterTM k adjust m) entries + where --k' = map (getKey . getUnique) k + adjust Nothing = Just (k,[v]) + adjust (Just (_,vs)) = Just (k,v:vs) groupByInt :: (a -> Int) -> [a] -> [[a]] groupByInt f xs = nonDetEltsUFM $ List.foldl' go emptyUFM xs - -- See Note [Unique Determinism and code generation] - where go m x = alterUFM (Just . maybe [x] (x:)) m (f x) + -- See Note [Unique Determinism and code generation] + where + go m x = alterUFM addEntry m (f x) + where + addEntry xs = Just $! maybe [x] (x:) xs diff --git a/compiler/cmm/Hoopl/Label.hs b/compiler/cmm/Hoopl/Label.hs index caed683..7fddbf4 100644 --- a/compiler/cmm/Hoopl/Label.hs +++ b/compiler/cmm/Hoopl/Label.hs @@ -21,6 +21,8 @@ import Outputable import Hoopl.Collections import Unique (Uniquable(..)) +import TrieMap + ----------------------------------------------------------------------------- -- Label @@ -120,6 +122,14 @@ instance Outputable LabelSet where instance Outputable a => Outputable (LabelMap a) where ppr = ppr . mapToList +instance TrieMap LabelMap where + type Key LabelMap = Label + emptyTM = mapEmpty + lookupTM k m = mapLookup k m + alterTM k f m = mapAlter f k m + foldTM k m z = mapFoldr k z m + mapTM f m = mapMap f m + ----------------------------------------------------------------------------- -- FactBase diff --git a/compiler/coreSyn/CoreMap.hs b/compiler/coreSyn/CoreMap.hs index dc30bed..73c6995 100644 --- a/compiler/coreSyn/CoreMap.hs +++ b/compiler/coreSyn/CoreMap.hs @@ -24,6 +24,8 @@ module CoreMap( ListMap, -- * Maps over 'Literal's LiteralMap, + -- * Map for compressing leaves. See Note [Compressed TrieMap] + GenMap, -- * 'TrieMap' class TrieMap(..), insertTM, deleteTM, lkDFreeVar, xtDFreeVar, From git at git.haskell.org Sat Jun 2 20:13:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 20:13:40 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #15186 (c983a1d) Message-ID: <20180602201340.685A83ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c983a1dbc01bb6ee68f67af5c7d662bc70845f6f/ghc >--------------------------------------------------------------- commit c983a1dbc01bb6ee68f67af5c7d662bc70845f6f Author: Ben Gamari Date: Thu May 31 07:48:53 2018 -0400 testsuite: Add test for #15186 Summary: Currently broken. Test Plan: Validate Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15186 Differential Revision: https://phabricator.haskell.org/D4757 >--------------------------------------------------------------- c983a1dbc01bb6ee68f67af5c7d662bc70845f6f testsuite/tests/simplCore/should_compile/T15186.hs | 31 ++++++++ .../tests/simplCore/should_compile/T15186A.hs | 84 ++++++++++++++++++++++ testsuite/tests/simplCore/should_compile/all.T | 1 + 3 files changed, 116 insertions(+) diff --git a/testsuite/tests/simplCore/should_compile/T15186.hs b/testsuite/tests/simplCore/should_compile/T15186.hs new file mode 100644 index 0000000..c04de6a --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15186.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PatternSynonyms #-} +module Bar (pattern PointerExpr) where + +import T15186A + +------------------------------------------------------------------------------- + +pattern PointerExpr :: Expr tp +pattern PointerExpr <- + App (RollRecursive (EmptyAssn :> BVRepr) (App _)) + +------------------------------------------------------------------------------- + +data CrucibleType where + RecursiveType :: Ctx CrucibleType -> CrucibleType + +data TypeRepr (tp :: CrucibleType) where + BVRepr :: TypeRepr tp + TypeReprDummy :: TypeRepr tp + +data App (f :: CrucibleType -> *) (tp :: CrucibleType) where + RollRecursive :: !(Assignment TypeRepr ctx) + -> !(Expr tp) + -> App f ('RecursiveType ctx) + +data Expr (tp :: CrucibleType) + = App !(App Expr tp) + | ExprDummy diff --git a/testsuite/tests/simplCore/should_compile/T15186A.hs b/testsuite/tests/simplCore/should_compile/T15186A.hs new file mode 100644 index 0000000..472d01c --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15186A.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +module T15186A (Ctx, Assignment, pattern EmptyAssn, pattern (:>)) where + +import Data.Kind (Type) + +data Ctx k + = EmptyCtx + | Ctx k ::> k + +type SingleCtx x = 'EmptyCtx '::> x + +type family (<+>) (x :: Ctx k) (y :: Ctx k) :: Ctx k where + x <+> 'EmptyCtx = x + x <+> (y '::> e) = (x <+> y) '::> e + +data Height = Zero | Succ Height + +data BinomialTree (h::Height) (f :: k -> Type) :: Ctx k -> Type where + Empty :: BinomialTree h f 'EmptyCtx + PlusOne :: !Int + -> !(BinomialTree ('Succ h) f x) + -> !(BalancedTree h f y) + -> BinomialTree h f (x <+> y) + PlusZero :: !Int + -> !(BinomialTree ('Succ h) f x) + -> BinomialTree h f x + +newtype Assignment (f :: k -> *) (ctx :: Ctx k) + = Assignment (BinomialTree 'Zero f ctx) + +data AssignView f ctx where + AssignEmpty :: AssignView f 'EmptyCtx + AssignExtend :: Assignment f ctx + -> f tp + -> AssignView f (ctx '::> tp) + +data DropResult f (ctx :: Ctx k) where + DropEmpty :: DropResult f 'EmptyCtx + DropExt :: BinomialTree 'Zero f x + -> f y + -> DropResult f (x '::> y) + +data BalancedTree h (f :: k -> Type) (p :: Ctx k) where + BalLeaf :: !(f x) -> BalancedTree 'Zero f (SingleCtx x) + BalPair :: !(BalancedTree h f x) + -> !(BalancedTree h f y) + -> BalancedTree ('Succ h) f (x <+> y) + +bal_drop :: forall h f x y + . BinomialTree h f x + -> BalancedTree h f y + -> DropResult f (x <+> y) +bal_drop t (BalLeaf e) = DropExt t e +bal_drop _ (BalPair {}) = undefined + +bin_drop :: forall h f ctx + . BinomialTree h f ctx + -> DropResult f ctx +bin_drop Empty = DropEmpty +bin_drop (PlusZero _ u) = bin_drop u +bin_drop (PlusOne s t u) = + let m = case t of + Empty -> Empty + _ -> PlusZero s t + in bal_drop m u + +viewAssign :: forall f ctx . Assignment f ctx -> AssignView f ctx +viewAssign (Assignment x) = + case bin_drop x of + DropEmpty -> AssignEmpty + DropExt t v -> AssignExtend (Assignment t) v + +pattern EmptyAssn :: () => ctx ~ 'EmptyCtx => Assignment f ctx +pattern EmptyAssn <- (viewAssign -> AssignEmpty) + +pattern (:>) :: () => ctx' ~ (ctx '::> tp) => Assignment f ctx -> f tp -> Assignment f ctx' +pattern (:>) a v <- (viewAssign -> AssignExtend a v) diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 1bc42af..a430521 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -315,3 +315,4 @@ test('T15002', [ req_profiling ], compile, ['-O -fprof-auto -prof']) 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', expect_broken(15186), multimod_compile, ['T15186', '-v0']) From git at git.haskell.org Sat Jun 2 20:13:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 20:13:54 +0000 (UTC) Subject: [commit: ghc] master: Conservatively estimate levity in worker/wrapper (f0c1eb8) Message-ID: <20180602201354.E9F403ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f0c1eb8b5640b0ec86b9fabb465ea5b841808d56/ghc >--------------------------------------------------------------- commit f0c1eb8b5640b0ec86b9fabb465ea5b841808d56 Author: Ben Gamari Date: Thu May 31 07:49:55 2018 -0400 Conservatively estimate levity in worker/wrapper The worker/wrapper transform needs to determine the levity of the result to determine whether it needs to introduce a lambda to preserve laziness of the result. For this is previously used isUnliftedType. However, this may fail in the presence of levity polymorphism. We now instead use isLiftedType_maybe, assuming that a lambda is needed if the levity of the result cannot be determined. Fixes #15186. Test Plan: make test=T15186 Reviewers: simonpj, goldfire, tdammers Reviewed By: simonpj Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15186 Differential Revision: https://phabricator.haskell.org/D4755 >--------------------------------------------------------------- f0c1eb8b5640b0ec86b9fabb465ea5b841808d56 compiler/stranal/WwLib.hs | 12 +++++++++++- testsuite/tests/simplCore/should_compile/all.T | 2 +- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index ab0a4d1..040a6d7 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -269,11 +269,21 @@ mkWorkerArgs dflags args res_ty | otherwise = (args ++ [voidArgId], args ++ [voidPrimId]) where + -- See "Making wrapper args" section above needsAValueLambda = - isUnliftedType res_ty + lifted + -- We may encounter a levity-polymorphic result, in which case we + -- conservatively assume that we have laziness that needs preservation. + -- See #15186. || not (gopt Opt_FunToThunk dflags) -- see Note [Protecting the last value argument] + -- Might the result be lifted? + lifted = + case isLiftedType_maybe res_ty of + Just lifted -> lifted + Nothing -> True + {- Note [Protecting the last value argument] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index a430521..5ad7dba 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -315,4 +315,4 @@ test('T15002', [ req_profiling ], compile, ['-O -fprof-auto -prof']) 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', expect_broken(15186), multimod_compile, ['T15186', '-v0']) +test('T15186', normal, multimod_compile, ['T15186', '-v0']) From git at git.haskell.org Sat Jun 2 20:17:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 20:17:49 +0000 (UTC) Subject: [commit: ghc] master: Add llvm-target for powerpc64le-unknown-linux (13a8660) Message-ID: <20180602201749.744F53ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/13a86606e51400bc2a81a0e04cfbb94ada5d2620/ghc >--------------------------------------------------------------- commit 13a86606e51400bc2a81a0e04cfbb94ada5d2620 Author: Alan Mock Date: Sat Jun 2 11:56:41 2018 -0400 Add llvm-target for powerpc64le-unknown-linux Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15212 Differential Revision: https://phabricator.haskell.org/D4765 >--------------------------------------------------------------- 13a86606e51400bc2a81a0e04cfbb94ada5d2620 llvm-targets | 1 + utils/llvm-targets/gen-data-layout.sh | 2 ++ 2 files changed, 3 insertions(+) diff --git a/llvm-targets b/llvm-targets index b67ee6c..6da97ee 100644 --- a/llvm-targets +++ b/llvm-targets @@ -15,6 +15,7 @@ ,("x86_64-unknown-linux", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "")) ,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) +,("powerpc64le-unknown-linux", ("e-m:e-i64:64-n32:64", "ppc64le", "")) ,("arm-unknown-nto-qnx-eabi", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align")) ,("i386-apple-darwin", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) ,("x86_64-apple-darwin", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index 3d9ded1..7a65a3e 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -29,6 +29,8 @@ TARGETS=( "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" # Linux Android "armv7-unknown-linux-androideabi" "aarch64-unknown-linux-android" + # Linux ppc64le + "powerpc64le-unknown-linux" # QNX "arm-unknown-nto-qnx-eabi" From git at git.haskell.org Sat Jun 2 20:21:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 20:21:35 +0000 (UTC) Subject: [commit: ghc] master: vectorise: Put it out of its misery (faee23b) Message-ID: <20180602202135.E554E3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/faee23bb69ca813296da484bc177f4480bcaee9f/ghc >--------------------------------------------------------------- commit faee23bb69ca813296da484bc177f4480bcaee9f Author: Ben Gamari Date: Sat Jun 2 11:56:58 2018 -0400 vectorise: Put it out of its misery Poor DPH and its vectoriser have long been languishing; sadly it seems there is little chance that the effort will be rekindled. Every few years we discuss what to do with this mass of code and at least once we have agreed that it should be archived on a branch and removed from `master`. Here we do just that, eliminating heaps of dead code in the process. Here we drop the ParallelArrays extension, the vectoriser, and the `vector` and `primitive` submodules. Test Plan: Validate Reviewers: simonpj, simonmar, hvr, goldfire, alanz Reviewed By: simonmar Subscribers: goldfire, rwbarton, thomie, mpickering, carter Differential Revision: https://phabricator.haskell.org/D4761 >--------------------------------------------------------------- faee23bb69ca813296da484bc177f4480bcaee9f compiler/backpack/RnModIface.hs | 1 - compiler/basicTypes/MkId.hs | 34 +- compiler/basicTypes/Module.hs | 11 +- compiler/basicTypes/Name.hs | 13 - compiler/basicTypes/OccName.hs | 31 - compiler/basicTypes/Unique.hs | 6 +- compiler/coreSyn/CoreFVs.hs | 12 - compiler/coreSyn/CoreLint.hs | 1 - compiler/coreSyn/CoreOpt.hs | 23 +- compiler/coreSyn/CoreSyn.hs | 21 - compiler/coreSyn/PprCore.hs | 18 - compiler/deSugar/Check.hs | 5 - compiler/deSugar/Coverage.hs | 8 - compiler/deSugar/Desugar.hs | 42 +- compiler/deSugar/DsArrows.hs | 1 - compiler/deSugar/DsExpr.hs | 27 - compiler/deSugar/DsListComp.hs | 210 +--- compiler/deSugar/DsMeta.hs | 11 - compiler/deSugar/DsMonad.hs | 166 +-- compiler/deSugar/DsUtils.hs | 78 +- compiler/deSugar/Match.hs | 9 - compiler/deSugar/MatchCon.hs | 6 +- compiler/deSugar/PmExpr.hs | 12 +- compiler/ghc.cabal.in | 30 - compiler/hsSyn/HsDecls.hs | 153 +-- compiler/hsSyn/HsExpr.hs | 56 +- compiler/hsSyn/HsExtension.hs | 39 - compiler/hsSyn/HsInstances.hs | 10 - compiler/hsSyn/HsPat.hs | 13 - compiler/hsSyn/HsTypes.hs | 10 - compiler/hsSyn/HsUtils.hs | 2 - compiler/iface/IfaceType.hs | 1 - compiler/iface/LoadIface.hs | 24 +- compiler/iface/MkIface.hs | 25 +- compiler/iface/TcIface.hs | 139 +-- compiler/iface/TcIface.hs-boot | 4 +- compiler/main/DynFlags.hs | 30 - compiler/main/HscTypes.hs | 148 +-- compiler/main/Packages.hs | 9 - compiler/main/TidyPgm.hs | 58 +- compiler/parser/Lexer.x | 23 +- compiler/parser/Parser.y | 68 +- compiler/parser/RdrHsSyn.hs | 5 +- compiler/prelude/PrelNames.hs | 11 - compiler/prelude/TysWiredIn.hs | 89 +- compiler/rename/RnExpr.hs | 33 +- compiler/rename/RnPat.hs | 4 - compiler/rename/RnSource.hs | 66 +- compiler/rename/RnTypes.hs | 9 +- compiler/rename/RnUtils.hs | 3 - compiler/simplCore/CoreMonad.hs | 2 - compiler/simplCore/OccurAnal.hs | 12 +- compiler/simplCore/SimplCore.hs | 64 +- compiler/specialise/SpecConstr.hs | 2 +- compiler/typecheck/FamInst.hs | 1 - compiler/typecheck/TcBinds.hs | 76 +- compiler/typecheck/TcExpr.hs | 38 - compiler/typecheck/TcHsSyn.hs | 47 +- compiler/typecheck/TcHsType.hs | 41 +- compiler/typecheck/TcMatches.hs | 15 +- compiler/typecheck/TcPat.hs | 8 - compiler/typecheck/TcPatSyn.hs | 3 - compiler/typecheck/TcRnDriver.hs | 17 +- compiler/typecheck/TcRnMonad.hs | 1 - compiler/typecheck/TcRnTypes.hs | 31 +- compiler/typecheck/TcUnify.hs | 8 - compiler/utils/Outputable.hs | 5 +- compiler/vectorise/Vectorise.hs | 358 ------ compiler/vectorise/Vectorise/Builtins.hs | 35 - compiler/vectorise/Vectorise/Builtins/Base.hs | 219 ---- .../vectorise/Vectorise/Builtins/Initialise.hs | 234 ---- compiler/vectorise/Vectorise/Convert.hs | 104 -- compiler/vectorise/Vectorise/Env.hs | 240 ---- compiler/vectorise/Vectorise/Exp.hs | 1260 -------------------- .../vectorise/Vectorise/Generic/Description.hs | 294 ----- compiler/vectorise/Vectorise/Generic/PADict.hs | 128 -- compiler/vectorise/Vectorise/Generic/PAMethods.hs | 586 --------- compiler/vectorise/Vectorise/Generic/PData.hs | 178 --- compiler/vectorise/Vectorise/Monad.hs | 196 --- compiler/vectorise/Vectorise/Monad/Base.hs | 245 ---- compiler/vectorise/Vectorise/Monad/Global.hs | 239 ---- compiler/vectorise/Vectorise/Monad/InstEnv.hs | 82 -- compiler/vectorise/Vectorise/Monad/Local.hs | 102 -- compiler/vectorise/Vectorise/Monad/Naming.hs | 132 -- compiler/vectorise/Vectorise/Type/Classify.hs | 131 -- compiler/vectorise/Vectorise/Type/Env.hs | 457 ------- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 223 ---- compiler/vectorise/Vectorise/Type/Type.hs | 87 -- compiler/vectorise/Vectorise/Utils.hs | 167 --- compiler/vectorise/Vectorise/Utils/Base.hs | 261 ---- compiler/vectorise/Vectorise/Utils/Closure.hs | 163 --- compiler/vectorise/Vectorise/Utils/Hoisting.hs | 98 -- compiler/vectorise/Vectorise/Utils/PADict.hs | 232 ---- compiler/vectorise/Vectorise/Utils/Poly.hs | 74 -- compiler/vectorise/Vectorise/Var.hs | 103 -- compiler/vectorise/Vectorise/Vect.hs | 128 -- docs/ndp/haskell.sty | 496 -------- docs/ndp/vect.tex | 363 ------ docs/users_guide/debugging.rst | 13 - docs/users_guide/extending_ghc.rst | 2 +- docs/users_guide/glasgow_exts.rst | 1 - docs/users_guide/parallel.rst | 10 - docs/users_guide/using-optimisation.rst | 52 - ghc.mk | 21 +- libraries/base/GHC/PArr.hs | 37 - libraries/base/base.cabal | 1 - libraries/dph | 1 - libraries/primitive | 1 - libraries/vector | 1 - packages | 6 +- testsuite/tests/dph/Makefile | 3 - testsuite/tests/dph/classes/DefsVect.hs | 53 - testsuite/tests/dph/classes/Main.hs | 15 - testsuite/tests/dph/classes/Makefile | 3 - .../tests/dph/classes/dph-classes-copy-fast.stdout | 1 - .../tests/dph/classes/dph-classes-vseg-fast.stdout | 1 - testsuite/tests/dph/classes/dph-classes.T | 6 - testsuite/tests/dph/diophantine/DiophantineVect.hs | 39 - testsuite/tests/dph/diophantine/Main.hs | 42 - testsuite/tests/dph/diophantine/Makefile | 3 - .../diophantine/dph-diophantine-copy-fast.stdout | 3 - .../diophantine/dph-diophantine-copy-opt.stdout | 3 - testsuite/tests/dph/diophantine/dph-diophantine.T | 11 - testsuite/tests/dph/dotp/DotPVect.hs | 15 - testsuite/tests/dph/dotp/Main.hs | 54 - testsuite/tests/dph/dotp/Makefile | 3 - testsuite/tests/dph/dotp/dph-dotp-copy-fast.stdout | 2 - testsuite/tests/dph/dotp/dph-dotp-copy-opt.stdout | 2 - testsuite/tests/dph/dotp/dph-dotp-vseg-fast.stdout | 2 - testsuite/tests/dph/dotp/dph-dotp-vseg-opt.stdout | 2 - testsuite/tests/dph/dotp/dph-dotp.T | 20 - testsuite/tests/dph/enumfromto/EnumFromToP.hs | 24 - testsuite/tests/dph/enumfromto/Makefile | 3 - testsuite/tests/dph/enumfromto/dph-enumfromto.T | 4 - testsuite/tests/dph/modules/ExportList.hs | 33 - testsuite/tests/dph/modules/Makefile | 3 - .../dph/modules/dph-ExportList-vseg-fast.stderr | 9 - testsuite/tests/dph/modules/dph-modules.T | 4 - testsuite/tests/dph/nbody/Body.hs | 85 -- testsuite/tests/dph/nbody/Config.hs | 50 - testsuite/tests/dph/nbody/Dump.hs | 46 - testsuite/tests/dph/nbody/Generate.hs | 98 -- testsuite/tests/dph/nbody/Main.hs | 103 -- testsuite/tests/dph/nbody/Makefile | 3 - testsuite/tests/dph/nbody/Randomish.hs | 82 -- testsuite/tests/dph/nbody/Solver.hs | 156 --- testsuite/tests/dph/nbody/Types.hs | 52 - testsuite/tests/dph/nbody/Util.hs | 18 - testsuite/tests/dph/nbody/World.hs | 47 - .../tests/dph/nbody/dph-nbody-copy-fast.stdout | 100 -- .../tests/dph/nbody/dph-nbody-copy-opt.stdout | 100 -- .../tests/dph/nbody/dph-nbody-vseg-fast.stdout | 100 -- .../tests/dph/nbody/dph-nbody-vseg-opt.stdout | 100 -- testsuite/tests/dph/nbody/dph-nbody.T | 19 - testsuite/tests/dph/primespj/Main.hs | 30 - testsuite/tests/dph/primespj/Makefile | 3 - testsuite/tests/dph/primespj/PrimesVect.hs | 25 - .../dph/primespj/dph-primespj-copy-fast.stdout | 3 - .../dph/primespj/dph-primespj-copy-opt.stdout | 3 - .../dph/primespj/dph-primespj-vseg-fast.stdout | 3 - .../dph/primespj/dph-primespj-vseg-opt.stdout | 3 - testsuite/tests/dph/primespj/dph-primespj.T | 11 - testsuite/tests/dph/quickhull/Main.hs | 43 - testsuite/tests/dph/quickhull/Makefile | 3 - testsuite/tests/dph/quickhull/QuickHullVect.hs | 41 - testsuite/tests/dph/quickhull/SVG.hs | 34 - testsuite/tests/dph/quickhull/TestData.hs | 92 -- testsuite/tests/dph/quickhull/Types.hs | 33 - .../dph/quickhull/dph-quickhull-copy-fast.stdout | 1019 ---------------- .../dph/quickhull/dph-quickhull-copy-opt.stdout | 1019 ---------------- .../dph/quickhull/dph-quickhull-vseg-fast.stdout | 1019 ---------------- .../dph/quickhull/dph-quickhull-vseg-opt.stdout | 1019 ---------------- testsuite/tests/dph/quickhull/dph-quickhull.T | 20 - testsuite/tests/dph/smvm/Main.hs | 60 - testsuite/tests/dph/smvm/Makefile | 3 - testsuite/tests/dph/smvm/SMVMVect.hs | 17 - testsuite/tests/dph/smvm/dph-smvm-copy.stdout | 1 - testsuite/tests/dph/smvm/dph-smvm-vseg.stdout | 1 - testsuite/tests/dph/smvm/dph-smvm.T | 41 - testsuite/tests/dph/smvm/result-i386.txt | 101 -- testsuite/tests/dph/smvm/result-sparc.txt | 101 -- testsuite/tests/dph/smvm/result-x86_64.txt | 101 -- testsuite/tests/dph/smvm/test-i386.dat | Bin 22384 -> 0 bytes testsuite/tests/dph/smvm/test-sparc.dat | Bin 11632 -> 0 bytes testsuite/tests/dph/smvm/test-x86_64.dat | Bin 16416 -> 0 bytes testsuite/tests/dph/sumnats/Main.hs | 21 - testsuite/tests/dph/sumnats/Makefile | 3 - testsuite/tests/dph/sumnats/SumNatsVect.hs | 14 - .../tests/dph/sumnats/dph-sumnats-copy.stdout | 3 - .../tests/dph/sumnats/dph-sumnats-vseg.stdout | 3 - testsuite/tests/dph/sumnats/dph-sumnats.T | 20 - testsuite/tests/dph/words/Main.hs | 37 - testsuite/tests/dph/words/Makefile | 3 - testsuite/tests/dph/words/WordsVect.hs | 125 -- .../tests/dph/words/dph-words-copy-fast.stdout | 3 - .../tests/dph/words/dph-words-copy-opt.stdout | 3 - .../tests/dph/words/dph-words-vseg-fast.stdout | 3 - .../tests/dph/words/dph-words-vseg-opt.stdout | 3 - testsuite/tests/dph/words/dph-words.T | 20 - testsuite/tests/ghc-api/T9015.hs | 1 - testsuite/tests/ghc-api/T9015.stdout | 4 +- testsuite/tests/ghci/should_run/T7253.script | 1 - testsuite/tests/ghci/should_run/T7253.stderr | 2 +- .../parser/should_compile/DumpRenamedAst.stderr | 1 - .../tests/parser/should_compile/T14189.stderr | 1 - utils/ghctags/Main.hs | 1 - utils/haddock | 2 +- validate | 6 - 208 files changed, 98 insertions(+), 16493 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc faee23bb69ca813296da484bc177f4480bcaee9f From git at git.haskell.org Sat Jun 2 21:27:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 21:27:22 +0000 (UTC) Subject: [commit: ghc] master: C codegen: print details of pprStatics panics (9ea4596) Message-ID: <20180602212722.E90A13ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9ea45963ad2ef2051ca3689562607eb4916d65e8/ghc >--------------------------------------------------------------- commit 9ea45963ad2ef2051ca3689562607eb4916d65e8 Author: Sergei Trofimovich Date: Sat Jun 2 21:08:06 2018 +0000 C codegen: print details of pprStatics panics Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 9ea45963ad2ef2051ca3689562607eb4916d65e8 compiler/cmm/PprC.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index f3f9d3c..e8f7144 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -540,11 +540,11 @@ pprStatics dflags (CmmStaticLit (CmmInt i W64) : rest) q = i `shiftR` 32 pprStatics dflags (CmmStaticLit (CmmInt _ w) : _) | w /= wordWidth dflags - = panic "pprStatics: cannot emit a non-word-sized static literal" + = pprPanic "pprStatics: cannot emit a non-word-sized static literal" (ppr w) pprStatics dflags (CmmStaticLit lit : rest) = pprLit1 lit : pprStatics dflags rest pprStatics _ (other : _) - = pprPanic "pprWord" (pprStatic other) + = pprPanic "pprStatics: other" (pprStatic other) pprStatic :: CmmStatic -> SDoc pprStatic s = case s of From git at git.haskell.org Sat Jun 2 23:05:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 23:05:16 +0000 (UTC) Subject: [commit: ghc] master: rts: Rip out support for STM invariants (a122d4f) Message-ID: <20180602230516.D74523ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a122d4fdd0a5858e44f9d3be90a258903e0288b2/ghc >--------------------------------------------------------------- commit a122d4fdd0a5858e44f9d3be90a258903e0288b2 Author: Ben Gamari Date: Sat Jun 2 11:48:39 2018 -0400 rts: Rip out support for STM invariants This feature has some very serious correctness issues (#14310), introduces a great deal of complexity, and hasn't seen wide usage. Consequently we are removing it, as proposed in Proposal #77 [1]. This is heavily based on a patch from fryguybob. Updates stm submodule. [1] https://github.com/ghc-proposals/ghc-proposals/pull/77 Test Plan: Validate Reviewers: erikd, simonmar, hvr Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14310 Differential Revision: https://phabricator.haskell.org/D4760 >--------------------------------------------------------------- a122d4fdd0a5858e44f9d3be90a258903e0288b2 compiler/prelude/primops.txt.pp | 7 - docs/users_guide/8.6.1-notes.rst | 5 + includes/Cmm.h | 1 - includes/rts/storage/Closures.h | 18 +- includes/stg/MiscClosures.h | 5 - libraries/base/GHC/Conc.hs | 2 - libraries/base/GHC/Conc/Sync.hs | 39 ----- libraries/base/changelog.md | 11 ++ libraries/stm | 2 +- rts/Capability.c | 1 - rts/Capability.h | 1 - rts/Exception.cmm | 5 - rts/PrimOps.cmm | 102 +++--------- rts/RtsSymbols.c | 1 - rts/STM.c | 347 +-------------------------------------- rts/STM.h | 13 -- rts/StgMiscClosures.cmm | 13 +- rts/sm/GC.c | 8 +- rts/sm/GC.h | 4 +- rts/sm/Scav.c | 4 - utils/deriveConstants/Main.hs | 7 - 21 files changed, 48 insertions(+), 548 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a122d4fdd0a5858e44f9d3be90a258903e0288b2 From git at git.haskell.org Sat Jun 2 23:05:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 2 Jun 2018 23:05:31 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Don't assume location of bash (e0f33a6) Message-ID: <20180602230531.2C24E3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0f33a6e6b3ab3d241cda7a60ffc92e543b06275/ghc >--------------------------------------------------------------- commit e0f33a6e6b3ab3d241cda7a60ffc92e543b06275 Author: Ben Gamari Date: Sat Jun 2 18:27:16 2018 -0400 testsuite: Don't assume location of bash >--------------------------------------------------------------- e0f33a6e6b3ab3d241cda7a60ffc92e543b06275 testsuite/tests/perf/compiler/genT14697 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/perf/compiler/genT14697 b/testsuite/tests/perf/compiler/genT14697 index e3fe4f4..73e8e93 100755 --- a/testsuite/tests/perf/compiler/genT14697 +++ b/testsuite/tests/perf/compiler/genT14697 @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash SIZE=100 ROOT=T14697 # Generates 100 empty modules and T14697 that imports them all From git at git.haskell.org Sun Jun 3 03:20:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:20:33 +0000 (UTC) Subject: [commit: ghc] master: Bump version of stm submodule back to 2.4 (7272566) Message-ID: <20180603032033.3A1A23ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/727256680c8547282bda09dffefba01f9db98d1e/ghc >--------------------------------------------------------------- commit 727256680c8547282bda09dffefba01f9db98d1e Author: Ben Gamari Date: Sat Jun 2 21:07:43 2018 -0400 Bump version of stm submodule back to 2.4 Haskeline doesn't have its upper bound lifted yet. >--------------------------------------------------------------- 727256680c8547282bda09dffefba01f9db98d1e libraries/stm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/stm b/libraries/stm index 8c4d0fa..b2af9b4 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit 8c4d0fabb15ad00beb1e15d027825c78b2c39881 +Subproject commit b2af9b4bb23cd2fc0b5d731b5614cdc90e7dda41 From git at git.haskell.org Sun Jun 3 03:21:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:21:20 +0000 (UTC) Subject: [commit: ghc] master: Extended the plugin system to run plugins on more representations (c2783cc) Message-ID: <20180603032120.4DAC33ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c2783ccf545faabd21a234a4dfc569cd856082b9/ghc >--------------------------------------------------------------- commit c2783ccf545faabd21a234a4dfc569cd856082b9 Author: Boldizsar Nemeth Date: Sat Jun 2 19:08:40 2018 -0400 Extended the plugin system to run plugins on more representations Extend GHC plugins to access parsed, type checked representation, interfaces that are loaded. And splices that are evaluated. The goal is to enable development tools to access the GHC representation in the pre-existing build environment. See the full proposal here: https://ghc.haskell.org/trac/ghc/wiki/ExtendedPluginsProposal Reviewers: goldfire, bgamari, ezyang, angerman, mpickering Reviewed By: mpickering Subscribers: ezyang, angerman, mpickering, ulysses4ever, rwbarton, thomie, carter GHC Trac Issues: #14709 Differential Revision: https://phabricator.haskell.org/D4342 >--------------------------------------------------------------- c2783ccf545faabd21a234a4dfc569cd856082b9 compiler/iface/LoadIface.hs | 5 +- compiler/main/HscMain.hs | 104 +++++++---- compiler/main/Plugins.hs | 69 ++++++- compiler/simplCore/CoreMonad.hs-boot | 37 ++++ compiler/typecheck/TcSplice.hs | 8 +- docs/users_guide/extending_ghc.rst | 203 +++++++++++++++++++++ testsuite/tests/plugins/Makefile | 28 +++ testsuite/tests/plugins/MetaRemoveHelper.hs | 6 + testsuite/tests/plugins/PluginFilteredExport.hs | 8 + testsuite/tests/plugins/QuasiQuotation.hs | 11 ++ testsuite/tests/plugins/all.T | 36 ++++ testsuite/tests/plugins/plugins04.stderr | 0 .../T12062/A.hs-boot => plugins/plugins09.hs} | 0 testsuite/tests/plugins/plugins09.stdout | 8 + testsuite/tests/plugins/plugins10.hs | 9 + testsuite/tests/plugins/plugins10.stdout | 18 ++ testsuite/tests/plugins/plugins11.hs | 2 + testsuite/tests/plugins/plugins11.stdout | 8 + testsuite/tests/plugins/plugins12.hs | 9 + testsuite/tests/plugins/plugins13.hs | 5 + testsuite/tests/plugins/plugins14.hs | 11 ++ testsuite/tests/plugins/plugins15.hs | 12 ++ .../plugins/simple-plugin/Simple/RemovePlugin.hs | 69 +++++++ .../plugins/simple-plugin/Simple/SourcePlugin.hs | 52 ++++++ .../plugins/simple-plugin/simple-plugin.cabal | 2 + 25 files changed, 673 insertions(+), 47 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c2783ccf545faabd21a234a4dfc569cd856082b9 From git at git.haskell.org Sun Jun 3 03:21:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:21:35 +0000 (UTC) Subject: [commit: ghc] master: Fix #13777 by improving the underdetermined CUSK error message (ac91d07) Message-ID: <20180603032135.A33963ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ac91d07399207f4e22467bea3577cafd27a937d7/ghc >--------------------------------------------------------------- commit ac91d07399207f4e22467bea3577cafd27a937d7 Author: Ryan Scott Date: Sat Jun 2 21:16:40 2018 -0400 Fix #13777 by improving the underdetermined CUSK error message The error message that GHC emits from underdetermined CUSKs is rather poor, since: 1. It may print an empty list of user-written variables if there are none in the declaration. 2. It may not mention any `forall`-bound, underdetermined variables in the result kind. To resolve these issues, this patch: 1. Doesn't bother printing a herald about user-written variables if there are none. 2. Prints the result kind to advertise any underdetermination it may exhibit. Test Plan: make test TEST=T13777 Reviewers: goldfire, bgamari Reviewed By: goldfire Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13777 Differential Revision: https://phabricator.haskell.org/D4771 >--------------------------------------------------------------- ac91d07399207f4e22467bea3577cafd27a937d7 compiler/typecheck/TcHsType.hs | 14 ++++++++++---- testsuite/tests/indexed-types/should_fail/T13777.hs | 14 ++++++++++++++ .../tests/indexed-types/should_fail/T13777.stderr | 20 ++++++++++++++++++++ testsuite/tests/indexed-types/should_fail/all.T | 1 + testsuite/tests/polykinds/T11648b.stderr | 1 + testsuite/tests/typecheck/should_fail/T14904a.stderr | 1 + 6 files changed, 47 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index d23ae23..2b2b64b 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1571,7 +1571,7 @@ kcLHsQTyVars name flav cusk -- fully settled down by this point, and so this check will get -- a false positive. ; when (not_associated && not (null meta_tvs)) $ - report_non_cusk_tvs (qkvs ++ tc_tvs) + report_non_cusk_tvs (qkvs ++ tc_tvs) res_kind -- If any of the scoped_kvs aren't actually mentioned in a binder's -- kind (or the return kind), then we're in the CUSK case from @@ -1643,7 +1643,7 @@ kcLHsQTyVars name flav cusk | otherwise = mkAnonTyConBinder tv - report_non_cusk_tvs all_tvs + report_non_cusk_tvs all_tvs res_kind = do { all_tvs <- mapM zonkTyCoVarKind all_tvs ; let (_, tidy_tvs) = tidyOpenTyCoVars emptyTidyEnv all_tvs (meta_tvs, other_tvs) = partition isMetaTyVar tidy_tvs @@ -1654,8 +1654,14 @@ kcLHsQTyVars name flav cusk isOrAre meta_tvs <+> text "undetermined:") 2 (vcat (map pp_tv meta_tvs)) , text "Perhaps add a kind signature." - , hang (text "Inferred kinds of user-written variables:") - 2 (vcat (map pp_tv other_tvs)) ] } + , ppUnless (null other_tvs) $ + hang (text "Inferred kinds of user-written variables:") + 2 (vcat (map pp_tv other_tvs)) + -- It's possible that the result kind contains + -- underdetermined, forall-bound variables which weren't + -- reported earier (see #13777). + , hang (text "Inferred result kind:") + 2 (ppr res_kind) ] } where pp_tv tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv) kcLHsQTyVars _ _ _ (XLHsQTyVars _) _ = panic "kcLHsQTyVars" diff --git a/testsuite/tests/indexed-types/should_fail/T13777.hs b/testsuite/tests/indexed-types/should_fail/T13777.hs new file mode 100644 index 0000000..bd6e859 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13777.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeInType #-} +module T13777 where + +import Data.Kind +import Data.Proxy + +data S :: forall k. Proxy k -> Type where + MkS :: S ('Proxy :: Proxy Maybe) + +data T (a :: b) :: forall c (d :: Type) e. + (forall f. Proxy f) -> Proxy c -> Proxy d -> Proxy e + -> Type where diff --git a/testsuite/tests/indexed-types/should_fail/T13777.stderr b/testsuite/tests/indexed-types/should_fail/T13777.stderr new file mode 100644 index 0000000..b920991 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13777.stderr @@ -0,0 +1,20 @@ + +T13777.hs:9:1: error: + You have written a *complete user-suppled kind signature*, + but the following variable is undetermined: k0 :: * + Perhaps add a kind signature. + Inferred result kind: forall (k :: k0). Proxy k -> * + +T13777.hs:12:1: error: + You have written a *complete user-suppled kind signature*, + but the following variables are undetermined: + k0 :: * + k1 :: * + k2 :: * + Perhaps add a kind signature. + Inferred kinds of user-written variables: + b :: * + a :: b + Inferred result kind: + forall (c :: k2) d (e :: k1). + (forall (f :: k0). Proxy f) -> Proxy c -> Proxy d -> Proxy e -> * diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index ef5eee2..f69bce8 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -134,6 +134,7 @@ test('T7102', [ expect_broken(7102) ], ghci_script, ['T7102.script']) test('T7102a', normal, ghci_script, ['T7102a.script']) test('T13271', normal, compile_fail, ['']) test('T13674', normal, compile_fail, ['']) +test('T13777', normal, compile_fail, ['']) test('T13784', normal, compile_fail, ['']) test('T13877', normal, compile_fail, ['']) test('T13972', normal, compile_fail, ['']) diff --git a/testsuite/tests/polykinds/T11648b.stderr b/testsuite/tests/polykinds/T11648b.stderr index e709e00..cbe9263 100644 --- a/testsuite/tests/polykinds/T11648b.stderr +++ b/testsuite/tests/polykinds/T11648b.stderr @@ -6,3 +6,4 @@ T11648b.hs:7:1: error: Inferred kinds of user-written variables: k :: k0 a :: Proxy k + Inferred result kind: * diff --git a/testsuite/tests/typecheck/should_fail/T14904a.stderr b/testsuite/tests/typecheck/should_fail/T14904a.stderr index 61be519..603ecb5 100644 --- a/testsuite/tests/typecheck/should_fail/T14904a.stderr +++ b/testsuite/tests/typecheck/should_fail/T14904a.stderr @@ -6,6 +6,7 @@ T14904a.hs:8:1: error: Inferred kinds of user-written variables: g :: k0 -> * f :: forall (a :: k0). g a + Inferred result kind: * T14904a.hs:9:6: error: • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ From git at git.haskell.org Sun Jun 3 03:21:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:21:50 +0000 (UTC) Subject: [commit: ghc] master: Check for singletons when creating Bag/OrdList from a list. (18cb4f5) Message-ID: <20180603032150.55E0C3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18cb4f5e1b88aef7770446a354bfcc1e0a075e89/ghc >--------------------------------------------------------------- commit 18cb4f5e1b88aef7770446a354bfcc1e0a075e89 Author: klebinger.andreas at gmx.at Date: Sat Jun 2 21:18:19 2018 -0400 Check for singletons when creating Bag/OrdList from a list. This gives us `One x` instead of `Many (x : [])` reducing overhead. For compiling spectral/simple with -O0 difference was ~ -0.05% allocations. The only drawback is that something like toOL (x:panic "") will now panic. But that seems like a reasonable tradeoff. Test Plan: ci, looking at +RTS -s Reviewers: bgamari, jmct Reviewed By: bgamari Subscribers: jmct, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4770 >--------------------------------------------------------------- 18cb4f5e1b88aef7770446a354bfcc1e0a075e89 compiler/utils/Bag.hs | 1 + compiler/utils/OrdList.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/compiler/utils/Bag.hs b/compiler/utils/Bag.hs index 727d1c5..41c8039 100644 --- a/compiler/utils/Bag.hs +++ b/compiler/utils/Bag.hs @@ -328,6 +328,7 @@ mapAccumBagLM f s (ListBag xs) = do { (s', xs') <- mapAccumLM f s xs listToBag :: [a] -> Bag a listToBag [] = EmptyBag +listToBag [x] = UnitBag x listToBag vs = ListBag vs bagToList :: Bag a -> [a] diff --git a/compiler/utils/OrdList.hs b/compiler/utils/OrdList.hs index 081210a..a573976 100644 --- a/compiler/utils/OrdList.hs +++ b/compiler/utils/OrdList.hs @@ -122,4 +122,5 @@ foldlOL k z (Many xs) = foldl k z xs toOL :: [a] -> OrdList a toOL [] = None +toOL [x] = One x toOL xs = Many xs From git at git.haskell.org Sun Jun 3 03:22:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:22:05 +0000 (UTC) Subject: [commit: ghc] master: Fix #15214 by listing (~) in isBuiltInOcc_maybe (21e9d4f) Message-ID: <20180603032205.8362A3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21e9d4f5f67dca22fbe3495f637347c5a8f7b52c/ghc >--------------------------------------------------------------- commit 21e9d4f5f67dca22fbe3495f637347c5a8f7b52c Author: Ryan Scott Date: Sat Jun 2 21:18:43 2018 -0400 Fix #15214 by listing (~) in isBuiltInOcc_maybe This changes an obscure error (which mistakenly mentions Template Haskell) to one that makes more sense. Test Plan: make test TEST=T15214 Reviewers: bgamari, mpickering Reviewed By: bgamari, mpickering Subscribers: mpickering, rwbarton, thomie, carter GHC Trac Issues: #15214 Differential Revision: https://phabricator.haskell.org/D4768 >--------------------------------------------------------------- 21e9d4f5f67dca22fbe3495f637347c5a8f7b52c compiler/prelude/TysWiredIn.hs | 3 +++ testsuite/tests/rename/should_fail/T15214.hs | 4 ++++ testsuite/tests/rename/should_fail/T15214.stderr | 2 ++ testsuite/tests/rename/should_fail/all.T | 1 + 4 files changed, 10 insertions(+) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 0817a75..9ba2f1f 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -679,6 +679,9 @@ isBuiltInOcc_maybe occ = "[]" -> Just $ choose_ns listTyConName nilDataConName ":" -> Just consDataConName + -- equality tycon + "~" -> Just eqTyConName + -- boxed tuple data/tycon "()" -> Just $ tup_name Boxed 0 _ | Just rest <- "(" `BS.stripPrefix` name diff --git a/testsuite/tests/rename/should_fail/T15214.hs b/testsuite/tests/rename/should_fail/T15214.hs new file mode 100644 index 0000000..55f1559 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15214.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeOperators #-} +module T15214 where + +type (~) = Either diff --git a/testsuite/tests/rename/should_fail/T15214.stderr b/testsuite/tests/rename/should_fail/T15214.stderr new file mode 100644 index 0000000..399438a --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15214.stderr @@ -0,0 +1,2 @@ + +T15214.hs:4:1: error: Illegal binding of built-in syntax: ~ diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index fb53d33..413b24f 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -130,3 +130,4 @@ test('T13947', normal, compile_fail, ['']) test('T13847', normal, multimod_compile_fail, ['T13847','-v0']) test('T14307', normal, compile_fail, ['']) test('T14591', normal, compile_fail, ['']) +test('T15214', normal, compile_fail, ['']) From git at git.haskell.org Sun Jun 3 03:22:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:22:20 +0000 (UTC) Subject: [commit: ghc] master: rts: Query system rlimit for maximum address-space size (2627377) Message-ID: <20180603032220.213403ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/26273774661bd0780b1ae8f0755ea135a0ceaf92/ghc >--------------------------------------------------------------- commit 26273774661bd0780b1ae8f0755ea135a0ceaf92 Author: Ben Gamari Date: Sat Jun 2 21:22:52 2018 -0400 rts: Query system rlimit for maximum address-space size When we attempt to reserve the heap, we query the system's rlimit to establish the starting point for our search over sizes. Test Plan: Validate Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14492 Differential Revision: https://phabricator.haskell.org/D4754 >--------------------------------------------------------------- 26273774661bd0780b1ae8f0755ea135a0ceaf92 rts/posix/OSMem.c | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 9ae9a4b..479ae9d 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -36,6 +36,10 @@ #if defined(HAVE_NUMAIF_H) #include #endif +#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H) +#include +#include +#endif #include @@ -502,6 +506,13 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len) (void*)startAddress, (void*)minimumAddress); } +#if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H) + struct rlimit limit; + if (!getrlimit(RLIMIT_AS, &limit) && *len > limit.rlim_cur) { + *len = limit.rlim_cur; + } +#endif + attempt = 0; while (1) { if (*len < MBLOCK_SIZE) { From git at git.haskell.org Sun Jun 3 03:22:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:22:34 +0000 (UTC) Subject: [commit: ghc] master: Handle abi-depends correctly in ghc-pkg (1626fe6) Message-ID: <20180603032234.D23303ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1626fe600672d3dabcf95d11a6c16da5f5ec1068/ghc >--------------------------------------------------------------- commit 1626fe600672d3dabcf95d11a6c16da5f5ec1068 Author: Tobias Dammers Date: Sat Jun 2 21:23:21 2018 -0400 Handle abi-depends correctly in ghc-pkg When inferring the correct abi-depends, we now look at all the package databases in the stack, up to and including the current one, because these are the ones that the current package can legally depend on. While doing so, we will issue warnings: - In verbose mode, we warn about every package that declares abi-depends:, whether we actually end up overriding them with the inferred ones or not ("possibly broken abi-depends"). - Otherwise, we only warn about packages whose declared abi-depends does not match what we inferred ("definitely broken abi-depends"). Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14381 Differential Revision: https://phabricator.haskell.org/D4729 >--------------------------------------------------------------- 1626fe600672d3dabcf95d11a6c16da5f5ec1068 testsuite/tests/cabal/cabal05/cabal05.stderr | 4 + .../tests/safeHaskell/check/pkg01/safePkg01.stdout | 16 +-- utils/ghc-pkg/Main.hs | 142 ++++++++++++++++++--- 3 files changed, 139 insertions(+), 23 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1626fe600672d3dabcf95d11a6c16da5f5ec1068 From git at git.haskell.org Sun Jun 3 03:22:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 03:22:49 +0000 (UTC) Subject: [commit: ghc] master: Remove ~# from surface syntax (5b82ee6) Message-ID: <20180603032249.9DD2C3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5b82ee695e1dbbe355c775e265521c4c3ee8cdbb/ghc >--------------------------------------------------------------- commit 5b82ee695e1dbbe355c775e265521c4c3ee8cdbb Author: David Feuer Date: Sat Jun 2 21:24:04 2018 -0400 Remove ~# from surface syntax For some reason, it seems that the `ConstraintKinds` commit introduced `~#` into Haskell syntax, in a pretty broken manner. Unless and until we have an actual story for unboxed equality, it doesn't make sense to expose it. Moreover, the way it was donet was wrong enough and small enough that it will probably be easier to start over if we do that. Yank it out. Reviewers: bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: RyanGlScott, rwbarton, thomie, mpickering, carter GHC Trac Issues: #15209 Differential Revision: https://phabricator.haskell.org/D4763 >--------------------------------------------------------------- 5b82ee695e1dbbe355c775e265521c4c3ee8cdbb compiler/basicTypes/RdrName.hs | 2 +- compiler/parser/ApiAnnotation.hs | 3 +-- compiler/parser/Lexer.x | 2 -- compiler/parser/Parser.y | 3 --- 4 files changed, 2 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 61ab1a9..bc90daf 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -112,7 +112,7 @@ import Data.List( sortBy, foldl', nub ) -- 'ApiAnnotation.AnnOpen' @'('@ or @'['@ or @'[:'@, -- 'ApiAnnotation.AnnClose' @')'@ or @']'@ or @':]'@,, -- 'ApiAnnotation.AnnBackquote' @'`'@, --- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnTildehsh', +-- 'ApiAnnotation.AnnVal' -- 'ApiAnnotation.AnnTilde', -- For details on above see note [Api annotations] in ApiAnnotation diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/parser/ApiAnnotation.hs index 282d390..4d1758f 100644 --- a/compiler/parser/ApiAnnotation.hs +++ b/compiler/parser/ApiAnnotation.hs @@ -280,7 +280,6 @@ data AnnKeywordId | AnnThIdTySplice -- ^ '$$' | AnnThTyQuote -- ^ double ''' | AnnTilde -- ^ '~' - | AnnTildehsh -- ^ '~#' | AnnType | AnnUnit -- ^ '()' for types | AnnUsing @@ -322,7 +321,7 @@ instance Outputable AnnotationComment where -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma', --- 'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnTildehsh', +-- 'ApiAnnotation.AnnRarrow' -- 'ApiAnnotation.AnnTilde' -- - May have 'ApiAnnotation.AnnComma' when in a list type LRdrName = Located RdrName diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index fc8b988..006facc 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -678,7 +678,6 @@ data Token | ITrarrow IsUnicodeSyntax | ITat | ITtilde - | ITtildehsh | ITdarrow IsUnicodeSyntax | ITminus | ITbang @@ -888,7 +887,6 @@ reservedSymsFM = listToUFM $ ,("->", ITrarrow NormalSyntax, always) ,("@", ITat, always) ,("~", ITtilde, always) - ,("~#", ITtildehsh, magicHashEnabled) ,("=>", ITdarrow NormalSyntax, always) ,("-", ITminus, always) ,("!", ITbang, always) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 533e21d..af8c95f 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -522,7 +522,6 @@ are the most common patterns, rewritten as regular expressions for clarity: '->' { L _ (ITrarrow _) } '@' { L _ ITat } '~' { L _ ITtilde } - '~#' { L _ ITtildehsh } '=>' { L _ (ITdarrow _) } '-' { L _ ITminus } '!' { L _ ITbang } @@ -3119,8 +3118,6 @@ ntgtycon :: { Located RdrName } -- A "general" qualified tycon, excluding unit | '(' '->' ')' {% ams (sLL $1 $> $ getRdrName funTyCon) [mop $1,mu AnnRarrow $2,mcp $3] } | '[' ']' {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] } - | '(' '~#' ')' {% ams (sLL $1 $> $ getRdrName eqPrimTyCon) - [mop $1,mj AnnTildehsh $2,mcp $3] } oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon; -- These can appear in export lists From git at git.haskell.org Sun Jun 3 04:30:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 04:30:21 +0000 (UTC) Subject: [commit: ghc] master: Fix a bad interaction between GADTs and COMPLETE sets (4d80044) Message-ID: <20180603043021.28DD63ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d8004483387c087f5132736863d895ae4869163/ghc >--------------------------------------------------------------- commit 4d8004483387c087f5132736863d895ae4869163 Author: Ryan Scott Date: Sat Jun 2 23:22:54 2018 -0400 Fix a bad interaction between GADTs and COMPLETE sets As observed in #14059 (starting at comment 5), the error messages surrounding a program involving GADTs and a `COMPLETE` set became worse between 8.2 and 8.4. The culprit was a new validity check in 8.4 which filters out `COMPLETE` set candidates if a return type of any conlike in the set doesn't match the type of the scrutinee. However, this check was too conservative, since it removed perfectly valid `COMPLETE` sets that contained GADT constructors, which quite often have return types that don't match the type of a scrutinee. To fix this, I adopted the most straightforward possible solution of only performing this validity check on //pattern synonym// constructors, not //data// constructors. Note that this does not fix #14059 entirely, but instead simply fixes a particular buglet that was discovered in that ticket. Test Plan: make test TEST=T14059 Reviewers: bgamari, mpickering Reviewed By: mpickering Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14059 Differential Revision: https://phabricator.haskell.org/D4752 >--------------------------------------------------------------- 4d8004483387c087f5132736863d895ae4869163 compiler/deSugar/Check.hs | 67 ++++++++++++++++++++-- testsuite/tests/pmcheck/complete_sigs/T14059a.hs | 23 ++++++++ .../tests/pmcheck/complete_sigs/T14059a.stderr | 8 +++ testsuite/tests/pmcheck/complete_sigs/all.T | 1 + 4 files changed, 94 insertions(+), 5 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index d5449f3..a776abe 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -40,6 +40,7 @@ import Util import Outputable import FastString import DataCon +import PatSyn import HscTypes (CompleteMatch(..)) import DsMonad @@ -1313,13 +1314,69 @@ allCompleteMatches cl tys = do let final_groups = fam ++ from_pragma return final_groups where - -- Check that all the pattern types in a `COMPLETE` - -- pragma subsume the type we're matching. See #14135. + -- Check that all the pattern synonym return types in a `COMPLETE` + -- pragma subsume the type we're matching. + -- See Note [Filtering out non-matching COMPLETE sets] isValidCompleteMatch :: Type -> [ConLike] -> Bool - isValidCompleteMatch ty = - isJust . mapM (flip tcMatchTy ty . resTy . conLikeFullSig) + isValidCompleteMatch ty = all go where - resTy (_, _, _, _, _, _, res_ty) = res_ty + go (RealDataCon {}) = True + go (PatSynCon psc) = isJust $ flip tcMatchTy ty $ patSynResTy + $ patSynSig psc + + patSynResTy (_, _, _, _, _, res_ty) = res_ty + +{- +Note [Filtering out non-matching COMPLETE sets] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Currently, conlikes in a COMPLETE set are simply grouped by the +type constructor heading the return type. This is nice and simple, but it does +mean that there are scenarios when a COMPLETE set might be incompatible with +the type of a scrutinee. For instance, consider (from #14135): + + data Foo a = Foo1 a | Foo2 a + + pattern MyFoo2 :: Int -> Foo Int + pattern MyFoo2 i = Foo2 i + + {-# COMPLETE Foo1, MyFoo2 #-} + + f :: Foo a -> a + f (Foo1 x) = x + +`f` has an incomplete pattern-match, so when choosing which constructors to +report as unmatched in a warning, GHC must choose between the original set of +data constructors {Foo1, Foo2} and the COMPLETE set {Foo1, MyFoo2}. But observe +that GHC shouldn't even consider the COMPLETE set as a possibility: the return +type of MyFoo2, Foo Int, does not match the type of the scrutinee, Foo a, since +there's no substitution `s` such that s(Foo Int) = Foo a. + +To ensure that GHC doesn't pick this COMPLETE set, it checks each pattern +synonym constructor's return type matches the type of the scrutinee, and if one +doesn't, then we remove the whole COMPLETE set from consideration. + +One might wonder why GHC only checks /pattern synonym/ constructors, and not +/data/ constructors as well. The reason is because that the type of a +GADT constructor very well may not match the type of a scrutinee, and that's +OK. Consider this example (from #14059): + + data SBool (z :: Bool) where + SFalse :: SBool False + STrue :: SBool True + + pattern STooGoodToBeTrue :: forall (z :: Bool). () + => z ~ True + => SBool z + pattern STooGoodToBeTrue = STrue + {-# COMPLETE SFalse, STooGoodToBeTrue #-} + + wobble :: SBool z -> Bool + wobble STooGoodToBeTrue = True + +In the incomplete pattern match for `wobble`, we /do/ want to warn that SFalse +should be matched against, even though its type, SBool False, does not match +the scrutinee type, SBool z. +-} -- ----------------------------------------------------------------------- -- * Types and constraints diff --git a/testsuite/tests/pmcheck/complete_sigs/T14059a.hs b/testsuite/tests/pmcheck/complete_sigs/T14059a.hs new file mode 100644 index 0000000..6128a8b --- /dev/null +++ b/testsuite/tests/pmcheck/complete_sigs/T14059a.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module T14059a where + +data SBool (z :: Bool) where + SFalse :: SBool False + STrue :: SBool True + +pattern STooGoodToBeTrue :: forall (z :: Bool). () + => z ~ True + => SBool z +pattern STooGoodToBeTrue = STrue +{-# COMPLETE SFalse, STooGoodToBeTrue #-} + +wibble :: SBool z -> Bool +wibble STrue = True + +wobble :: SBool z -> Bool +wobble STooGoodToBeTrue = True diff --git a/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr b/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr new file mode 100644 index 0000000..4a52c97 --- /dev/null +++ b/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr @@ -0,0 +1,8 @@ + +T14059a.hs:20:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘wibble’: Patterns not matched: SFalse + +T14059a.hs:23:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘wobble’: Patterns not matched: SFalse diff --git a/testsuite/tests/pmcheck/complete_sigs/all.T b/testsuite/tests/pmcheck/complete_sigs/all.T index 7e47877..d58c182 100644 --- a/testsuite/tests/pmcheck/complete_sigs/all.T +++ b/testsuite/tests/pmcheck/complete_sigs/all.T @@ -13,4 +13,5 @@ test('completesig12', normal, compile, ['']) test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) +test('T14059a', normal, compile, ['']) test('T14253', expect_broken(14253), compile, ['']) From git at git.haskell.org Sun Jun 3 04:30:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 04:30:35 +0000 (UTC) Subject: [commit: ghc] master: Turn "inaccessible code" error into a warning (08073e1) Message-ID: <20180603043035.DB8913ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/08073e16cf672d8009309e4e55d4566af1ecaff4/ghc >--------------------------------------------------------------- commit 08073e16cf672d8009309e4e55d4566af1ecaff4 Author: Tobias Dammers Date: Sat Jun 2 23:23:22 2018 -0400 Turn "inaccessible code" error into a warning With GADTs, it is possible to write programs such that the type constraints make some code branches inaccessible. Take, for example, the following program :: {-# LANGUAGE GADTs #-} data Foo a where Foo1 :: Foo Char Foo2 :: Foo Int data TyEquality a b where Refl :: TyEquality a a checkTEQ :: Foo t -> Foo u -> Maybe (TyEquality t u) checkTEQ x y = error "unimportant" step2 :: Bool step2 = case checkTEQ Foo1 Foo2 of Just Refl -> True -- Inaccessible code Nothing -> False Clearly, the `Just Refl` case cannot ever be reached, because the `Foo1` and `Foo2` constructors say `t ~ Char` and `u ~ Int`, while the `Refl` constructor essentially mandates `t ~ u`, and thus `Char ~ Int`. Previously, GHC would reject such programs entirely; however, in practice this is too harsh. Accepting such code does little harm, since attempting to use the "impossible" code will still produce errors down the chain, while rejecting it means we cannot legally write or generate such code at all. Hence, we turn the error into a warning, and provide `-Winaccessible-code` to control GHC's behavior upon encountering this situation. Test Plan: ./validate Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #11066 Differential Revision: https://phabricator.haskell.org/D4744 >--------------------------------------------------------------- 08073e16cf672d8009309e4e55d4566af1ecaff4 compiler/main/DynFlags.hs | 5 ++- compiler/typecheck/TcErrors.hs | 2 +- docs/users_guide/using-warnings.rst | 38 ++++++++++++++++++++++ testsuite/tests/gadt/T3651.stderr | 27 ++++++--------- testsuite/tests/gadt/T7293.stderr | 6 +++- testsuite/tests/gadt/T7294.stderr | 2 +- testsuite/tests/gadt/T7558.stderr | 13 ++++---- testsuite/tests/gadt/all.T | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 2 +- .../typecheck/should_fail/FrozenErrorTests.stderr | 9 ----- testsuite/tests/typecheck/should_fail/all.T | 2 +- .../tests/typecheck/should_fail/tcfail167.stderr | 6 +++- .../tests/typecheck/should_run/Typeable1.stderr | 2 +- testsuite/tests/typecheck/should_run/all.T | 2 +- 14 files changed, 75 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 08073e16cf672d8009309e4e55d4566af1ecaff4 From git at git.haskell.org Sun Jun 3 04:30:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 04:30:50 +0000 (UTC) Subject: [commit: ghc] master: tcExtendTyVarEnv2 changed to tcExtendNameTyVarEnv (9b7eec8) Message-ID: <20180603043050.7DBDE3ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9b7eec8614f531e20a34e8dd2f62293ab0fedf8c/ghc >--------------------------------------------------------------- commit 9b7eec8614f531e20a34e8dd2f62293ab0fedf8c Author: Alanas Plascinskas Date: Sat Jun 2 23:23:48 2018 -0400 tcExtendTyVarEnv2 changed to tcExtendNameTyVarEnv Reviewers: mpickering, goldfire, bgamari Reviewed By: mpickering Subscribers: goldfire, rwbarton, thomie, carter GHC Trac Issues: #15017 Differential Revision: https://phabricator.haskell.org/D4732 >--------------------------------------------------------------- 9b7eec8614f531e20a34e8dd2f62293ab0fedf8c compiler/typecheck/TcBinds.hs | 6 +++--- compiler/typecheck/TcEnv.hs | 8 ++++---- compiler/typecheck/TcExpr.hs | 6 +++--- compiler/typecheck/TcHsType.hs | 6 +++--- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcPat.hs | 6 +++--- compiler/typecheck/TcRules.hs | 2 +- 7 files changed, 18 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9b7eec8614f531e20a34e8dd2f62293ab0fedf8c From git at git.haskell.org Sun Jun 3 05:40:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 05:40:30 +0000 (UTC) Subject: [commit: ghc] master: Allow aligning of cmm procs at specific boundry (f68c2cb) Message-ID: <20180603054030.3EA093ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f68c2cb60f881a0a41ae2e8cafc5de193ef9c3fb/ghc >--------------------------------------------------------------- commit f68c2cb60f881a0a41ae2e8cafc5de193ef9c3fb Author: klebinger.andreas at gmx.at Date: Sun Jun 3 00:37:59 2018 -0400 Allow aligning of cmm procs at specific boundry Allows to align CmmProcs at the given boundries. It makes performance usually worse but can be helpful to limit the effect of a unrelated function B becoming faster/slower after changing function A. Test Plan: ci, using it. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15148 Differential Revision: https://phabricator.haskell.org/D4706 >--------------------------------------------------------------- f68c2cb60f881a0a41ae2e8cafc5de193ef9c3fb compiler/main/DynFlags.hs | 7 +++++++ compiler/nativeGen/X86/Ppr.hs | 7 +++++++ docs/users_guide/debugging.rst | 11 +++++++++++ 3 files changed, 25 insertions(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index b9141f9..b2c82fa 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -876,6 +876,8 @@ data DynFlags = DynFlags { floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating -- See CoreMonad.FloatOutSwitches + cmmProcAlignment :: Maybe Int, -- ^ Align Cmm functions at this boundry or use default. + historySize :: Int, -- ^ Simplification history size importPaths :: [FilePath], @@ -1758,6 +1760,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) = specConstrRecursive = 3, liberateCaseThreshold = Just 2000, floatLamArgs = Just 0, -- Default: float only if no fvs + cmmProcAlignment = Nothing, historySize = 20, strictnessBefore = [], @@ -3397,6 +3400,10 @@ dynamic_flags_deps = [ (intSuffix (\n d -> d { floatLamArgs = Just n })) , make_ord_flag defFlag "ffloat-all-lams" (noArg (\d -> d { floatLamArgs = Nothing })) + , make_ord_flag defFlag "fproc-alignment" + (intSuffix (\n d -> d { cmmProcAlignment = Just n })) + + , make_ord_flag defFlag "fhistory-size" (intSuffix (\n d -> d { historySize = n })) , make_ord_flag defFlag "funfolding-creation-threshold" diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index c03bf4f..c5fbeb5 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -73,12 +73,17 @@ import Data.Bits -- .subsections_via_symbols and -dead_strip can be found at -- +pprProcAlignment :: SDoc +pprProcAlignment = sdocWithDynFlags $ \dflags -> + (maybe empty pprAlign . cmmProcAlignment $ dflags) + pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc pprNatCmmDecl (CmmData section dats) = pprSectionAlign section $$ pprDatas dats pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = sdocWithDynFlags $ \dflags -> + pprProcAlignment $$ case topInfoTable proc of Nothing -> case blocks of @@ -86,6 +91,7 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprLabel lbl blocks -> -- special case for code without info table: pprSectionAlign (Section Text lbl) $$ + pprProcAlignment $$ pprLabel lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock top_info) blocks) $$ (if debugLevel dflags > 0 @@ -95,6 +101,7 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = Just (Statics info_lbl _) -> sdocWithPlatform $ \platform -> pprSectionAlign (Section Text info_lbl) $$ + pprProcAlignment $$ (if platformHasSubsectionsViaSymbols platform then ppr (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index 4e0be93..7adcc84 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -758,6 +758,17 @@ Checking for consistency Compile with alignment checks for all info table dereferences. This can be useful when finding pointer tagging issues. +.. ghc-flag:: -fproc-alignment + :shortdesc: Align functions at given boundry. + :type: dynamic + + Align functions to multiples of the given value. Only valid values are powers + of two. + + ``-fproc-alignment=64`` can be used to limit alignment impact on performance + as each function will start at a cache line. + However forcing larger alignments in general reduces performance. + .. ghc-flag:: -fcatch-bottoms :shortdesc: Insert ``error`` expressions after bottoming expressions; useful when debugging the compiler. From git at git.haskell.org Sun Jun 3 05:40:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 05:40:46 +0000 (UTC) Subject: [commit: ghc] master: Improve exhaustiveness checking for literal values and patterns, fix #14546 (1f88f54) Message-ID: <20180603054046.35DB03ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f88f541aad1e36d01f22f9e71dfbc247e6558e2/ghc >--------------------------------------------------------------- commit 1f88f541aad1e36d01f22f9e71dfbc247e6558e2 Author: HE, Tao Date: Sun Jun 3 00:38:30 2018 -0400 Improve exhaustiveness checking for literal values and patterns, fix #14546 Currently, we parse both the **integral literal** value and the patterns as `OverLit HsIntegral`. For example: ``` case 0::Int of 0 -> putStrLn "A" 1 -> putStrLn "B" _ -> putStrLn "C" ``` When checking the exhaustiveness of pattern matching, we translate the `0` in value position as `PmOLit`, but translate the `0` and `1` in pattern position as `PmSLit`. The inconsistency leads to the failure of `eqPmLit` to detect the equality and report warning of "Pattern match is redundant" on pattern `0`, as reported in #14546. In this patch we remove the specialization of `OverLit` patterns, and keep the overloaded number literal in pattern as it is to maintain the consistency. Now we can capture the exhaustiveness of pattern `0` and the redundancy of pattern `1` and `_`. For **string literals**, we parse the string literals as `HsString`. When `OverloadedStrings` is enabled, it further be turned as `HsOverLit HsIsString`, whether it's type is `String` or not. For example: ``` case "foo" of "foo" -> putStrLn "A" "bar" -> putStrLn "B" "baz" -> putStrLn "C" ``` Previously, the overloaded string values are translated to `PmOLit` and the non-overloaded string values are translated to `PmSLit`. However the string patterns, both overloaded and non-overloaded, are translated to list of characters. The inconsistency leads to wrong warnings about redundant and non-exhaustive pattern matching warnings, as reported in #14546. In order to catch the redundant pattern in following case: ``` case "foo" of ('f':_) -> putStrLn "A" "bar" -> putStrLn "B" ``` In this patch, we translate non-overloaded string literals, both in value position and pattern position, as list of characters. For overloaded string literals, we only translate it to list of characters only when it's type is `stringTy`, since we know nothing about the `toString` methods. But we know that if two overloaded strings are syntax equal, then they are equal. Then if it's type is not `stringTy`, we just translate it to `PmOLit`. We can still capture the exhaustiveness of pattern `"foo"` and the redundancy of pattern `"bar"` and `"baz"` in the following code: ``` {-# LANGUAGE OverloadedStrings #-} main = do case "foo" of "foo" -> putStrLn "A" "bar" -> putStrLn "B" "baz" -> putStrLn "C" ``` Test Plan: make test TEST="T14546" Reviewers: bgamari, simonpj Reviewed By: bgamari, simonpj Subscribers: simonpj, thomie, carter GHC Trac Issues: #14546 Differential Revision: https://phabricator.haskell.org/D4571 >--------------------------------------------------------------- 1f88f541aad1e36d01f22f9e71dfbc247e6558e2 compiler/deSugar/Check.hs | 163 ++++++++++++++------- compiler/deSugar/Match.hs | 2 +- compiler/deSugar/MatchLit.hs | 13 +- compiler/deSugar/PmExpr.hs | 35 ++++- testsuite/tests/deSugar/should_compile/T14546a.hs | 29 ++++ .../tests/deSugar/should_compile/T14546a.stderr | 56 +++++++ testsuite/tests/deSugar/should_compile/T14546b.hs | 11 ++ .../tests/deSugar/should_compile/T14546b.stderr | 16 ++ testsuite/tests/deSugar/should_compile/T14546c.hs | 20 +++ .../tests/deSugar/should_compile/T14546c.stderr | 24 +++ testsuite/tests/deSugar/should_compile/all.T | 3 + .../tests/simplCore/should_compile/T9400.stderr | 8 + 12 files changed, 308 insertions(+), 72 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 1f88f541aad1e36d01f22f9e71dfbc247e6558e2 From git at git.haskell.org Sun Jun 3 08:09:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 08:09:59 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in OverloadedLabels docs (6128037) Message-ID: <20180603080959.480793ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/61280373f4531e87e8429f21cc6f72aa7182d139/ghc >--------------------------------------------------------------- commit 61280373f4531e87e8429f21cc6f72aa7182d139 Author: Joachim Breitner Date: Sun Jun 3 10:09:15 2018 +0200 Fix typo in OverloadedLabels docs as helpfully reported by elpinal (#15217). >--------------------------------------------------------------- 61280373f4531e87e8429f21cc6f72aa7182d139 docs/users_guide/glasgow_exts.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index b00d75f..8b99d62 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -6939,7 +6939,7 @@ Overloaded labels GHC supports *overloaded labels*, a form of identifier whose interpretation may depend both on its type and on its literal text. When the -:extension:`OverloadedLabels` extension is enabled, an overloaded label can written +:extension:`OverloadedLabels` extension is enabled, an overloaded label can be written with a prefix hash, for example ``#foo``. The type of this expression is ``IsLabel "foo" a => a``. From git at git.haskell.org Sun Jun 3 11:49:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 11:49:31 +0000 (UTC) Subject: [commit: ghc] master: Add tests for #8128 and #8740 (90e99c4) Message-ID: <20180603114931.2B2573ABA1@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/90e99c4cfd601601e56fc6041186ca3e070408d9/ghc >--------------------------------------------------------------- commit 90e99c4cfd601601e56fc6041186ca3e070408d9 Author: Ryan Scott Date: Sun Jun 3 07:47:51 2018 -0400 Add tests for #8128 and #8740 Commit 08073e16cf672d8009309e4e55d4566af1ecaff4 (#11066) ended up fixing these, fortunately enough. >--------------------------------------------------------------- 90e99c4cfd601601e56fc6041186ca3e070408d9 testsuite/tests/deriving/should_compile/T8128.hs | 9 +++++++++ testsuite/tests/deriving/should_compile/T8128.stderr | 14 ++++++++++++++ testsuite/tests/deriving/should_compile/T8740.hs | 17 +++++++++++++++++ testsuite/tests/deriving/should_compile/T8740.stderr | 18 ++++++++++++++++++ testsuite/tests/deriving/should_compile/all.T | 2 ++ 5 files changed, 60 insertions(+) diff --git a/testsuite/tests/deriving/should_compile/T8128.hs b/testsuite/tests/deriving/should_compile/T8128.hs new file mode 100644 index 0000000..624702e --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8128.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneDeriving, GADTs, FlexibleInstances #-} + +module T8128 where + +data T a where + MkT1 :: T Int + MkT2 :: Bool -> T Bool + +deriving instance Show (T Int) diff --git a/testsuite/tests/deriving/should_compile/T8128.stderr b/testsuite/tests/deriving/should_compile/T8128.stderr new file mode 100644 index 0000000..5f8b130 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8128.stderr @@ -0,0 +1,14 @@ + +T8128.hs:9:1: warning: [-Winaccessible-code (in -Wdefault)] + • Couldn't match type ‘Int’ with ‘Bool’ + Inaccessible code in + a pattern with constructor: MkT2 :: Bool -> T Bool, + in an equation for ‘showsPrec’ + • In the pattern: MkT2 b1 + In an equation for ‘showsPrec’: + showsPrec a (MkT2 b1) + = showParen (a >= 11) ((.) (showString "MkT2 ") (showsPrec 11 b1)) + When typechecking the code for ‘showsPrec’ + in a derived instance for ‘Show (T Int)’: + To see the code I am typechecking, use -ddump-deriv + In the instance declaration for ‘Show (T Int)’ diff --git a/testsuite/tests/deriving/should_compile/T8740.hs b/testsuite/tests/deriving/should_compile/T8740.hs new file mode 100644 index 0000000..95a114c --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8740.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} +module T8740 where + +data Abstract +data Reified +data Player + +data Elect p a where + ElectRefAsTypeOf :: Int -> Elect Abstract a -> Elect Abstract a + ElectHandle :: a -> Elect Reified a + Controller :: Elect Abstract Player + Owner :: Elect Abstract Player + You :: Elect Abstract Player + +deriving instance (Eq a) => Eq (Elect p a) +deriving instance (Ord a) => Ord (Elect p a) diff --git a/testsuite/tests/deriving/should_compile/T8740.stderr b/testsuite/tests/deriving/should_compile/T8740.stderr new file mode 100644 index 0000000..9b60741 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8740.stderr @@ -0,0 +1,18 @@ + +T8740.hs:17:1: warning: [-Winaccessible-code (in -Wdefault)] + • Couldn't match type ‘Reified’ with ‘Abstract’ + Inaccessible code in + a pattern with constructor: + ElectRefAsTypeOf :: forall a. + Int -> Elect Abstract a -> Elect Abstract a, + in a case alternative + • In the pattern: ElectRefAsTypeOf {} + In a case alternative: ElectRefAsTypeOf {} -> GT + In the expression: + case b of + ElectRefAsTypeOf {} -> GT + ElectHandle b1 -> (a1 `compare` b1) + _ -> LT + When typechecking the code for ‘compare’ + in a derived instance for ‘Ord (Elect p a)’: + To see the code I am typechecking, use -ddump-deriv diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index b2dd670..0e0494f 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -44,11 +44,13 @@ test('T7710', normal, compile, ['']) test('AutoDeriveTypeable', normal, compile, ['']) +test('T8128', normal, compile, ['']) test('T8138', reqlib('primitive'), compile, ['-O2']) test('T8165', normal, compile, ['']) test('T8631', normal, compile, ['']) test('T8758', [], multimod_compile, ['T8758a', '-v0']) test('T8678', normal, compile, ['']) +test('T8740', normal, compile, ['']) test('T8865', normal, compile, ['']) test('T8893', normal, compile, ['']) test('T8950', normal, compile, ['']) From git at git.haskell.org Sun Jun 3 14:28:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 14:28:08 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark T14547 as broken (b564eb7) Message-ID: <20180603142808.A2DB83ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b564eb7eb93590556d3107ec38ad9b0232215c28/ghc >--------------------------------------------------------------- commit b564eb7eb93590556d3107ec38ad9b0232215c28 Author: Ben Gamari Date: Sun Jun 3 10:24:55 2018 -0400 testsuite: Mark T14547 as broken >--------------------------------------------------------------- b564eb7eb93590556d3107ec38ad9b0232215c28 testsuite/tests/deSugar/should_compile/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 9951047..05e0ee5 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -104,6 +104,7 @@ test('T14546a', normal, compile, ['-Wincomplete-patterns']) test('T14546b', normal, compile, ['-Wincomplete-patterns']) test('T14546c', normal, compile, ['-Wincomplete-patterns']) test('T14547', normal, compile, ['-Wincomplete-patterns']) +test('T14547', expect_broken(15222), compile, ['-Wincomplete-patterns']) test('T14773a', normal, compile, ['-Wincomplete-patterns']) test('T14773b', normal, compile, ['-Wincomplete-patterns']) test('T14815', [], run_command, ['$MAKE -s --no-print-directory T14815']) From git at git.haskell.org Sun Jun 3 20:51:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 20:51:02 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Really mark T14547 as broken (4dd1895) Message-ID: <20180603205102.D25563ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4dd1895bf8bbe5aac7a8e80f18ba76e78520be18/ghc >--------------------------------------------------------------- commit 4dd1895bf8bbe5aac7a8e80f18ba76e78520be18 Author: Ben Gamari Date: Sun Jun 3 16:49:45 2018 -0400 testsuite: Really mark T14547 as broken >--------------------------------------------------------------- 4dd1895bf8bbe5aac7a8e80f18ba76e78520be18 testsuite/tests/deSugar/should_compile/all.T | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 05e0ee5..3aadbea 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -103,7 +103,6 @@ test('T14135', normal, compile, ['']) test('T14546a', normal, compile, ['-Wincomplete-patterns']) test('T14546b', normal, compile, ['-Wincomplete-patterns']) test('T14546c', normal, compile, ['-Wincomplete-patterns']) -test('T14547', normal, compile, ['-Wincomplete-patterns']) test('T14547', expect_broken(15222), compile, ['-Wincomplete-patterns']) test('T14773a', normal, compile, ['-Wincomplete-patterns']) test('T14773b', normal, compile, ['-Wincomplete-patterns']) From git at git.haskell.org Sun Jun 3 21:20:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 21:20:52 +0000 (UTC) Subject: [commit: packages/haskeline] master: Bump stm upper bound (4f0fae2) Message-ID: <20180603212052.443CD3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/4f0fae2e0dcd769f8063e5b0c220de9583819235 >--------------------------------------------------------------- commit 4f0fae2e0dcd769f8063e5b0c220de9583819235 Author: Ben Gamari Date: Sat Jun 2 19:21:37 2018 -0400 Bump stm upper bound >--------------------------------------------------------------- 4f0fae2e0dcd769f8063e5b0c220de9583819235 haskeline.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskeline.cabal b/haskeline.cabal index 84cd0e0..6620f53 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -46,7 +46,7 @@ Library Build-depends: base >=4.5 && < 4.13, containers>=0.4 && < 0.6, directory>=1.1 && < 1.4, bytestring>=0.9 && < 0.11, filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.6, - process >= 1.0 && < 1.7, stm >= 2.4 && < 2.5 + process >= 1.0 && < 1.7, stm >= 2.4 && < 2.6 Default-Language: Haskell98 Default-Extensions: ForeignFunctionInterface, Rank2Types, FlexibleInstances, From git at git.haskell.org Sun Jun 3 21:20:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 3 Jun 2018 21:20:54 +0000 (UTC) Subject: [commit: packages/haskeline] master: Merge pull request #83 from bgamari/patch-1 (4168a4a) Message-ID: <20180603212054.491AA3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/4168a4adb7a8a572995d4b5deee33fbe34d0f1aa >--------------------------------------------------------------- commit 4168a4adb7a8a572995d4b5deee33fbe34d0f1aa Merge: 481b890 4f0fae2 Author: Judah Jacobson Date: Sun Jun 3 08:32:59 2018 -0700 Merge pull request #83 from bgamari/patch-1 Bump stm upper bound >--------------------------------------------------------------- 4168a4adb7a8a572995d4b5deee33fbe34d0f1aa haskeline.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) From git at git.haskell.org Mon Jun 4 02:06:24 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 02:06:24 +0000 (UTC) Subject: [commit: ghc] master: Provide `getWithUserData` and `putWithUserData` (554bc7f) Message-ID: <20180604020624.E0CD93ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/554bc7fcca30b1b6ffb6a2daca684ea74eb83ad8/ghc >--------------------------------------------------------------- commit 554bc7fcca30b1b6ffb6a2daca684ea74eb83ad8 Author: Matthew Pickering Date: Mon Jun 4 02:05:46 2018 +0000 Provide `getWithUserData` and `putWithUserData` Summary: This makes it possible to serialise Names and FastStrings in user programs, for example, when writing a source plugin. When writing my first source plugin, I wanted to serialise names but it wasn't possible easily without exporting additional constructors. This interface is sufficient and abstracts nicely over the symbol table and dictionary. Reviewers: alpmestan, bgamari Reviewed By: alpmestan Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15223 Differential Revision: https://phabricator.haskell.org/D4782 >--------------------------------------------------------------- 554bc7fcca30b1b6ffb6a2daca684ea74eb83ad8 compiler/iface/BinIface.hs | 33 ++++++++++++++++++++++++++------- 1 file changed, 26 insertions(+), 7 deletions(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 2a4696a..b8b4bb0 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -15,7 +15,10 @@ module BinIface ( getSymtabName, getDictFastString, CheckHiWay(..), - TraceBinIFaceReading(..) + TraceBinIFaceReading(..), + getWithUserData, + putWithUserData + ) where #include "HsVersions.h" @@ -134,7 +137,14 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do wantedGot "Way" way_descr check_way when (checkHiWay == CheckHiWay) $ errorOnMismatch "mismatched interface file ways" way_descr check_way + getWithUserData ncu bh + +-- | This performs a get action after reading the dictionary and symbol +-- table. It is necessary to run this before trying to deserialise any +-- Names or FastStrings. +getWithUserData :: Binary a => NameCacheUpdater -> BinHandle -> IO a +getWithUserData ncu bh = do -- Read the dictionary -- The next word in the file is a pointer to where the dictionary is -- (probably at the end of the file) @@ -179,6 +189,17 @@ writeBinIface dflags hi_path mod_iface = do let way_descr = getWayDescr dflags put_ bh way_descr + + putWithUserData (debugTraceMsg dflags 3) bh mod_iface + -- And send the result to the file + writeBinMem bh hi_path + +-- | Put a piece of data with an initialised `UserData` field. This +-- is necessary if you want to serialise Names or FastStrings. +-- It also writes a symbol table and the dictionary. +-- This segment should be read using `getWithUserData`. +putWithUserData :: Binary a => (SDoc -> IO ()) -> BinHandle -> a -> IO () +putWithUserData log_action bh payload = do -- Remember where the dictionary pointer will go dict_p_p <- tellBin bh -- Placeholder for ptr to dictionary @@ -187,7 +208,6 @@ writeBinIface dflags hi_path mod_iface = do -- Remember where the symbol table pointer will go symtab_p_p <- tellBin bh put_ bh symtab_p_p - -- Make some intial state symtab_next <- newFastMutInt writeFastMutInt symtab_next 0 @@ -206,7 +226,7 @@ writeBinIface dflags hi_path mod_iface = do bh <- return $ setUserData bh $ newWriteState (putName bin_dict bin_symtab) (putName bin_dict bin_symtab) (putFastString bin_dict) - put_ bh mod_iface + put_ bh payload -- Write the symtab pointer at the front of the file symtab_p <- tellBin bh -- This is where the symtab will start @@ -217,7 +237,7 @@ writeBinIface dflags hi_path mod_iface = do symtab_next <- readFastMutInt symtab_next symtab_map <- readIORef symtab_map putSymbolTable bh symtab_next symtab_map - debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next + log_action (text "writeBinIface:" <+> int symtab_next <+> text "Names") -- NB. write the dictionary after the symbol table, because @@ -232,11 +252,10 @@ writeBinIface dflags hi_path mod_iface = do dict_next <- readFastMutInt dict_next_ref dict_map <- readIORef dict_map_ref putDictionary bh dict_next dict_map - debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next + log_action (text "writeBinIface:" <+> int dict_next <+> text "dict entries") - -- And send the result to the file - writeBinMem bh hi_path + -- | Initial ram buffer to allocate for writing interface files initBinMemSize :: Int From git at git.haskell.org Mon Jun 4 15:54:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 15:54:22 +0000 (UTC) Subject: [commit: ghc] master: Do a late CSE pass (0e5d2b7) Message-ID: <20180604155422.7450D3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0e5d2b7442ff9e55837913a53da451fb97417496/ghc >--------------------------------------------------------------- commit 0e5d2b7442ff9e55837913a53da451fb97417496 Author: Simon Peyton Jones Date: Fri Jun 1 12:53:41 2018 +0100 Do a late CSE pass When investigating something else I found that a condition was being re-evaluated in wheel-seive1. Why, when CSE should find it? Because the opportunity only showed up after LiberateCase This patch adds a late CSE pass. Rather than give it an extra flag I do it when (cse && (spec_constr || liberate_case)), so roughly speaking it happense with -O2. In any case, CSE is very cheap. Nofib results are minor but in the right direction: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.1% -0.0% 0.163 0.163 0.0% eliza -0.1% -0.4% 0.001 0.001 0.0% fft2 -0.1% 0.0% 0.087 0.087 0.0% mate -0.0% -1.3% -0.8% -0.8% 0.0% paraffins -0.0% -0.1% +0.9% +0.9% 0.0% pic -0.0% -0.1% 0.009 0.009 0.0% wheel-sieve1 -0.2% -0.0% -0.1% -0.1% 0.0% -------------------------------------------------------------------------------- Min -0.6% -1.3% -2.4% -2.4% 0.0% Max +0.0% +0.0% +3.8% +3.8% +23.8% Geometric Mean -0.0% -0.0% +0.2% +0.2% +0.2% >--------------------------------------------------------------- 0e5d2b7442ff9e55837913a53da451fb97417496 compiler/simplCore/SimplCore.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 8884636..d461b99 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -321,6 +321,12 @@ getCoreToDo dflags (CoreDoPasses [ CoreDoSpecialising , simpl_phase 0 ["post-late-spec"] max_iter]), + -- LiberateCase can yield new CSE opportunities because it peels + -- off one layer of a recursive function (concretely, I saw this + -- in wheel-sieve1), and I'm guessing that SpecConstr can too + -- And CSE is a very cheap pass. So it seems worth doing here. + runWhen ((liberate_case || spec_constr) && cse) CoreCSE, + -- Final clean-up simplification: simpl_phase 0 ["final"] max_iter, From git at git.haskell.org Mon Jun 4 15:54:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 15:54:25 +0000 (UTC) Subject: [commit: ghc] master: Expand type synonyms when Linting a forall (9d600ea) Message-ID: <20180604155425.C44BF3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d600ea68c283b0d38ac663c3cc48baba6b94f57/ghc >--------------------------------------------------------------- commit 9d600ea68c283b0d38ac663c3cc48baba6b94f57 Author: Simon Peyton Jones Date: Fri Jun 1 16:36:57 2018 +0100 Expand type synonyms when Linting a forall Trac #14939 showed a type like type Alg cls ob = ob f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b where the kind of the forall looks like (Alg cls *), with a free cls. This tripped up Core Lint. I fixed this by making Core Lint a bit more forgiving, expanding type synonyms if necessary. I'm worried that this might not be the whole story; notably typeKind looks suspect. But it certainly fixes this problem. >--------------------------------------------------------------- 9d600ea68c283b0d38ac663c3cc48baba6b94f57 compiler/coreSyn/CoreLint.hs | 37 ++++++++++++++++++++++++++++++------- compiler/types/Type.hs | 4 +++- testsuite/tests/polykinds/T14939.hs | 19 +++++++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 4 files changed, 53 insertions(+), 8 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index d92082c..517b1be 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1296,7 +1296,8 @@ lintInTy ty = addLoc (InType ty) $ do { ty' <- applySubstTy ty ; k <- lintType ty' - ; lintKind k + -- No need to lint k, because lintType + -- guarantees that k is linted ; return (ty', k) } checkTyCon :: TyCon -> LintM () @@ -1355,12 +1356,19 @@ lintType ty@(FunTy t1 t2) lintType t@(ForAllTy (TvBndr tv _vis) ty) = do { lintL (isTyVar tv) (text "Covar bound in type:" <+> ppr t) ; lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; lintL (not (tv' `elemVarSet` tyCoVarsOfType k)) - (text "Variable escape in forall:" <+> ppr t) - ; lintL (classifiesTypeWithValues k) - (text "Non-* and non-# kind in forall:" <+> ppr t) - ; return k }} + do { k <- lintType ty + ; lintL (classifiesTypeWithValues k) + (text "Non-* and non-# kind in forall:" <+> ppr t) + ; if (not (tv' `elemVarSet` tyCoVarsOfType k)) + then return k + else + do { -- See Note [Stupid type synonyms] + let k' = expandTypeSynonyms k + ; lintL (not (tv' `elemVarSet` tyCoVarsOfType k')) + (hang (text "Variable escape in forall:") + 2 (vcat [ text "type:" <+> ppr t + , text "kind:" <+> ppr k' ])) + ; return k' }}} lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) @@ -1374,6 +1382,21 @@ lintType (CoercionTy co) = do { (k1, k2, ty1, ty2, r) <- lintCoercion co ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } +{- Note [Stupid type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (Trac #14939) + type Alg cls ob = ob + f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b + +Here 'cls' appears free in b's kind, which would usually be illegal +(becuase in (forall a. ty), ty's kind should not mention 'a'). But +#in this case (Alg cls *) = *, so all is well. Currently we allow +this, and make Lint expand synonyms where necessary to make it so. + +c.f. TcUnify.occCheckExpand and CoreUtils.coreAltsType which deal +with the same problem. A single systematic solution eludes me. +-} + ----------------- lintTySynApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind -- See Note [Linting type synonym applications] diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 1e0ce99..9963208 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -2311,10 +2311,12 @@ typeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys typeKind (AppTy fun arg) = typeKind_apps fun [arg] typeKind (LitTy l) = typeLiteralKind l typeKind (FunTy {}) = liftedTypeKind -typeKind (ForAllTy _ ty) = typeKind ty typeKind (TyVarTy tyvar) = tyVarKind tyvar typeKind (CastTy _ty co) = pSnd $ coercionKind co typeKind (CoercionTy co) = coercionType co +typeKind (ForAllTy _ ty) = typeKind ty -- Urk. See Note [Stupid type synonyms] + -- in CoreLint. Maybe we should do + -- something similar here... typeKind_apps :: HasDebugCallStack => Type -> [Type] -> Kind -- The sole purpose of the function is to accumulate diff --git a/testsuite/tests/polykinds/T14939.hs b/testsuite/tests/polykinds/T14939.hs new file mode 100644 index 0000000..eb3c700 --- /dev/null +++ b/testsuite/tests/polykinds/T14939.hs @@ -0,0 +1,19 @@ +{-# Language RankNTypes, ConstraintKinds, TypeInType, GADTs #-} + +module T14939 where + +import Data.Kind + +type Cat ob = ob -> ob -> Type + +type Alg cls ob = ob + +newtype Frí (cls::Type -> Constraint) :: (Type -> Alg cls Type) where + Frí :: { with :: forall x. cls x => (a -> x) -> x } + -> Frí cls a + +data AlgCat (cls::Type -> Constraint) :: Cat (Alg cls Type) where + AlgCat :: (cls a, cls b) => (a -> b) -> AlgCat cls a b + +leftAdj :: AlgCat cls (Frí cls a) b -> (a -> b) +leftAdj (AlgCat f) a = undefined \ No newline at end of file diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 788832d..4fe88b2 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -192,3 +192,4 @@ test('SigTvKinds3', normal, compile_fail, ['']) test('T15116', normal, compile_fail, ['']) test('T15116a', normal, compile_fail, ['']) test('T15170', normal, compile, ['']) +test('T14939', normal, compile, ['-O']) From git at git.haskell.org Mon Jun 4 15:54:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 15:54:28 +0000 (UTC) Subject: [commit: ghc] master: Refactor SetLevels.abstractVars (a1a507a) Message-ID: <20180604155428.9601D3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1a507a1faefef550378758f5228bd01c78c4f25/ghc >--------------------------------------------------------------- commit a1a507a1faefef550378758f5228bd01c78c4f25 Author: Simon Peyton Jones Date: Fri Jun 1 16:42:11 2018 +0100 Refactor SetLevels.abstractVars This patch is pure refactoring: using utility functions rather than special-purpose code, especially for closeOverKinds >--------------------------------------------------------------- a1a507a1faefef550378758f5228bd01c78c4f25 compiler/simplCore/SetLevels.hs | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 25b2018..65f7713 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -88,6 +88,7 @@ import Demand ( StrictSig, Demand, isStrictDmd, splitStrictSig, increa import Name ( getOccName, mkSystemVarName ) import OccName ( occNameString ) import Type ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType ) +import TyCoRep ( closeOverKindsDSet ) import BasicTypes ( Arity, RecFlag(..), isRec ) import DataCon ( dataConOrigResTy ) import TysWiredIn @@ -1558,17 +1559,14 @@ abstractVars :: Level -> LevelEnv -> DVarSet -> [OutVar] -- Uniques are not deterministic. abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs = -- NB: sortQuantVars might not put duplicates next to each other - map zap $ sortQuantVars $ uniq - [out_var | out_fv <- dVarSetElems (substDVarSet subst in_fvs) - , out_var <- dVarSetElems (close out_fv) - , abstract_me out_var ] + map zap $ sortQuantVars $ + filter abstract_me $ + dVarSetElems $ + closeOverKindsDSet $ + substDVarSet subst in_fvs -- NB: it's important to call abstract_me only on the OutIds the -- come from substDVarSet (not on fv, which is an InId) where - uniq :: [Var] -> [Var] - -- Remove duplicates, preserving order - uniq = dVarSetElems . mkDVarSet - abstract_me v = case lookupVarEnv lvl_env v of Just lvl -> dest_lvl `ltLvl` lvl Nothing -> False @@ -1581,12 +1579,6 @@ abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs setIdInfo v vanillaIdInfo | otherwise = v - close :: Var -> DVarSet -- Close over variables free in the type - -- Result includes the input variable itself - close v = foldDVarSet (unionDVarSet . close) - (unitDVarSet v) - (fvDVarSet $ varTypeTyCoFVs v) - type LvlM result = UniqSM result initLvl :: UniqSupply -> UniqSM a -> a From git at git.haskell.org Mon Jun 4 18:20:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 18:20:05 +0000 (UTC) Subject: [commit: ghc] master: Bump stm and haskeline submodules (c560f38) Message-ID: <20180604182005.E686A3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c560f3824b00c4bcc7f2d6648df3139d985c263a/ghc >--------------------------------------------------------------- commit c560f3824b00c4bcc7f2d6648df3139d985c263a Author: Ben Gamari Date: Sun Jun 3 17:18:12 2018 -0400 Bump stm and haskeline submodules >--------------------------------------------------------------- c560f3824b00c4bcc7f2d6648df3139d985c263a libraries/haskeline | 2 +- libraries/stm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libraries/haskeline b/libraries/haskeline index 481b890..4168a4a 160000 --- a/libraries/haskeline +++ b/libraries/haskeline @@ -1 +1 @@ -Subproject commit 481b890e8616d9e85da69173d5079ad49f9fb83d +Subproject commit 4168a4adb7a8a572995d4b5deee33fbe34d0f1aa diff --git a/libraries/stm b/libraries/stm index b2af9b4..637013d 160000 --- a/libraries/stm +++ b/libraries/stm @@ -1 +1 @@ -Subproject commit b2af9b4bb23cd2fc0b5d731b5614cdc90e7dda41 +Subproject commit 637013d3f2596c86adc8c946e2f38e9e1a85fd84 From git at git.haskell.org Mon Jun 4 18:21:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 18:21:56 +0000 (UTC) Subject: [commit: ghc] master: Fix broken test T14547. (d8efb09) Message-ID: <20180604182156.A8F6B3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d8efb0983cf90aa4224cb62ce8d7fb37e7e6dffb/ghc >--------------------------------------------------------------- commit d8efb0983cf90aa4224cb62ce8d7fb37e7e6dffb Author: HE, Tao Date: Sun Jun 3 17:18:54 2018 -0400 Fix broken test T14547. Phab:D4571 lags behind HEAD for too many commits. The commit of Phab:4571 1f88f541aad1e36d01f22f9e71dfbc247e6558e2 brought some unintentional changes (not belong to [Phab:4571's Diff 16314](https://phabricator.haskell.org/differential/diff/16314/)) into ghc-head, breaking T14557. Let's fix that. Test Plan: make test TEST="T14547" Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15222 Differential Revision: https://phabricator.haskell.org/D4778 >--------------------------------------------------------------- d8efb0983cf90aa4224cb62ce8d7fb37e7e6dffb compiler/deSugar/Check.hs | 38 +++++++++++++++++++--------- testsuite/tests/deSugar/should_compile/all.T | 2 +- 2 files changed, 27 insertions(+), 13 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index ba64154..201ed12 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -53,6 +53,7 @@ import Type import UniqSupply import DsGRHSs (isTrueLHsExpr) import Maybes (expectJust) +import qualified GHC.LanguageExtensions as LangExt import Data.List (find) import Data.Maybe (catMaybes, isJust, fromMaybe) @@ -788,18 +789,31 @@ translatePat fam_insts pat = case pat of <$> translatePatVec fam_insts (map unLoc ps) -- overloaded list - ListPat (ListPatTc elem_ty (Just (pat_ty, _to_list))) lpats - | Just e_ty <- splitListTyConApp_maybe pat_ty - , (_, norm_elem_ty) <- normaliseType fam_insts Nominal elem_ty - -- elem_ty is frequently something like - -- `Item [Int]`, but we prefer `Int` - , norm_elem_ty `eqType` e_ty -> - -- We have to ensure that the element types are exactly the same. - -- Otherwise, one may give an instance IsList [Int] (more specific than - -- the default IsList [a]) with a different implementation for `toList' - translatePat fam_insts (ListPat (ListPatTc e_ty Nothing) lpats) - -- See Note [Guards and Approximation] - | otherwise -> mkCanFailPmPat pat_ty + ListPat (ListPatTc _elem_ty (Just (pat_ty, _to_list))) lpats -> do + dflags <- getDynFlags + if xopt LangExt.RebindableSyntax dflags + then mkCanFailPmPat pat_ty + else case splitListTyConApp_maybe pat_ty of + Just e_ty -> translatePat fam_insts + (ListPat (ListPatTc e_ty Nothing) lpats) + Nothing -> mkCanFailPmPat pat_ty + -- (a) In the presence of RebindableSyntax, we don't know anything about + -- `toList`, we should treat `ListPat` as any other view pattern. + -- + -- (b) In the absence of RebindableSyntax, + -- - If the pat_ty is `[a]`, then we treat the overloaded list pattern + -- as ordinary list pattern. Although we can give an instance + -- `IsList [Int]` (more specific than the default `IsList [a]`), in + -- practice, we almost never do that. We assume the `_to_list` is + -- the `toList` from `instance IsList [a]`. + -- + -- - Otherwise, we treat the `ListPat` as ordinary view pattern. + -- + -- See Trac #14547, especially comment#9 and comment#10. + -- + -- Here we construct CanFailPmPat directly, rather can construct a view + -- pattern and do further translation as an optimization, for the reason, + -- see Note [Guards and Approximation]. ConPatOut { pat_con = L _ con , pat_arg_tys = arg_tys diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 3aadbea..9951047 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -103,7 +103,7 @@ test('T14135', normal, compile, ['']) test('T14546a', normal, compile, ['-Wincomplete-patterns']) test('T14546b', normal, compile, ['-Wincomplete-patterns']) test('T14546c', normal, compile, ['-Wincomplete-patterns']) -test('T14547', expect_broken(15222), compile, ['-Wincomplete-patterns']) +test('T14547', normal, compile, ['-Wincomplete-patterns']) test('T14773a', normal, compile, ['-Wincomplete-patterns']) test('T14773b', normal, compile, ['-Wincomplete-patterns']) test('T14815', [], run_command, ['$MAKE -s --no-print-directory T14815']) From git at git.haskell.org Mon Jun 4 18:22:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 18:22:12 +0000 (UTC) Subject: [commit: ghc] master: Document the fact that cmm dumps won't show unreachable blocks. (36091ec) Message-ID: <20180604182212.ECA1A3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/36091ec94e85d871b12b07e69c1589224d1dd7e2/ghc >--------------------------------------------------------------- commit 36091ec94e85d871b12b07e69c1589224d1dd7e2 Author: klebinger.andreas at gmx.at Date: Mon Jun 4 13:26:22 2018 -0400 Document the fact that cmm dumps won't show unreachable blocks. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4788 >--------------------------------------------------------------- 36091ec94e85d871b12b07e69c1589224d1dd7e2 docs/users_guide/debugging.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index 7adcc84..a3f0be7 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -382,6 +382,9 @@ These flags dump various phases of GHC's C-\\- pipeline. ``.cmm`` compilation this also dumps the result of file parsing. + Cmm dumps don't include unreachable blocks since we print + blocks in reverse post order. + .. ghc-flag:: -ddump-cmm-from-stg :shortdesc: Dump STG-to-C-\\- output :type: dynamic From git at git.haskell.org Mon Jun 4 18:24:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 4 Jun 2018 18:24:29 +0000 (UTC) Subject: [commit: ghc] master: Implement QuantifiedConstraints (7df5896) Message-ID: <20180604182429.4956B3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7df589608abb178efd6499ee705ba4eebd0cf0d1/ghc >--------------------------------------------------------------- commit 7df589608abb178efd6499ee705ba4eebd0cf0d1 Author: Simon Peyton Jones Date: Sat Jan 27 14:32:34 2018 +0000 Implement QuantifiedConstraints We have wanted quantified constraints for ages and, as I hoped, they proved remarkably simple to implement. All the machinery was already in place. The main ticket is Trac #2893, but also relevant are #5927 #8516 #9123 (especially! higher kinded roles) #14070 #14317 The wiki page is https://ghc.haskell.org/trac/ghc/wiki/QuantifiedConstraints which in turn contains a link to the GHC Proposal where the change is specified. Here is the relevant Note: Note [Quantified constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The -XQuantifiedConstraints extension allows type-class contexts like this: data Rose f x = Rose x (f (Rose f x)) instance (Eq a, forall b. Eq b => Eq (f b)) => Eq (Rose f a) where (Rose x1 rs1) == (Rose x2 rs2) = x1==x2 && rs1 >= rs2 Note the (forall b. Eq b => Eq (f b)) in the instance contexts. This quantified constraint is needed to solve the [W] (Eq (f (Rose f x))) constraint which arises form the (==) definition. Here are the moving parts * Language extension {-# LANGUAGE QuantifiedConstraints #-} and add it to ghc-boot-th:GHC.LanguageExtensions.Type.Extension * A new form of evidence, EvDFun, that is used to discharge such wanted constraints * checkValidType gets some changes to accept forall-constraints only in the right places. * Type.PredTree gets a new constructor ForAllPred, and and classifyPredType analyses a PredType to decompose the new forall-constraints * Define a type TcRnTypes.QCInst, which holds a given quantified constraint in the inert set * TcSMonad.InertCans gets an extra field, inert_insts :: [QCInst], which holds all the Given forall-constraints. In effect, such Given constraints are like local instance decls. * When trying to solve a class constraint, via TcInteract.matchInstEnv, use the InstEnv from inert_insts so that we include the local Given forall-constraints in the lookup. (See TcSMonad.getInstEnvs.) * topReactionsStage calls doTopReactOther for CIrredCan and CTyEqCan, so they can try to react with any given quantified constraints (TcInteract.matchLocalInst) * TcCanonical.canForAll deals with solving a forall-constraint. See Note [Solving a Wanted forall-constraint] Note [Solving a Wanted forall-constraint] * We augment the kick-out code to kick out an inert forall constraint if it can be rewritten by a new type equality; see TcSMonad.kick_out_rewritable Some other related refactoring ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * Move SCC on evidence bindings to post-desugaring, which fixed #14735, and is generally nicer anyway because we can use existing CoreSyn free-var functions. (Quantified constraints made the free-vars of an ev-term a bit more complicated.) * In LookupInstResult, replace GenInst with OneInst and NotSure, using the latter for multiple matches and/or one or more unifiers >--------------------------------------------------------------- 7df589608abb178efd6499ee705ba4eebd0cf0d1 compiler/basicTypes/Id.hs | 2 +- compiler/deSugar/DsBinds.hs | 42 ++- compiler/main/DynFlags.hs | 2 + compiler/specialise/Specialise.hs | 1 + compiler/typecheck/Inst.hs | 12 +- compiler/typecheck/TcCanonical.hs | 416 ++++++++++++++++----- compiler/typecheck/TcErrors.hs | 4 +- compiler/typecheck/TcEvTerm.hs | 5 +- compiler/typecheck/TcEvidence.hs | 126 ++++--- compiler/typecheck/TcHsSyn.hs | 39 +- compiler/typecheck/TcInstDcls.hs | 2 +- compiler/typecheck/TcInteract.hs | 377 +++++++++++-------- compiler/typecheck/TcMType.hs | 11 +- compiler/typecheck/TcPatSyn.hs | 7 +- compiler/typecheck/TcPluginM.hs | 4 +- compiler/typecheck/TcRnTypes.hs | 67 +++- compiler/typecheck/TcSMonad.hs | 319 +++++++++++----- compiler/typecheck/TcSimplify.hs | 2 +- compiler/typecheck/TcType.hs | 4 +- compiler/typecheck/TcValidity.hs | 113 ++++-- compiler/types/Class.hs | 54 +-- compiler/types/InstEnv.hs | 75 ++-- compiler/types/Kind.hs | 2 + compiler/types/Type.hs | 26 +- docs/users_guide/glasgow_exts.rst | 260 ++++++++++++- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + testsuite/tests/driver/T4437.hs | 3 +- .../tests/{ado => quantified-constraints}/Makefile | 0 testsuite/tests/quantified-constraints/T14833.hs | 28 ++ testsuite/tests/quantified-constraints/T14835.hs | 20 + testsuite/tests/quantified-constraints/T14863.hs | 27 ++ testsuite/tests/quantified-constraints/T14961.hs | 98 +++++ testsuite/tests/quantified-constraints/T2893.hs | 18 + testsuite/tests/quantified-constraints/T2893a.hs | 27 ++ testsuite/tests/quantified-constraints/T2893c.hs | 15 + testsuite/tests/quantified-constraints/T9123.hs | 25 ++ testsuite/tests/quantified-constraints/T9123a.hs | 30 ++ testsuite/tests/quantified-constraints/all.T | 10 + testsuite/tests/rebindable/T5908.hs | 0 testsuite/tests/typecheck/should_compile/T14735.hs | 30 ++ testsuite/tests/typecheck/should_compile/all.T | 2 + testsuite/tests/typecheck/should_fail/T7019.stderr | 1 + .../tests/typecheck/should_fail/T7019a.stderr | 1 + testsuite/tests/typecheck/should_fail/T9196.stderr | 8 +- 44 files changed, 1775 insertions(+), 541 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7df589608abb178efd6499ee705ba4eebd0cf0d1 From git at git.haskell.org Tue Jun 5 00:44:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 00:44:32 +0000 (UTC) Subject: [commit: ghc] master: Add Outputable instance for HsArg (1a61c6b) Message-ID: <20180605004432.C6C643ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1a61c6b8c8959ca4cd9500d261ae225210eaff64/ghc >--------------------------------------------------------------- commit 1a61c6b8c8959ca4cd9500d261ae225210eaff64 Author: Matthew Pickering Date: Mon Jun 4 17:49:34 2018 -0400 Add Outputable instance for HsArg Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4791 >--------------------------------------------------------------- 1a61c6b8c8959ca4cd9500d261ae225210eaff64 compiler/typecheck/TcExpr.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 2588899..b59b176 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1098,6 +1098,10 @@ data HsArg tm ty = HsValArg tm -- Argument is an ordinary expression (f arg) | HsTypeArg ty -- Argument is a visible type application (f @ty) +instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where + ppr (HsValArg tm) = text "HsValArg" <> ppr tm + ppr (HsTypeArg ty) = text "HsTypeArg" <> ppr ty + isHsValArg :: HsArg tm ty -> Bool isHsValArg (HsValArg {}) = True isHsValArg (HsTypeArg {}) = False From git at git.haskell.org Tue Jun 5 00:44:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 00:44:47 +0000 (UTC) Subject: [commit: ghc] master: Improve extendTvSubst assertion (97cea31) Message-ID: <20180605004447.89DD43ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97cea3155c7161b7983625417b717239ff52e100/ghc >--------------------------------------------------------------- commit 97cea3155c7161b7983625417b717239ff52e100 Author: Matthew Pickering Date: Mon Jun 4 17:50:01 2018 -0400 Improve extendTvSubst assertion Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4790 >--------------------------------------------------------------- 97cea3155c7161b7983625417b717239ff52e100 compiler/simplCore/SimplEnv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/simplCore/SimplEnv.hs b/compiler/simplCore/SimplEnv.hs index 7504fc6..18d9f57 100644 --- a/compiler/simplCore/SimplEnv.hs +++ b/compiler/simplCore/SimplEnv.hs @@ -319,7 +319,7 @@ extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv extendTvSubst env@(SimplEnv {seTvSubst = tsubst}) var res - = ASSERT( isTyVar var ) + = ASSERT2( isTyVar var, ppr var $$ ppr res ) env {seTvSubst = extendVarEnv tsubst var res} extendCvSubst :: SimplEnv -> CoVar -> Coercion -> SimplEnv From git at git.haskell.org Tue Jun 5 00:45:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 00:45:03 +0000 (UTC) Subject: [commit: ghc] master: Also suppress uniques in cmm dumps with `-dsuppress-uniques`. (aa77c60) Message-ID: <20180605004503.036D33ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa77c602e910cb9a4e17022464c0341fd731f3e0/ghc >--------------------------------------------------------------- commit aa77c602e910cb9a4e17022464c0341fd731f3e0 Author: klebinger.andreas at gmx.at Date: Mon Jun 4 17:50:21 2018 -0400 Also suppress uniques in cmm dumps with `-dsuppress-uniques`. Allows easier structural comparison of Cmm code. Before: ``` cxCH: // global _suEU::P64 = R1; if ((Sp + -16) < SpLim) (likely: False) goto cxCI; else goto cxCJ; ``` After ``` _lbl_: // global __locVar_::P64 = R1; if ((Sp + -16) < SpLim) (likely: False) goto cxBf; else goto cxBg; ``` Test Plan: Looking at dumps, ci Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4786 >--------------------------------------------------------------- aa77c602e910cb9a4e17022464c0341fd731f3e0 compiler/cmm/PprCmm.hs | 6 +++++- compiler/cmm/PprCmmExpr.hs | 9 +++++++-- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index 51deb8c..90f26e4 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -185,9 +185,13 @@ pprNode node = pp_node <+> pp_debug pp_node :: SDoc pp_node = sdocWithDynFlags $ \dflags -> case node of -- label: - CmmEntry id tscope -> ppr id <> colon <+> + CmmEntry id tscope -> lbl <> colon <+> (sdocWithDynFlags $ \dflags -> ppUnless (gopt Opt_SuppressTicks dflags) (text "//" <+> ppr tscope)) + where + lbl = if gopt Opt_SuppressUniques dflags + then text "_lbl_" + else ppr id -- // text CmmComment s -> text "//" <+> ftext s diff --git a/compiler/cmm/PprCmmExpr.hs b/compiler/cmm/PprCmmExpr.hs index 4538556..7bf73f1 100644 --- a/compiler/cmm/PprCmmExpr.hs +++ b/compiler/cmm/PprCmmExpr.hs @@ -43,6 +43,7 @@ import GhcPrelude import CmmExpr import Outputable +import DynFlags import Data.Maybe import Numeric ( fromRat ) @@ -226,14 +227,18 @@ pprReg r -- We only print the type of the local reg if it isn't wordRep -- pprLocalReg :: LocalReg -> SDoc -pprLocalReg (LocalReg uniq rep) +pprLocalReg (LocalReg uniq rep) = sdocWithDynFlags $ \dflags -> -- = ppr rep <> char '_' <> ppr uniq -- Temp Jan08 - = char '_' <> ppr uniq <> + char '_' <> pprUnique dflags uniq <> (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh then dcolon <> ptr <> ppr rep else dcolon <> ptr <> ppr rep) where + pprUnique dflags unique = + if gopt Opt_SuppressUniques dflags + then text "_locVar_" + else ppr unique ptr = empty --if isGcPtrType rep -- then doubleQuotes (text "ptr") From git at git.haskell.org Tue Jun 5 00:45:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 00:45:21 +0000 (UTC) Subject: [commit: ghc] master: Serialize docstrings to ifaces, display them with new GHCi :doc command (85309a3) Message-ID: <20180605004521.B04A93ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/85309a3cda367425cca727dfa45e5e6c63b47391/ghc >--------------------------------------------------------------- commit 85309a3cda367425cca727dfa45e5e6c63b47391 Author: Simon Jakobi Date: Mon Jun 4 17:51:03 2018 -0400 Serialize docstrings to ifaces, display them with new GHCi :doc command If `-haddock` is set, we now extract docstrings from the renamed ast and serialize them in the .hi-files. This includes some of the changes from D4749 with the notable exceptions of the docstring lexing and renaming. A currently limited and experimental GHCi :doc command can be used to display docstrings for declarations. The formatting of pretty-printed docstrings is changed slightly, causing some changes in testsuite/tests/haddock. Test Plan: ./validate Reviewers: alexbiehl, hvr, gershomb, harpocrates, bgamari Reviewed By: alexbiehl Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4758 >--------------------------------------------------------------- 85309a3cda367425cca727dfa45e5e6c63b47391 compiler/deSugar/Desugar.hs | 8 +- compiler/deSugar/ExtractDocs.hs | 344 +++++++++++++++++++++ compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsDoc.hs | 92 +++++- compiler/iface/LoadIface.hs | 3 + compiler/iface/MkIface.hs | 26 +- compiler/main/GHC.hs | 3 + compiler/main/HscTypes.hs | 38 ++- compiler/main/InteractiveEval.hs | 68 ++++ compiler/typecheck/TcRnMonad.hs | 6 + docs/users_guide/8.6.1-notes.rst | 6 + docs/users_guide/ghci.rst | 8 + ghc/GHCi/UI.hs | 36 +++ mk/config.mk.in | 5 +- .../haddock/haddock_examples/haddock.Test.stderr | 83 ++--- .../should_compile_flag_haddock/T11768.stderr | 4 +- .../should_compile_flag_haddock/haddockA014.stderr | 2 +- .../should_compile_flag_haddock/haddockA015.stderr | 2 +- .../should_compile_flag_haddock/haddockA016.stderr | 2 +- .../should_compile_flag_haddock/haddockA018.stderr | 2 +- .../should_compile_flag_haddock/haddockA019.stderr | 2 +- .../should_compile_flag_haddock/haddockA020.stderr | 2 +- .../should_compile_flag_haddock/haddockA021.stderr | 4 +- .../should_compile_flag_haddock/haddockA023.stderr | 2 +- .../should_compile_flag_haddock/haddockA024.stderr | 2 +- .../should_compile_flag_haddock/haddockA025.stderr | 2 +- .../should_compile_flag_haddock/haddockA026.stderr | 2 +- .../should_compile_flag_haddock/haddockA027.stderr | 4 +- .../should_compile_flag_haddock/haddockA028.stderr | 2 +- .../should_compile_flag_haddock/haddockA029.stderr | 2 +- .../should_compile_flag_haddock/haddockA030.stderr | 5 +- .../should_compile_flag_haddock/haddockA031.stderr | 4 +- .../should_compile_flag_haddock/haddockA032.stderr | 6 +- .../should_compile_flag_haddock/haddockA034.stderr | 4 +- .../should_compile_flag_haddock/haddockA035.stderr | 10 +- .../should_compile_flag_haddock/haddockA036.stderr | 18 +- .../should_compile_flag_haddock/haddockA037.stderr | 4 +- testsuite/tests/showIface/DocsInHiFile.hs | 37 +++ testsuite/tests/showIface/DocsInHiFile0.stdout | 4 + testsuite/tests/showIface/DocsInHiFile1.stdout | 36 +++ testsuite/tests/showIface/Makefile | 8 + testsuite/tests/showIface/all.T | 8 + 42 files changed, 816 insertions(+), 91 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 85309a3cda367425cca727dfa45e5e6c63b47391 From git at git.haskell.org Tue Jun 5 02:53:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 02:53:07 +0000 (UTC) Subject: [commit: ghc] master: Introduce DerivingVia (8ed8b03) Message-ID: <20180605025307.85AA53ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ed8b037fee9611b1c4ef49adb6cf50bbd929a27/ghc >--------------------------------------------------------------- commit 8ed8b037fee9611b1c4ef49adb6cf50bbd929a27 Author: Ryan Scott Date: Mon Jun 4 21:20:02 2018 -0400 Introduce DerivingVia This implements the `DerivingVia` proposal put forth in https://github.com/ghc-proposals/ghc-proposals/pull/120. This introduces the `DerivingVia` deriving strategy. This is a generalization of `GeneralizedNewtypeDeriving` that permits the user to specify the type to `coerce` from. The major change in this patch is the introduction of the `ViaStrategy` constructor to `DerivStrategy`, which takes a type as a field. As a result, `DerivStrategy` is no longer a simple enumeration type, but rather something that must be renamed and typechecked. The process by which this is done is explained more thoroughly in section 3 of this paper ( https://www.kosmikus.org/DerivingVia/deriving-via-paper.pdf ), although I have inlined the relevant parts into Notes where possible. There are some knock-on changes as well. I took the opportunity to do some refactoring of code in `TcDeriv`, especially the `mkNewTypeEqn` function, since it was bundling all of the logic for (1) deriving instances for newtypes and (2) `GeneralizedNewtypeDeriving` into one huge broth. `DerivingVia` reuses much of part (2), so that was factored out as much as possible. Bumps the Haddock submodule. Test Plan: ./validate Reviewers: simonpj, bgamari, goldfire, alanz Subscribers: alanz, goldfire, rwbarton, thomie, mpickering, carter GHC Trac Issues: #15178 Differential Revision: https://phabricator.haskell.org/D4684 >--------------------------------------------------------------- 8ed8b037fee9611b1c4ef49adb6cf50bbd929a27 compiler/basicTypes/BasicTypes.hs | 27 - compiler/deSugar/DsMeta.hs | 31 +- compiler/hsSyn/Convert.hs | 18 +- compiler/hsSyn/HsDecls.hs | 66 ++- compiler/hsSyn/HsExtension.hs | 8 + compiler/hsSyn/HsInstances.hs | 5 + compiler/main/DynFlags.hs | 3 + compiler/parser/ApiAnnotation.hs | 1 + compiler/parser/Lexer.x | 2 + compiler/parser/Parser.y | 89 ++-- compiler/prelude/THNames.hs | 47 +- compiler/rename/RnSource.hs | 158 +++++- compiler/typecheck/TcDeriv.hs | 572 ++++++++++++++------- compiler/typecheck/TcDerivUtils.hs | 97 ++-- compiler/typecheck/TcHsType.hs | 53 +- docs/users_guide/8.6.1-notes.rst | 8 + docs/users_guide/glasgow_exts.rst | 128 ++++- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + .../template-haskell/Language/Haskell/TH/Lib.hs | 23 +- .../Language/Haskell/TH/Lib/Internal.hs | 27 +- .../template-haskell/Language/Haskell/TH/Ppr.hs | 19 +- .../template-haskell/Language/Haskell/TH/Syntax.hs | 1 + libraries/template-haskell/changelog.md | 2 + testsuite/tests/deriving/should_compile/all.T | 2 + .../should_compile/deriving-via-compile.hs | 459 +++++++++++++++++ .../should_compile/deriving-via-standalone.hs | 41 ++ testsuite/tests/deriving/should_fail/all.T | 4 + .../deriving/should_fail/deriving-via-fail.hs | 19 + .../deriving/should_fail/deriving-via-fail.stderr | 16 + .../deriving/should_fail/deriving-via-fail2.hs | 7 + .../deriving/should_fail/deriving-via-fail2.stderr | 6 + .../deriving/should_fail/deriving-via-fail3.hs | 3 + .../deriving/should_fail/deriving-via-fail3.stderr | 4 + .../deriving/should_fail/deriving-via-fail4.hs | 17 + .../deriving/should_fail/deriving-via-fail4.stderr | 18 + testsuite/tests/driver/T4437.hs | 1 + testsuite/tests/ghc-api/annotations/T10312.stdout | 4 +- utils/haddock | 2 +- 38 files changed, 1608 insertions(+), 381 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8ed8b037fee9611b1c4ef49adb6cf50bbd929a27 From git at git.haskell.org Tue Jun 5 14:02:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 14:02:04 +0000 (UTC) Subject: [commit: ghc] master: Rename some mutable closure types for consistency (4075656) Message-ID: <20180605140204.6D5263ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4075656e8bb2338d9857acfa54f8b9c5e0661f44/ghc >--------------------------------------------------------------- commit 4075656e8bb2338d9857acfa54f8b9c5e0661f44 Author: Ömer Sinan Ağacan Date: Tue Jun 5 17:00:22 2018 +0300 Rename some mutable closure types for consistency SMALL_MUT_ARR_PTRS_FROZEN0 -> SMALL_MUT_ARR_PTRS_FROZEN_DIRTY SMALL_MUT_ARR_PTRS_FROZEN -> SMALL_MUT_ARR_PTRS_FROZEN_CLEAN MUT_ARR_PTRS_FROZEN0 -> MUT_ARR_PTRS_FROZEN_DIRTY MUT_ARR_PTRS_FROZEN -> MUT_ARR_PTRS_FROZEN_CLEAN Naming is now consistent with other CLEAR/DIRTY objects (MVAR, MUT_VAR, MUT_ARR_PTRS). (alternatively we could rename MVAR_DIRTY/MVAR_CLEAN etc. to MVAR0/MVAR) Removed a few comments in Scav.c about FROZEN0 being on the mut_list because it's now clear from the closure type. Reviewers: bgamari, simonmar, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4784 >--------------------------------------------------------------- 4075656e8bb2338d9857acfa54f8b9c5e0661f44 compiler/cmm/CLabel.hs | 21 ++++---- compiler/codeGen/StgCmmPrim.hs | 16 +++--- includes/rts/storage/ClosureMacros.h | 8 +-- includes/rts/storage/ClosureTypes.h | 8 +-- includes/stg/MiscClosures.h | 8 +-- libraries/ghc-heap/GHC/Exts/Heap.hs | 2 +- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs | 8 +-- rts/CheckUnload.c | 8 +-- rts/ClosureFlags.c | 12 ++--- rts/Compact.cmm | 8 +-- rts/Heap.c | 6 +-- rts/LdvProfile.c | 8 +-- rts/PrimOps.cmm | 37 +++++--------- rts/Printer.c | 16 +++--- rts/ProfHeap.c | 8 +-- rts/RetainerProfile.c | 20 ++++---- rts/RtsSymbols.c | 8 +-- rts/StgMiscClosures.cmm | 16 +++--- rts/Weak.c | 2 +- rts/sm/CNF.c | 16 +++--- rts/sm/Compact.c | 16 +++--- rts/sm/Evac.c | 8 +-- rts/sm/Sanity.c | 4 +- rts/sm/Scav.c | 64 ++++++++++-------------- 24 files changed, 152 insertions(+), 176 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4075656e8bb2338d9857acfa54f8b9c5e0661f44 From git at git.haskell.org Tue Jun 5 14:02:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 14:02:07 +0000 (UTC) Subject: [commit: ghc] master: rts: Reuse dbl_link_remove in a few places (455477a) Message-ID: <20180605140207.4DC963ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/455477a3675c53ce186b3e75ec88f5488fec792c/ghc >--------------------------------------------------------------- commit 455477a3675c53ce186b3e75ec88f5488fec792c Author: Ömer Sinan Ağacan Date: Tue Jun 5 17:01:12 2018 +0300 rts: Reuse dbl_link_remove in a few places Test Plan: this validates Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4795 >--------------------------------------------------------------- 455477a3675c53ce186b3e75ec88f5488fec792c rts/sm/Evac.c | 18 ++---------------- 1 file changed, 2 insertions(+), 16 deletions(-) diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index 3415a4a..deaad27 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -278,14 +278,7 @@ evacuate_large(StgPtr p) } // remove from large_object list - if (bd->u.back) { - bd->u.back->link = bd->link; - } else { // first object in the list - gen->large_objects = bd->link; - } - if (bd->link) { - bd->link->u.back = bd->u.back; - } + dbl_link_remove(bd, &gen->large_objects); /* link it on to the evacuated large object list of the destination gen */ @@ -414,14 +407,7 @@ evacuate_compact (StgPtr p) } // remove from compact_objects list - if (bd->u.back) { - bd->u.back->link = bd->link; - } else { // first object in the list - gen->compact_objects = bd->link; - } - if (bd->link) { - bd->link->u.back = bd->u.back; - } + dbl_link_remove(bd, &gen->compact_objects); /* link it on to the evacuated compact object list of the destination gen */ From git at git.haskell.org Tue Jun 5 19:07:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 19:07:51 +0000 (UTC) Subject: [commit: ghc] branch 'wip/seq-res-eval' created Message-ID: <20180605190751.8F87B3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/seq-res-eval Referencing: ff1d40a9fd0e95fadfee6e0b9195e31818e3684f From git at git.haskell.org Tue Jun 5 19:07:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 5 Jun 2018 19:07:54 +0000 (UTC) Subject: [commit: ghc] wip/seq-res-eval: Let the simplifier know that seq# forces (ff1d40a) Message-ID: <20180605190754.771D23ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/seq-res-eval Link : http://ghc.haskell.org/trac/ghc/changeset/ff1d40a9fd0e95fadfee6e0b9195e31818e3684f/ghc >--------------------------------------------------------------- commit ff1d40a9fd0e95fadfee6e0b9195e31818e3684f Author: David Feuer Date: Tue Jun 5 12:45:34 2018 -0400 Let the simplifier know that seq# forces Summary: Add a special case in `simplAlt` to record that the result of `seq#` is in WHNF. Reviewers: simonmar, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15226 Differential Revision: https://phabricator.haskell.org/D4796 >--------------------------------------------------------------- ff1d40a9fd0e95fadfee6e0b9195e31818e3684f compiler/simplCore/Simplify.hs | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 6d1b434..bfaf7c3 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -28,7 +28,9 @@ import Name ( mkSystemVarName, isExternalName, getOccFS ) import Coercion hiding ( substCo, substCoVar ) import OptCoercion ( optCoercion ) import FamInstEnv ( topNormaliseType_maybe ) -import DataCon ( DataCon, dataConWorkId, dataConRepStrictness, dataConRepArgTys ) +import DataCon ( DataCon, dataConWorkId, dataConRepStrictness + , dataConRepArgTys, isUnboxedTupleCon + , StrictnessMark (MarkedStrict) ) import CoreMonad ( Tick(..), SimplMode(..) ) import CoreSyn import Demand ( StrictSig(..), dmdTypeDepth, isStrictDmd ) @@ -50,6 +52,7 @@ import Pair import Util import ErrUtils import Module ( moduleName, pprModuleName ) +import PrimOp ( PrimOp (SeqOp) ) {- @@ -2603,7 +2606,14 @@ simplAlt env scrut' _ case_bndr' cont' (DataAlt con, vs, rhs) -- Mark the ones that are in ! positions in the -- data constructor as certainly-evaluated. -- NB: simplLamBinders preserves this eval info - ; let vs_with_evals = add_evals (dataConRepStrictness con) + ; let vs_with_evals + | isUnboxedTupleCon con + , [s,x] <- vs + , Just (App (App (App (App (Var f) _) _) _) _) <- scrut' + , Just SeqOp <- isPrimOpId_maybe f + = [s, add_seq_eval x] + | otherwise = add_evals (dataConRepStrictness con) + ; (env', vs') <- simplLamBndrs env vs_with_evals -- Bind the case-binder to (con args) @@ -2645,6 +2655,18 @@ simplAlt env scrut' _ case_bndr' cont' (DataAlt con, vs, rhs) zap str v = setCaseBndrEvald str $ -- Add eval'dness info zapIdOccInfo v -- And kill occ info; -- see Note [Case alternative occ info] + -- add_seq_eval records the fact that the result of seq# is in WHNF. In + -- + -- case seq# v s of + -- (# s', v' #) -> E + -- + -- we want the compiler to be aware that v' is in WHNF in E. See #15226. + -- We don't record that v itself is in WHNF (and we can't do it here). + -- Should we do it elsewhere? Arguably it would be better to do all this + -- in PrelRules/caseRules, but at least for now that only allows + -- certain pattern transformations and doesn't allow branches to be + -- changed. + add_seq_eval x = setCaseBndrEvald MarkedStrict (zapIdOccInfo x) addAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv addAltUnfoldings env scrut case_bndr con_app From git at git.haskell.org Wed Jun 6 19:51:55 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 6 Jun 2018 19:51:55 +0000 (UTC) Subject: [commit: ghc] master: Let the simplifier know that seq# forces (d964b05) Message-ID: <20180606195155.5B9273ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d964b054d530ea9e29ed051fdf2b49a6afe465fb/ghc >--------------------------------------------------------------- commit d964b054d530ea9e29ed051fdf2b49a6afe465fb Author: David Feuer Date: Wed Jun 6 15:50:06 2018 -0400 Let the simplifier know that seq# forces Add a special case in `simplAlt` to record that the result of `seq#` is in WHNF. Reviewers: simonmar, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15226 Differential Revision: https://phabricator.haskell.org/D4796 >--------------------------------------------------------------- d964b054d530ea9e29ed051fdf2b49a6afe465fb compiler/coreSyn/CoreSyn.hs | 12 +++- compiler/simplCore/Simplify.hs | 108 ++++++++++++++++++++---------- testsuite/tests/perf/should_run/T15226.hs | 30 +++++++++ testsuite/tests/perf/should_run/all.T | 10 +++ 4 files changed, 123 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 d964b054d530ea9e29ed051fdf2b49a6afe465fb From git at git.haskell.org Thu Jun 7 04:06:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Jun 2018 04:06:30 +0000 (UTC) Subject: [commit: ghc] master: Do not scavenge SMALL_MUT_ARR_PTRS_CLEAN in mut_lists (635a59a) Message-ID: <20180607040630.28A313ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/635a59a5038fc6f4d8ea0a2c7e3f75057deb4e5e/ghc >--------------------------------------------------------------- commit 635a59a5038fc6f4d8ea0a2c7e3f75057deb4e5e Author: Ömer Sinan Ağacan Date: Thu Jun 7 07:05:12 2018 +0300 Do not scavenge SMALL_MUT_ARR_PTRS_CLEAN in mut_lists For the same reason with MUT_ARR_PTRS_CLEAN we don't need to scavenge SMALL_MUT_ARR_PTRS_CLEAN in mut_lists. Because SMALL_MUT_ARR_PTRS doesn't have a card table we don't have a special case when scavenging SMALL_MUT_ARR_PTRS_DIRTY in a mut_list. Test Plan: this validates Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar, bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4800 >--------------------------------------------------------------- 635a59a5038fc6f4d8ea0a2c7e3f75057deb4e5e rts/sm/Scav.c | 1 + 1 file changed, 1 insertion(+) diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 26687b8..39374c0 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -1583,6 +1583,7 @@ scavenge_mutable_list(bdescr *bd, generation *gen) // switch (get_itbl((StgClosure *)p)->type) { case MUT_ARR_PTRS_CLEAN: + case SMALL_MUT_ARR_PTRS_CLEAN: recordMutableGen_GC((StgClosure *)p,gen_no); continue; case MUT_ARR_PTRS_DIRTY: From git at git.haskell.org Thu Jun 7 10:06:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Jun 2018 10:06:15 +0000 (UTC) Subject: [commit: ghc] master: Comments only (7f45906) Message-ID: <20180607100615.221683ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7f45906428c97a097ca4d9e1f46d35495380bee1/ghc >--------------------------------------------------------------- commit 7f45906428c97a097ca4d9e1f46d35495380bee1 Author: Simon Peyton Jones Date: Thu Jun 7 11:02:55 2018 +0100 Comments only >--------------------------------------------------------------- 7f45906428c97a097ca4d9e1f46d35495380bee1 compiler/prelude/PrelRules.hs | 4 ++++ compiler/simplCore/Simplify.hs | 54 ++++++++++++++++++++++-------------------- 2 files changed, 32 insertions(+), 26 deletions(-) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index d0ad6c5..84e4173 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -1067,6 +1067,10 @@ Implementing seq#. The compiler has magic for SeqOp in - CoreUtils.exprOkForSpeculation; see Note [seq# and expr_ok] in CoreUtils + +- Simplify.addEvals records evaluated-ness for the result; see + Note [Adding evaluatedness info to pattern-bound variables] + in Simplify -} seqRule :: RuleM CoreExpr diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 89e7df2..a4651bb 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -2615,32 +2615,34 @@ simplAlt env scrut' _ case_bndr' cont' (DataAlt con, vs, rhs) ; rhs' <- simplExprC env'' rhs cont' ; return (DataAlt con, vs', rhs') } --- Note [Adding evaluatedness info to pattern-bound variables] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- add_evals records the evaluated-ness of the bound variables of --- a case pattern. This is *important*. Consider --- --- data T = T !Int !Int --- --- case x of { T a b -> T (a+1) b } --- --- We really must record that b is already evaluated so that we don't --- go and re-evaluate it when constructing the result. --- See Note [Data-con worker strictness] in MkId.hs --- --- NB: simplLamBinders preserves this eval info --- --- In addition to handling data constructor fields with !s, add_evals --- also records the fact that the result of seq# is always in WHNF. --- in --- --- case seq# v s of --- (# s', v' #) -> E --- --- we want the compiler to be aware that v' is in WHNF in E. See #15226. --- We don't record that v itself is in WHNF (and we can't do it here). --- I don't know if we should attempt to do so. +{- Note [Adding evaluatedness info to pattern-bound variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +addEvals records the evaluated-ness of the bound variables of +a case pattern. This is *important*. Consider + + data T = T !Int !Int + + case x of { T a b -> T (a+1) b } + +We really must record that b is already evaluated so that we don't +go and re-evaluate it when constructing the result. +See Note [Data-con worker strictness] in MkId.hs + +NB: simplLamBinders preserves this eval info + +In addition to handling data constructor fields with !s, addEvals +also records the fact that the result of seq# is always in WHNF. +See Note [seq# magic] in PrelRules. Example (Trac #15226): + + case seq# v s of + (# s', v' #) -> E + +we want the compiler to be aware that v' is in WHNF in E. + +Open problem: we don't record that v itself is in WHNF (and we can't +do it here). The right thing is to do some kind of binder-swap; +see Trac #15226 for discussion. +-} addEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id] -- See Note [Adding evaluatedness info to pattern-bound variables] From git at git.haskell.org Thu Jun 7 10:06:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Jun 2018 10:06:17 +0000 (UTC) Subject: [commit: ghc] master: Remove ad-hoc special case in occAnal (c16382d) Message-ID: <20180607100617.F2E603ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c16382d57ed9bf51089a14f079404ff8b4ce6eb2/ghc >--------------------------------------------------------------- commit c16382d57ed9bf51089a14f079404ff8b4ce6eb2 Author: Simon Peyton Jones Date: Thu Jun 7 11:03:21 2018 +0100 Remove ad-hoc special case in occAnal Back in 1999 I put this ad-hoc code in the Case-handling code for occAnal: occAnal env (Case scrut bndr ty alts) = ... -- Note [Case binder usage] -- ~~~~~~~~~~~~~~~~~~~~~~~~ -- The case binder gets a usage of either "many" or "dead", never "one". -- Reason: we like to inline single occurrences, to eliminate a binding, -- but inlining a case binder *doesn't* eliminate a binding. -- We *don't* want to transform -- case x of w { (p,q) -> f w } -- into -- case x of w { (p,q) -> f (p,q) } tag_case_bndr usage bndr = (usage', setIdOccInfo bndr final_occ_info) where occ_info = lookupDetails usage bndr usage' = usage `delDetails` bndr final_occ_info = case occ_info of IAmDead -> IAmDead _ -> noOccInfo But the comment looks wrong -- the bad inlining will not happen -- and I think it relates to some long-ago version of the simplifier. So I simply removed the special case, which gives more accurate occurrence-info to the case binder. Interestingly I got a slight improvement in nofib binary sizes. -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- cacheprof -0.1% +0.2% -0.7% -1.2% +8.6% -------------------------------------------------------------------------------- Min -0.2% 0.0% -14.5% -30.5% 0.0% Max -0.1% +0.2% +10.0% +10.0% +25.0% Geometric Mean -0.2% +0.0% -1.9% -5.4% +0.3% I have no idea if the improvement in runtime is real. I did look at the tiny increase in allocation for cacheprof and concluded that it was unimportant (I forget the details). Also the more accurate occ-info for the case binder meant that some inlining happens in one pass that previously took successive passes for the test dependent/should_compile/dynamic-paper (which has a known Russel-paradox infinite loop in the simplifier). In short, a small win: less ad-hoc complexity and slightly smaller binaries. >--------------------------------------------------------------- c16382d57ed9bf51089a14f079404ff8b4ce6eb2 compiler/simplCore/OccurAnal.hs | 75 +++++++++++----------- .../tests/codeGen/should_compile/T14626.stdout | 2 +- testsuite/tests/dependent/should_compile/all.T | 2 +- .../should_compile/dynamic-paper.stderr} | 0 .../tests/simplCore/should_compile/T13143.stderr | 4 +- .../tests/simplCore/should_compile/T3717.stderr | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 4 +- .../tests/simplCore/should_compile/T7360.stderr | 4 +- .../tests/simplCore/should_compile/T7865.stdout | 2 +- .../simplCore/should_compile/spec-inline.stderr | 6 +- 10 files changed, 54 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 c16382d57ed9bf51089a14f079404ff8b4ce6eb2 From git at git.haskell.org Thu Jun 7 22:10:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 7 Jun 2018 22:10:19 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Fix dynamic-paper stderr file (1508600) Message-ID: <20180607221019.2D81C3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1508600cb2dd6b57d27742411489b8c46b78b53f/ghc >--------------------------------------------------------------- commit 1508600cb2dd6b57d27742411489b8c46b78b53f Author: Ben Gamari Date: Thu Jun 7 22:05:51 2018 +0000 testsuite: Fix dynamic-paper stderr file The stderr file was empty, yet GHC fails with an error. >--------------------------------------------------------------- 1508600cb2dd6b57d27742411489b8c46b78b53f .../tests/dependent/should_compile/dynamic-paper.stderr | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr index 0519ecb..3ba4db2 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr @@ -1 +1,15 @@ +Simplifier ticks exhausted + When trying UnfoldingDone delta1 + To increase the limit, use -fsimpl-tick-factor=N (default 100). + If you need to increase the limit substantially, please file a + bug report and indicate the factor you needed. + + If GHC was unable to complete compilation even with a very large factor + (a thousand or more), please consult the "Known bugs or infelicities" + section in the Users Guide before filing a report. There are a + few situations unlikely to occur in practical programs for which + simplifier non-termination has been judged acceptable. + + To see detailed counts use -ddump-simpl-stats + Total ticks: 140004 From git at git.haskell.org Fri Jun 8 00:02:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:12 +0000 (UTC) Subject: [commit: hadrian] master: Fix missing symbols when cross-compiling (#583) (fcc62d1) Message-ID: <20180608000212.E25B83ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/fcc62d1efad0f216b5469f418f57b81a238804ea >--------------------------------------------------------------- commit fcc62d1efad0f216b5469f418f57b81a238804ea Author: Zhen Zhang Date: Fri Apr 27 18:57:59 2018 +0800 Fix missing symbols when cross-compiling (#583) >--------------------------------------------------------------- fcc62d1efad0f216b5469f418f57b81a238804ea src/Settings/Builders/Common.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 36be143..3b8a413 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -29,9 +29,7 @@ cIncludeArgs = do gmpIncludeDir <- getSetting GmpIncludeDir ffiIncludeDir <- getSetting FfiIncludeDir - cross <- expr crossCompiling - compilerOrGhc <- package compiler ||^ package ghc - mconcat [ not (cross && compilerOrGhc) ? arg "-Iincludes" + mconcat [ arg "-Iincludes" , arg $ "-I" ++ root -/- generatedDir , arg $ "-I" ++ path , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir] From git at git.haskell.org Fri Jun 8 00:02:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:14 +0000 (UTC) Subject: [commit: hadrian] master: Update cross-compiling doc (#586) (7c04521) Message-ID: <20180608000214.E4EA13ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/7c045215719b151a154f14e9eb6f8416419203af >--------------------------------------------------------------- commit 7c045215719b151a154f14e9eb6f8416419203af Author: Zhen Zhang Date: Fri Apr 27 18:59:47 2018 +0800 Update cross-compiling doc (#586) >--------------------------------------------------------------- 7c045215719b151a154f14e9eb6f8416419203af doc/cross-compile.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/cross-compile.md b/doc/cross-compile.md index 5611d2a..724d0e1 100644 --- a/doc/cross-compile.md +++ b/doc/cross-compile.md @@ -16,11 +16,13 @@ After all the dependencies are in place: - `git submodule update --init` - `./configure --target=arm-linux-gnueabihf` - `cd hadrian` -- Modify `src/UserSettings.hs`, set `stage1Only` and `crossCompiling` to `True`. +- Modify `src/UserSettings.hs`, set `stage1Only` to `True`. - Build the compiler by e.g. `./build.sh --flavour=quickest --integer-simple -V -j` After that, you should have built `inplace/bin/ghc-stage1` cross compiler. We will go to the next section to validate this. +**NOTE**: Use of `-c` to configure the target is currently not supported. Please manually run `./configure` like above. + ## Test run Write a simple hello world haskell program: From git at git.haskell.org Fri Jun 8 00:02:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:16 +0000 (UTC) Subject: [commit: hadrian] master: Add all the default-on extensions to build.global-db.bat (#587) (d8190ba) Message-ID: <20180608000216.E9FC53ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/d8190ba0a22ba6d0efbacf64e0186511fdb0fd34 >--------------------------------------------------------------- commit d8190ba0a22ba6d0efbacf64e0186511fdb0fd34 Author: Neil Mitchell Date: Fri Apr 27 22:52:49 2018 +0100 Add all the default-on extensions to build.global-db.bat (#587) >--------------------------------------------------------------- d8190ba0a22ba6d0efbacf64e0186511fdb0fd34 build.global-db.bat | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/build.global-db.bat b/build.global-db.bat index 0d6a696..1022beb 100644 --- a/build.global-db.bat +++ b/build.global-db.bat @@ -3,19 +3,25 @@ setlocal cd %~dp0 mkdir bin 2> nul -set ghcArgs=--make ^ - -Wall ^ - -fno-warn-name-shadowing ^ - -XRecordWildCards ^ - src\Main.hs ^ - -threaded ^ - -isrc ^ - -i..\libraries\Cabal\Cabal ^ - -rtsopts ^ - -with-rtsopts=-I0 ^ - -outputdir=bin ^ - -j ^ - -O ^ +set ghcArgs=--make ^ + -Wall ^ + -fno-warn-name-shadowing ^ + -XDeriveGeneric ^ + -XFlexibleInstances ^ + -XGeneralizedNewtypeDeriving ^ + -XLambdaCase ^ + -XRecordWildCards ^ + -XScopedTypeVariables ^ + -XTupleSections ^ + src\Main.hs ^ + -threaded ^ + -isrc ^ + -i..\libraries\Cabal\Cabal ^ + -rtsopts ^ + -with-rtsopts=-I0 ^ + -outputdir=bin ^ + -j ^ + -O ^ -o bin\hadrian set hadrianArgs=--lint ^ From git at git.haskell.org Fri Jun 8 00:02:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:18 +0000 (UTC) Subject: [commit: hadrian] master: Fix unlit by placing it under lib/bin/ instead of bin/ (#591) (a161b8e) Message-ID: <20180608000218.EECA63ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/a161b8eee6d0465a605a9fb21a5be41078e9b42f >--------------------------------------------------------------- commit a161b8eee6d0465a605a9fb21a5be41078e9b42f Author: Alp Mestanogullari Date: Fri May 11 00:29:34 2018 +0200 Fix unlit by placing it under lib/bin/ instead of bin/ (#591) A nicer fix would involve patching GHC to not just look under $libexec/ but also under the directory where the GHC binary itself lives (bin/ for hadrian), so that we can leave all binaries under bin/. Addresses Trac #15132. >--------------------------------------------------------------- a161b8eee6d0465a605a9fb21a5be41078e9b42f src/GHC.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 0262823..5c690dd 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -131,8 +131,10 @@ programPath context at Context {..} = do -- The @touchy@ utility lives in the @lib/bin@ directory instead of @bin@, -- which is likely just a historical accident that will hopefully be fixed. -- See: https://github.com/snowleopard/hadrian/issues/570 - path <- if package /= touchy then stageBinPath stage - else stageLibPath stage <&> (-/- "bin") + -- Likewise for 'unlit'. + path <- if package `elem` [touchy, unlit] + then stageLibPath stage <&> (-/- "bin") + else stageBinPath stage pgm <- programName context return $ path -/- pgm <.> exe From git at git.haskell.org Fri Jun 8 00:02:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:20 +0000 (UTC) Subject: [commit: hadrian] master: Fix redundant import, minor revision (1ee62bf) Message-ID: <20180608000220.F36EF3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/1ee62bf5ed6aa82cf57b8a5a8160e30d66f4a170 >--------------------------------------------------------------- commit 1ee62bf5ed6aa82cf57b8a5a8160e30d66f4a170 Author: Andrey Mokhov Date: Fri May 11 22:33:17 2018 +0200 Fix redundant import, minor revision >--------------------------------------------------------------- 1ee62bf5ed6aa82cf57b8a5a8160e30d66f4a170 src/Settings/Builders/Common.hs | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 3b8a413..1995c66 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -11,8 +11,7 @@ module Settings.Builders.Common ( import Base import Expression -import GHC.Packages -import Hadrian.Haskell.Cabal.PackageData as PD +import Hadrian.Haskell.Cabal.PackageData import Oracles.Flag import Oracles.Setting import Settings @@ -23,22 +22,21 @@ cIncludeArgs = do pkg <- getPackage root <- getBuildRoot path <- getBuildPath - incDirs <- getPackageData PD.includeDirs - depDirs <- getPackageData PD.depIncludeDirs + incDirs <- getPackageData includeDirs + depDirs <- getPackageData depIncludeDirs iconvIncludeDir <- getSetting IconvIncludeDir gmpIncludeDir <- getSetting GmpIncludeDir ffiIncludeDir <- getSetting FfiIncludeDir - mconcat [ arg "-Iincludes" , arg $ "-I" ++ root -/- generatedDir , arg $ "-I" ++ path , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir] , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir) - -- add the build path with include dirs in case we generated - -- some files with autoconf, which will end up in the build directory. + -- Add @incDirs@ in the build directory, since some files generated + -- with @autoconf@ may end up in the build directory. , pure [ "-I" ++ path -/- dir | dir <- incDirs ] - -- add the package directory with include dirs, for includes - -- shipped with the package + -- Add @incDirs@ in the package directory for include files shipped + -- with the package. , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ] , pure [ "-I" ++ unifyPath dir | dir <- depDirs ] ] @@ -58,12 +56,12 @@ cWarnings = mconcat packageDatabaseArgs :: Args packageDatabaseArgs = do - stage <- getStage - dbPath <- expr (packageDbPath stage) - expr (need [dbPath -/- packageDbStamp]) - root <- getBuildRoot - prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=") - arg $ prefix ++ root -/- relativePackageDbPath stage + stage <- getStage + dbPath <- expr (packageDbPath stage) + expr (need [dbPath -/- packageDbStamp]) + root <- getBuildRoot + prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=") + arg $ prefix ++ root -/- relativePackageDbPath stage bootPackageDatabaseArgs :: Args bootPackageDatabaseArgs = do From git at git.haskell.org Fri Jun 8 00:02:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:23 +0000 (UTC) Subject: [commit: hadrian] master: Add checkPpr package and infrastructure for testsuite packages (#596) (44368b6) Message-ID: <20180608000223.058953ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/44368b61d78b4ccf4e5aa6312cd64f4b2466efc4 >--------------------------------------------------------------- commit 44368b61d78b4ccf4e5aa6312cd64f4b2466efc4 Author: Andrey Mokhov Date: Sat May 12 00:28:56 2018 +0200 Add checkPpr package and infrastructure for testsuite packages (#596) See #593 >--------------------------------------------------------------- 44368b61d78b4ccf4e5aa6312cd64f4b2466efc4 src/GHC.hs | 16 ++++++++----- src/GHC/Packages.hs | 13 +++++----- src/Rules.hs | 44 ++++++++++++++++------------------ src/Rules/Program.hs | 68 ++++++++++++++++++++++++++-------------------------- src/Rules/Test.hs | 14 +++++------ 5 files changed, 77 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 44368b61d78b4ccf4e5aa6312cd64f4b2466efc4 From git at git.haskell.org Fri Jun 8 00:02:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:25 +0000 (UTC) Subject: [commit: hadrian] master: Add dependency on the new "llvm-passes" file. (#604) (85f2506) Message-ID: <20180608000225.0A5C53ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/85f2506f87c890ba985825c74dea92c10e80152e >--------------------------------------------------------------- commit 85f2506f87c890ba985825c74dea92c10e80152e Author: Kavon Farvardin Date: Wed May 16 18:28:04 2018 -0500 Add dependency on the new "llvm-passes" file. (#604) For details, see https://phabricator.haskell.org/D4695 >--------------------------------------------------------------- 85f2506f87c890ba985825c74dea92c10e80152e src/Base.hs | 1 + src/Rules/Generate.hs | 1 + src/Rules/Program.hs | 3 ++- 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Base.hs b/src/Base.hs index fea33a9..430078d 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -111,6 +111,7 @@ ghcDeps stage = mapM (\f -> stageLibPath stage <&> (-/- f)) [ "ghc-usage.txt" , "ghci-usage.txt" , "llvm-targets" + , "llvm-passes" , "platformConstants" , "settings" ] diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index cc2bf4b..8355ccc 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -164,6 +164,7 @@ copyRules = do prefix -/- "ghc-usage.txt" <~ return "driver" prefix -/- "ghci-usage.txt" <~ return "driver" prefix -/- "llvm-targets" <~ return "." + prefix -/- "llvm-passes" <~ return "." prefix -/- "platformConstants" <~ (buildRoot <&> (-/- generatedDir)) prefix -/- "settings" <~ return "." prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index aebaaab..083f3cd 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -45,7 +45,8 @@ buildProgram rs = do need [template] when (package == ghc) $ do -- GHC depends on @settings@, @platformConstants@, - -- @llvm-targets@, @ghc-usage.txt@, @ghci-usage.txt at . + -- @llvm-targets@, @ghc-usage.txt@, @ghci-usage.txt@, + -- @llvm-passes at . need =<< ghcDeps stage cross <- crossCompiling From git at git.haskell.org Fri Jun 8 00:02:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:27 +0000 (UTC) Subject: [commit: hadrian] master: Preliminary nofib rule (#599) (d6c4e04) Message-ID: <20180608000227.11E523ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/d6c4e0423c3c41f01daf6a3e0403e8cf6ca82d95 >--------------------------------------------------------------- commit d6c4e0423c3c41f01daf6a3e0403e8cf6ca82d95 Author: Alp Mestanogullari Date: Thu May 17 15:19:06 2018 +0200 Preliminary nofib rule (#599) * first draft of a nofib rule * address some of Andrey's feedback * refactor nofib into a proper Builder, now runs but one of the programs fails * more subtle error handling, docs * get rid of RunNofib builder, invoke commands directly >--------------------------------------------------------------- d6c4e0423c3c41f01daf6a3e0403e8cf6ca82d95 hadrian.cabal | 1 + src/Main.hs | 2 ++ src/Rules/Nofib.hs | 58 +++++++++++++++++++++++++++++++++++++++++++ src/Settings/Builders/Make.hs | 11 +++++++- 4 files changed, 71 insertions(+), 1 deletion(-) diff --git a/hadrian.cabal b/hadrian.cabal index 96d5891..0bcbf1f 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -62,6 +62,7 @@ executable hadrian , Rules.Gmp , Rules.Libffi , Rules.Library + , Rules.Nofib , Rules.Program , Rules.Register , Rules.Selftest diff --git a/src/Main.hs b/src/Main.hs index c90b052..083e683 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,6 +10,7 @@ import qualified Environment import qualified Rules import qualified Rules.Clean import qualified Rules.Documentation +import qualified Rules.Nofib import qualified Rules.SourceDist import qualified Rules.Selftest import qualified Rules.Test @@ -43,6 +44,7 @@ main = do Rules.buildRules Rules.Documentation.documentationRules Rules.Clean.cleanRules + Rules.Nofib.nofibRules Rules.oracleRules Rules.Selftest.selftestRules Rules.SourceDist.sourceDistRules diff --git a/src/Rules/Nofib.hs b/src/Rules/Nofib.hs new file mode 100644 index 0000000..e0ef5ea --- /dev/null +++ b/src/Rules/Nofib.hs @@ -0,0 +1,58 @@ +module Rules.Nofib where + +import Base +import Expression +import GHC +import Oracles.Setting +import Target + +import System.Environment +import System.Exit + +nofibRules :: Rules () +nofibRules = do + root <- buildRootRules + + -- a phony "nofib" rule that just triggers + -- the rule below. + "nofib" ~> need [root -/- nofibLogFile] + + -- a rule to produce /nofig-log + -- by running the nofib suite and capturing + -- the relevant output. + root -/- nofibLogFile %> \fp -> do + needNofibDeps + + makePath <- builderPath (Make "nofib") + top <- topDirectory + ghcPath <- builderPath (Ghc CompileHs Stage2) + perlPath <- builderPath Perl + + -- some makefiles in nofib rely on a $MAKE + -- env var being defined + liftIO (setEnv "MAKE" makePath) + + -- this runs make commands in the nofib + -- subdirectory, passing the path to + -- the GHC to benchmark and perl to + -- nofib's makefiles. + let nofibArgs = ["WithNofibHc=" ++ (top -/- ghcPath), "PERL=" ++ perlPath] + unit $ cmd (Cwd "nofib") [makePath] ["clean"] + unit $ cmd (Cwd "nofib") [makePath] (nofibArgs ++ ["boot"]) + (Exit e, Stdouterr log) <- cmd (Cwd "nofib") [makePath] nofibArgs + writeFile' fp log + if e == ExitSuccess + then putLoud $ "nofib log available at " ++ fp + else error $ "nofib failed, full log available at " ++ fp + +nofibLogFile :: FilePath +nofibLogFile = "nofib-log" + + +-- the dependencies that nofib seems to require. +needNofibDeps :: Action () +needNofibDeps = do + unlitPath <- programPath (Context Stage1 unlit vanilla) + mtlPath <- pkgConfFile (Context Stage1 mtl vanilla) + need [ unlitPath, mtlPath ] + needBuilder (Ghc CompileHs Stage2) diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index cc350df..79d73cc 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -1,5 +1,6 @@ module Settings.Builders.Make (makeBuilderArgs) where +import Builder import Rules.Gmp import Rules.Libffi import Settings.Builders.Common @@ -9,8 +10,16 @@ makeBuilderArgs = do threads <- shakeThreads <$> expr getShakeOptions gmpPath <- expr gmpBuildPath libffiPath <- expr libffiBuildPath + ghcPath <- expr $ + (-/-) <$> topDirectory <*> builderPath (Ghc CompileHs Stage2) + perlPath <- expr $ builderPath Perl let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads mconcat [ builder (Make gmpPath ) ? pure ["MAKEFLAGS=-j" ++ t] , builder (Make libffiPath ) ? pure ["MAKEFLAGS=-j" ++ t, "install"] - , builder (Make "testsuite/tests") ? pure ["THREADS=" ++ t, "fast"] ] + , builder (Make "testsuite/tests") ? pure ["THREADS=" ++ t, "fast"] + , builder (Make "nofib" ) ? pure + [ "WithNofibHc=" ++ ghcPath + , "PERL=" ++ perlPath + ] + ] From git at git.haskell.org Fri Jun 8 00:02:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:29 +0000 (UTC) Subject: [commit: hadrian] master: remove (unnecessary) recursive dependency involving ghcPath (#606) (3837187) Message-ID: <20180608000229.169933ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/3837187e57bfcc9c00a717eb70cb3e9271525047 >--------------------------------------------------------------- commit 3837187e57bfcc9c00a717eb70cb3e9271525047 Author: Alp Mestanogullari Date: Fri May 18 11:58:12 2018 +0200 remove (unnecessary) recursive dependency involving ghcPath (#606) >--------------------------------------------------------------- 3837187e57bfcc9c00a717eb70cb3e9271525047 src/Settings/Builders/Make.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index 79d73cc..d231fd7 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -1,6 +1,5 @@ module Settings.Builders.Make (makeBuilderArgs) where -import Builder import Rules.Gmp import Rules.Libffi import Settings.Builders.Common @@ -10,16 +9,9 @@ makeBuilderArgs = do threads <- shakeThreads <$> expr getShakeOptions gmpPath <- expr gmpBuildPath libffiPath <- expr libffiBuildPath - ghcPath <- expr $ - (-/-) <$> topDirectory <*> builderPath (Ghc CompileHs Stage2) - perlPath <- expr $ builderPath Perl let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads mconcat [ builder (Make gmpPath ) ? pure ["MAKEFLAGS=-j" ++ t] , builder (Make libffiPath ) ? pure ["MAKEFLAGS=-j" ++ t, "install"] , builder (Make "testsuite/tests") ? pure ["THREADS=" ++ t, "fast"] - , builder (Make "nofib" ) ? pure - [ "WithNofibHc=" ++ ghcPath - , "PERL=" ++ perlPath - ] ] From git at git.haskell.org Fri Jun 8 00:02:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:31 +0000 (UTC) Subject: [commit: hadrian] master: Add ghc-heap (c0292ff) Message-ID: <20180608000231.1BD5C3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/c0292ffcaee940cfd3a81a878a680e0e273c10bc >--------------------------------------------------------------- commit c0292ffcaee940cfd3a81a878a680e0e273c10bc Author: Andrey Mokhov Date: Sat May 26 00:17:48 2018 +0200 Add ghc-heap >--------------------------------------------------------------- c0292ffcaee940cfd3a81a878a680e0e273c10bc src/GHC.hs | 13 +++++++------ src/GHC/Packages.hs | 5 +++-- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 61bfb7f..bdb211b 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -3,12 +3,12 @@ module GHC ( -- * GHC packages array, base, binary, bytestring, cabal, checkPpr, compareSizes, compiler, containers, deepseq, deriveConstants, directory, filepath, genapply, - genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg, - ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, - integerGmp, integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, - primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text, time, - touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, - defaultPackages, testsuitePackages, + genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghcHeap, ghci, + ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, + hpcBin, integerGmp, integerSimple, iservBin, libffi, mtl, parsec, parallel, + pretty, primitive, process, rts, runGhc, stm, templateHaskell, terminfo, + text, time, touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, + isGhcPackage, defaultPackages, testsuitePackages, -- * Package information programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage, @@ -46,6 +46,7 @@ stage0Packages = do , ghc , ghcBoot , ghcBootTh + , ghcHeap , ghci , ghcPkg , ghcTags diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 79830dc..e7ede7f 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -13,8 +13,8 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabal, checkPpr, compareSizes, compiler , containers, deepseq, deriveConstants, directory, filepath, genapply - , genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact, ghci, ghcPkg, ghcPrim - , ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp + , genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact, ghcHeap, ghci, ghcPkg + , ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp , integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, primitive , process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy , transformers, unlit, unix, win32, xhtml ] @@ -44,6 +44,7 @@ ghcBoot = hsLib "ghc-boot" ghcBootTh = hsLib "ghc-boot-th" ghcCabal = hsUtil "ghc-cabal" ghcCompact = hsLib "ghc-compact" +ghcHeap = hsLib "ghc-heap" ghci = hsLib "ghci" ghcPkg = hsUtil "ghc-pkg" ghcPrim = hsLib "ghc-prim" From git at git.haskell.org Fri Jun 8 00:02:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:02:33 +0000 (UTC) Subject: [commit: hadrian] master: Do not always add -Iincludes to C arguments (#610) (ec5e9d3) Message-ID: <20180608000233.206F83ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/ec5e9d3acdf9ca5ae0e5808ad6f510e9167f2552 >--------------------------------------------------------------- commit ec5e9d3acdf9ca5ae0e5808ad6f510e9167f2552 Author: Alp Mestanogullari Date: Wed Jun 6 22:26:13 2018 +0200 Do not always add -Iincludes to C arguments (#610) >--------------------------------------------------------------- ec5e9d3acdf9ca5ae0e5808ad6f510e9167f2552 src/Settings/Builders/Common.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 1995c66..ae660db 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -11,6 +11,7 @@ module Settings.Builders.Common ( import Base import Expression +import GHC.Packages import Hadrian.Haskell.Cabal.PackageData import Oracles.Flag import Oracles.Setting @@ -27,7 +28,7 @@ cIncludeArgs = do iconvIncludeDir <- getSetting IconvIncludeDir gmpIncludeDir <- getSetting GmpIncludeDir ffiIncludeDir <- getSetting FfiIncludeDir - mconcat [ arg "-Iincludes" + mconcat [ notStage0 ||^ package compiler ? arg "-Iincludes" , arg $ "-I" ++ root -/- generatedDir , arg $ "-I" ++ path , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir] From git at git.haskell.org Fri Jun 8 00:06:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:06:12 +0000 (UTC) Subject: [commit: ghc] master: Update hadrian submodule (f741711) Message-ID: <20180608000612.165D83ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7417118732d6c8431b3f281c3d34455c7443550/ghc >--------------------------------------------------------------- commit f7417118732d6c8431b3f281c3d34455c7443550 Author: Ben Gamari Date: Tue Jun 5 11:27:21 2018 -0400 Update hadrian submodule >--------------------------------------------------------------- f7417118732d6c8431b3f281c3d34455c7443550 hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index 7c3c45f..ec5e9d3 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit 7c3c45f4539af8e75764a1c100dfbb35a86f4be3 +Subproject commit ec5e9d3acdf9ca5ae0e5808ad6f510e9167f2552 From git at git.haskell.org Fri Jun 8 00:06:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:06:26 +0000 (UTC) Subject: [commit: ghc] master: Don't use unsafeGlobalDynFlags in optCoercion (64c71ce) Message-ID: <20180608000626.DE2E43ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64c71ce956af3af593a46ef0d615c7f6fe6ecece/ghc >--------------------------------------------------------------- commit 64c71ce956af3af593a46ef0d615c7f6fe6ecece Author: Ben Gamari Date: Thu Jun 7 13:20:30 2018 -0400 Don't use unsafeGlobalDynFlags in optCoercion This plumbs DynFlags through CoreOpt so optCoercion can finally eliminate its usage of `unsafeGlobalDynFlags`. Note that this doesn't completely eliminate `unsafeGlobalDynFlags` usage from this bit of the compiler. A few uses are introduced in call-sites where we don't (yet) have ready access to `DynFlags`. Test Plan: Validate Reviewers: goldfire Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4774 >--------------------------------------------------------------- 64c71ce956af3af593a46ef0d615c7f6fe6ecece compiler/coreSyn/CoreOpt.hs | 43 ++++++++++++++++++++++----------------- compiler/coreSyn/CoreUnfold.hs | 27 ++++++++++++------------ compiler/deSugar/Desugar.hs | 6 +++--- compiler/deSugar/DsBinds.hs | 4 ++-- compiler/simplCore/Simplify.hs | 5 +++-- compiler/specialise/Specialise.hs | 2 +- compiler/types/OptCoercion.hs | 12 +++++++---- 7 files changed, 55 insertions(+), 44 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 64c71ce956af3af593a46ef0d615c7f6fe6ecece From git at git.haskell.org Fri Jun 8 00:06:41 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:06:41 +0000 (UTC) Subject: [commit: ghc] master: WorkWrap: Rip out unsafeGlobalDynFlags usage in mkWwInlineRule (db4f064) Message-ID: <20180608000641.826EB3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db4f064eca209fde171d8a108cace6f27a5e9b27/ghc >--------------------------------------------------------------- commit db4f064eca209fde171d8a108cace6f27a5e9b27 Author: Ben Gamari Date: Thu Jun 7 13:20:49 2018 -0400 WorkWrap: Rip out unsafeGlobalDynFlags usage in mkWwInlineRule Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4775 >--------------------------------------------------------------- db4f064eca209fde171d8a108cace6f27a5e9b27 compiler/coreSyn/CoreUnfold.hs | 6 +++--- compiler/stranal/WorkWrap.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 20c8d0d..3d26d3c 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -104,10 +104,10 @@ mkDFunUnfolding bndrs con ops , df_args = map occurAnalyseExpr ops } -- See Note [Occurrence analysis of unfoldings] -mkWwInlineRule :: CoreExpr -> Arity -> Unfolding -mkWwInlineRule expr arity +mkWwInlineRule :: DynFlags -> CoreExpr -> Arity -> Unfolding +mkWwInlineRule dflags expr arity = mkCoreUnfolding InlineStable True - (simpleOptExpr unsafeGlobalDynFlags expr) + (simpleOptExpr dflags expr) (UnfWhen { ug_arity = arity, ug_unsat_ok = unSaturatedOk , ug_boring_ok = boringCxtNotOk }) diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 8da2a12..6289ba0 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -562,7 +562,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs -- inl_inline: see Note [Wrapper NoUserInline] -- inl_rule: RuleMatchInfo is (and must be) unaffected - wrap_id = fn_id `setIdUnfolding` mkWwInlineRule wrap_rhs arity + wrap_id = fn_id `setIdUnfolding` mkWwInlineRule dflags wrap_rhs arity `setInlinePragma` wrap_prag `setIdOccInfo` noOccInfo -- Zap any loop-breaker-ness, to avoid bleating from Lint From git at git.haskell.org Fri Jun 8 00:06:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:06:56 +0000 (UTC) Subject: [commit: ghc] master: Index arrays more eagerly (e7678d6) Message-ID: <20180608000656.21D1D3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e7678d6a0607013749e9ba4d88df949ad1192765/ghc >--------------------------------------------------------------- commit e7678d6a0607013749e9ba4d88df949ad1192765 Author: David Feuer Date: Thu Jun 7 13:21:41 2018 -0400 Index arrays more eagerly Many basic functions in `GHC.Arr` were unreasonably lazy about performing array lookups. This could lead to useless thunks at best and memory leaks at worst. Use eager lookups where they're obviously appropriate. Reviewers: bgamari, hvr Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4773 >--------------------------------------------------------------- e7678d6a0607013749e9ba4d88df949ad1192765 libraries/base/GHC/Arr.hs | 38 +++++++++++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 9 deletions(-) diff --git a/libraries/base/GHC/Arr.hs b/libraries/base/GHC/Arr.hs index 3698852..8dbda6f 100644 --- a/libraries/base/GHC/Arr.hs +++ b/libraries/base/GHC/Arr.hs @@ -508,6 +508,10 @@ listArray (l,u) es = runST (ST $ \s1# -> (!) :: Ix i => Array i e -> i -> e (!) arr@(Array l u n _) i = unsafeAt arr $ safeIndex (l,u) n i +{-# INLINE (!#) #-} +(!#) :: Ix i => Array i e -> i -> (# e #) +(!#) arr@(Array l u n _) i = unsafeAt# arr $ safeIndex (l,u) n i + {-# INLINE safeRangeSize #-} safeRangeSize :: Ix i => (i, i) -> Int safeRangeSize (l,u) = let r = rangeSize (l, u) @@ -551,6 +555,15 @@ unsafeAt :: Array i e -> Int -> e unsafeAt (Array _ _ _ arr#) (I# i#) = case indexArray# arr# i# of (# e #) -> e +-- | Look up an element in an array without forcing it +unsafeAt# :: Array i e -> Int -> (# e #) +unsafeAt# (Array _ _ _ arr#) (I# i#) = indexArray# arr# i# + +-- | A convenient version of unsafeAt# +unsafeAtA :: Applicative f + => Array i e -> Int -> f e +unsafeAtA ary i = case unsafeAt# ary i of (# e #) -> pure e + -- | The bounds with which an array was constructed. {-# INLINE bounds #-} bounds :: Array i e -> (i,i) @@ -570,7 +583,7 @@ indices (Array l u _ _) = range (l,u) {-# INLINE elems #-} elems :: Array i e -> [e] elems arr@(Array _ _ n _) = - [unsafeAt arr i | i <- [0 .. n - 1]] + [e | i <- [0 .. n - 1], e <- unsafeAtA arr i] -- | A right fold over the elements {-# INLINABLE foldrElems #-} @@ -578,7 +591,8 @@ foldrElems :: (a -> b -> b) -> b -> Array i a -> b foldrElems f b0 = \ arr@(Array _ _ n _) -> let go i | i == n = b0 - | otherwise = f (unsafeAt arr i) (go (i+1)) + | (# e #) <- unsafeAt# arr i + = f e (go (i+1)) in go 0 -- | A left fold over the elements @@ -587,7 +601,8 @@ foldlElems :: (b -> a -> b) -> b -> Array i a -> b foldlElems f b0 = \ arr@(Array _ _ n _) -> let go i | i == (-1) = b0 - | otherwise = f (go (i-1)) (unsafeAt arr i) + | (# e #) <- unsafeAt# arr i + = f (go (i-1)) e in go (n-1) -- | A strict right fold over the elements @@ -596,7 +611,8 @@ foldrElems' :: (a -> b -> b) -> b -> Array i a -> b foldrElems' f b0 = \ arr@(Array _ _ n _) -> let go i a | i == (-1) = a - | otherwise = go (i-1) (f (unsafeAt arr i) $! a) + | (# e #) <- unsafeAt# arr i + = go (i-1) (f e $! a) in go (n-1) b0 -- | A strict left fold over the elements @@ -605,7 +621,8 @@ foldlElems' :: (b -> a -> b) -> b -> Array i a -> b foldlElems' f b0 = \ arr@(Array _ _ n _) -> let go i a | i == n = a - | otherwise = go (i+1) (a `seq` f a (unsafeAt arr i)) + | (# e #) <- unsafeAt# arr i + = go (i+1) (a `seq` f a e) in go 0 b0 -- | A left fold over the elements with no starting value @@ -614,7 +631,8 @@ foldl1Elems :: (a -> a -> a) -> Array i a -> a foldl1Elems f = \ arr@(Array _ _ n _) -> let go i | i == 0 = unsafeAt arr 0 - | otherwise = f (go (i-1)) (unsafeAt arr i) + | (# e #) <- unsafeAt# arr i + = f (go (i-1)) e in if n == 0 then errorWithoutStackTrace "foldl1: empty Array" else go (n-1) @@ -624,7 +642,8 @@ foldr1Elems :: (a -> a -> a) -> Array i a -> a foldr1Elems f = \ arr@(Array _ _ n _) -> let go i | i == n-1 = unsafeAt arr i - | otherwise = f (unsafeAt arr i) (go (i + 1)) + | (# e #) <- unsafeAt# arr i + = f e (go (i + 1)) in if n == 0 then errorWithoutStackTrace "foldr1: empty Array" else go 0 @@ -632,7 +651,7 @@ foldr1Elems f = \ arr@(Array _ _ n _) -> {-# INLINE assocs #-} assocs :: Ix i => Array i e -> [(i, e)] assocs arr@(Array l u _ _) = - [(i, arr ! i) | i <- range (l,u)] + [(i, e) | i <- range (l,u), let !(# e #) = arr !# i] -- | The 'accumArray' function deals with repeated indices in the association -- list using an /accumulating function/ which combines the values of @@ -740,7 +759,8 @@ amap f arr@(Array l u n@(I# n#) _) = runST (ST $ \s1# -> (# s2#, marr# #) -> let go i s# | i == n = done l u n marr# s# - | otherwise = fill marr# (i, f (unsafeAt arr i)) (go (i+1)) s# + | (# e #) <- unsafeAt# arr i + = fill marr# (i, f e) (go (i+1)) s# in go 0 s2# ) {- Note [amap] From git at git.haskell.org Fri Jun 8 00:07:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:07:13 +0000 (UTC) Subject: [commit: ghc] master: Fix unparseable pretty-printing of promoted data cons (767536c) Message-ID: <20180608000713.3B2A83ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/767536ccf95d8352d146b6544857b28d9c42937e/ghc >--------------------------------------------------------------- commit 767536ccf95d8352d146b6544857b28d9c42937e Author: Andreas Herrmann Date: Thu Jun 7 13:24:52 2018 -0400 Fix unparseable pretty-printing of promoted data cons Previously we would print code which would not round-trip: ``` > :set -XDataKinds > :set -XPolyKinds > data Proxy k = Proxy > _ :: Proxy '[ 'True ] error: Found hole: _ :: Proxy '['True] > _ :: Proxy '['True] error: Invalid type signature: _ :: ... Should be of form :: ``` Test Plan: Validate with T14343 Reviewers: RyanGlScott, goldfire, bgamari, tdammers Reviewed By: RyanGlScott, bgamari Subscribers: tdammers, rwbarton, thomie, carter GHC Trac Issues: #14343 Differential Revision: https://phabricator.haskell.org/D4746 >--------------------------------------------------------------- 767536ccf95d8352d146b6544857b28d9c42937e compiler/iface/IfaceType.hs | 18 ++++++++-- testsuite/tests/perf/compiler/T13035.stderr | 2 +- testsuite/tests/perf/compiler/T9872b.stderr | 32 +++++++++--------- testsuite/tests/printer/Makefile | 8 +++++ testsuite/tests/printer/T14343.hs | 12 +++++++ testsuite/tests/printer/T14343.stderr | 36 ++++++++++++++++++++ testsuite/tests/printer/T14343b.hs | 12 +++++++ testsuite/tests/printer/T14343b.stderr | 39 ++++++++++++++++++++++ testsuite/tests/printer/all.T | 2 ++ .../tests/typecheck/should_fail/T15067.stderr | 10 +++--- testsuite/tests/unboxedsums/T12711.stdout | 2 +- 11 files changed, 147 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 767536ccf95d8352d146b6544857b28d9c42937e From git at git.haskell.org Fri Jun 8 00:07:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:07:28 +0000 (UTC) Subject: [commit: ghc] master: Check if both branches of an Cmm if have the same target. (efea32c) Message-ID: <20180608000728.94E533ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/efea32cf2c41d35f2ba5a79bf70cc7768b7b0fd5/ghc >--------------------------------------------------------------- commit efea32cf2c41d35f2ba5a79bf70cc7768b7b0fd5 Author: klebinger.andreas at gmx.at Date: Thu Jun 7 13:26:19 2018 -0400 Check if both branches of an Cmm if have the same target. This for some reason or the other and makes it into the final binary. I've added the check to ContFlowOpt as that seems like a logical place for this. In a regular nofib run there were 30 occurences of this pattern. Test Plan: ci Reviewers: bgamari, simonmar, dfeuer, jrtc27, tdammers Reviewed By: bgamari, simonmar Subscribers: tdammers, dfeuer, rwbarton, thomie, carter GHC Trac Issues: #15188 Differential Revision: https://phabricator.haskell.org/D4740 >--------------------------------------------------------------- efea32cf2c41d35f2ba5a79bf70cc7768b7b0fd5 compiler/cmm/CmmContFlowOpt.hs | 13 +++++++++---- testsuite/tests/cmm/opt/Makefile | 6 ++++++ testsuite/tests/cmm/opt/T15188.cmm | 6 ++++++ .../should_run/bkprun02.stdout => cmm/opt/T15188.stdout} | 0 testsuite/tests/cmm/opt/all.T | 3 +++ 5 files changed, 24 insertions(+), 4 deletions(-) diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index 9f091da..146c4f3 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -254,8 +254,8 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id } -- unconditional jump to a block that can be shortcut. | Nothing <- callContinuation_maybe last = let oldSuccs = successors last - newSuccs = successors swapcond_last - in ( mapInsert bid (blockJoinTail head swapcond_last) blocks + newSuccs = successors rewrite_last + in ( mapInsert bid (blockJoinTail head rewrite_last) blocks , shortcut_map , if oldSuccs == newSuccs then backEdges @@ -283,8 +283,13 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id } Just b | Just dest <- canShortcut b -> dest _otherwise -> l - -- See Note [Invert Cmm conditionals] - swapcond_last + rewrite_last + -- Sometimes we can get rid of the conditional completely. + | CmmCondBranch _cond t f _l <- shortcut_last + , t == f + = CmmBranch t + + -- See Note [Invert Cmm conditionals] | CmmCondBranch cond t f l <- shortcut_last , hasOnePredecessor t -- inverting will make t a fallthrough , likelyTrue l || (numPreds f > 1) diff --git a/testsuite/tests/cmm/opt/Makefile b/testsuite/tests/cmm/opt/Makefile new file mode 100644 index 0000000..3c462ec --- /dev/null +++ b/testsuite/tests/cmm/opt/Makefile @@ -0,0 +1,6 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T15188: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm-cps -dsuppress-all T15188.cmm | grep if ; echo $$? diff --git a/testsuite/tests/cmm/opt/T15188.cmm b/testsuite/tests/cmm/opt/T15188.cmm new file mode 100644 index 0000000..59df92d --- /dev/null +++ b/testsuite/tests/cmm/opt/T15188.cmm @@ -0,0 +1,6 @@ +func(bits64 r2) { + foo: + if (r2 == 0) { goto bar; } else { goto bar; } + bar: + return (1); +} diff --git a/testsuite/tests/backpack/should_run/bkprun02.stdout b/testsuite/tests/cmm/opt/T15188.stdout similarity index 100% copy from testsuite/tests/backpack/should_run/bkprun02.stdout copy to testsuite/tests/cmm/opt/T15188.stdout diff --git a/testsuite/tests/cmm/opt/all.T b/testsuite/tests/cmm/opt/all.T new file mode 100644 index 0000000..b2c0f5f --- /dev/null +++ b/testsuite/tests/cmm/opt/all.T @@ -0,0 +1,3 @@ +# Verify that we optimize away conditional branches which always jump +# to the same target. +test('T15188', normal, run_command, ['$MAKE -s --no-print-directory T15188']) From git at git.haskell.org Fri Jun 8 00:07:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:07:43 +0000 (UTC) Subject: [commit: ghc] master: Move 'HsBangTy' out in constructor arguments (0361fc0) Message-ID: <20180608000743.BC3E53ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0361fc038e117befc3c59fcd589d640006407ed6/ghc >--------------------------------------------------------------- commit 0361fc038e117befc3c59fcd589d640006407ed6 Author: Alec Theriault Date: Thu Jun 7 13:26:53 2018 -0400 Move 'HsBangTy' out in constructor arguments When run with -haddock, a constructor argument can have both a a strictness/unpackedness annotation and a docstring. The parser binds 'HsBangTy' more tightly than 'HsDocTy', yet for constructor arguments we really need the 'HsBangTy' on the outside. This commit does this shuffling in the 'mkConDeclH98' and 'mkGadtDecl' smart constructors. Test Plan: haddockA038, haddockC038 Reviewers: bgamari, dfeuer Reviewed By: bgamari Subscribers: dfeuer, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4727 >--------------------------------------------------------------- 0361fc038e117befc3c59fcd589d640006407ed6 compiler/parser/RdrHsSyn.hs | 29 ++++++++++++++++++++-- .../haddock/should_compile_flag_haddock/all.T | 1 + .../should_compile_flag_haddock/haddockA038.hs | 14 +++++++++++ .../should_compile_flag_haddock/haddockA038.stderr | 7 ++++++ .../haddock/should_compile_noflag_haddock/all.T | 1 + .../should_compile_noflag_haddock/haddockC038.hs | 14 +++++++++++ 6 files changed, 64 insertions(+), 2 deletions(-) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index dfcccd3..35371af 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -626,8 +626,10 @@ mkConDeclH98 name mb_forall mb_cxt args , con_forall = isJust mb_forall , con_ex_tvs = mb_forall `orElse` [] , con_mb_cxt = mb_cxt - , con_args = args + , con_args = args' , con_doc = Nothing } + where + args' = nudgeHsSrcBangs args mkGadtDecl :: [Located RdrName] -> LHsType GhcPs -- Always a HsForAllTy @@ -638,7 +640,7 @@ mkGadtDecl names ty , con_forall = isLHsForAllTy ty , con_qvars = mkHsQTvs tvs , con_mb_cxt = mcxt - , con_args = args + , con_args = args' , con_res_ty = res_ty , con_doc = Nothing } where @@ -651,6 +653,7 @@ mkGadtDecl names ty split_rho tau = (Nothing, tau) (args, res_ty) = split_tau tau + args' = nudgeHsSrcBangs args -- See Note [GADT abstract syntax] in HsDecls split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty)) @@ -658,6 +661,28 @@ mkGadtDecl names ty split_tau (L _ (HsParTy _ ty)) = split_tau ty split_tau tau = (PrefixCon [], tau) +nudgeHsSrcBangs :: HsConDeclDetails GhcPs -> HsConDeclDetails GhcPs +-- ^ This function ensures that fields with strictness or packedness +-- annotations put these annotations on an outer 'HsBangTy'. +-- +-- The problem is that in the parser, strictness and packedness annotations +-- bind more tightly that docstrings. However, the expectation downstream of +-- the parser (by functions such as 'getBangType' and 'getBangStrictness') +-- is that docstrings bind more tightly so that 'HsBangTy' may end up as the +-- top-level type. +-- +-- See #15206 +nudgeHsSrcBangs details + = case details of + PrefixCon as -> PrefixCon (map go as) + RecCon r -> RecCon r + InfixCon a1 a2 -> InfixCon (go a1) (go a2) + where + go (L l (HsDocTy _ (L _ (HsBangTy _ s lty)) lds)) = + L l (HsBangTy noExt s (addCLoc lty lds (HsDocTy noExt lty lds))) + go lty = lty + + setRdrNameSpace :: RdrName -> NameSpace -> RdrName -- ^ This rather gruesome function is used mainly by the parser. -- When parsing: diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/all.T b/testsuite/tests/haddock/should_compile_flag_haddock/all.T index 90d4a55..5450fcb 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/all.T +++ b/testsuite/tests/haddock/should_compile_flag_haddock/all.T @@ -42,6 +42,7 @@ test('haddockA032', normal, compile, ['-haddock -ddump-parsed']) test('haddockA035', normal, compile, ['-haddock -ddump-parsed']) test('haddockA036', normal, compile, ['-haddock -ddump-parsed']) test('haddockA037', normal, compile, ['-haddock -ddump-parsed']) +test('haddockA038', normal, compile, ['-haddock -ddump-parsed']) # The tests below this line are not duplicated in # should_compile_noflag_haddock. diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.hs new file mode 100644 index 0000000..b839bde --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.hs @@ -0,0 +1,14 @@ +module UnamedConstructorStrictFields where +-- See #15206 + +data A = A +data B = B + +data Foo = MkFoo + {-# UNPACK #-} !A -- ^ Unpacked strict field + B + +data Bar = + {-# UNPACK #-} !A -- ^ Unpacked strict field + :%% + B diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr new file mode 100644 index 0000000..94318ef --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr @@ -0,0 +1,7 @@ + +==================== Parser ==================== +module UnamedConstructorStrictFields where +data A = A +data B = B +data Foo = MkFoo {-# UNPACK #-} !A Unpacked strict field B +data Bar = {-# UNPACK #-} !A Unpacked strict field :%% B diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/all.T b/testsuite/tests/haddock/should_compile_noflag_haddock/all.T index edb2bd0..4e52c2d 100644 --- a/testsuite/tests/haddock/should_compile_noflag_haddock/all.T +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/all.T @@ -42,6 +42,7 @@ test('haddockC032', normal, compile, ['']) test('haddockC035', normal, compile, ['']) test('haddockC036', normal, compile, ['']) test('haddockC037', normal, compile, ['']) +test('haddockC038', normal, compile, ['']) # The tests below this line are not duplicated in # should_compile_flag_haddock. diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC038.hs b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC038.hs new file mode 100644 index 0000000..b839bde --- /dev/null +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC038.hs @@ -0,0 +1,14 @@ +module UnamedConstructorStrictFields where +-- See #15206 + +data A = A +data B = B + +data Foo = MkFoo + {-# UNPACK #-} !A -- ^ Unpacked strict field + B + +data Bar = + {-# UNPACK #-} !A -- ^ Unpacked strict field + :%% + B From git at git.haskell.org Fri Jun 8 00:08:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:08:00 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add test for #15232 (5026840) Message-ID: <20180608000800.1BD7A3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5026840fddc86c3bc10693eed676fbf6a74f4227/ghc >--------------------------------------------------------------- commit 5026840fddc86c3bc10693eed676fbf6a74f4227 Author: Ben Gamari Date: Thu Jun 7 13:27:37 2018 -0400 testsuite: Add test for #15232 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15232 Differential Revision: https://phabricator.haskell.org/D4807 >--------------------------------------------------------------- 5026840fddc86c3bc10693eed676fbf6a74f4227 testsuite/tests/typecheck/should_compile/T15232.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 13 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/T15232.hs b/testsuite/tests/typecheck/should_compile/T15232.hs new file mode 100644 index 0000000..ec7659a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15232.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wredundant-constraints -Wall -Werror #-} +import GHC.TypeLits (TypeError, ErrorMessage(..)) + +class C a where f :: a -> a +instance {-# OVERLAPPING #-} C Int where f _ = 42 +instance {-# OVERLAPPABLE #-} TypeError ( 'Text "Only Int is supported" ) => C a where f = undefined + +main :: IO () +main = print $ f (42::Int) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 4328234..2b7b9ef 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -621,4 +621,5 @@ test('SplitWD', normal, compile, ['']) test('T14441', omit_ways(['profasm']), compile, ['']) test('T15050', [expect_broken(15050)], compile, ['']) test('T14735', normal, compile, ['']) +test('T15232', expect_broken(15232), compile, ['']) From git at git.haskell.org Fri Jun 8 00:08:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:08:15 +0000 (UTC) Subject: [commit: ghc] master: Fix #15243 by fixing incorrect uses of NotPromoted (569c16a) Message-ID: <20180608000815.B098A3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/569c16a76ead8f9012fafe7a7e97c72fabe0bb94/ghc >--------------------------------------------------------------- commit 569c16a76ead8f9012fafe7a7e97c72fabe0bb94 Author: Ryan Scott Date: Thu Jun 7 13:28:53 2018 -0400 Fix #15243 by fixing incorrect uses of NotPromoted In `Convert`, we were incorrectly using `NotPromoted` to denote type constructors that were actually intended to be promoted, resulting in poor `-ddump-splices` output (as seen in #15243). Easily fixed. Test Plan: make test TEST=T15243 Reviewers: bgamari, goldfire Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15243 Differential Revision: https://phabricator.haskell.org/D4809 >--------------------------------------------------------------- 569c16a76ead8f9012fafe7a7e97c72fabe0bb94 compiler/hsSyn/Convert.hs | 6 +++--- testsuite/tests/th/T15243.hs | 15 +++++++++++++++ testsuite/tests/th/T15243.stderr | 12 ++++++++++++ testsuite/tests/th/TH_PromotedTuple.stderr | 4 ++-- testsuite/tests/th/TH_TyInstWhere1.stderr | 4 ++-- testsuite/tests/th/all.T | 1 + 6 files changed, 35 insertions(+), 7 deletions(-) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 71cf5a6..7487983 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1344,7 +1344,7 @@ cvtTypeKind ty_str ty } PromotedT nm -> do { nm' <- cName nm - ; mk_apps (HsTyVar noExt NotPromoted + ; mk_apps (HsTyVar noExt Promoted (noLoc nm')) tys' } -- Promoted data constructor; hence cName @@ -1354,7 +1354,7 @@ cvtTypeKind ty_str ty | m == n -- Saturated -> returnL (HsExplicitTupleTy noExt tys') | otherwise - -> mk_apps (HsTyVar noExt NotPromoted + -> mk_apps (HsTyVar noExt Promoted (noLoc (getRdrName (tupleDataCon Boxed n)))) tys' where m = length tys' @@ -1367,7 +1367,7 @@ cvtTypeKind ty_str ty | [ty1, L _ (HsExplicitListTy _ ip tys2)] <- tys' -> returnL (HsExplicitListTy noExt ip (ty1:tys2)) | otherwise - -> mk_apps (HsTyVar noExt NotPromoted + -> mk_apps (HsTyVar noExt Promoted (noLoc (getRdrName consDataCon))) tys' diff --git a/testsuite/tests/th/T15243.hs b/testsuite/tests/th/T15243.hs new file mode 100644 index 0000000..8b36640 --- /dev/null +++ b/testsuite/tests/th/T15243.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -ddump-splices #-} +module T15243 where + +data Unit = Unit + +$([d| type family F (a :: k) :: k where + F 'Unit = 'Unit + F '(,) = '(,) + F '[] = '[] + F '(:) = '(:) + |]) diff --git a/testsuite/tests/th/T15243.stderr b/testsuite/tests/th/T15243.stderr new file mode 100644 index 0000000..26082a1 --- /dev/null +++ b/testsuite/tests/th/T15243.stderr @@ -0,0 +1,12 @@ +T15243.hs:(10,3)-(15,6): Splicing declarations + [d| type family F_at5 (a_at7 :: k_at6) :: k_at6 where + F_at5 'Unit = 'Unit + F_at5 '(,) = '(,) + F_at5 '[] = '[] + F_at5 '(:) = '(:) |] + ======> + type family F_a3ZE (a_a3ZG :: k_a3ZF) :: k_a3ZF where + F_a3ZE 'Unit = 'Unit + F_a3ZE '(,) = '(,) + F_a3ZE '[] = '[] + F_a3ZE '(:) = '(:) diff --git a/testsuite/tests/th/TH_PromotedTuple.stderr b/testsuite/tests/th/TH_PromotedTuple.stderr index 9619d52..92792a3 100644 --- a/testsuite/tests/th/TH_PromotedTuple.stderr +++ b/testsuite/tests/th/TH_PromotedTuple.stderr @@ -3,7 +3,7 @@ TH_PromotedTuple.hs:(14,32)-(16,43): Splicing type reportWarning (show ty) return ty ======> - '(Int, False) + '(Int, 'False) -TH_PromotedTuple.hs:14:32: Warning: +TH_PromotedTuple.hs:14:32: warning: AppT (AppT (PromotedTupleT 2) (ConT GHC.Types.Int)) (PromotedT GHC.Types.False) diff --git a/testsuite/tests/th/TH_TyInstWhere1.stderr b/testsuite/tests/th/TH_TyInstWhere1.stderr index 971b7ee..0d07db8 100644 --- a/testsuite/tests/th/TH_TyInstWhere1.stderr +++ b/testsuite/tests/th/TH_TyInstWhere1.stderr @@ -4,5 +4,5 @@ TH_TyInstWhere1.hs:(5,3)-(7,24): Splicing declarations F a b = False |] ======> type family F (a :: k) (b :: k) :: Bool where - F a a = True - F a b = False + F a a = 'True + F a b = 'False diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index e998bd0..b97ed40 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -414,3 +414,4 @@ test('T14875', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T14885a', normal, compile, ['']) test('T14885b', normal, compile, ['']) test('T14885c', normal, compile, ['']) +test('T15243', normal, compile, ['']) From git at git.haskell.org Fri Jun 8 00:08:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:08:30 +0000 (UTC) Subject: [commit: ghc] master: Document #15079 in the users' guide (bc9a838) Message-ID: <20180608000830.698B73ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bc9a838a27f40a6008e127d9105981713abe774b/ghc >--------------------------------------------------------------- commit bc9a838a27f40a6008e127d9105981713abe774b Author: Ryan Scott Date: Thu Jun 7 13:29:12 2018 -0400 Document #15079 in the users' guide Trac #15079 revealed an interesting limitation in the interaction between variable visibility and higher-rank kinds. We (Richard and I) came to the conclusion that this is an acceptable (albeit surprising) limitation, so this documents in the users' guide to hopefully eliminate some confusion for others in the future. Test Plan: Read it Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15079 Differential Revision: https://phabricator.haskell.org/D4803 >--------------------------------------------------------------- bc9a838a27f40a6008e127d9105981713abe774b docs/users_guide/glasgow_exts.rst | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 95b2256..98786e6 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9130,6 +9130,24 @@ In this redefinition, we give an explicit kind for ``(:~~:)``, deferring the cho of ``k2`` until after the first argument (``a``) has been given. With this declaration for ``(:~~:)``, the instance for ``HTestEquality`` is accepted. +Another difference between higher-rank kinds and types can be found in their +treatment of inferred and user-specified type variables. Consider the following +program: :: + + newtype Foo (f :: forall k. k -> Type) = MkFoo (f Int) + data Proxy a = Proxy + + foo :: Foo Proxy + foo = MkFoo Proxy + +The kind of ``Foo``'s parameter is ``forall k. k -> Type``, but the kind of +``Proxy`` is ``forall {k}. k -> Type``, where ``{k}`` denotes that the kind +variable ``k`` is to be inferred, not specified by the user. (See +:ref:`visible-type-application` for more discussion on the inferred-specified +distinction). GHC does not consider ``forall k. k -> Type`` and +``forall {k}. k -> Type`` to be equal at the kind level, and thus rejects +``Foo Proxy`` as ill-kinded. + Constraints in kinds -------------------- From git at git.haskell.org Fri Jun 8 00:08:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:08:44 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Skip T13838 in ghci way (04e29fc) Message-ID: <20180608000844.CD6893ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/04e29fc63e1f1d975c73449b27471cf59c9ffca2/ghc >--------------------------------------------------------------- commit 04e29fc63e1f1d975c73449b27471cf59c9ffca2 Author: Ben Gamari Date: Thu Jun 7 13:30:13 2018 -0400 testsuite: Skip T13838 in ghci way Test Plan: `make slowtest TEST=T13838` Reviewers: alpmestan, dfeuer Reviewed By: dfeuer Subscribers: dfeuer, rwbarton, thomie, carter GHC Trac Issues: #15238 Differential Revision: https://phabricator.haskell.org/D4802 >--------------------------------------------------------------- 04e29fc63e1f1d975c73449b27471cf59c9ffca2 testsuite/tests/typecheck/should_run/all.T | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 3344d4c..a96c2b7 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -130,7 +130,9 @@ test('TypeableEq', normal, compile_and_run, ['']) test('T13435', normal, compile_and_run, ['']) test('T11715', exit_code(1), compile_and_run, ['']) test('T13594a', normal, ghci_script, ['T13594a.script']) -test('T13838', [exit_code(1)], compile_and_run, ['-fdefer-type-errors']) + +# GHCi exits with code zero due to deferred type errors +test('T13838', [exit_code(1), omit_ways(['ghci'])], compile_and_run, ['-fdefer-type-errors']) test('T14218', normal, compile_and_run, ['']) test('T14236', normal, compile_and_run, ['']) test('T14925', normal, compile_and_run, ['']) From git at git.haskell.org Fri Jun 8 00:08:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:08:59 +0000 (UTC) Subject: [commit: ghc] master: Don't expose (~#), (~R#), (~P#) from GHC.Prim (5926b6e) Message-ID: <20180608000859.CFE863ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5926b6ed0dcc86f8fd6038fdcc5e2ba2856f40ce/ghc >--------------------------------------------------------------- commit 5926b6ed0dcc86f8fd6038fdcc5e2ba2856f40ce Author: Ryan Scott Date: Thu Jun 7 13:30:28 2018 -0400 Don't expose (~#), (~R#), (~P#) from GHC.Prim Currently, the primitive `(~#)`, `(~R#)`, and `(~P#)` type constructors are wired in to be exported from `GHC.Prim`. This has some unfortunate consequences, however. It turns out that `(~#)` is actually a legal infix identifier, so users can make use of unboxed equalities in strange ways in user code (see #15209). The other two, `(~R#)` and `(~P#)`, can't be used in source code, but they can be observed with GHCi's `:browse` command, which is somewhat unnerving. The fix for both of these problems is simple: just don't wire them to be exported from `GHC.Prim`. Test Plan: make test TEST="T12023 T15209" Reviewers: bgamari, dfeuer Reviewed By: bgamari, dfeuer Subscribers: rwbarton, thomie, carter, dfeuer GHC Trac Issues: #12023, #15209 Differential Revision: https://phabricator.haskell.org/D4801 >--------------------------------------------------------------- 5926b6ed0dcc86f8fd6038fdcc5e2ba2856f40ce compiler/prelude/PrelInfo.hs | 2 +- compiler/prelude/TysPrim.hs | 22 +++++++++++++++++----- testsuite/tests/ghci/scripts/Makefile | 5 +++++ testsuite/tests/ghci/scripts/T12023.script | 1 + .../tests/ghci/scripts/T12023.stdout | 0 testsuite/tests/ghci/scripts/all.T | 2 ++ testsuite/tests/parser/should_fail/T15209.hs | 7 +++++++ testsuite/tests/parser/should_fail/T15209.stderr | 2 ++ testsuite/tests/parser/should_fail/all.T | 1 + 9 files changed, 36 insertions(+), 6 deletions(-) diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 8d1f140..2a5fad6 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -252,7 +252,7 @@ ghcPrimExports = map (avail . idName) ghcPrimIds ++ map (avail . idName . primOpId) allThePrimOps ++ [ AvailTC n [n] [] - | tc <- funTyCon : primTyCons, let n = tyConName tc ] + | tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc ] {- ************************************************************************ diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index f7a51a5..ff61878 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -30,7 +30,7 @@ module TysPrim( tYPE, primRepToRuntimeRep, funTyCon, funTyConName, - primTyCons, + unexposedPrimTyCons, exposedPrimTyCons, primTyCons, charPrimTyCon, charPrimTy, charPrimTyConName, intPrimTyCon, intPrimTy, intPrimTyConName, @@ -118,7 +118,22 @@ import Data.Char -} primTyCons :: [TyCon] -primTyCons +primTyCons = unexposedPrimTyCons ++ exposedPrimTyCons + +-- | Primitive 'TyCon's that are defined in "GHC.Prim" but not exposed. +-- It's important to keep these separate as we don't want users to be able to +-- write them (see Trac #15209) or see them in GHCi's @:browse@ output +-- (see Trac #12023). +unexposedPrimTyCons :: [TyCon] +unexposedPrimTyCons + = [ eqPrimTyCon + , eqReprPrimTyCon + , eqPhantPrimTyCon + ] + +-- | Primitive 'TyCon's that are defined in, and exported from, "GHC.Prim". +exposedPrimTyCons :: [TyCon] +exposedPrimTyCons = [ addrPrimTyCon , arrayPrimTyCon , byteArrayPrimTyCon @@ -150,9 +165,6 @@ primTyCons , wordPrimTyCon , word32PrimTyCon , word64PrimTyCon - , eqPrimTyCon - , eqReprPrimTyCon - , eqPhantPrimTyCon , tYPETyCon diff --git a/testsuite/tests/ghci/scripts/Makefile b/testsuite/tests/ghci/scripts/Makefile index 5f84865..40ba561 100644 --- a/testsuite/tests/ghci/scripts/Makefile +++ b/testsuite/tests/ghci/scripts/Makefile @@ -61,3 +61,8 @@ T11389: # (without -v0) '$(TEST_HC)' $(filter-out -v0,$(TEST_HC_OPTS_INTERACTIVE)) \ -ghci-script T11389.script < /dev/null | grep 'configuration' + +.PHONY: T12023 +T12023: + -'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) \ + -ghci-script T12023.script < /dev/null | grep -c -E '(~#|~R#|~P#)' diff --git a/testsuite/tests/ghci/scripts/T12023.script b/testsuite/tests/ghci/scripts/T12023.script new file mode 100644 index 0000000..c7552fe --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12023.script @@ -0,0 +1 @@ +:browse GHC.Prim diff --git a/libraries/base/tests/dynamic005.stdout b/testsuite/tests/ghci/scripts/T12023.stdout similarity index 100% copy from libraries/base/tests/dynamic005.stdout copy to testsuite/tests/ghci/scripts/T12023.stdout diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index f4b4177..e803522 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -239,6 +239,8 @@ test('T12007', normal, ghci_script, ['T12007.script']) test('T11975', normal, ghci_script, ['T11975.script']) test('T10963', normal, ghci_script, ['T10963.script']) test('T11721', normal, ghci_script, ['T11721.script']) +test('T12023', normal, run_command, + ['$MAKE -s --no-print-directory T12023']) test('T12520', normal, ghci_script, ['T12520.script']) test('T12091', [extra_run_opts('-fobject-code')], ghci_script, ['T12091.script']) diff --git a/testsuite/tests/parser/should_fail/T15209.hs b/testsuite/tests/parser/should_fail/T15209.hs new file mode 100644 index 0000000..1679d80 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15209.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs, TypeOperators #-} +module T15209 where + +import GHC.Prim + +foo :: a ~# Int -> () +foo = () diff --git a/testsuite/tests/parser/should_fail/T15209.stderr b/testsuite/tests/parser/should_fail/T15209.stderr new file mode 100644 index 0000000..f5418fa --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15209.stderr @@ -0,0 +1,2 @@ + +T15209.hs:6:8: error: Not in scope: type constructor or class ‘~#’ diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 01075f2..9fcc3ba 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -110,6 +110,7 @@ test('T13450', normal, compile_fail, ['']) test('T13450TH', normal, compile_fail, ['']) test('T14588', normal, compile_fail, ['']) test('T14740', normal, compile_fail, ['']) +test('T15209', normal, compile_fail, ['']) test('NoNumericUnderscores0', normal, compile_fail, ['']) test('NoNumericUnderscores1', normal, compile_fail, ['']) From git at git.haskell.org Fri Jun 8 00:09:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:09:14 +0000 (UTC) Subject: [commit: ghc] master: Fix #15236 by removing parentheses from funTyConName (3397396) Message-ID: <20180608000914.729FD3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3397396a385ef9f493cf1e20894e88d21dfec48d/ghc >--------------------------------------------------------------- commit 3397396a385ef9f493cf1e20894e88d21dfec48d Author: Ryan Scott Date: Thu Jun 7 13:30:44 2018 -0400 Fix #15236 by removing parentheses from funTyConName Currently, `funTyConName` is defined as: ```lang=haskell funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon ``` What's strange about this definition is that there are extraneous parentheses around `->`, which is quite unlike every other infix `Name`. As a result, the `:info (->)` output is totally garbled (see Trac #15236). It's quite straightforward to fix that particular bug by removing the extraneous parentheses. However, it turns out that this makes some test output involving `Show` instances for `TypeRep` look less appealing, since `->` is no longer surrounded with parentheses when applied prefix. But neither were any /other/ infix type constructors! The right fix there was to change `showTypeable` to put parentheses around prefix applications of infix tycons. Test Plan: ./validate Reviewers: bgamari, hvr Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15236 Differential Revision: https://phabricator.haskell.org/D4799 >--------------------------------------------------------------- 3397396a385ef9f493cf1e20894e88d21dfec48d compiler/prelude/TysPrim.hs | 2 +- libraries/base/Data/Typeable/Internal.hs | 30 +++++++++++++++++++--- testsuite/tests/ghci/scripts/T8535.stdout | 2 +- testsuite/tests/ghci/scripts/ghci020.stdout | 2 +- testsuite/tests/ghci/should_run/T10145.stdout | 2 +- testsuite/tests/typecheck/should_run/TypeOf.stdout | 2 +- 6 files changed, 31 insertions(+), 9 deletions(-) diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index ff61878..754bb8f 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -340,7 +340,7 @@ openBetaTy = mkTyVarTy openBetaTyVar -} funTyConName :: Name -funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon +funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon -- | The @(->)@ type constructor. -- diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 6c52cc5..3b7753d 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -85,7 +85,7 @@ import GHC.Base import qualified GHC.Arr as A import GHC.Types ( TYPE ) import Data.Type.Equality -import GHC.List ( splitAt, foldl' ) +import GHC.List ( splitAt, foldl', elem ) import GHC.Word import GHC.Show import GHC.TypeLits ( KnownSymbol, symbolVal', AppendSymbol ) @@ -777,11 +777,11 @@ showTypeable _ rep | isTupleTyCon tc = showChar '(' . showArgs (showChar ',') tys . showChar ')' where (tc, tys) = splitApps rep -showTypeable p (TrTyCon {trTyCon = tycon, trKindVars = []}) - = showsPrec p tycon +showTypeable _ (TrTyCon {trTyCon = tycon, trKindVars = []}) + = showTyCon tycon showTypeable p (TrTyCon {trTyCon = tycon, trKindVars = args}) = showParen (p > 9) $ - showsPrec p tycon . + showTyCon tycon . showChar ' ' . showArgs (showChar ' ') args showTypeable p (TrFun {trFunArg = x, trFunRes = r}) @@ -841,6 +841,28 @@ isTupleTyCon tc | ('(':',':_) <- tyConName tc = True | otherwise = False +-- This is only an approximation. We don't have the general +-- character-classification machinery here, so we just do our best. +-- This should work for promoted Haskell 98 data constructors and +-- for TypeOperators type constructors that begin with ASCII +-- characters, but it will miss Unicode operators. +-- +-- If we wanted to catch Unicode as well, we ought to consider moving +-- GHC.Lexeme from ghc-boot-th to base. Then we could just say: +-- +-- startsVarSym symb || startsConSym symb +-- +-- But this is a fair deal of work just for one corner case, so I think I'll +-- leave it like this unless someone shouts. +isOperatorTyCon :: TyCon -> Bool +isOperatorTyCon tc + | symb : _ <- tyConName tc + , symb `elem` "!#$%&*+./<=>?@\\^|-~:" = True + | otherwise = False + +showTyCon :: TyCon -> ShowS +showTyCon tycon = showParen (isOperatorTyCon tycon) (shows tycon) + showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout index 873b992..6ae0c4c 100644 --- a/testsuite/tests/ghci/scripts/T8535.stdout +++ b/testsuite/tests/ghci/scripts/T8535.stdout @@ -1,5 +1,5 @@ data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’ -infixr 0 `(->)` +infixr 0 -> instance Applicative ((->) a) -- Defined in ‘GHC.Base’ instance Functor ((->) r) -- Defined in ‘GHC.Base’ instance Monad ((->) r) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout index 873b992..6ae0c4c 100644 --- a/testsuite/tests/ghci/scripts/ghci020.stdout +++ b/testsuite/tests/ghci/scripts/ghci020.stdout @@ -1,5 +1,5 @@ data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’ -infixr 0 `(->)` +infixr 0 -> instance Applicative ((->) a) -- Defined in ‘GHC.Base’ instance Functor ((->) r) -- Defined in ‘GHC.Base’ instance Monad ((->) r) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/should_run/T10145.stdout b/testsuite/tests/ghci/should_run/T10145.stdout index 873b992..6ae0c4c 100644 --- a/testsuite/tests/ghci/should_run/T10145.stdout +++ b/testsuite/tests/ghci/should_run/T10145.stdout @@ -1,5 +1,5 @@ data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’ -infixr 0 `(->)` +infixr 0 -> instance Applicative ((->) a) -- Defined in ‘GHC.Base’ instance Functor ((->) r) -- Defined in ‘GHC.Base’ instance Monad ((->) r) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout index 6e9a28e..912fe39 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.stdout +++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout @@ -21,4 +21,4 @@ Proxy * * Proxy * * Proxy RuntimeRep 'LiftedRep Proxy (Nat,Symbol) ('(,) Nat Symbol 1 "hello") -Proxy (* -> * -> Constraint) (~~ * *) +Proxy (* -> * -> Constraint) ((~~) * *) From git at git.haskell.org Fri Jun 8 00:09:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:09:28 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix reference to srt_bitmap in ASSERT in RetainerProfile (838cb53) Message-ID: <20180608000928.BBD233ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/838cb53a80cf468df68975c613fa275338d8d355/ghc >--------------------------------------------------------------- commit 838cb53a80cf468df68975c613fa275338d8d355 Author: Ben Gamari Date: Thu Jun 7 13:31:26 2018 -0400 rts: Fix reference to srt_bitmap in ASSERT in RetainerProfile Test Plan: Validate Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4798 >--------------------------------------------------------------- 838cb53a80cf468df68975c613fa275338d8d355 rts/RetainerProfile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c index b7c85e6..6a0af21 100644 --- a/rts/RetainerProfile.c +++ b/rts/RetainerProfile.c @@ -535,7 +535,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // SRT only case THUNK_STATIC: - ASSERT(get_itbl(c)->srt_bitmap != 0); + ASSERT(get_itbl(c)->srt != 0); case THUNK_0_1: case THUNK_0_2: thunk_srt_only: From git at git.haskell.org Fri Jun 8 00:09:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:09:43 +0000 (UTC) Subject: [commit: ghc] master: Rename dataConRepNameUnique to dataConTyRepNameUnique (fa34ced) Message-ID: <20180608000943.582233ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fa34ced5204b13ba809a3441a89b9cf98de2d54e/ghc >--------------------------------------------------------------- commit fa34ced5204b13ba809a3441a89b9cf98de2d54e Author: Matthew Pickering Date: Thu Jun 7 13:31:38 2018 -0400 Rename dataConRepNameUnique to dataConTyRepNameUnique The `DataCon` rep also applies to the worker. For example, see `MkId.mkDataConRep`. `dataConTyRepNameUnique` is for the type representation, so we rename it to make this distinction clear. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4797 >--------------------------------------------------------------- fa34ced5204b13ba809a3441a89b9cf98de2d54e compiler/basicTypes/Unique.hs | 6 +++--- compiler/types/TyCon.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index f0c9814..4a709d2 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -64,7 +64,7 @@ module Unique ( -- *** From TyCon name uniques tyConRepNameUnique, -- *** From DataCon name uniques - dataConWorkerUnique, dataConRepNameUnique + dataConWorkerUnique, dataConTyRepNameUnique ) where #include "HsVersions.h" @@ -400,9 +400,9 @@ tyConRepNameUnique u = incrUnique u mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic -------------------------------------------------- -dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique +dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique dataConWorkerUnique u = incrUnique u -dataConRepNameUnique u = stepUnique u 2 +dataConTyRepNameUnique u = stepUnique u 2 -------------------------------------------------- mkPrimOpIdUnique op = mkUnique '9' op diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 5717aef..230cec7 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -152,7 +152,7 @@ import FastStringEnv import FieldLabel import Constants import Util -import Unique( tyConRepNameUnique, dataConRepNameUnique ) +import Unique( tyConRepNameUnique, dataConTyRepNameUnique ) import UniqSet import Module import {-# SOURCE #-} DataCon @@ -1209,7 +1209,7 @@ mkPrelTyConRepName tc_name -- Prelude tc_name is always External, name_mod = nameModule tc_name name_uniq = nameUnique tc_name rep_uniq | isTcOcc name_occ = tyConRepNameUnique name_uniq - | otherwise = dataConRepNameUnique name_uniq + | otherwise = dataConTyRepNameUnique name_uniq (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ -- | The name (and defining module) for the Typeable representation (TyCon) of a From git at git.haskell.org Fri Jun 8 00:09:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:09:58 +0000 (UTC) Subject: [commit: ghc] master: Run typeCheckResultAction and renamedResultAction in TcM rather than Hsc (dc8c03b) Message-ID: <20180608000958.6B1343ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dc8c03b2a5c70d3169e88d407f3ef28e0cb26af5/ghc >--------------------------------------------------------------- commit dc8c03b2a5c70d3169e88d407f3ef28e0cb26af5 Author: Matthew Pickering Date: Thu Jun 7 13:31:52 2018 -0400 Run typeCheckResultAction and renamedResultAction in TcM rather than Hsc The primary motivation for this is that this allows users to access the warnings and error machinery present in TcM. However, it also allows users to use TcM actions which means they can typecheck GhcPs which could be significantly easier than constructing GhcTc. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15229 Differential Revision: https://phabricator.haskell.org/D4792 >--------------------------------------------------------------- dc8c03b2a5c70d3169e88d407f3ef28e0cb26af5 compiler/main/HscMain.hs | 39 +++------------ compiler/main/Plugins.hs | 8 +-- compiler/typecheck/TcRnDriver.hs | 57 +++++++++++++++++++--- docs/users_guide/extending_ghc.rst | 8 +-- .../plugins/simple-plugin/Simple/RemovePlugin.hs | 2 +- .../plugins/simple-plugin/Simple/SourcePlugin.hs | 4 +- 6 files changed, 66 insertions(+), 52 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc dc8c03b2a5c70d3169e88d407f3ef28e0cb26af5 From git at git.haskell.org Fri Jun 8 00:10:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:10:15 +0000 (UTC) Subject: [commit: ghc] master: Allow Haddock comments before function arguments. (200c8e0) Message-ID: <20180608001015.B9E2B3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/200c8e046b44e38698d7e7bb9801f306e9570a0a/ghc >--------------------------------------------------------------- commit 200c8e046b44e38698d7e7bb9801f306e9570a0a Author: Iavor Diatchki Date: Thu Jun 7 13:32:27 2018 -0400 Allow Haddock comments before function arguments. Currently, documentation strings on function arguments has to be written after the argument (i.e., using `{-^ -}` comments). This patch allows us to use `{-| -}` comments to put the comment string before an argument. The same works for the results of functions. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, mpickering, carter Differential Revision: https://phabricator.haskell.org/D4767 >--------------------------------------------------------------- 200c8e046b44e38698d7e7bb9801f306e9570a0a compiler/parser/Parser.y | 9 +++++++ .../should_compile_flag_haddock/haddockA038.stderr | 4 +-- .../should_compile_flag_haddock/haddockA039.hs | 29 ++++++++++++++++++++++ .../should_compile_flag_haddock/haddockA039.stderr | 11 ++++++++ 4 files changed, 51 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 6fc233e..25edb3e 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1890,6 +1890,7 @@ type :: { LHsType GhcPs } typedoc :: { LHsType GhcPs } : btype { $1 } | btype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 } + | docnext btype { sLL $1 $> $ HsDocTy noExt $2 $1 } | btype '->' ctypedoc {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations] >> ams (sLL $1 $> $ HsFunTy noExt $1 $3) [mu AnnRarrow $2] } @@ -1899,6 +1900,14 @@ typedoc :: { LHsType GhcPs } (HsDocTy noExt $1 $2)) $4) [mu AnnRarrow $3] } + | docnext btype '->' ctypedoc {% ams $2 [mu AnnRarrow $3] -- See note [GADT decl discards annotations] + >> ams (sLL $1 $> $ + HsFunTy noExt (L (comb2 $1 $2) + (HsDocTy noExt $2 $1)) + $4) + [mu AnnRarrow $3] } + + -- See Note [Parsing ~] btype :: { LHsType GhcPs } diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr index 94318ef..3021fa7 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr @@ -3,5 +3,5 @@ module UnamedConstructorStrictFields where data A = A data B = B -data Foo = MkFoo {-# UNPACK #-} !A Unpacked strict field B -data Bar = {-# UNPACK #-} !A Unpacked strict field :%% B +data Foo = MkFoo {-# UNPACK #-} !A " Unpacked strict field" B +data Bar = {-# UNPACK #-} !A " Unpacked strict field" :%% B diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs new file mode 100644 index 0000000..79d23e9 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs @@ -0,0 +1,29 @@ +module CommentsBeforeArguments where + +data A = A +data B = B + +f1 :: {-| Comment before -} + () -> + + () + {-^ Comment after -} -> + + () + {-^ Result after -} +f1 _ _ = () + + +f2 :: {-| Comment before -} + () -> + + () + {-^ Comment after -} -> + + {-| Result after -} + () +f2 _ _ = () + + + + diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr new file mode 100644 index 0000000..0c12f5c --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr @@ -0,0 +1,11 @@ + +==================== Parser ==================== +module CommentsBeforeArguments where +f1 :: + () Comment before -> () Comment after -> () Result after +f1 _ _ = () +f2 :: + () Comment before -> () Comment after -> () Result after +f2 _ _ = () + + From git at git.haskell.org Fri Jun 8 00:11:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:11:50 +0000 (UTC) Subject: [commit: ghc] master: Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` (6fbe5f2) Message-ID: <20180608001150.193BE3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6fbe5f274ba84181f5db50901639ae382ef68c4b/ghc >--------------------------------------------------------------- commit 6fbe5f274ba84181f5db50901639ae382ef68c4b Author: Moritz Angermann Date: Thu Jun 7 13:36:24 2018 -0400 Move `iserv` into `utils` and change package name from `iserv-bin` to `iserv` This is done for consistency. We usually call the package file the same name the folder has. The move into `utils` is done so that we can move the library into `libraries/iserv` and the proxy into `utils/iserv-proxy` and then break the `iserv.cabal` apart. This will make building the cross compiler with TH simpler, because we can build the library and proxy as separate packages. Test Plan: ./validate Reviewers: bgamari, goldfire, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4436 >--------------------------------------------------------------- 6fbe5f274ba84181f5db50901639ae382ef68c4b .gitignore | 3 +- ghc.mk | 13 +-- {iserv => libraries/libiserv}/Makefile | 0 {iserv => libraries/libiserv}/cbits/iservmain.c | 0 libraries/libiserv/ghc.mk | 5 + libraries/libiserv/libiserv.cabal | 39 +++++++ {iserv => libraries/libiserv}/proxy-src/Remote.hs | 0 {iserv => libraries/libiserv}/src/GHCi/Utils.hsc | 0 {iserv => libraries/libiserv}/src/Lib.hs | 0 .../libiserv}/src/Remote/Message.hs | 0 {iserv => libraries/libiserv}/src/Remote/Slave.hs | 0 {iserv => utils/iserv-proxy}/Makefile | 0 utils/iserv-proxy/ghc.mk | 113 +++++++++++++++++++++ .../iserv-proxy/iserv-proxy.cabal | 72 +------------ .../Remote.hs => utils/iserv-proxy/src/Main.hs | 0 utils/{hp2ps => iserv}/Makefile | 2 +- {iserv => utils/iserv}/cbits/iservmain.c | 0 {iserv => utils/iserv}/ghc.mk | 66 ++++++------ utils/iserv/iserv.cabal | 44 ++++++++ {iserv => utils/iserv}/src/Main.hs | 0 20 files changed, 248 insertions(+), 109 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 6fbe5f274ba84181f5db50901639ae382ef68c4b From git at git.haskell.org Fri Jun 8 00:12:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:12:05 +0000 (UTC) Subject: [commit: ghc] master: Add support for FreeBSD arm (297879a) Message-ID: <20180608001205.573ED3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/297879a78cc6ca4c27afb0cc863c8796b60da6e1/ghc >--------------------------------------------------------------- commit 297879a78cc6ca4c27afb0cc863c8796b60da6e1 Author: Ben Gamari Date: Thu Jun 7 14:13:04 2018 -0400 Add support for FreeBSD arm Test Plan: Tested on armv6, armv7 and aarch64 on FreeBSD 12-CURRENT. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, erikd, carter Differential Revision: https://phabricator.haskell.org/D4810 >--------------------------------------------------------------- 297879a78cc6ca4c27afb0cc863c8796b60da6e1 aclocal.m4 | 16 ++++++++++++++++ llvm-targets | 3 +++ utils/llvm-targets/gen-data-layout.sh | 3 +++ 3 files changed, 22 insertions(+) diff --git a/aclocal.m4 b/aclocal.m4 index 1cef842..11c7acd 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -651,6 +651,14 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], $3="$$3 -D_HPUX_SOURCE" $5="$$5 -D_HPUX_SOURCE" ;; + + arm*freebsd*) + # On arm/freebsd, tell gcc to generate Arm + # instructions (ie not Thumb). + $2="$$2 -marm" + $3="$$3 -Wl,-z,noexecstack" + $4="$$4 -z noexecstack" + ;; arm*linux*) # On arm/linux and arm/android, tell gcc to generate Arm # instructions (ie not Thumb). @@ -659,6 +667,10 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], $4="$$4 -z noexecstack" ;; + aarch64*freebsd*) + $3="$$3 -Wl,-z,noexecstack" + $4="$$4 -z noexecstack" + ;; aarch64*linux*) $3="$$3 -Wl,-z,noexecstack" $4="$$4 -z noexecstack" @@ -1902,6 +1914,10 @@ case "$1" in # converts the canonicalized target into someting llvm can understand AC_DEFUN([GHC_LLVM_TARGET], [ case "$2-$3" in + *-freebsd*-gnueabihf) + llvm_target_vendor="unknown" + llvm_target_os="freebsd-gnueabihf" + ;; hardfloat-*eabi) llvm_target_vendor="unknown" llvm_target_os="$3""hf" diff --git a/llvm-targets b/llvm-targets index 6da97ee..a0277f3 100644 --- a/llvm-targets +++ b/llvm-targets @@ -23,4 +23,7 @@ ,("aarch64-apple-ios", ("e-m:o-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("i386-apple-ios", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) ,("x86_64-apple-ios", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) +,("aarch64-unknown-freebsd", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) +,("armv6-unknown-freebsd-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align")) +,("armv7-unknown-freebsd-gnueabihf", ("e-m:e-p:32:32-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "+strict-align")) ] diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index 7a65a3e..7b5f9e3 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -39,6 +39,9 @@ TARGETS=( "i386-apple-darwin" "x86_64-apple-darwin" # iOS "armv7-apple-ios arm64-apple-ios" "i386-apple-ios x86_64-apple-ios" + + # FreeBSD ARM + "aarch64-unknown-freebsd" "armv6-unknown-freebsd-gnueabihf" "armv7-unknown-freebsd-gnueabihf" ) # given the call to clang -c11 that clang --target -v generates, From git at git.haskell.org Fri Jun 8 00:12:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 00:12:20 +0000 (UTC) Subject: [commit: ghc] master: typecheck: Don't warn about "redundant" TypeError constraints (d66ca01) Message-ID: <20180608001220.79E2F3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d66ca0111cefcda6620a4c82a932456b3e48874c/ghc >--------------------------------------------------------------- commit d66ca0111cefcda6620a4c82a932456b3e48874c Author: Ben Gamari Date: Thu Jun 7 13:40:57 2018 -0400 typecheck: Don't warn about "redundant" TypeError constraints Summary: This fixes #15232, where we would warn about `TypeError` constraints being redundant. Test Plan: Validate Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15232 Differential Revision: https://phabricator.haskell.org/D4808 >--------------------------------------------------------------- d66ca0111cefcda6620a4c82a932456b3e48874c compiler/typecheck/TcErrors.hs | 11 ++++++++--- testsuite/tests/typecheck/should_compile/all.T | 3 +-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 897ed96..95dc152 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -459,9 +459,14 @@ warnRedundantConstraints ctxt env info ev_vars doc = text "Redundant constraint" <> plural redundant_evs <> colon <+> pprEvVarTheta redundant_evs - redundant_evs = case info of -- See Note [Redundant constraints in instance decls] - InstSkol -> filterOut improving ev_vars - _ -> ev_vars + redundant_evs = + filterOut is_type_error $ + case info of -- See Note [Redundant constraints in instance decls] + InstSkol -> filterOut improving ev_vars + _ -> ev_vars + + -- See #15232 + is_type_error = isJust . userTypeError_maybe . idType improving ev_var = any isImprovementPred $ transSuperClasses (idType ev_var) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 2b7b9ef..0d2b089 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -621,5 +621,4 @@ test('SplitWD', normal, compile, ['']) test('T14441', omit_ways(['profasm']), compile, ['']) test('T15050', [expect_broken(15050)], compile, ['']) test('T14735', normal, compile, ['']) -test('T15232', expect_broken(15232), compile, ['']) - +test('T15232', normal, compile, ['']) From git at git.haskell.org Fri Jun 8 12:41:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 12:41:23 +0000 (UTC) Subject: [commit: ghc] master: Run Linux slow validate nightly on Circle CI (838aeb9) Message-ID: <20180608124123.1C2083ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/838aeb9b254efb3df7ed0cedeb945ec7c7789c90/ghc >--------------------------------------------------------------- commit 838aeb9b254efb3df7ed0cedeb945ec7c7789c90 Author: Alp Mestanogullari Date: Fri May 25 00:07:02 2018 +0200 Run Linux slow validate nightly on Circle CI >--------------------------------------------------------------- 838aeb9b254efb3df7ed0cedeb945ec7c7789c90 .circleci/config.yml | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index a7d08b1..49f145d 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -258,6 +258,22 @@ jobs: - *test - *store_test_results + "slow-validate-x86_64-linux": + resource_class: xlarge + docker: + - image: ghcci/x86_64-linux:0.0.2 + environment: + <<: *buildenv + GHC_COLLECTOR_FLAVOR: x86_64-linux + steps: + - checkout + - *prepare + - *submodules + - *boot + - *configure_unix + - *make + - *slowtest + workflows: version: 2 validate: @@ -287,6 +303,7 @@ workflows: - validate-x86_64-linux-unreg - validate-x86_64-linux-llvm - validate-x86_64-linux-debug + - slow-validate-x86_64-linux notify: webhooks: From git at git.haskell.org Fri Jun 8 12:41:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 12:41:39 +0000 (UTC) Subject: [commit: ghc] master: Fix `print-explicit-runtime-reps` (#11786). (40db277) Message-ID: <20180608124139.D3EAC3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/40db277f1dedd4df7e75cc0eb35aa7e1e1ded02a/ghc >--------------------------------------------------------------- commit 40db277f1dedd4df7e75cc0eb35aa7e1e1ded02a Author: HE, Tao Date: Thu Jun 7 20:43:55 2018 -0400 Fix `print-explicit-runtime-reps` (#11786). By fixing splitting of IfaceTypes in splitIfaceSigmaTy. Test Plan: make test TEST="T11549 T11376 T11786" Reviewers: goldfire, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #11786, #11376 Differential Revision: https://phabricator.haskell.org/D4733 >--------------------------------------------------------------- 40db277f1dedd4df7e75cc0eb35aa7e1e1ded02a compiler/iface/IfaceType.hs | 25 +++- docs/users_guide/glasgow_exts.rst | 2 +- testsuite/driver/testlib.py | 4 +- testsuite/tests/dependent/ghci/T11549.script | 4 + testsuite/tests/dependent/ghci/T11549.stdout | 17 ++- testsuite/tests/dependent/ghci/T11786.script | 11 ++ testsuite/tests/dependent/ghci/T11786.stdout | 15 +++ testsuite/tests/dependent/ghci/all.T | 6 +- testsuite/tests/ghci/scripts/T11975.stdout | 12 +- testsuite/tests/ghci/scripts/T13963.script | 6 +- testsuite/tests/ghci/scripts/T13963.stdout | 4 + testsuite/tests/ghci/scripts/T5545.stdout | 5 +- testsuite/tests/ghci/scripts/ghci025.stdout | 28 ++--- .../tests/typecheck/should_compile/T13050.stderr | 12 +- .../tests/typecheck/should_compile/T14590.stderr | 16 +-- .../abstract_refinement_hole_fits.stderr | 140 +++++++++------------ .../should_compile/constraint_hole_fits.stderr | 34 ++--- .../should_compile/free_monad_hole_fits.stderr | 20 ++- .../tests/typecheck/should_compile/holes.stderr | 14 +-- .../tests/typecheck/should_compile/holes3.stderr | 14 +-- .../should_compile/refinement_hole_fits.stderr | 64 ++++------ .../subsumption_sort_hole_fits.stderr | 6 +- .../tests/typecheck/should_compile/tc231.stderr | 5 +- .../should_compile/valid_hole_fits.stderr | 10 +- .../tests/typecheck/should_fail/T12083b.stderr | 2 +- .../tests/typecheck/should_fail/T12151.stderr | 2 +- .../tests/typecheck/should_fail/T12918b.stderr | 10 +- .../tests/typecheck/should_fail/T14884.stderr | 6 +- testsuite/tests/typecheck/should_fail/T7437.stderr | 4 +- 29 files changed, 251 insertions(+), 247 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 40db277f1dedd4df7e75cc0eb35aa7e1e1ded02a From git at git.haskell.org Fri Jun 8 13:15:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 8 Jun 2018 13:15:52 +0000 (UTC) Subject: [commit: ghc] master: users guide: Fix spelling (a9eb645) Message-ID: <20180608131552.E0A6A3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9eb645bb1e6bbaee3597640edc2fa211aafae60/ghc >--------------------------------------------------------------- commit a9eb645bb1e6bbaee3597640edc2fa211aafae60 Author: Ben Gamari Date: Fri Jun 8 09:15:10 2018 -0400 users guide: Fix spelling >--------------------------------------------------------------- a9eb645bb1e6bbaee3597640edc2fa211aafae60 docs/users_guide/glasgow_exts.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index e25f5ab..8705852 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9901,7 +9901,7 @@ There are several possible approaches for handling these overlapping local axiom instances), so it is a much more pervasive change, with substantial consequences for the type inference engine. -GHC adoptst **Reject if in doubt** for now. We can see how painful it +GHC adopts **Reject if in doubt** for now. We can see how painful it is in practice, and try something more ambitious if necessary. Instance lookup From git at git.haskell.org Sat Jun 9 09:50:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 9 Jun 2018 09:50:15 +0000 (UTC) Subject: [commit: ghc] master: rts: Handle SMALL_MUT_ARR_PTRS in checkClosure (9976bed) Message-ID: <20180609095015.715523ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9976bed24dda9449ac2e3e95fb4bf8b379114a28/ghc >--------------------------------------------------------------- commit 9976bed24dda9449ac2e3e95fb4bf8b379114a28 Author: Ömer Sinan Ağacan Date: Sat Jun 9 12:49:19 2018 +0300 rts: Handle SMALL_MUT_ARR_PTRS in checkClosure >--------------------------------------------------------------- 9976bed24dda9449ac2e3e95fb4bf8b379114a28 rts/sm/Sanity.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c index 81e6922..e5a22fd 100644 --- a/rts/sm/Sanity.c +++ b/rts/sm/Sanity.c @@ -391,6 +391,18 @@ checkClosure( const StgClosure* p ) return mut_arr_ptrs_sizeW(a); } + case SMALL_MUT_ARR_PTRS_CLEAN: + case SMALL_MUT_ARR_PTRS_DIRTY: + case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: + case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: + { + StgSmallMutArrPtrs *a = (StgSmallMutArrPtrs *)p; + for (uint32_t i = 0; i < a->ptrs; i++) { + ASSERT(LOOKS_LIKE_CLOSURE_PTR(a->payload[i])); + } + return small_mut_arr_ptrs_sizeW(a); + } + case TSO: checkTSO((StgTSO *)p); return sizeofW(StgTSO); From git at git.haskell.org Sun Jun 10 07:26:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Jun 2018 07:26:10 +0000 (UTC) Subject: [commit: ghc] master: Do not omit T4030 in GHCi mode (bb83831) Message-ID: <20180610072610.E30F33ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb8383149640d919df071fce248afa0d83661c4b/ghc >--------------------------------------------------------------- commit bb8383149640d919df071fce248afa0d83661c4b Author: Ömer Sinan Ağacan Date: Sun Jun 10 10:25:40 2018 +0300 Do not omit T4030 in GHCi mode (it currently works fine in GHCi) Reviewers: bgamari Reviewed By: bgamari Subscribers: simonmar, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4824 >--------------------------------------------------------------- bb8383149640d919df071fce248afa0d83661c4b testsuite/tests/concurrent/should_run/all.T | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 5b548b7..ca9c720 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -40,8 +40,7 @@ test('T3429', [ extra_run_opts('+RTS -C0.001 -RTS'), compile_and_run, ['']) # without -O, goes into an infinite loop -# GHCi does not detect the infinite loop. We should really fix this. -test('T4030', omit_ways('ghci'), compile_and_run, ['-O']) +test('T4030', normal, compile_and_run, ['-O']) # each of these runs for about a second test('throwto001', [reqlib('random'), extra_run_opts('1000 2000')], From git at git.haskell.org Sun Jun 10 15:39:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Jun 2018 15:39:23 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Spelling and style pass over QuantifiedConstraints docs (e1f74aa) Message-ID: <20180610153923.C411C3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e1f74aaa2fa9d1907e313f9c86a2fba9abe238e4/ghc >--------------------------------------------------------------- commit e1f74aaa2fa9d1907e313f9c86a2fba9abe238e4 Author: Ben Gamari Date: Fri Jun 8 15:35:48 2018 -0400 users-guide: Spelling and style pass over QuantifiedConstraints docs >--------------------------------------------------------------- e1f74aaa2fa9d1907e313f9c86a2fba9abe238e4 docs/users_guide/glasgow_exts.rst | 55 +++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 31 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 8705852..ae12fea 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9747,9 +9747,9 @@ Introducing quantified constraints offers two main benefits: instance (Eq a, forall b. Eq b => Eq (f b)) => Eq (Rose f a) where (Rose x1 rs1) == (Rose x2 rs2) = x1 == x2 && rs1 == rs2 - This extension allows to write constraints of the form ``forall b. Eq b => Eq (f b)``, - which is needed to solve the ``Eq (f (Rose f x))`` constraint arising from the - second usage of the ``(==)`` method. + This extension allows us to write constraints of the form ``forall b. Eq b => + Eq (f b)``, which is needed to solve the ``Eq (f (Rose f x))`` constraint + arising from the second usage of the ``(==)`` method. - Secondly, quantified constraints allow for more concise and precise specifications. As an example, consider the MTL type class for monad transformers:: @@ -9757,7 +9757,7 @@ Introducing quantified constraints offers two main benefits: lift :: Monad m => m a -> (t m) a The developer knows that a monad transformer takes a monad ``m`` into a new monad ``t m``. - But this is property is not formally specified in the above declaration. + But this property is not formally specified in the above declaration. This omission becomes an issue when defining monad transformer composition:: newtype (t1 * t2) m a = C { runC :: t1 (t2 m) a } @@ -9776,31 +9776,37 @@ Introducing quantified constraints offers two main benefits: class (forall m. Monad m => Monad (t m)) => Trans t where lift :: Monad m => m a -> (t m) a -THe idea is very old; see Seciton 7 of `Derivable type classes `_. +This idea is very old; see Seciton 7 of `Derivable type classes `_. Syntax changes ---------------- `Haskell 2010 `_ defines a ``context`` (the bit to the left of ``=>`` in a type) like this :: - context ::= class - | ( class1, ..., classn ) +.. code-block:: none + + context ::= class + | ( class1, ..., classn ) - class ::= qtycls tyvar - | qtycls (tyvar atype1 ... atypen) + class ::= qtycls tyvar + | qtycls (tyvar atype1 ... atypen) We to extend ``class`` (warning: this is a rather confusingly named non-terminal symbol) with two extra forms, namely precisely what can appear in an instance declaration :: - class ::= ... - | context => qtycls inst - | context => tyvar inst +.. code-block:: none + + class ::= ... + | 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. Notes: -- Where GHC allows extensions instance declarations we allow exactly the same extensions to this new form of ``class``. Specifically, with ``ExplicitForAll`` and ``MultiParameterTypeClasses`` the syntax becomes :: +- Where GHC allows extensions instance declarations we allow exactly the same extensions to this new form of ``class``. Specifically, with :extension:`ExplicitForAll` and :extension:`MultiParameterTypeClasses` the syntax becomes :: + +.. code-block:: none class ::= ... | [forall tyavrs .] context => qtycls inst1 ... instn @@ -9822,7 +9828,7 @@ Notes: instance (forall xx. c (Free c xx)) => Monad (Free c) where Free f >>= g = f g - See `Iceland Jack's summary `_. The key point is that the bit to the right of the `=>` may be headed by a type *variable* (`c` in this case), rather than a class. It should not be one of the forall'd variables, though. + See `Iceland Jack's summary `_. The key point is that the bit to the right of the ``=>`` may be headed by a type *variable* (``c`` in this case), rather than a class. It should not be one of the forall'd variables, though. (NB: this goes beyond what is described in `the paper `_, but does not seem to introduce any new technical difficulties.) @@ -9907,7 +9913,7 @@ is in practice, and try something more ambitious if necessary. Instance lookup ------------------- -In the light of the overlap decision, instance lookup works like this, when +In the light of the overlap decision, instance lookup works like this when trying to solve a class constraint ``C t`` 1. First see if there is a given un-quantified constraint ``C t``. If so, use it to solve the constraint. @@ -9919,22 +9925,9 @@ trying to solve a class constraint ``C t`` Termination --------------- -GHC uses the `Paterson Conditions `_ to ensure that instance resolution terminates: - -The Paterson Conditions are these: for each class constraint ``(C t1 ... tn)`` -in the context - -1. No type variable has more occurrences in the constraint than in - the head - -2. The constraint has fewer constructors and variables (taken - together and counting repetitions) than the head - -3. The constraint mentions no type functions. A type function - application can in principle expand to a type of arbitrary size, - and so are rejected out of hand - -How are those rules modified for quantified constraints? In two ways. +GHC uses the :ref:`Paterson Conditions ` to ensure +that instance resolution terminates. How are those rules modified for quantified +constraints? In two ways. - Each quantified constraint, taken by itself, must satisfy the termination rules for an instance declaration. From git at git.haskell.org Sun Jun 10 15:39:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Jun 2018 15:39:38 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump performance metrics of T9233 and T13035 (229789a) Message-ID: <20180610153938.547963ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/229789ab27851436a522c38ac522c94eb1a74ad9/ghc >--------------------------------------------------------------- commit 229789ab27851436a522c38ac522c94eb1a74ad9 Author: Ben Gamari Date: Sun Jun 10 10:20:55 2018 -0400 testsuite: Bump performance metrics of T9233 and T13035 Unfortunately it's very unclear which commit caused these two to regress; they only fail on Darwin and not even deterministically it sesems. >--------------------------------------------------------------- 229789ab27851436a522c38ac522c94eb1a74ad9 testsuite/tests/perf/compiler/all.T | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 94bba5f..346fa23 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -942,7 +942,7 @@ test('T9961', test('T9233', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 924299320, 5), + [(wordsize(64), 973149832, 5), # 2015-08-04 999826288 initial value # 2016-04-14 1066246248 Final demand analyzer run # 2016-06-18 984268712 shuffling around of Data.Functor.Identity @@ -954,6 +954,7 @@ test('T9233', # 2017-02-07 884436192 Another improvement to SetLevels # 2017-02-17 974530192 Type-indexed Typeable # 2017-03-21 924299320 It's unclear + # 2018-06-09 973149832 It's unclear (wordsize(32), 460112888, 5) # 2016-04-06 515672240 (x86/Linux) initial value @@ -1094,7 +1095,7 @@ test('T12545', test('T13035', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 118665640, 5), + [(wordsize(64), 125020728, 5), # 2017-01-05 90595208 initial # 2017-01-19 95269000 Allow top-level string literals in Core # 2017-02-05 88806416 Probably OccAnal fixes @@ -1102,6 +1103,7 @@ test('T13035', # 2017-02-25 98390488 Early inline patch # 2017-03-21 93249744 It's unclear # 2017-07-19 118665640 Generate Typeable bindings for data instances + # 2018-06-10 125020728 It's unclear ]), ], compile, From git at git.haskell.org Sun Jun 10 22:11:25 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Jun 2018 22:11:25 +0000 (UTC) Subject: [commit: ghc] master: Bump Cabal submodule (14f4347) Message-ID: <20180610221125.0E0E83ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/14f4347c28a2d8d45e795fd01bc0e547fe8738e6/ghc >--------------------------------------------------------------- commit 14f4347c28a2d8d45e795fd01bc0e547fe8738e6 Author: Ben Gamari Date: Sun Jun 10 18:10:47 2018 -0400 Bump Cabal submodule Fixes #15254. >--------------------------------------------------------------- 14f4347c28a2d8d45e795fd01bc0e547fe8738e6 libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index cbdb135..b8c4ce3 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit cbdb135bdadab9595f1a80be4c65453b49a9dde2 +Subproject commit b8c4ce3dacece1b1ac68360b48a3129d9ca440c1 From git at git.haskell.org Sun Jun 10 22:48:47 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 10 Jun 2018 22:48:47 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Suppress uniques in T15243 output (96ddfa4) Message-ID: <20180610224847.F0A4D3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/96ddfa410e8b1294cf9e04cc05593fd981fa3014/ghc >--------------------------------------------------------------- commit 96ddfa410e8b1294cf9e04cc05593fd981fa3014 Author: Ben Gamari Date: Sun Jun 10 18:13:10 2018 -0400 testsuite: Suppress uniques in T15243 output Fixes test for #15243. >--------------------------------------------------------------- 96ddfa410e8b1294cf9e04cc05593fd981fa3014 testsuite/tests/th/all.T | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index b97ed40..f86cc96 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -414,4 +414,4 @@ test('T14875', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T14885a', normal, compile, ['']) test('T14885b', normal, compile, ['']) test('T14885c', normal, compile, ['']) -test('T15243', normal, compile, ['']) +test('T15243', normal, compile, ['-dsuppress-uniques']) From git at git.haskell.org Mon Jun 11 02:28:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Jun 2018 02:28:10 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Remove uniques from T15243's stderr output (93220d4) Message-ID: <20180611022810.7C69B3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/93220d46fceabf3afeae36f1fda94e1698c3639a/ghc >--------------------------------------------------------------- commit 93220d46fceabf3afeae36f1fda94e1698c3639a Author: Ben Gamari Date: Sun Jun 10 22:26:13 2018 -0400 testsuite: Remove uniques from T15243's stderr output >--------------------------------------------------------------- 93220d46fceabf3afeae36f1fda94e1698c3639a testsuite/tests/th/T15243.stderr | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/testsuite/tests/th/T15243.stderr b/testsuite/tests/th/T15243.stderr index 26082a1..4e50186 100644 --- a/testsuite/tests/th/T15243.stderr +++ b/testsuite/tests/th/T15243.stderr @@ -1,12 +1,12 @@ T15243.hs:(10,3)-(15,6): Splicing declarations - [d| type family F_at5 (a_at7 :: k_at6) :: k_at6 where - F_at5 'Unit = 'Unit - F_at5 '(,) = '(,) - F_at5 '[] = '[] - F_at5 '(:) = '(:) |] + [d| type family F (a :: k) :: k where + F 'Unit = 'Unit + F '(,) = '(,) + F '[] = '[] + F '(:) = '(:) |] ======> - type family F_a3ZE (a_a3ZG :: k_a3ZF) :: k_a3ZF where - F_a3ZE 'Unit = 'Unit - F_a3ZE '(,) = '(,) - F_a3ZE '[] = '[] - F_a3ZE '(:) = '(:) + type family F (a :: k) :: k where + F 'Unit = 'Unit + F '(,) = '(,) + F '[] = '[] + F '(:) = '(:) From git at git.haskell.org Mon Jun 11 14:35:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Jun 2018 14:35:13 +0000 (UTC) Subject: [commit: ghc] master: Make seq# evaluatedness look through casts (502026f) Message-ID: <20180611143513.DEC153ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/502026fc0a35460c7f04b26a11320723a7bbfdff/ghc >--------------------------------------------------------------- commit 502026fc0a35460c7f04b26a11320723a7bbfdff Author: David Feuer Date: Mon Jun 11 10:32:23 2018 -0400 Make seq# evaluatedness look through casts In d964b05, I forgot to look through casts to find the `seq#` identifier. Fix that. Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4804 >--------------------------------------------------------------- 502026fc0a35460c7f04b26a11320723a7bbfdff compiler/coreSyn/CoreSyn.hs | 3 ++- testsuite/tests/perf/should_run/{T15226.hs => T15226a.hs} | 5 ++++- testsuite/tests/perf/should_run/all.T | 9 +++++++++ 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 4dd70b0..50e40d1 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -2046,10 +2046,11 @@ collectArgs expr go e as = (e, as) -- | Attempt to remove the last N arguments of a function call. --- Strip off any ticks encountered along the way and any ticks +-- Strip off any ticks or coercions encountered along the way and any -- at the end. stripNArgs :: Word -> Expr a -> Maybe (Expr a) stripNArgs !n (Tick _ e) = stripNArgs n e +stripNArgs n (Cast f _) = stripNArgs n f stripNArgs 0 e = Just e stripNArgs n (App f _) = stripNArgs (n - 1) f stripNArgs _ _ = Nothing diff --git a/testsuite/tests/perf/should_run/T15226.hs b/testsuite/tests/perf/should_run/T15226a.hs similarity index 89% copy from testsuite/tests/perf/should_run/T15226.hs copy to testsuite/tests/perf/should_run/T15226a.hs index 4c09114..6e9a1db 100644 --- a/testsuite/tests/perf/should_run/T15226.hs +++ b/testsuite/tests/perf/should_run/T15226a.hs @@ -3,6 +3,7 @@ import Control.Exception (evaluate) -- Just in case Prelude.repeat changes for some reason. import Prelude hiding (repeat) +import Data.Coerce -- We want to be sure that the compiler *doesn't* know that -- all the elements of the list are in WHNF, because if it @@ -12,11 +13,13 @@ repeat a = res where res = a : res {-# NOINLINE repeat #-} -- Belt *and* suspenders +newtype Foo = Foo Int + silly :: [Int] -> IO () silly = foldr go (pure ()) where go x r = do - x' <- evaluate x + x' <- (coerce (evaluate :: Foo -> IO Foo) :: Int -> IO Int) x evaluate (x' + 3) -- GHC should know that x' has been evaluated, -- so this calculation will be erased entirely. -- Otherwise, we'll create a thunk to pass to diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index b248dd5..0e7996ef 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -584,3 +584,12 @@ test('T15226', only_ways(['normal'])], compile_and_run, ['-O']) + +test('T15226a', + [stats_num_field('bytes allocated', + [ (wordsize(64), 41040, 5) ]), + # 2018-06-06 41040 Look through casts for seq# + # initial 400041040 + only_ways(['normal'])], + compile_and_run, + ['-O']) From git at git.haskell.org Mon Jun 11 15:29:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Jun 2018 15:29:28 +0000 (UTC) Subject: [commit: ghc] master: Remove duplicate quantified constraints (a169149) Message-ID: <20180611152928.0C9493ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a169149ce80de3676adb3ece43d5164b6a875b9c/ghc >--------------------------------------------------------------- commit a169149ce80de3676adb3ece43d5164b6a875b9c Author: Simon Peyton Jones Date: Mon Jun 11 13:55:56 2018 +0100 Remove duplicate quantified constraints This is an easy fix for Trac #15244: just avoid adding the same quantified Given constraint to the inert set twice. See TcSMonad Note [Do not add duplicate quantified instances]. >--------------------------------------------------------------- a169149ce80de3676adb3ece43d5164b6a875b9c compiler/typecheck/TcInteract.hs | 36 +++++++++++-- compiler/typecheck/TcSMonad.hs | 56 +++++++++---------- testsuite/tests/quantified-constraints/T15244.hs | 69 ++++++++++++++++++++++++ testsuite/tests/quantified-constraints/all.T | 1 + 4 files changed, 131 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 a169149ce80de3676adb3ece43d5164b6a875b9c From git at git.haskell.org Mon Jun 11 15:29:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Jun 2018 15:29:30 +0000 (UTC) Subject: [commit: ghc] master: Small refactor, adding checkBadTelescope (97d0542) Message-ID: <20180611152930.D3D903ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97d0542f40a17c10108046969fb19fa6e4de77fb/ghc >--------------------------------------------------------------- commit 97d0542f40a17c10108046969fb19fa6e4de77fb Author: Simon Peyton Jones Date: Mon Jun 11 13:58:05 2018 +0100 Small refactor, adding checkBadTelescope No change in behaviour >--------------------------------------------------------------- 97d0542f40a17c10108046969fb19fa6e4de77fb compiler/typecheck/TcSimplify.hs | 56 +++++++++++++++++++++++----------------- 1 file changed, 32 insertions(+), 24 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index bd04fd5..6e44471 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1578,12 +1578,10 @@ setImplicationStatus :: Implication -> TcS (Maybe Implication) -- * Trim the ic_wanted field to remove Derived constraints -- Precondition: the ic_status field is not already IC_Solved -- Return Nothing if we can discard the implication altogether -setImplicationStatus implic@(Implic { ic_status = status - , ic_info = info - , ic_skols = skols - , ic_telescope = m_telescope - , ic_wanted = wc - , ic_given = givens }) +setImplicationStatus implic@(Implic { ic_status = status + , ic_info = info + , ic_wanted = wc + , ic_given = givens }) | ASSERT2( not (isSolvedStatus status ), ppr info ) -- Precondition: we only set the status if it is not already solved not (isSolvedWC pruned_wc) @@ -1606,20 +1604,20 @@ setImplicationStatus implic@(Implic { ic_status = status -- See Note [Tracking redundant constraints] = do { traceTcS "setImplicationStatus(all-solved) {" (ppr implic) - ; implic <- neededEvVars implic - ; skols <- mapM TcS.zonkTcTyCoVarBndr skols + ; implic@(Implic { ic_need_inner = need_inner + , ic_need_outer = need_outer }) <- neededEvVars implic + + ; bad_telescope <- checkBadTelescope implic ; let dead_givens | warnRedundantGivens info - = filterOut (`elemVarSet` ic_need_inner implic) givens + = filterOut (`elemVarSet` need_inner) givens | otherwise = [] -- None to report - bad_telescope = check_telescope skols - discard_entire_implication -- Can we discard the entire implication? = null dead_givens -- No warning from this implication && not bad_telescope && isEmptyBag pruned_implics -- No live children - && isEmptyVarSet (ic_need_outer implic) -- No needed vars to pass up to parent + && isEmptyVarSet need_outer -- No needed vars to pass up to parent final_status | bad_telescope = IC_BadTelescope @@ -1653,18 +1651,28 @@ setImplicationStatus implic@(Implic { ic_status = status | otherwise = True -- Otherwise, keep it - -- See Note [Keeping scoped variables in order: Explicit] in TcHsType - check_telescope sks = isJust m_telescope && go emptyVarSet (reverse sks) - where - go :: TyVarSet -- skolems that appear *later* than the current ones - -> [TcTyVar] -- ordered skolems, in reverse order - -> Bool -- True <=> there is an out-of-order skolem - go _ [] = False - go later_skols (one_skol : earlier_skols) - | tyCoVarsOfType (tyVarKind one_skol) `intersectsVarSet` later_skols - = True - | otherwise - = go (later_skols `extendVarSet` one_skol) earlier_skols +checkBadTelescope :: Implication -> TcS Bool +-- True <=> the skolems form a bad telescope +-- See Note [Keeping scoped variables in order: Explicit] in TcHsType +checkBadTelescope (Implic { ic_telescope = m_telescope + , ic_skols = skols }) + | isJust m_telescope + = do{ skols <- mapM TcS.zonkTcTyCoVarBndr skols + ; return (go emptyVarSet (reverse skols))} + + | otherwise + = return False + + where + go :: TyVarSet -- skolems that appear *later* than the current ones + -> [TcTyVar] -- ordered skolems, in reverse order + -> Bool -- True <=> there is an out-of-order skolem + go _ [] = False + go later_skols (one_skol : earlier_skols) + | tyCoVarsOfType (tyVarKind one_skol) `intersectsVarSet` later_skols + = True + | otherwise + = go (later_skols `extendVarSet` one_skol) earlier_skols warnRedundantGivens :: SkolemInfo -> Bool warnRedundantGivens (SigSkol ctxt _ _) From git at git.haskell.org Mon Jun 11 15:29:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Jun 2018 15:29:33 +0000 (UTC) Subject: [commit: ghc] master: Remove a tc-trace (6ccfa62) Message-ID: <20180611152933.A69583ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ccfa6201f27a46a9f9cb4ede1463d17a185e668/ghc >--------------------------------------------------------------- commit 6ccfa6201f27a46a9f9cb4ede1463d17a185e668 Author: Simon Peyton Jones Date: Mon Jun 11 13:58:40 2018 +0100 Remove a tc-trace >--------------------------------------------------------------- 6ccfa6201f27a46a9f9cb4ede1463d17a185e668 compiler/typecheck/TcValidity.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 1e15f65..8572d32 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1418,8 +1418,7 @@ checkInstTermination theta head_pred check2 foralld_tvs pred pred_size | not (null bad_tvs) = addErrTc (noMoreMsg bad_tvs what) | not (isTyFamFree pred) = addErrTc (nestedMsg what) - | pred_size >= head_size = traceTc "check2" (ppr pred $$ ppr pred_size $$ ppr head_pred $$ ppr head_size) - >> addErrTc (smallerMsg what) + | pred_size >= head_size = addErrTc (smallerMsg what) | otherwise = return () -- isTyFamFree: see Note [Type families in instance contexts] where From git at git.haskell.org Mon Jun 11 15:29:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 11 Jun 2018 15:29:36 +0000 (UTC) Subject: [commit: ghc] master: Comments only (25597a9) Message-ID: <20180611152936.773B93ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/25597a97174990b49b4005497473b417888a7a64/ghc >--------------------------------------------------------------- commit 25597a97174990b49b4005497473b417888a7a64 Author: Simon Peyton Jones Date: Mon Jun 11 13:55:10 2018 +0100 Comments only >--------------------------------------------------------------- 25597a97174990b49b4005497473b417888a7a64 compiler/basicTypes/Avail.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs index 673d2fb..779f770 100644 --- a/compiler/basicTypes/Avail.hs +++ b/compiler/basicTypes/Avail.hs @@ -80,7 +80,7 @@ datatype like gives rise to the AvailInfo - AvailTC T [T, MkT] [FieldLabel "foo" False foo], + AvailTC T [T, MkT] [FieldLabel "foo" False foo] whereas if -XDuplicateRecordFields is enabled it gives @@ -98,8 +98,9 @@ multiple distinct fields with the same label. For example, gives rise to - AvailTC F [F, MkFInt, MkFBool] - [FieldLabel "foo" True $sel:foo:MkFInt, FieldLabel "foo" True $sel:foo:MkFBool]. + AvailTC F [ F, MkFInt, MkFBool ] + [ FieldLabel "foo" True $sel:foo:MkFInt + , FieldLabel "foo" True $sel:foo:MkFBool ] Moreover, note that the flIsOverloaded flag need not be the same for all the elements of the list. In the example above, this occurs if @@ -107,8 +108,9 @@ the two data instances are defined in different modules, one with `-XDuplicateRecordFields` enabled and one with it disabled. Thus it is possible to have - AvailTC F [F, MkFInt, MkFBool] - [FieldLabel "foo" True $sel:foo:MkFInt, FieldLabel "foo" False foo]. + AvailTC F [ F, MkFInt, MkFBool ] + [ FieldLabel "foo" True $sel:foo:MkFInt + , FieldLabel "foo" False foo ] If the two data instances are defined in different modules, both without `-XDuplicateRecordFields`, it will be impossible to export From git at git.haskell.org Tue Jun 12 07:12:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 07:12:51 +0000 (UTC) Subject: [commit: ghc] master: rts: Fix a var name in a comment, fix a typo (0180230) Message-ID: <20180612071251.3960D3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01802304463ee3b7314e9ecc53bcb2b1b5be305a/ghc >--------------------------------------------------------------- commit 01802304463ee3b7314e9ecc53bcb2b1b5be305a Author: Ömer Sinan Ağacan Date: Tue Jun 12 10:12:26 2018 +0300 rts: Fix a var name in a comment, fix a typo >--------------------------------------------------------------- 01802304463ee3b7314e9ecc53bcb2b1b5be305a rts/Schedule.c | 2 +- rts/sm/MarkWeak.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/rts/Schedule.c b/rts/Schedule.c index 0ef1047..cf975b5 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -67,7 +67,7 @@ * -------------------------------------------------------------------------- */ #if !defined(THREADED_RTS) -// Blocked/sleeping thrads +// Blocked/sleeping threads StgTSO *blocked_queue_hd = NULL; StgTSO *blocked_queue_tl = NULL; StgTSO *sleeping_queue = NULL; // perhaps replace with a hash table? diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c index 0153539..88037f6 100644 --- a/rts/sm/MarkWeak.c +++ b/rts/sm/MarkWeak.c @@ -344,7 +344,7 @@ static void tidyThreadList (generation *gen) if (tmp == NULL) { // not alive (yet): leave this thread on the - // old_all_threads list. + // old_threads list. prev = &(t->global_link); } else { From git at git.haskell.org Tue Jun 12 10:41:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 10:41:03 +0000 (UTC) Subject: [commit: ghc] branch 'wip/tdammers/disable-defer-type-errors-ghci' created Message-ID: <20180612104103.432DF3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/tdammers/disable-defer-type-errors-ghci Referencing: 32ed0c593ad388f5e1b345ca208cd3ee57b7902f From git at git.haskell.org Tue Jun 12 10:41:06 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 10:41:06 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/disable-defer-type-errors-ghci: Test for #14963 workaround (6471606) Message-ID: <20180612104106.A57EA3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/disable-defer-type-errors-ghci Link : http://ghc.haskell.org/trac/ghc/changeset/6471606310d396f012e76071dab8f6fd99169324/ghc >--------------------------------------------------------------- commit 6471606310d396f012e76071dab8f6fd99169324 Author: Tobias Dammers Date: Tue Jun 12 12:38:04 2018 +0200 Test for #14963 workaround >--------------------------------------------------------------- 6471606310d396f012e76071dab8f6fd99169324 testsuite/tests/ghci/should_run/Foo.hs | 4 +++ testsuite/tests/ghci/should_run/T14963.script | 2 ++ testsuite/tests/ghci/should_run/T14963.stderr | 4 +++ testsuite/tests/ghci/should_run/T7253.stderr | 51 +++++++++++++++++++++++++-- testsuite/tests/ghci/should_run/T7253.stdout | 3 -- testsuite/tests/ghci/should_run/all.T | 1 + 6 files changed, 60 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/ghci/should_run/Foo.hs b/testsuite/tests/ghci/should_run/Foo.hs new file mode 100644 index 0000000..5fc811d --- /dev/null +++ b/testsuite/tests/ghci/should_run/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +test :: IO Int +test = return 1 diff --git a/testsuite/tests/ghci/should_run/T14963.script b/testsuite/tests/ghci/should_run/T14963.script new file mode 100644 index 0000000..785d861 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963.script @@ -0,0 +1,2 @@ +:load Foo.hs +test diff --git a/testsuite/tests/ghci/should_run/T14963.stderr b/testsuite/tests/ghci/should_run/T14963.stderr new file mode 100644 index 0000000..9f8ad02 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963.stderr @@ -0,0 +1,4 @@ + +: error: can't find file: Foo.hs + +:2:1: error: Variable not in scope: test diff --git a/testsuite/tests/ghci/should_run/T7253.stderr b/testsuite/tests/ghci/should_run/T7253.stderr index f7dedda..bd107ba 100644 --- a/testsuite/tests/ghci/should_run/T7253.stderr +++ b/testsuite/tests/ghci/should_run/T7253.stderr @@ -1,8 +1,55 @@ +:8:7: error: + • Ambiguous type variable ‘t0’ arising from a use of ‘sum’ + prevents the constraint ‘(Foldable t0)’ from being solved. + Relevant bindings include + add :: t0 Integer -> Integer (bound at :8:1) + Probable fix: use a type annotation to specify what ‘t0’ should be. + These potential instances exist: + instance Foldable (Either a) -- Defined in ‘Data.Foldable’ + instance Foldable Maybe -- Defined in ‘Data.Foldable’ + instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ + ...plus one other + ...plus 24 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the expression: sum + In an equation for ‘add’: add = sum + +:9:5: error: + • Couldn't match expected type ‘Int’ with actual type ‘[Integer]’ + • In the first argument of ‘add’, namely ‘[1, 2, 3]’ + In the expression: add [1, 2, 3] + In an equation for ‘it’: it = add [1, 2, 3] + :19:1: warning: [-Wunrecognised-pragmas (in -Wdefault)] Unrecognised pragma +:27:1: error: + Illegal standalone deriving declaration + Use StandaloneDeriving to enable this extension + +:31:1: error: + • No instance for (Show Foo) arising from a use of ‘show’ + • In the expression: show foo + In an equation for ‘it’: it = show foo + +:44:3: error: + Unexpected default signature: + default content :: Show a => a -> String + Use DefaultSignatures to enable default signatures + +:49:10: error: + Not in scope: type constructor or class ‘HasString’ + +:54:1: error: + Variable not in scope: upcase :: Foo -> t + :62:1: error: - • Role mismatch on variable b: - Annotation says phantom but role representational is required + • Illegal role annotation for T1; + did you intend to use RoleAnnotations? • while checking a role annotation for ‘T1’ + +:67:1: error: + • Illegal role annotation for T2; + did you intend to use RoleAnnotations? + • while checking a role annotation for ‘T2’ diff --git a/testsuite/tests/ghci/should_run/T7253.stdout b/testsuite/tests/ghci/should_run/T7253.stdout index 2d29a0f..fd3c81a 100644 --- a/testsuite/tests/ghci/should_run/T7253.stdout +++ b/testsuite/tests/ghci/should_run/T7253.stdout @@ -1,5 +1,2 @@ 5 -6 5 -"Foo \"Some foo\"" -Foo "SOME FOO" diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index c64b0e7..c4b00ba 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -30,3 +30,4 @@ test('T12549', just_ghci, ghci_script, ['T12549.script']) test('BinaryArray', normal, compile_and_run, ['']) test('T14125a', just_ghci, ghci_script, ['T14125a.script']) test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) +test('T14963', just_ghci, ghci_script, ['T14963.script', '-fdefer-type-errors']) From git at git.haskell.org Tue Jun 12 10:41:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 10:41:09 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/disable-defer-type-errors-ghci: testsuite: allow passing extra_hc_options to ghci (a4ab3b7) Message-ID: <20180612104109.794F83ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/disable-defer-type-errors-ghci Link : http://ghc.haskell.org/trac/ghc/changeset/a4ab3b774a035d420306a51aa936214e2d0cf2d0/ghc >--------------------------------------------------------------- commit a4ab3b774a035d420306a51aa936214e2d0cf2d0 Author: Tobias Dammers Date: Tue Jun 12 12:38:26 2018 +0200 testsuite: allow passing extra_hc_options to ghci We need this in order to test passing flags to ghci externally vs. via a :set command. >--------------------------------------------------------------- a4ab3b774a035d420306a51aa936214e2d0cf2d0 testsuite/driver/testlib.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 3bae765..17029e1 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -963,14 +963,14 @@ def run_command( name, way, cmd ): # ----------------------------------------------------------------------------- # GHCi tests -def ghci_script( name, way, script): +def ghci_script( name, way, script, extra_hc_opts='' ): flags = ' '.join(get_compiler_flags()) way_flags = ' '.join(config.way_flags[way]) # 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}' - ).format(flags=flags, way_flags=way_flags) + cmd = ('HC={{compiler}} HC_OPTS="{flags}" {{compiler}} {flags} {way_flags} {extra_hc_opts}' + ).format(flags=flags, way_flags=way_flags, extra_hc_opts=extra_hc_opts) getTestOpts().stdin = script return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) From git at git.haskell.org Tue Jun 12 10:41:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 10:41:12 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/disable-defer-type-errors-ghci: Documentation (8f97095) Message-ID: <20180612104112.459763ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/disable-defer-type-errors-ghci Link : http://ghc.haskell.org/trac/ghc/changeset/8f9709553ac86e00c9e2640b3f9e668ec3cf93f6/ghc >--------------------------------------------------------------- commit 8f9709553ac86e00c9e2640b3f9e668ec3cf93f6 Author: Tobias Dammers Date: Tue Jun 12 10:40:22 2018 +0200 Documentation >--------------------------------------------------------------- 8f9709553ac86e00c9e2640b3f9e668ec3cf93f6 ghc/GHCi/UI.hs | 21 ++++++++++++++++++++- ghc/GHCi/UI/Monad.hs | 2 ++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 6e22d9e..80d0083 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -1078,13 +1078,13 @@ enqueueCommands cmds = do -- The return value True indicates success, as in `runOneCommand`. runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult) runStmt stmt step = do + -- Override session DynFlags. See Note [Disabling defer-type-errors in GHCi] sdflags <- GHC.getSessionDynFlags let sdflags' = sdflags `gopt_unset` Opt_DeferTypeErrors `gopt_unset` Opt_DeferTypedHoles `gopt_unset` Opt_DeferOutOfScopeVariables - `wopt_unset` Opt_WarnDeferredTypeErrors bracketGHCi_ (GHC.setSessionDynFlags sdflags') (GHC.setSessionDynFlags sdflags) @@ -1309,6 +1309,25 @@ getCurrentBreakModule = do let hist = GHC.resumeHistory r !! (ix-1) return $ Just $ GHC.getHistoryModule hist +-- Note [Disabling defer-type-errors in GHCi] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- In Trac:#14963, we saw that a recent fix causes deferring type errors, typed +-- holes, and out-of-scope variables (all three implied by the +-- -fdefer-type-errors flag) to produce incorrect Core when compiling +-- interactive statements for immediate execution in GHCi, which in turn causes +-- a compiler panic, even for some perfectly simple and well-typed programs. +-- +-- We don't have a fix for the underlying problem yet, however considering how +-- deferring errors in interactive statements doesn't really buy the user +-- anything (the deferred errors would just pop up immediately after compiling +-- anyway), we decided on a workaround: we simply disable the three offending +-- DynFlags options temporarily while running interactive statements. +-- +-- This avoids the panic, but still allows users to enable deferring for all +-- things that are not interactively issued statements, particularly modules +-- loaded into GHCi. + ----------------------------------------------------------------------------- -- -- Commands diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs index 83af305..e1425ca 100644 --- a/ghc/GHCi/UI/Monad.hs +++ b/ghc/GHCi/UI/Monad.hs @@ -226,6 +226,7 @@ reifyGHCi f = GHCi f' -- f'' :: IORef GHCiState -> Session -> IO a f'' gs s = f (s, gs) +-- | 'bracket', lifted to the `GHCi` monad. bracketGHCi :: GHCi a -> (a -> GHCi c) -> (a -> GHCi b) -> GHCi b bracketGHCi acquire release run = GHCi (\gs -> @@ -235,6 +236,7 @@ bracketGHCi acquire release run = (\a -> reflectGHCi (s, gs) (release a)) (\a -> reflectGHCi (s, gs) (run a)))) +-- | 'bracket_', lifted to the `GHCi` monad. bracketGHCi_ :: GHCi a -> GHCi c -> GHCi b -> GHCi b bracketGHCi_ acquire release run = bracketGHCi acquire (const release) (const run) From git at git.haskell.org Tue Jun 12 10:41:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 10:41:15 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/disable-defer-type-errors-ghci: Disable error deferring in interactive statements (425d8ac) Message-ID: <20180612104115.128373ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/disable-defer-type-errors-ghci Link : http://ghc.haskell.org/trac/ghc/changeset/425d8ac50f17b404d6f704b5096aef6fc1e65414/ghc >--------------------------------------------------------------- commit 425d8ac50f17b404d6f704b5096aef6fc1e65414 Author: Tobias Dammers Date: Tue Jun 12 10:01:26 2018 +0200 Disable error deferring in interactive statements The `-fdefer-type-errors` flag, as well as `-fdefer-typed-holes` and `-fdefer-out-of-scope-variables` (which are implied by `-fdefer-type-errors`) currently cause GHCi to crash on perfectly well-typed programs (see Trac:#14963). Rather than fixing the underlying problem, we provide a workaround by simply disabling the three offending extensions while running interactive statements. >--------------------------------------------------------------- 425d8ac50f17b404d6f704b5096aef6fc1e65414 ghc/GHCi/UI.hs | 37 ++++++++++++++++++++++++------------- ghc/GHCi/UI/Monad.hs | 14 ++++++++++++++ 2 files changed, 38 insertions(+), 13 deletions(-) diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 3ed1c7f..6e22d9e 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -1078,19 +1078,30 @@ enqueueCommands cmds = do -- The return value True indicates success, as in `runOneCommand`. runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult) runStmt stmt step = do - dflags <- GHC.getInteractiveDynFlags - if | GHC.isStmt dflags stmt -> run_stmt - | GHC.isImport dflags stmt -> run_import - -- Every import declaration should be handled by `run_import`. As GHCi - -- in general only accepts one command at a time, we simply throw an - -- exception when the input contains multiple commands of which at least - -- one is an import command (see #10663). - | GHC.hasImport dflags stmt -> throwGhcException - (CmdLineError "error: expecting a single import declaration") - -- Note: `GHC.isDecl` returns False on input like - -- `data Infix a b = a :@: b; infixl 4 :@:` - -- and should therefore not be used here. - | otherwise -> run_decl + sdflags <- GHC.getSessionDynFlags + let sdflags' = + sdflags + `gopt_unset` Opt_DeferTypeErrors + `gopt_unset` Opt_DeferTypedHoles + `gopt_unset` Opt_DeferOutOfScopeVariables + `wopt_unset` Opt_WarnDeferredTypeErrors + bracketGHCi_ + (GHC.setSessionDynFlags sdflags') + (GHC.setSessionDynFlags sdflags) + $ do + dflags <- GHC.getInteractiveDynFlags + if | GHC.isStmt dflags stmt -> run_stmt + | GHC.isImport dflags stmt -> run_import + -- Every import declaration should be handled by `run_import`. As GHCi + -- in general only accepts one command at a time, we simply throw an + -- exception when the input contains multiple commands of which at least + -- one is an import command (see #10663). + | GHC.hasImport dflags stmt -> throwGhcException + (CmdLineError "error: expecting a single import declaration") + -- Note: `GHC.isDecl` returns False on input like + -- `data Infix a b = a :@: b; infixl 4 :@:` + -- and should therefore not be used here. + | otherwise -> run_decl where run_import = do diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs index 45a5271..83af305 100644 --- a/ghc/GHCi/UI/Monad.hs +++ b/ghc/GHCi/UI/Monad.hs @@ -12,6 +12,7 @@ module GHCi.UI.Monad ( GHCi(..), startGHCi, + bracketGHCi, bracketGHCi_, GHCiState(..), setGHCiState, getGHCiState, modifyGHCiState, GHCiOption(..), isOptionSet, setOption, unsetOption, Command(..), @@ -225,6 +226,19 @@ reifyGHCi f = GHCi f' -- f'' :: IORef GHCiState -> Session -> IO a f'' gs s = f (s, gs) +bracketGHCi :: GHCi a -> (a -> GHCi c) -> (a -> GHCi b) -> GHCi b +bracketGHCi acquire release run = + GHCi (\gs -> + Ghc (\s -> + bracket + (reflectGHCi (s, gs) acquire) + (\a -> reflectGHCi (s, gs) (release a)) + (\a -> reflectGHCi (s, gs) (run a)))) + +bracketGHCi_ :: GHCi a -> GHCi c -> GHCi b -> GHCi b +bracketGHCi_ acquire release run = + bracketGHCi acquire (const release) (const run) + startGHCi :: GHCi a -> GHCiState -> Ghc a startGHCi g state = do ref <- liftIO $ newIORef state; unGHCi g ref From git at git.haskell.org Tue Jun 12 10:41:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 10:41:19 +0000 (UTC) Subject: [commit: ghc] wip/tdammers/disable-defer-type-errors-ghci: Regressions caused by workaround to #14963 (32ed0c5) Message-ID: <20180612104119.ABD7F3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/tdammers/disable-defer-type-errors-ghci Link : http://ghc.haskell.org/trac/ghc/changeset/32ed0c593ad388f5e1b345ca208cd3ee57b7902f/ghc >--------------------------------------------------------------- commit 32ed0c593ad388f5e1b345ca208cd3ee57b7902f Author: Tobias Dammers Date: Tue Jun 12 12:39:22 2018 +0200 Regressions caused by workaround to #14963 >--------------------------------------------------------------- 32ed0c593ad388f5e1b345ca208cd3ee57b7902f testsuite/tests/ghci/scripts/Defer02.stderr | 22 +- testsuite/tests/ghci/scripts/T10248.stderr | 31 +- testsuite/tests/ghci/scripts/T10508.script | 2 +- testsuite/tests/ghci/scripts/T13202a.stderr | 10 +- testsuite/tests/ghci/scripts/T14969.stderr | 50 +- testsuite/tests/ghci/scripts/T8831.stderr | 4 + testsuite/tests/ghci/scripts/T8831.stdout | 1 - testsuite/tests/ghci/scripts/T8931.stderr | 37 + testsuite/tests/ghci/scripts/T8931.stdout | 1 - testsuite/tests/ghci/scripts/T9140.stdout | 11 +- testsuite/tests/ghci/scripts/T9293.stderr | 9 + testsuite/tests/ghci/scripts/T9293.stdout | 3 - testsuite/tests/ghci/scripts/ghci014.stderr | 1968 +++++++++++++++++++++++++++ testsuite/tests/ghci/scripts/ghci057.stderr | 9 + testsuite/tests/ghci/scripts/ghci057.stdout | 3 - testsuite/tests/ghci/scripts/ghci063.stderr | 2 + 16 files changed, 2125 insertions(+), 38 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 32ed0c593ad388f5e1b345ca208cd3ee57b7902f From git at git.haskell.org Tue Jun 12 14:00:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 14:00:03 +0000 (UTC) Subject: [commit: ghc] master: docs: Add mentions of new plugins mechanisms to users guide (da53417) Message-ID: <20180612140003.F32B23ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/da534170b6d1560e46d6966b488100701d9177ec/ghc >--------------------------------------------------------------- commit da534170b6d1560e46d6966b488100701d9177ec Author: Ben Gamari Date: Tue Jun 12 09:57:14 2018 -0400 docs: Add mentions of new plugins mechanisms to users guide >--------------------------------------------------------------- da534170b6d1560e46d6966b488100701d9177ec docs/users_guide/8.6.1-notes.rst | 31 +++++++++++++++++++++++++++++++ docs/users_guide/extending_ghc.rst | 2 +- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index 366e94b..ef9a6b6 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -126,6 +126,37 @@ Compiler :ghc-flag:`-fexternal-dynamic-refs`. If you don't know why you might need this, you don't need it. +Plugins +~~~~~~~ + +- GHC's plugin mechanism now offers plugin authors control over their plugin's + effect on recompilation checking. Specifically the ``Plugin`` record name has + a new field :: + + data Plugin = Plugin { + pluginRecompile :: [CommandLineOption] -> IO PluginRecompile + , {- ... -} + } + + data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint + + Plugin based on ``defaultPlugin`` will have their previous recompilation + behavior (``ForceRecompile``) preserved. However, plugins that are "pure" are + encouraged to override this to either ``NoForceRecompile`` or ``MaybeRecompile``. + See :ref:`plugin_recompilation` for details. + +- GHC now provides a class of new plugins: source plugins. These plugins can + inspect and modify a variety of intermediate representations used by the + compiler's frontend. These include: + + * The ability to modify the parser output + * The ability to inspect the renamer output + * The ability to modify the typechecked AST + * The ability to modify Template Haskell splices + * The ability to modify interface files as they are loaded + + See :ref:`source-plugins` for details. + GHCi ~~~~ diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst index a0d3db6..97f2143 100644 --- a/docs/users_guide/extending_ghc.rst +++ b/docs/users_guide/extending_ghc.rst @@ -612,7 +612,7 @@ plugins is to make it easier to implement development tools. There are several different access points that you can use for defining plugins that access the representations. All these fields receive the list of ``CommandLineOption`` strings that are passed to the compiler using the -``-fplugin-opt`` flags. +:ghc-flag:`-fplugin-opt` flags. :: From git at git.haskell.org Tue Jun 12 16:43:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 16:43:27 +0000 (UTC) Subject: [commit: ghc] master: Refactor TcExpr.tcSeq (aab3c6d) Message-ID: <20180612164327.65C263ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aab3c6d18416b3bc8e1378dfc4d485a9307ca5c7/ghc >--------------------------------------------------------------- commit aab3c6d18416b3bc8e1378dfc4d485a9307ca5c7 Author: Simon Peyton Jones Date: Tue Jun 12 17:36:44 2018 +0100 Refactor TcExpr.tcSeq The function TcExpr.tcSeq seemed much longer that is really justifiable; and was set to get worse with the fix to Trac #15242. This patch refactors the special cases for function applications, so that the special case for 'seq' can use the regular tcFunApp, which makes the code both clearer and shorter. And smooths the way for #15242. The special case for 'tagToEnum#' is even more weird and ad-hoc, so I refrained from meddling iwth it for now. I also combined HsUtils.mkHsAppType and mkHsAppTypeOut, so that I could have a single 'wrapHsArgs' function, thereby fixing a ToDo from Alan Zimmerman. That means tha tmkHsAppType now has an equality predicate, but I guess that's fair enough. >--------------------------------------------------------------- aab3c6d18416b3bc8e1378dfc4d485a9307ca5c7 compiler/hsSyn/HsUtils.hs | 9 +-- compiler/typecheck/TcExpr.hs | 117 +++++++++++++--------------- testsuite/tests/ghci/scripts/Defer02.stderr | 4 +- 3 files changed, 57 insertions(+), 73 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc aab3c6d18416b3bc8e1378dfc4d485a9307ca5c7 From git at git.haskell.org Tue Jun 12 22:53:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 22:53:38 +0000 (UTC) Subject: [commit: hadrian] master: Add libiserv, rename iserv-bin to iserv, drop primitive (#612) (8dba674) Message-ID: <20180612225338.27EB73ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/8dba6748e84c632c3c0302620c3e62c9fcc3e948 >--------------------------------------------------------------- commit 8dba6748e84c632c3c0302620c3e62c9fcc3e948 Author: Andrey Mokhov Date: Sun Jun 10 02:09:51 2018 +0100 Add libiserv, rename iserv-bin to iserv, drop primitive (#612) See https://phabricator.haskell.org/D4436 >--------------------------------------------------------------- 8dba6748e84c632c3c0302620c3e62c9fcc3e948 src/GHC.hs | 28 ++++++++++++++-------------- src/GHC/Packages.hs | 5 +++-- 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index bdb211b..037ecf6 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -5,8 +5,8 @@ module GHC ( containers, deepseq, deriveConstants, directory, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, - hpcBin, integerGmp, integerSimple, iservBin, libffi, mtl, parsec, parallel, - pretty, primitive, process, rts, runGhc, stm, templateHaskell, terminfo, + hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl, parsec, + parallel, pretty, process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, defaultPackages, testsuitePackages, @@ -93,7 +93,8 @@ stage1Packages = do ++ [ haddock | not cross ] ++ [ runGhc | not cross ] ++ [ hpcBin | not cross ] - ++ [ iservBin | not win, not cross ] + ++ [ iserv | not win, not cross ] + ++ [ libiserv | not win, not cross ] ++ [ unix | not win ] ++ [ win32 | win ] @@ -114,11 +115,11 @@ programName Context {..} = do targetPlatform <- setting TargetPlatformFull let prefix = if cross then targetPlatform ++ "-" else "" in return $ prefix ++ case package of - p | p == ghc -> "ghc" - | p == hpcBin -> "hpc" - | p == runGhc -> "runhaskell" - | p == iservBin -> "ghc-iserv" - _ -> pkgName package + p | p == ghc -> "ghc" + | p == hpcBin -> "hpc" + | p == runGhc -> "runhaskell" + | p == iserv -> "ghc-iserv" + _ -> pkgName package -- | The build stage whose results are used when installing a package, or -- @Nothing@ if the package is not installed, e.g. because it is a user package. @@ -154,16 +155,15 @@ nonCabalContext Context {..} = (package `elem` [ hp2ps -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [ghc, hp2ps, iservBin, touchy, unlit]) +nonHsMainPackage = (`elem` [ghc, hp2ps, iserv, touchy, unlit]) -- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'. autogenPath :: Context -> Action FilePath autogenPath context at Context {..} - | isLibrary package = autogen "build" - | package == ghc = autogen "build/ghc" - | package == hpcBin = autogen "build/hpc" - | package == iservBin = autogen "build/iserv" - | otherwise = autogen $ "build" -/- pkgName package + | isLibrary package = autogen "build" + | package == ghc = autogen "build/ghc" + | package == hpcBin = autogen "build/hpc" + | otherwise = autogen $ "build" -/- pkgName package where autogen dir = contextPath context <&> (-/- dir -/- "autogen") diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index e7ede7f..5902396 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -15,7 +15,7 @@ ghcPackages = , containers, deepseq, deriveConstants, directory, filepath, genapply , genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact, ghcHeap, ghci, ghcPkg , ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp - , integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, primitive + , integerSimple, iserv, libffi, libiserv, mtl, parsec, parallel, pretty , process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy , transformers, unlit, unix, win32, xhtml ] @@ -58,8 +58,9 @@ hpc = hsLib "hpc" hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" integerGmp = hsLib "integer-gmp" integerSimple = hsLib "integer-simple" -iservBin = hsUtil "iserv-bin" `setPath` "iserv" +iserv = hsUtil "iserv" libffi = cTop "libffi" +libiserv = hsLib "libiserv" mtl = hsLib "mtl" parsec = hsLib "parsec" parallel = hsLib "parallel" From git at git.haskell.org Tue Jun 12 22:53:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 22:53:40 +0000 (UTC) Subject: [commit: hadrian] master: Update RTS flags (#613) (a63ad32) Message-ID: <20180612225340.2C15B3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hadrian On branch : master Link : http://git.haskell.org/hadrian.git/commitdiff/a63ad3294b5d51eec50d454810a314c0b2a696c7 >--------------------------------------------------------------- commit a63ad3294b5d51eec50d454810a314c0b2a696c7 Author: Andrey Mokhov Date: Tue Jun 12 11:19:52 2018 +0100 Update RTS flags (#613) * Update RTS flags See #611 * More tweaks >--------------------------------------------------------------- a63ad3294b5d51eec50d454810a314c0b2a696c7 src/Settings/Packages/Rts.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index a4ba3dd..67ea3e7 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -115,6 +115,7 @@ rtsPackageArgs = package rts ? do , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\"" -- Set the namespace for the rts fs functions , arg $ "-DFS_NAMESPACE=rts" + , arg $ "-DCOMPILING_RTS" -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro -- requires that functions are inlined to work as expected. Inlining -- only happens for optimised builds. Otherwise we can assume that @@ -122,8 +123,13 @@ rtsPackageArgs = package rts ? do -- provide non-inlined alternatives and hence needs the function to -- be inlined. See https://github.com/snowleopard/hadrian/issues/90. , arg "-O2" + , arg "-fomit-frame-pointer" + , arg "-g" - , Debug `wayUnit` way ? arg "-DDEBUG" + , Debug `wayUnit` way ? pure [ "-DDEBUG" + , "-fno-omit-frame-pointer" + , "-g" + , "-O0" ] , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY" , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" @@ -153,8 +159,7 @@ rtsPackageArgs = package rts ? do , input "//xxhash.c" ? pure [ "-O3" , "-ffast-math" - , "-ftree-vectorize" - ] + , "-ftree-vectorize" ] , inputs ["//Evac.c", "//Evac_thr.c"] ? arg "-funroll-loops" @@ -175,7 +180,6 @@ rtsPackageArgs = package rts ? do -- emits warnings about call-clobbered registers on x86_64 , inputs [ "//RetainerProfile.c", "//StgCRun.c" , "//win32/ConsoleHandler.c", "//win32/ThrIOManager.c"] ? arg "-w" - , inputs ["//RetainerSet.c"] ? arg "-Wno-format" -- The above warning suppression flags are a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See: @@ -184,7 +188,6 @@ rtsPackageArgs = package rts ? do , (not <$> flag GccIsClang) ? inputs ["//Compact.c"] ? arg "-finline-limit=2500" - , input "//StgCRun.c" ? windowsHost ? arg "-Wno-return-local-addr" , input "//RetainerProfile.c" ? flag GccIsClang ? arg "-Wno-incompatible-pointer-types" , windowsHost ? arg ("-DWINVER=" ++ windowsVersion) From git at git.haskell.org Tue Jun 12 22:54:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 12 Jun 2018 22:54:07 +0000 (UTC) Subject: [commit: ghc] master: Bump hadrian submodule (bb539cf) Message-ID: <20180612225407.660A03ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb539cfe335eeec7989332b859b1f3162c5e105a/ghc >--------------------------------------------------------------- commit bb539cfe335eeec7989332b859b1f3162c5e105a Author: Ben Gamari Date: Tue Jun 12 10:56:32 2018 -0400 Bump hadrian submodule >--------------------------------------------------------------- bb539cfe335eeec7989332b859b1f3162c5e105a hadrian | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian b/hadrian index ec5e9d3..a63ad32 160000 --- a/hadrian +++ b/hadrian @@ -1 +1 @@ -Subproject commit ec5e9d3acdf9ca5ae0e5808ad6f510e9167f2552 +Subproject commit a63ad3294b5d51eec50d454810a314c0b2a696c7 From git at git.haskell.org Wed Jun 13 12:30:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Jun 2018 12:30:01 +0000 (UTC) Subject: [commit: ghc] master: Fix some of the failures in sanity way (a610c21) Message-ID: <20180613123001.82D933ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a610c215580c56116b0882d3dce4a3a45993df19/ghc >--------------------------------------------------------------- commit a610c215580c56116b0882d3dce4a3a45993df19 Author: Ömer Sinan Ağacan Date: Wed Jun 13 15:29:11 2018 +0300 Fix some of the failures in sanity way Tests for runtime argument parsing should only run in normal way to avoid breakage caused by way-specific RTS arguments. Reviewers: bgamari, AndreasK, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15241 Differential Revision: https://phabricator.haskell.org/D4839 >--------------------------------------------------------------- a610c215580c56116b0882d3dce4a3a45993df19 testsuite/tests/rts/flags/all.T | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/testsuite/tests/rts/flags/all.T b/testsuite/tests/rts/flags/all.T index 6bfa14f..6d9368e 100644 --- a/testsuite/tests/rts/flags/all.T +++ b/testsuite/tests/rts/flags/all.T @@ -1,53 +1,53 @@ -#We ignore ways which depend on passing RTS arguments for simplicity. +# We ignore ways which depend on passing RTS arguments for simplicity and only +# run in normal way. -#Standard handling of RTS arguments +# Standard handling of RTS arguments test('T12870a', [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), - omit_ways(['ghci','threaded2','profasm','profthreaded'])], + only_ways(['normal'])], multimod_compile_and_run, ['T12870', '-rtsopts']) test('T12870b', [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), - exit_code(1), ignore_stderr, omit_ways(['ghci','threaded2','profasm','profthreaded'])], + exit_code(1), ignore_stderr, only_ways(['normal'])], multimod_compile_and_run, ['T12870', '-rtsopts=none']) test('T12870c', [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), - exit_code(1), omit_ways(['ghci','threaded2','profasm','profthreaded'])], + exit_code(1), only_ways(['normal'])], multimod_compile_and_run, ['T12870', '-rtsopts=some']) test('T12870d', [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), - omit_ways(['ghci','threaded2','profasm','profthreaded'])], + only_ways(['normal'])], multimod_compile_and_run, ['T12870', '']) -#RTS options should be passed along to the program +# RTS options should be passed along to the program test('T12870e', [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), - omit_ways(['ghci','threaded2','profasm','profthreaded'])], + only_ways(['normal'])], multimod_compile_and_run, ['T12870', '-rtsopts=ignore']) test('T12870f', [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), - omit_ways(['ghci','threaded2','profasm','profthreaded'])], + only_ways(['normal'])], multimod_compile_and_run, ['T12870', '-rtsopts=ignoreAll']) -#Check handling of env variables +# Check handling of env variables test('T12870g', [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs']), - omit_ways(['ghci','threaded2','profasm','profthreaded'])], + only_ways(['normal'])], multimod_compile_and_run, ['T12870g', '-rtsopts -with-rtsopts="-G3"']) test('T12870h', [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs']), - omit_ways(['ghci','threaded2','profasm','profthreaded'])], + only_ways(['normal'])], multimod_compile_and_run, ['T12870g', '-rtsopts=ignoreAll -with-rtsopts="-G3"']) - From git at git.haskell.org Wed Jun 13 19:31:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 13 Jun 2018 19:31:23 +0000 (UTC) Subject: [commit: ghc] master: testuite: remove strace call. (cc78d25) Message-ID: <20180613193123.A0E4B3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc78d25a2d81130a2f1f0eb0dba67ce41f435091/ghc >--------------------------------------------------------------- commit cc78d25a2d81130a2f1f0eb0dba67ce41f435091 Author: Tamar Christina Date: Wed Jun 13 20:29:35 2018 +0100 testuite: remove strace call. >--------------------------------------------------------------- cc78d25a2d81130a2f1f0eb0dba67ce41f435091 testsuite/driver/testlib.py | 3 --- 1 file changed, 3 deletions(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 0f988ca..dac2684 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -869,9 +869,6 @@ def do_test(name, way, func, args, files): if exit_code != 0: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) if_verbose(1, '** pre_cmd was "{0}". Running trace'.format(override_options(opts.pre_cmd))) - runCmd('cd "{0}" && strace {1}'.format(opts.testdir, override_options(opts.pre_cmd)), - stderr = subprocess.STDOUT, - print_output = True) result = func(*[name,way] + args) From git at git.haskell.org Thu Jun 14 06:08:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 06:08:33 +0000 (UTC) Subject: [commit: ghc] master: Do not skip conc004 in GHCi way (b5ccee4) Message-ID: <20180614060833.3802C3ABA2@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5ccee49f96e093854133fb431d75b757988f794/ghc >--------------------------------------------------------------- commit b5ccee49f96e093854133fb431d75b757988f794 Author: Ömer Sinan Ağacan Date: Thu Jun 14 09:07:56 2018 +0300 Do not skip conc004 in GHCi way According to the comments it used to allocate too much, but currently I get 205,987,176 bytes allocated in the heap 50,352,200 bytes copied during GC 14,244,968 bytes maximum residency (6 sample(s)) 172,952 bytes maximum slop 36 MB total memory in use (0 MB lost due to fragmentation) Reviewers: bgamari, tdammers, simonmar Subscribers: tdammers, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4831 >--------------------------------------------------------------- b5ccee49f96e093854133fb431d75b757988f794 testsuite/tests/concurrent/should_run/all.T | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index ca9c720..08f439c 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -118,10 +118,7 @@ setTestOpts(when(fast(), skip)) test('conc001', normal, compile_and_run, ['']) test('conc002', normal, compile_and_run, ['']) - -# Omit GHCi way - it blows up to 0.5G. Something to do with the threaded RTS? -test('conc004', omit_ways(['ghci']), compile_and_run, ['']) - +test('conc004', normal, compile_and_run, ['']) test('conc007', extra_run_opts('+RTS -H128M -RTS'), compile_and_run, ['']) test('conc008', normal, compile_and_run, ['']) test('conc009', exit_code(1), compile_and_run, ['']) From git at git.haskell.org Thu Jun 14 09:34:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 09:34:44 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Print summary even if interrupted (a3c0b42) Message-ID: <20180614093444.3562F3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a3c0b42ee6abe0b0fa4cf6f24a7011c5ebcb0225/ghc >--------------------------------------------------------------- commit a3c0b42ee6abe0b0fa4cf6f24a7011c5ebcb0225 Author: Ben Gamari Date: Thu Jun 14 12:33:35 2018 +0300 testsuite: Print summary even if interrupted Fixes #15265. Reviewers: osa1 Reviewed By: osa1 Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15265 Differential Revision: https://phabricator.haskell.org/D4841 >--------------------------------------------------------------- a3c0b42ee6abe0b0fa4cf6f24a7011c5ebcb0225 testsuite/driver/runtests.py | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 622e2ea..811a6e0 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -308,21 +308,24 @@ else: watcher = Watcher(len(parallelTests)) # Now run all the tests - for oneTest in parallelTests: - if stopping(): - break - oneTest(watcher) - - # wait for parallel tests to finish - if not stopping(): - watcher.wait() - - # Run the following tests purely sequential - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest(watcher) + try: + for oneTest in parallelTests: + if stopping(): + break + oneTest(watcher) + + # wait for parallel tests to finish + if not stopping(): + watcher.wait() + + # Run the following tests purely sequential + config.use_threads = False + for oneTest in aloneTests: + if stopping(): + break + oneTest(watcher) + except KeyboardInterrupt: + pass # flush everything before we continue sys.stdout.flush() From git at git.haskell.org Thu Jun 14 11:52:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 11:52:22 +0000 (UTC) Subject: [commit: ghc] master: Minor refactoring and docs in selector optimisation (f7b9456) Message-ID: <20180614115222.0E85F3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7b9456cbec62a68806a945479e539ae5a984a4e/ghc >--------------------------------------------------------------- commit f7b9456cbec62a68806a945479e539ae5a984a4e Author: Ömer Sinan Ağacan Date: Thu Jun 14 14:26:15 2018 +0300 Minor refactoring and docs in selector optimisation Reviewers: bgamari, simonmar, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4835 >--------------------------------------------------------------- f7b9456cbec62a68806a945479e539ae5a984a4e rts/sm/Evac.c | 55 ++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 38 insertions(+), 17 deletions(-) diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index deaad27..2890319 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -43,7 +43,7 @@ */ #define MAX_THUNK_SELECTOR_DEPTH 16 -static void eval_thunk_selector (StgClosure **q, StgSelector * p, bool); +static void eval_thunk_selector (StgClosure **q, StgSelector *p, bool); STATIC_INLINE void evacuate_large(StgPtr p); /* ----------------------------------------------------------------------------- @@ -934,23 +934,34 @@ evacuate_BLACKHOLE(StgClosure **p) copy(p,info,q,sizeofW(StgInd),gen_no); } -/* ----------------------------------------------------------------------------- - Evaluate a THUNK_SELECTOR if possible. +/* ---------------------------------------------------------------------------- + Update a chain of thunk selectors with the given value. All selectors in the + chain become IND pointing to the value, except when there is a loop (i.e. + the value of a THUNK_SELECTOR is the THUNK_SELECTOR itself), in that case we + leave the selector as-is. + + p is the current selector to update. In eval_thunk_selector we make a list + from selectors using ((StgThunk*)p)->payload[0] for the link field and use + that field to traverse the chain here. + + val is the final value of the selector chain. - p points to a THUNK_SELECTOR that we want to evaluate. The - result of "evaluating" it will be evacuated and a pointer to the - to-space closure will be returned. + A chain is formed when we've got something like: - If the THUNK_SELECTOR could not be evaluated (its selectee is still - a THUNK, for example), then the THUNK_SELECTOR itself will be - evacuated. + let x = C1 { f1 = e1 } + y = C2 { f2 = f1 x } + z = f2 y + + Here the chain (p) we get when evacuating z is: + + [ f2 y, f1 x ] + + and val is e1. -------------------------------------------------------------------------- */ + static void unchain_thunk_selectors(StgSelector *p, StgClosure *val) { - StgSelector *prev; - - prev = NULL; while (p) { ASSERT(p->header.info == &stg_WHITEHOLE_info); @@ -960,7 +971,7 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val) // not evacuate it), so in this case val is in from-space. // ASSERT(!HEAP_ALLOCED_GC(val) || Bdescr((P_)val)->gen_no > N || (Bdescr((P_)val)->flags & BF_EVACUATED)); - prev = (StgSelector*)((StgClosure *)p)->payload[0]; + StgSelector *prev = (StgSelector*)((StgClosure *)p)->payload[0]; // Update the THUNK_SELECTOR with an indirection to the // value. The value is still in from-space at this stage. @@ -997,8 +1008,18 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val) } } +/* ----------------------------------------------------------------------------- + Evaluate a THUNK_SELECTOR if possible. + + p points to a THUNK_SELECTOR that we want to evaluate. + + If the THUNK_SELECTOR could not be evaluated (its selectee is still a THUNK, + for example), then the THUNK_SELECTOR itself will be evacuated depending on + the evac parameter. + -------------------------------------------------------------------------- */ + static void -eval_thunk_selector (StgClosure **q, StgSelector * p, bool evac) +eval_thunk_selector (StgClosure **q, StgSelector *p, bool evac) // NB. for legacy reasons, p & q are swapped around :( { uint32_t field; @@ -1007,7 +1028,6 @@ eval_thunk_selector (StgClosure **q, StgSelector * p, bool evac) StgClosure *selectee; StgSelector *prev_thunk_selector; bdescr *bd; - StgClosure *val; prev_thunk_selector = NULL; // this is a chain of THUNK_SELECTORs that we are going to update @@ -1132,7 +1152,7 @@ selector_loop: info->layout.payload.nptrs)); // Select the right field from the constructor - val = selectee->payload[field]; + StgClosure *val = selectee->payload[field]; #if defined(PROFILING) // For the purposes of LDV profiling, we have destroyed @@ -1164,6 +1184,8 @@ selector_loop: val = ((StgInd *)val)->indirectee; goto val_loop; case THUNK_SELECTOR: + // Use payload to make a list of thunk selectors, to be + // used in unchain_thunk_selectors ((StgClosure*)p)->payload[0] = (StgClosure *)prev_thunk_selector; prev_thunk_selector = p; p = (StgSelector*)val; @@ -1278,5 +1300,4 @@ bale_out: copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no); } unchain_thunk_selectors(prev_thunk_selector, *q); - return; } From git at git.haskell.org Thu Jun 14 14:03:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:03:45 +0000 (UTC) Subject: [commit: ghc] master: Disable T12903 on Darwin due to flakiness (16c70da) Message-ID: <20180614140345.342333ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/16c70dafe21ddf8da6085e22994376a9c79628fb/ghc >--------------------------------------------------------------- commit 16c70dafe21ddf8da6085e22994376a9c79628fb Author: Tamar Christina Date: Mon Dec 12 14:21:27 2016 +0100 Disable T12903 on Darwin due to flakiness Test seems to randomly fail on harbormaster and CircleCI. Disabling it until it can be fixed. Test Plan: make test TEST=T12903 Reviewers: austin, bgamari, simonmar, mpickering Reviewed By: mpickering Subscribers: mpickering, thomie, qnikst GHC Trac Issues: #12903 >--------------------------------------------------------------- 16c70dafe21ddf8da6085e22994376a9c79628fb testsuite/tests/rts/all.T | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 663d8b7..2faa7b7 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -386,9 +386,11 @@ test('T12497', [ unless(opsys('mingw32'), skip) # This test sometimes produces out of sequence samples in the profasm way, but # not reliably, so we just skip it. See ticket #15065. +# Test is being skipped on darwin due to it's flakiness. test('T12903', [ when(opsys('mingw32'), skip) - , omit_ways(['ghci', 'profasm']) - ], compile_and_run, ['']) + , when(opsys('darwin'), skip) + , omit_ways(['ghci', 'profasm'])] + , compile_and_run, ['']) test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13894', normal, compile_and_run, ['']) From git at git.haskell.org Thu Jun 14 14:03:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:03:59 +0000 (UTC) Subject: [commit: ghc] master: OptCoercion: Ensure we use new UnivCo provenance to construct optimised cos. (f1b097f) Message-ID: <20180614140359.837D43ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f1b097f9b4798a7f92b176517896dba1ce90736a/ghc >--------------------------------------------------------------- commit f1b097f9b4798a7f92b176517896dba1ce90736a Author: Ben Gamari Date: Tue Jun 12 13:31:08 2018 -0400 OptCoercion: Ensure we use new UnivCo provenance to construct optimised cos. @goldfire noticed that there were several points in OptOercion.opt_univ where we constructed the optimised coercion using the untransformed provenance. >--------------------------------------------------------------- f1b097f9b4798a7f92b176517896dba1ce90736a compiler/types/OptCoercion.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index e862271..ccad41b 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -434,7 +434,7 @@ opt_univ env sym prov role oty1 oty2 -- NB: prov must not be the two interesting ones (ProofIrrel & Phantom); -- Phantom is already taken care of, and ProofIrrel doesn't relate tyconapps = let roles = tyConRolesX role tc1 - arg_cos = zipWith3 (mkUnivCo prov) roles tys1 tys2 + arg_cos = zipWith3 (mkUnivCo prov') roles tys1 tys2 arg_cos' = zipWith (opt_co4 env sym False) roles arg_cos in mkTyConAppCo role tc1 arg_cos' @@ -446,13 +446,13 @@ opt_univ env sym prov role oty1 oty2 -- NB: prov isn't interesting here either = let k1 = tyVarKind tv1 k2 = tyVarKind tv2 - eta = mkUnivCo prov Nominal k1 k2 + eta = mkUnivCo prov' Nominal k1 k2 -- eta gets opt'ed soon, but not yet. ty2' = substTyWith [tv2] [TyVarTy tv1 `mkCastTy` eta] ty2 (env', tv1', eta') = optForAllCoBndr env sym tv1 eta in - mkForAllCo tv1' eta' (opt_univ env' sym prov role ty1 ty2') + mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2') | otherwise = let ty1 = substTyUnchecked (lcSubstLeft env) oty1 From git at git.haskell.org Thu Jun 14 14:04:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:04:14 +0000 (UTC) Subject: [commit: ghc] master: libiserv: Add license file (908edbf) Message-ID: <20180614140414.864463ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/908edbfbc65049d102c2a861cc5954fa50c772ae/ghc >--------------------------------------------------------------- commit 908edbfbc65049d102c2a861cc5954fa50c772ae Author: Ben Gamari Date: Thu Jun 14 09:09:23 2018 -0400 libiserv: Add license file Test Plan: Run `make bindist` on built tree. Subscribers: rwbarton, thomie, carter, angerman GHC Trac Issues: #14392 Differential Revision: https://phabricator.haskell.org/D4844 >--------------------------------------------------------------- 908edbfbc65049d102c2a861cc5954fa50c772ae libraries/{ghc-prim => libiserv}/LICENSE | 0 libraries/libiserv/libiserv.cabal | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/ghc-prim/LICENSE b/libraries/libiserv/LICENSE similarity index 100% copy from libraries/ghc-prim/LICENSE copy to libraries/libiserv/LICENSE diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index 0ae3bf4..dc3076d 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -2,7 +2,7 @@ Name: libiserv Version: 8.5 Copyright: XXX License: BSD3 --- XXX License-File: LICENSE +License-File: LICENSE Author: XXX Maintainer: XXX Synopsis: Provides shared functionality between iserv and iserv-proxy From git at git.haskell.org Thu Jun 14 14:04:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:04:28 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add -fghci-leak-check to expected output on mingw32 (3606075) Message-ID: <20180614140428.EC66E3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3606075104e3aa3a3fd9f3a5ca9d314587b03821/ghc >--------------------------------------------------------------- commit 3606075104e3aa3a3fd9f3a5ca9d314587b03821 Author: Ben Gamari Date: Thu Jun 14 09:09:38 2018 -0400 testsuite: Add -fghci-leak-check to expected output on mingw32 Test Plan: Validate on Windows Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4843 >--------------------------------------------------------------- 3606075104e3aa3a3fd9f3a5ca9d314587b03821 testsuite/tests/ghci/scripts/T9293.stdout-mingw32 | 4 ++++ testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/testsuite/tests/ghci/scripts/T9293.stdout-mingw32 b/testsuite/tests/ghci/scripts/T9293.stdout-mingw32 index c5be11a..fe0c830 100644 --- a/testsuite/tests/ghci/scripts/T9293.stdout-mingw32 +++ b/testsuite/tests/ghci/scripts/T9293.stdout-mingw32 @@ -9,6 +9,7 @@ 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: @@ -27,6 +28,7 @@ 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: @@ -44,6 +46,7 @@ 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: @@ -63,6 +66,7 @@ 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/ghci057.stdout-mingw32 b/testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 index c5be11a..fe0c830 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 +++ b/testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 @@ -9,6 +9,7 @@ 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: @@ -27,6 +28,7 @@ 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: @@ -44,6 +46,7 @@ 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: @@ -63,6 +66,7 @@ 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 Thu Jun 14 14:04:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:04:44 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add Windows-specific output for T5611 (5600729) Message-ID: <20180614140444.237E23ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/56007290cad2db5a30af5b0d34ee235e9c8adc83/ghc >--------------------------------------------------------------- commit 56007290cad2db5a30af5b0d34ee235e9c8adc83 Author: Ben Gamari Date: Thu Jun 14 09:09:56 2018 -0400 testsuite: Add Windows-specific output for T5611 It's not entirely clear why this is necessary, but this currently fails on Windows and the difference seems rather minor. Test Plan: Validate on Windows Reviewers: Phyx Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4842 >--------------------------------------------------------------- 56007290cad2db5a30af5b0d34ee235e9c8adc83 testsuite/tests/concurrent/should_run/T5611.stderr.mingw32 | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/concurrent/should_run/T5611.stderr.mingw32 b/testsuite/tests/concurrent/should_run/T5611.stderr.mingw32 new file mode 100644 index 0000000..c034e20 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T5611.stderr.mingw32 @@ -0,0 +1 @@ +T5611: : commitBuffer: user error (Exception delivered successfully) From git at git.haskell.org Thu Jun 14 14:04:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:04:58 +0000 (UTC) Subject: [commit: ghc] master: Duplicated and (261209d) Message-ID: <20180614140458.D16393ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/261209d1f7d33a124b97c0f59412ae62ff9c1ca8/ghc >--------------------------------------------------------------- commit 261209d1f7d33a124b97c0f59412ae62ff9c1ca8 Author: Gabor Greif Date: Fri Jun 8 18:24:47 2018 +0200 Duplicated and >--------------------------------------------------------------- 261209d1f7d33a124b97c0f59412ae62ff9c1ca8 libraries/base/Data/Traversable.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index cb205cf..bed2ef9 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -164,7 +164,7 @@ class (Functor t, Foldable t) => Traversable t where traverse f = sequenceA . fmap f -- | Evaluate each action in the structure from left to right, and - -- and collect the results. For a version that ignores the results + -- collect the results. For a version that ignores the results -- see 'Data.Foldable.sequenceA_'. sequenceA :: Applicative f => t (f a) -> f (t a) {-# INLINE sequenceA #-} -- See Note [Inline default methods] From git at git.haskell.org Thu Jun 14 14:05:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:05:14 +0000 (UTC) Subject: [commit: ghc] master: Update user manual sections for -rtsopts and -with-rtsopts (97d1419) Message-ID: <20180614140514.8083B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97d141989348b2bd399ff7bc92eaf1a502f59952/ghc >--------------------------------------------------------------- commit 97d141989348b2bd399ff7bc92eaf1a502f59952 Author: Ömer Sinan Ağacan Date: Thu Jun 14 09:12:57 2018 -0400 Update user manual sections for -rtsopts and -with-rtsopts - References to -rtsopts updated for the new ignore and ignoreAll options. - Short description of -rtsopts updated. ignore and ignoreAll are now shown in the man page. - Add a few clarifications about -rtsopts and -with-rtsopts interaction. Reviewers: bgamari, AndreasK Reviewed By: AndreasK Subscribers: Phyx, rwbarton, thomie, carter GHC Trac Issues: #15268 Differential Revision: https://phabricator.haskell.org/D4840 >--------------------------------------------------------------- 97d141989348b2bd399ff7bc92eaf1a502f59952 docs/users_guide/phases.rst | 32 +++++++++++++++++++++----------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst index a2c25c7..27948e7 100644 --- a/docs/users_guide/phases.rst +++ b/docs/users_guide/phases.rst @@ -874,11 +874,12 @@ for example). ``Main`` module present (normally the compiler will not attempt linking when there is no ``Main``). - The flags :ghc-flag:`-rtsopts[=⟨none|some|all⟩]` and + The flags :ghc-flag:`-rtsopts[=⟨none|some|all|ignore|ignoreAll⟩]` and :ghc-flag:`-with-rtsopts=⟨opts⟩` have no effect when used with :ghc-flag:`-no-hs-main`, because they are implemented by changing the definition of ``main`` that GHC generates. See :ref:`using-own-main` for - how to get the effect of :ghc-flag:`-rtsopts[=⟨none|some|all⟩]` and + how to get the effect of + :ghc-flag:`-rtsopts[=⟨none|some|all|ignore|ignoreAll⟩]` and :ghc-flag:`-with-rtsopts=⟨opts⟩` when using your own ``main``. .. ghc-flag:: -debug @@ -932,12 +933,17 @@ for example). :ghc-flag:`-eventlog` can be used with :ghc-flag:`-threaded`. It is implied by :ghc-flag:`-debug`. -.. ghc-flag:: -rtsopts[=⟨none|some|all⟩] +.. ghc-flag:: -rtsopts[=⟨none|some|all|ignore|ignoreAll⟩] :shortdesc: Control whether the RTS behaviour can be tweaked via command-line flags and the ``GHCRTS`` environment variable. Using ``none`` means no RTS flags can be given; ``some`` means only a minimum - of safe options can be given (the default), and ``all`` (or no - argument at all) means that all RTS flags are permitted. + of safe options can be given (the default); ``all`` (or no + argument at all) means that all RTS flags are permitted; ``ignore`` + means RTS flags can be given, but are treated as regular arguments and + passed to the Haskell program as arguments; ``ignoreAll`` is the same as + ``ignore``, but ``GHCRTS`` is also ignored. ``-rtsopts`` does not + affect ``-with-rtsopts`` behavior; flags passed via ``-with-rtsopts`` + are used regardless of ``-rtsopts``. :type: dynamic :category: linking @@ -982,6 +988,9 @@ for example). Note that ``-rtsopts`` has no effect when used with :ghc-flag:`-no-hs-main`; see :ref:`using-own-main` for details. + ``-rtsopts`` does not affect RTS options passed via ``-with-rtsopts``; + those are used regardless of ``-rtsopts``. + .. ghc-flag:: -with-rtsopts=⟨opts⟩ :shortdesc: Set the default RTS options to ⟨opts⟩. :type: dynamic @@ -1000,16 +1009,17 @@ for example). .. ghc-flag:: -no-rtsopts-suggestions :shortdesc: Don't print RTS suggestions about linking with - :ghc-flag:`-rtsopts[=⟨none|some|all⟩]`. + :ghc-flag:`-rtsopts[=⟨none|some|all|ignore|ignoreAll⟩]`. :type: dynamic :category: linking This option disables RTS suggestions about linking with - :ghc-flag:`-rtsopts[=⟨none|some|all⟩]` when they are not available. These - suggestions would be unhelpful if the users have installed Haskell programs - through their package managers. With this option enabled, these suggestions - will not appear. It is recommended for people distributing binaries to - build with either ``-rtsopts`` or ``-no-rtsopts-suggestions``. + :ghc-flag:`-rtsopts[=⟨none|some|all|ignore|ignoreAll⟩]` when they are not + available. These suggestions would be unhelpful if the users have installed + Haskell programs through their package managers. With this option enabled, + these suggestions will not appear. It is recommended for people + distributing binaries to build with either ``-rtsopts`` or + ``-no-rtsopts-suggestions``. .. ghc-flag:: -fno-gen-manifest :shortdesc: Do not generate a manifest file (Windows only) From git at git.haskell.org Thu Jun 14 14:05:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:05:29 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Fix T4442 on i386 (ca7653a) Message-ID: <20180614140529.36EB63ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca7653a97e660e95e2a52713cb0a9417c1c239ae/ghc >--------------------------------------------------------------- commit ca7653a97e660e95e2a52713cb0a9417c1c239ae Author: Ben Gamari Date: Thu Jun 14 09:13:11 2018 -0400 testsuite: Fix T4442 on i386 Test Plan: Validate on i386 Reviewers: tdammers Reviewed By: tdammers Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15184 Differential Revision: https://phabricator.haskell.org/D4838 >--------------------------------------------------------------- ca7653a97e660e95e2a52713cb0a9417c1c239ae testsuite/tests/primops/should_run/T4442.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/testsuite/tests/primops/should_run/T4442.hs b/testsuite/tests/primops/should_run/T4442.hs index 0d09f62..40d7879 100644 --- a/testsuite/tests/primops/should_run/T4442.hs +++ b/testsuite/tests/primops/should_run/T4442.hs @@ -8,6 +8,9 @@ import GHC.Stable( StablePtr(..), castStablePtrToPtr, castPtrToStablePtr, newStablePtr) import GHC.Exts import Data.Char(ord) +#if WORD_SIZE_IN_BITS < 64 +import GHC.Int (Int64(..)) +#endif assertEqual :: (Show a, Eq a) => a -> a -> IO () assertEqual a b From git at git.haskell.org Thu Jun 14 14:05:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:05:43 +0000 (UTC) Subject: [commit: ghc] master: UNREG: PprC: add support for of W32 literals (0238a6c) Message-ID: <20180614140543.A563F3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0238a6c78102d43dae2f56192bd3486e4f9ecf1d/ghc >--------------------------------------------------------------- commit 0238a6c78102d43dae2f56192bd3486e4f9ecf1d Author: Sergei Trofimovich Date: Thu Jun 14 09:13:32 2018 -0400 UNREG: PprC: add support for of W32 literals Today UNREG build fails to generate sub-word literals: ``` rts_dist_HC rts/dist/build/StgStartup.o ghc-stage1: panic! (the 'impossible' happened) (GHC version 8.5.20180612 for x86_64-unknown-linux): pprStatics: cannot emit a non-word-sized static literal W32 ``` The change allows combining two subwords into one word. Signed-off-by: Sergei Trofimovich Reviewers: simonmar, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15237 Differential Revision: https://phabricator.haskell.org/D4837 >--------------------------------------------------------------- 0238a6c78102d43dae2f56192bd3486e4f9ecf1d compiler/cmm/PprC.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index e8f7144..e46fff1 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -538,6 +538,14 @@ pprStatics dflags (CmmStaticLit (CmmInt i W64) : rest) CmmStaticLit (CmmInt q W32) : rest) where r = i .&. 0xffffffff q = i `shiftR` 32 +pprStatics dflags (CmmStaticLit (CmmInt a W32) : + CmmStaticLit (CmmInt b W32) : rest) + | wordWidth dflags == W64 + = if wORDS_BIGENDIAN dflags + then pprStatics dflags (CmmStaticLit (CmmInt ((shiftL a 32) .|. b) W64) : + rest) + else pprStatics dflags (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) : + rest) pprStatics dflags (CmmStaticLit (CmmInt _ w) : _) | w /= wordWidth dflags = pprPanic "pprStatics: cannot emit a non-word-sized static literal" (ppr w) From git at git.haskell.org Thu Jun 14 14:05:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:05:59 +0000 (UTC) Subject: [commit: ghc] master: Disable `-fdefer-out-of-scope-variables` in ghci. (4a93166) Message-ID: <20180614140559.432AB3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4a931665e41be2621abe4458b64190123109b746/ghc >--------------------------------------------------------------- commit 4a931665e41be2621abe4458b64190123109b746 Author: HE, Tao Date: Thu Jun 14 09:14:58 2018 -0400 Disable `-fdefer-out-of-scope-variables` in ghci. We have already disabled `-fdefer-type-errors` and `-fdefer-typed-holes` in ghci. This patch disables `-fdefer-out-of-scope-variables` as well. Fixes Trac #15259, as well as #14963. Test Plan: make test TEST="T15259 T14963a T14963b T14963c" Reviewers: bgamari, tdammers Reviewed By: tdammers Subscribers: tdammers, rwbarton, thomie, carter GHC Trac Issues: #15259, #14963 Differential Revision: https://phabricator.haskell.org/D4830 >--------------------------------------------------------------- 4a931665e41be2621abe4458b64190123109b746 compiler/typecheck/TcRnDriver.hs | 66 +++++++++++++++++++--- ghc/GHCi/UI.hs | 4 ++ testsuite/tests/ghci/scripts/T15259.script | 3 + testsuite/tests/ghci/scripts/T15259.stderr | 2 + testsuite/tests/ghci/scripts/all.T | 1 + testsuite/tests/ghci/should_run/T14963a.hs | 2 + .../T10248.script => should_run/T14963a.script} | 3 +- .../tests/ghci/should_run/T14963a.stdout | 0 testsuite/tests/ghci/should_run/T14963b.hs | 2 + .../T10248.script => should_run/T14963b.script} | 3 +- .../tests/ghci/should_run/T14963b.stdout | 0 testsuite/tests/ghci/should_run/T14963c.hs | 4 ++ .../T10248.script => should_run/T14963c.script} | 3 +- .../tests/ghci/should_run/T14963c.stdout | 0 testsuite/tests/ghci/should_run/all.T | 3 + 15 files changed, 86 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 4a931665e41be2621abe4458b64190123109b746 From git at git.haskell.org Thu Jun 14 14:06:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:06:15 +0000 (UTC) Subject: [commit: ghc] master: Make Control.Exception.throw levity polymorphic. (8ae7c1b) Message-ID: <20180614140615.12B553ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ae7c1b5033beba576a2d9ffeb9f148bff220482/ghc >--------------------------------------------------------------- commit 8ae7c1b5033beba576a2d9ffeb9f148bff220482 Author: Félix Baylac-Jacqué Date: Thu Jun 14 09:15:26 2018 -0400 Make Control.Exception.throw levity polymorphic. Test Plan: Validate. Reviewers: hvr, bgamari, sighingnow Reviewed By: sighingnow Subscribers: tdammers, sighingnow, rwbarton, thomie, carter GHC Trac Issues: #15180 Differential Revision: https://phabricator.haskell.org/D4827 >--------------------------------------------------------------- 8ae7c1b5033beba576a2d9ffeb9f148bff220482 libraries/base/GHC/Exception.hs | 5 ++++- libraries/base/changelog.md | 2 ++ testsuite/tests/typecheck/should_compile/T15180.hs | 11 +++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 18 insertions(+), 1 deletion(-) diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index df90cb2..f966b3f 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -5,6 +5,7 @@ , RecordWildCards , PatternSynonyms #-} +{-# LANGUAGE TypeInType #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- @@ -41,6 +42,7 @@ import GHC.Base import GHC.Show import GHC.Stack.Types import GHC.OldList +import GHC.Prim import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS @@ -164,7 +166,8 @@ instance Exception SomeException where -- | Throw an exception. Exceptions may be thrown from purely -- functional code, but may only be caught within the 'IO' monad. -throw :: Exception e => e -> a +throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e. + Exception e => e -> a throw e = raise# (toException e) -- | This is thrown when the user calls 'error'. The first @String@ is the diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index c588b21..5188fa9 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -35,6 +35,8 @@ * `Data.Monoid.Ap` has been introduced + * `Control.Exception.throw` is now levity polymorphic. (#15180) + ## 4.11.1.0 *TBA* * Bundled with GHC 8.4.2 diff --git a/testsuite/tests/typecheck/should_compile/T15180.hs b/testsuite/tests/typecheck/should_compile/T15180.hs new file mode 100644 index 0000000..a81f130 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15180.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE MagicHash #-} +module Main where + +import Control.Exception +import System.Exit +import GHC.Exts + +main :: IO () +main = do + let a = throw $ toException ExitSuccess :: Int# + return () diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 0d2b089..f566182 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -621,4 +621,5 @@ test('SplitWD', normal, compile, ['']) test('T14441', omit_ways(['profasm']), compile, ['']) test('T15050', [expect_broken(15050)], compile, ['']) test('T14735', normal, compile, ['']) +test('T15180', normal, compile, ['']) test('T15232', normal, compile, ['']) From git at git.haskell.org Thu Jun 14 14:06:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:06:29 +0000 (UTC) Subject: [commit: ghc] master: Mark test broken on powerpc64[le] (5f5d0c9) Message-ID: <20180614140629.C370D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f5d0c9d43bbab922582f437c4a1a3f06ff3fd0e/ghc >--------------------------------------------------------------- commit 5f5d0c9d43bbab922582f437c4a1a3f06ff3fd0e Author: Peter Trommler Date: Thu Jun 14 09:15:40 2018 -0400 Mark test broken on powerpc64[le] Test num009 fails different results. #15062 lists more issues on other platforms. Test T14894 fails because DWARF support is not implemented in the PowerPC native code backend. T5435_v_asm_b fails because the runtime linker is not implemented for PowerPC 64-bit systems. Test Plan: validate Reviewers: bgamari, hvr, erikd, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13634, #11261, #11259, #15062 Differential Revision: https://phabricator.haskell.org/D4825 >--------------------------------------------------------------- 5f5d0c9d43bbab922582f437c4a1a3f06ff3fd0e libraries/base/tests/Numeric/all.T | 1 + testsuite/tests/rts/all.T | 2 ++ testsuite/tests/simplCore/should_run/all.T | 2 +- 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/libraries/base/tests/Numeric/all.T b/libraries/base/tests/Numeric/all.T index 0d7467e..7b63cda 100644 --- a/libraries/base/tests/Numeric/all.T +++ b/libraries/base/tests/Numeric/all.T @@ -14,6 +14,7 @@ else: opts = '' test('num009', [ when(fast(), skip) , when(platform('i386-apple-darwin'), expect_broken(2370)) + , when(platform('powerpc64le-unknown-linux'), expect_broken(13634)) , when(opsys('mingw32'), omit_ways(['ghci'])) ], # We get different results at 1e20 on x86/Windows, so there is # a special output file for that. I (SDM) don't think these are diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 2faa7b7..a08003d 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -198,6 +198,8 @@ test('T5435_v_asm_a', [extra_files(['T5435.hs', 'T5435_asm.c']), # this one just needs to run on linux, as darwin/mingw32 are covered # by the _a test already. test('T5435_v_asm_b', [extra_files(['T5435.hs', 'T5435_asm.c']), + when(arch('powerpc64') or arch('powerpc64le'), + expect_broken(11259)), when(opsys('darwin') or opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory T5435_v_asm_b']) test('T5435_v_gcc', [extra_files(['T5435.hs', 'T5435_gcc.c']), diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 3d8f540..99055a3 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -82,6 +82,6 @@ test('T14768', reqlib('vector'), compile_and_run, ['']) test('T14868', [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], compile_and_run, ['']) -test('T14894', normal, compile_and_run, ['']) +test('T14894', [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], compile_and_run, ['']) test('T14965', normal, compile_and_run, ['']) test('T15114', only_ways('optasm'), compile_and_run, ['']) From git at git.haskell.org Thu Jun 14 14:06:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:06:44 +0000 (UTC) Subject: [commit: ghc] master: users-guide: Fix PtrRepLifted to LiftedRep (87d691c) Message-ID: <20180614140644.6E6FC3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/87d691c025fa7cff44717d9a860d40bae2dc4cc9/ghc >--------------------------------------------------------------- commit 87d691c025fa7cff44717d9a860d40bae2dc4cc9 Author: Takenobu Tani Date: Thu Jun 14 09:18:19 2018 -0400 users-guide: Fix PtrRepLifted to LiftedRep Fix `TYPE 'PtrRepLifted` to `TYPE 'LiftedRep` [ci skip] Test Plan: build Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4818 >--------------------------------------------------------------- 87d691c025fa7cff44717d9a860d40bae2dc4cc9 docs/users_guide/glasgow_exts.rst | 2 +- docs/users_guide/using.rst | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index ae12fea..37ebf9c 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -156,7 +156,7 @@ kind ``TYPE 'IntRep`` and ``Double#`` has kind ``TYPE 'DoubleRep``. These kinds say that the runtime representation of an ``Int#`` is a machine integer, and the runtime representation of a ``Double#`` is a machine double-precision floating point. In contrast, the kind ``*`` is actually just a synonym -for ``TYPE 'PtrRepLifted``. More details of the ``TYPE`` mechanisms appear in +for ``TYPE 'LiftedRep``. More details of the ``TYPE`` mechanisms appear in the `section on runtime representation polymorphism <#runtime-rep>`__. Given that ``Int#``'s kind is not ``*``, it then it follows that diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index d5544e4..4c98e08 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -806,7 +806,7 @@ messages and in GHCi: When :ghc-flag:`-fprint-explicit-runtime-reps` is enabled, GHC prints ``RuntimeRep`` type variables for levity-polymorphic types. - Otherwise GHC will default these to ``PtrRepLifted``. For example, + Otherwise GHC will default these to ``LiftedRep``. For example, .. code-block:: none From git at git.haskell.org Thu Jun 14 14:06:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:06:59 +0000 (UTC) Subject: [commit: ghc] master: Fix deserialization of docs (#15240) (69b50ef) Message-ID: <20180614140659.5A9863ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/69b50efe08bdd09de0b4f0208fe52804ad938853/ghc >--------------------------------------------------------------- commit 69b50efe08bdd09de0b4f0208fe52804ad938853 Author: Simon Jakobi Date: Thu Jun 14 09:18:35 2018 -0400 Fix deserialization of docs (#15240) We were using Map.fromDistinctAscList to deserialize a (Map Name HsDocString). As the Names' Uniques had changed, we ended up with an invalid map in which we couldn't lookup certain keys. Switching to Map.fromList fixed the issue. Added comments in several places. Reviewers: alexbiehl, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15240 Differential Revision: https://phabricator.haskell.org/D4816 >--------------------------------------------------------------- 69b50efe08bdd09de0b4f0208fe52804ad938853 compiler/basicTypes/Name.hs | 8 ++++++++ compiler/hsSyn/HsDoc.hs | 13 ++++++++----- testsuite/tests/showIface/DocsInHiFile1.stdout | 26 +++++++++++++------------- 3 files changed, 29 insertions(+), 18 deletions(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 4e11276..8fa60a8 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -454,10 +454,18 @@ stableNameCmp (Name { n_sort = s1, n_occ = occ1 }) ************************************************************************ -} +-- | The same comments as for `Name`'s `Ord` instance apply. instance Eq Name where a == b = case (a `compare` b) of { EQ -> True; _ -> False } a /= b = case (a `compare` b) of { EQ -> False; _ -> True } +-- | __Caution__: This instance is implemented via `nonDetCmpUnique`, which +-- means that the ordering is not stable across deserialization or rebuilds. +-- +-- See `nonDetCmpUnique` for further information, and trac #15240 for a bug +-- caused by improper use of this instance. + +-- For a deterministic lexicographic ordering, use `stableNameCmp`. instance Ord Name where a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False } diff --git a/compiler/hsSyn/HsDoc.hs b/compiler/hsSyn/HsDoc.hs index ed88763..affbf1b 100644 --- a/compiler/hsSyn/HsDoc.hs +++ b/compiler/hsSyn/HsDoc.hs @@ -118,8 +118,10 @@ concatDocs xs = newtype DeclDocMap = DeclDocMap (Map Name HsDocString) instance Binary DeclDocMap where - put_ bh (DeclDocMap m) = put_ bh (Map.toAscList m) - get bh = DeclDocMap . Map.fromDistinctAscList <$> get bh + put_ bh (DeclDocMap m) = put_ bh (Map.toList m) + -- We can't rely on a deterministic ordering of the `Name`s here. + -- See the comments on `Name`'s `Ord` instance for context. + get bh = DeclDocMap . Map.fromList <$> get bh instance Outputable DeclDocMap where ppr (DeclDocMap m) = vcat (map pprPair (Map.toAscList m)) @@ -133,9 +135,10 @@ emptyDeclDocMap = DeclDocMap Map.empty newtype ArgDocMap = ArgDocMap (Map Name (Map Int HsDocString)) instance Binary ArgDocMap where - put_ bh (ArgDocMap m) = put_ bh (Map.toAscList (Map.toAscList <$> m)) - get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromDistinctAscList - <$> get bh + put_ bh (ArgDocMap m) = put_ bh (Map.toList (Map.toAscList <$> m)) + -- We can't rely on a deterministic ordering of the `Name`s here. + -- See the comments on `Name`'s `Ord` instance for context. + get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromList <$> get bh instance Outputable ArgDocMap where ppr (ArgDocMap m) = vcat (map pprPair (Map.toAscList m)) diff --git a/testsuite/tests/showIface/DocsInHiFile1.stdout b/testsuite/tests/showIface/DocsInHiFile1.stdout index fcb5f94..2576c25 100644 --- a/testsuite/tests/showIface/DocsInHiFile1.stdout +++ b/testsuite/tests/showIface/DocsInHiFile1.stdout @@ -4,28 +4,25 @@ module header: '<>', ':=:', 'Bool' " declaration docs: - D': - " Another datatype... - - ...with two docstrings." - P: - " A class" - p: - " A class method" + elem: + " '()', 'elem'." D: " A datatype." D0: " A constructor for 'D'. '" D1: " Another constructor" - elem: - " '()', 'elem'." + P: + " A class" + p: + " A class method" $fShowD: " 'Show' instance" + D': + " Another datatype... + + ...with two docstrings." arg docs: - p: - 0: - " An argument" add: 0: " First summand for 'add'" @@ -33,4 +30,7 @@ arg docs: " Second summand" 2: " Sum" + p: + 0: + " An argument" From git at git.haskell.org Thu Jun 14 14:07:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:07:14 +0000 (UTC) Subject: [commit: ghc] master: Replace `showSDocUnsafe` with `showSDoc` in extending_ghc.rst (d24e73a) Message-ID: <20180614140714.966AA3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d24e73adf7fb33e2c94b7b6c43fe9feb9b23c3a6/ghc >--------------------------------------------------------------- commit d24e73adf7fb33e2c94b7b6c43fe9feb9b23c3a6 Author: HE, Tao Date: Thu Jun 14 09:18:49 2018 -0400 Replace `showSDocUnsafe` with `showSDoc` in extending_ghc.rst ... and fix compile errors. Replace the usage of `showSDocUnsafe` with `showSDoc dflags` in example code in extending_ghc.rts. This example contains several compile errors (missing import and syntax error), this patch also fixes that. Test Plan: [skip ci] Reviewers: bgamari, mpickering Reviewed By: mpickering Subscribers: mpickering, rwbarton, thomie, carter GHC Trac Issues: #15228 Differential Revision: https://phabricator.haskell.org/D4815 >--------------------------------------------------------------- d24e73adf7fb33e2c94b7b6c43fe9feb9b23c3a6 docs/users_guide/extending_ghc.rst | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/docs/users_guide/extending_ghc.rst b/docs/users_guide/extending_ghc.rst index 97f2143..91034e6 100644 --- a/docs/users_guide/extending_ghc.rst +++ b/docs/users_guide/extending_ghc.rst @@ -725,11 +725,15 @@ displayed. module SourcePlugin where import Control.Monad.IO.Class + import DynFlags (getDynFlags) import Plugins import HscTypes import TcRnTypes import HsExtension + import HsDecls import HsExpr + import HsImpExp + import Avail import Outputable import HsDoc @@ -743,7 +747,8 @@ displayed. parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule parsedPlugin _ _ pm - = do liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDocUnsafe $ ppr $ hpm_module pm) + = do dflags <- getDynFlags + liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDoc dflags $ ppr $ hpm_module pm) return pm renamedAction :: [CommandLineOption] -> ModSummary @@ -751,22 +756,26 @@ displayed. , Maybe [(LIE GhcRn, Avails)], Maybe LHsDocString ) -> TcM () renamedAction _ _ ( gr, _, _, _ ) - = liftIO $ putStrLn "typeCheckPlugin (rn): " ++ (showSDocUnsafe $ ppr gr) + = do dflags <- getDynFlags + liftIO $ putStrLn $ "typeCheckPlugin (rn): " ++ (showSDoc dflags $ ppr gr) typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv typecheckPlugin _ _ tc - = do liftIO $ putStrLn $ "typeCheckPlugin (rn): \n" ++ (showSDocUnsafe $ ppr $ tcg_rn_decls tc) - liftIO $ putStrLn $ "typeCheckPlugin (tc): \n" ++ (showSDocUnsafe $ ppr $ tcg_binds tc) + = do dflags <- getDynFlags + liftIO $ putStrLn $ "typeCheckPlugin (rn): \n" ++ (showSDoc dflags $ ppr $ tcg_rn_decls tc) + liftIO $ putStrLn $ "typeCheckPlugin (tc): \n" ++ (showSDoc dflags $ ppr $ tcg_binds tc) return tc metaPlugin :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) metaPlugin _ meta - = do liftIO $ putStrLn $ "meta: " ++ (showSDocUnsafe $ ppr meta) + = do dflags <- getDynFlags + liftIO $ putStrLn $ "meta: " ++ (showSDoc dflags $ ppr meta) return meta interfaceLoadPlugin :: [CommandLineOption] -> ModIface -> IfM lcl ModIface interfaceLoadPlugin _ iface - = do liftIO $ putStrLn $ "interface loaded: " ++ (showSDocUnsafe $ ppr $ mi_module iface) + = do dflags <- getDynFlags + liftIO $ putStrLn $ "interface loaded: " ++ (showSDoc dflags $ ppr $ mi_module iface) return iface When you compile a simple module that contains Template Haskell splice From git at git.haskell.org Thu Jun 14 14:07:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:07:34 +0000 (UTC) Subject: [commit: ghc] master: rts: Ignore RLIMIT_AS if it is zero (233d815) Message-ID: <20180614140734.996FF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/233d8150e672494dc5764d0dad5ea721a56517a1/ghc >--------------------------------------------------------------- commit 233d8150e672494dc5764d0dad5ea721a56517a1 Author: Ben Gamari Date: Thu Jun 14 09:19:11 2018 -0400 rts: Ignore RLIMIT_AS if it is zero Reviewers: erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14492 Differential Revision: https://phabricator.haskell.org/D4811 >--------------------------------------------------------------- 233d8150e672494dc5764d0dad5ea721a56517a1 rts/posix/OSMem.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 479ae9d..e63e798 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -508,7 +508,9 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len) #if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H) struct rlimit limit; - if (!getrlimit(RLIMIT_AS, &limit) && *len > limit.rlim_cur) { + if (!getrlimit(RLIMIT_AS, &limit) + && limit.rlim_cur > 0 + && *len > limit.rlim_cur) { *len = limit.rlim_cur; } #endif From git at git.haskell.org Thu Jun 14 14:07:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 14:07:50 +0000 (UTC) Subject: [commit: ghc] master: desugar: Rip out unsafeGlobalDynFlags usage in decomposeRuleLhs (6f083b3) Message-ID: <20180614140750.525663ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f083b3df830a74e3d4c08f1b4a5204c4822c537/ghc >--------------------------------------------------------------- commit 6f083b3df830a74e3d4c08f1b4a5204c4822c537 Author: Ben Gamari Date: Thu Jun 14 09:19:51 2018 -0400 desugar: Rip out unsafeGlobalDynFlags usage in decomposeRuleLhs Reviewers: dfeuer Reviewed By: dfeuer Subscribers: dfeuer, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4776 >--------------------------------------------------------------- 6f083b3df830a74e3d4c08f1b4a5204c4822c537 compiler/deSugar/Desugar.hs | 6 +++--- compiler/deSugar/DsBinds.hs | 13 +++++++------ 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 532bd00..583bc59 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -393,12 +393,12 @@ dsRule (L loc (HsRule _ name rule_act vars lhs rhs)) -- Substitute the dict bindings eagerly, -- and take the body apart into a (f args) form - ; case decomposeRuleLhs bndrs'' lhs'' of { + ; dflags <- getDynFlags + ; case decomposeRuleLhs dflags bndrs'' lhs'' of { Left msg -> do { warnDs NoReason msg; return Nothing } ; Right (final_bndrs, fn_id, args) -> do - { dflags <- getDynFlags - ; let is_local = isLocalId fn_id + { let is_local = isLocalId fn_id -- NB: isLocalId is False of implicit Ids. This is good because -- we don't want to attach rules to the bindings of implicit Ids, -- because they don't show up in the bindings until just before code gen diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 4b3c781..bec68b0 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -682,12 +682,12 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) ; -- pprTrace "dsRule" (vcat [ text "Id:" <+> ppr poly_id -- , text "spec_co:" <+> ppr spec_co -- , text "ds_rhs:" <+> ppr ds_lhs ]) $ - case decomposeRuleLhs spec_bndrs ds_lhs of { + dflags <- getDynFlags + ; case decomposeRuleLhs dflags spec_bndrs ds_lhs of { Left msg -> do { warnDs NoReason msg; return Nothing } ; Right (rule_bndrs, _fn, args) -> do - { dflags <- getDynFlags - ; this_mod <- getModule + { this_mod <- getModule ; let fn_unf = realIdUnfolding poly_id spec_unf = specUnfolding dflags spec_bndrs core_app arity_decrease fn_unf spec_id = mkLocalId spec_name spec_ty @@ -821,14 +821,15 @@ SPEC f :: ty [n] INLINE [k] ************************************************************************ -} -decomposeRuleLhs :: [Var] -> CoreExpr -> Either SDoc ([Var], Id, [CoreExpr]) +decomposeRuleLhs :: DynFlags -> [Var] -> CoreExpr + -> Either SDoc ([Var], Id, [CoreExpr]) -- (decomposeRuleLhs bndrs lhs) takes apart the LHS of a RULE, -- The 'bndrs' are the quantified binders of the rules, but decomposeRuleLhs -- may add some extra dictionary binders (see Note [Free dictionaries]) -- -- Returns an error message if the LHS isn't of the expected shape -- Note [Decomposing the left-hand side of a RULE] -decomposeRuleLhs orig_bndrs orig_lhs +decomposeRuleLhs dflags orig_bndrs orig_lhs | not (null unbound) -- Check for things unbound on LHS -- See Note [Unused spec binders] = Left (vcat (map dead_msg unbound)) @@ -849,7 +850,7 @@ decomposeRuleLhs orig_bndrs orig_lhs = Left bad_shape_msg where lhs1 = drop_dicts orig_lhs - lhs2 = simpleOptExpr unsafeGlobalDynFlags lhs1 -- See Note [Simplify rule LHS] + lhs2 = simpleOptExpr dflags lhs1 -- See Note [Simplify rule LHS] (fun2,args2) = collectArgs lhs2 lhs_fvs = exprFreeVars lhs2 From git at git.haskell.org Thu Jun 14 15:08:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 15:08:07 +0000 (UTC) Subject: [commit: ghc] branch 'ghc-8.6' created Message-ID: <20180614150807.375AB3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : ghc-8.6 Referencing: 6f083b3df830a74e3d4c08f1b4a5204c4822c537 From git at git.haskell.org Thu Jun 14 16:03:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 16:03:14 +0000 (UTC) Subject: [commit: ghc] master: rts: Don't keep findPtr symbol alive if not -DDEBUG (e4c41ec) Message-ID: <20180614160314.4DF763ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e4c41ec2b1f2f222c9c8a83ef64d4e566aa47a44/ghc >--------------------------------------------------------------- commit e4c41ec2b1f2f222c9c8a83ef64d4e566aa47a44 Author: Ben Gamari Date: Thu Jun 14 11:37:05 2018 -0400 rts: Don't keep findPtr symbol alive if not -DDEBUG Test Plan: Test with Hadrian Reviewers: simonmar, snowleopard, erikd Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4846 >--------------------------------------------------------------- e4c41ec2b1f2f222c9c8a83ef64d4e566aa47a44 rts/rts.cabal.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index d41135d..ffa6282 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -251,9 +251,11 @@ library "-Wl,-u,_hs_atomicwrite8" "-Wl,-u,_hs_atomicwrite16" "-Wl,-u,_hs_atomicwrite32" +#if defined(DEBUG) -- This symbol is useful in gdb, but not referred to anywhere, -- so we need to force it to be included in the binary. "-Wl,-u,_findPtr" +#endif else ld-options: "-Wl,-u,base_GHCziTopHandler_runIO_closure" @@ -324,9 +326,11 @@ library "-Wl,-u,hs_atomicwrite8" "-Wl,-u,hs_atomicwrite16" "-Wl,-u,hs_atomicwrite32" +#if defined(DEBUG) -- This symbol is useful in gdb, but not referred to anywhere, -- so we need to force it to be included in the binary. "-Wl,-u,findPtr" +#endif if os(osx) ld-options: "-Wl,-search_paths_first" From git at git.haskell.org Thu Jun 14 16:03:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 16:03:29 +0000 (UTC) Subject: [commit: ghc] master: relnotes: Add mention of QuantifiedConstraints (4672e2e) Message-ID: <20180614160329.997503ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4672e2ebf040feffde4e7e2d79c479e4c0c3efaf/ghc >--------------------------------------------------------------- commit 4672e2ebf040feffde4e7e2d79c479e4c0c3efaf Author: Ben Gamari Date: Thu Jun 14 11:44:36 2018 -0400 relnotes: Add mention of QuantifiedConstraints >--------------------------------------------------------------- 4672e2ebf040feffde4e7e2d79c479e4c0c3efaf docs/users_guide/8.6.1-notes.rst | 13 +++++++++++++ docs/users_guide/glasgow_exts.rst | 9 +++++++++ 2 files changed, 22 insertions(+) diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index ef9a6b6..d7ba6ed 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -28,6 +28,19 @@ Full details Language ~~~~~~~~ + +- Use of quantified type variables in constraints is now allowed via the + :extension:`QuantifiedConstraints` language extension. This long-awaited feature + enables users to encode significantly more precision in their types. For instance, + the common ``MonadTrans`` typeclass could now make the expectation that an + applied transformer is must be a ``Monad`` :: + + class (forall a. Monad m => Monad (t m)) => MonadTrans t where {- ... -} + + Additionally, quantification can enable terminating instance resolution + where this previously was not possible. See :ref:`quantified-constraints` for + details. + - A new :extension:`DerivingVia` language extension has been added which allows the use of the ``via`` deriving strategy. For instance: :: diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 37ebf9c..24ae3bc 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9707,9 +9707,18 @@ contexts and superclasses, but to do so you must use :extension:`UndecidableInstances` to signal that you don't mind if the type checker fails to terminate. +.. _quantified-constraints: + Quantified constraints ====================== +.. extension:: QuantifiedConstraints + :shortdesc: Allow ``forall`` quantifiers in constraints. + + :since: 8.6.1 + + Allow constraints to quantify over types. + The extension :extension:`QuantifiedConstraints` introduces **quantified constraints**, which give a new level of expressiveness in constraints. For example, consider :: From git at git.haskell.org Thu Jun 14 19:07:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 19:07:32 +0000 (UTC) Subject: [commit: ghc] master: Embrace -XTypeInType, add -XStarIsType (d650729) Message-ID: <20180614190732.057773ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60/ghc >--------------------------------------------------------------- commit d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60 Author: Vladislav Zavialov Date: Thu Jun 14 15:02:36 2018 -0400 Embrace -XTypeInType, add -XStarIsType Summary: Implement the "Embrace Type :: Type" GHC proposal, .../ghc-proposals/blob/master/proposals/0020-no-type-in-type.rst GHC 8.0 included a major change to GHC's type system: the Type :: Type axiom. Though casual users were protected from this by hiding its features behind the -XTypeInType extension, all programs written in GHC 8+ have the axiom behind the scenes. In order to preserve backward compatibility, various legacy features were left unchanged. For example, with -XDataKinds but not -XTypeInType, GADTs could not be used in types. Now these restrictions are lifted and -XTypeInType becomes a redundant flag that will be eventually deprecated. * Incorporate the features currently in -XTypeInType into the -XPolyKinds and -XDataKinds extensions. * Introduce a new extension -XStarIsType to control how to parse * in code and whether to print it in error messages. Test Plan: Validate Reviewers: goldfire, hvr, bgamari, alanz, simonpj Reviewed By: goldfire, simonpj Subscribers: rwbarton, thomie, mpickering, carter GHC Trac Issues: #15195 Differential Revision: https://phabricator.haskell.org/D4748 >--------------------------------------------------------------- d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60 .gitignore | 1 + .gitmodules | 4 +- compiler/basicTypes/DataCon.hs | 22 +- compiler/basicTypes/Name.hs | 21 +- compiler/basicTypes/RdrName.hs | 96 +++- compiler/basicTypes/SrcLoc.hs | 5 +- compiler/deSugar/DsMeta.hs | 7 +- compiler/hsSyn/Convert.hs | 37 +- compiler/hsSyn/HsDecls.hs | 9 +- compiler/hsSyn/HsExtension.hs | 16 +- compiler/hsSyn/HsInstances.hs | 5 - compiler/hsSyn/HsTypes.hs | 117 +---- compiler/iface/IfaceType.hs | 8 +- compiler/main/DynFlags.hs | 31 ++ compiler/main/DynFlags.hs-boot | 1 + compiler/main/HscTypes.hs | 3 +- compiler/parser/Lexer.x | 104 +++-- compiler/parser/Parser.y | 88 ++-- compiler/parser/RdrHsSyn.hs | 190 ++++---- compiler/prelude/PrelNames.hs | 7 +- compiler/prelude/PrelNames.hs-boot | 3 +- compiler/prelude/TysWiredIn.hs | 24 +- compiler/rename/RnEnv.hs | 43 +- compiler/rename/RnSource.hs | 4 +- compiler/rename/RnTypes.hs | 186 ++------ compiler/typecheck/TcDeriv.hs | 14 +- compiler/typecheck/TcHsType.hs | 82 ++-- compiler/typecheck/TcInstDcls.hs | 4 +- compiler/typecheck/TcMType.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 6 - compiler/typecheck/TcSplice.hs | 4 +- compiler/typecheck/TcTyClsDecls.hs | 43 +- compiler/types/Kind.hs | 33 +- compiler/types/TyCoRep.hs | 1 + compiler/types/TyCon.hs | 8 +- compiler/types/Type.hs | 11 +- compiler/types/Unify.hs | 2 +- compiler/utils/Outputable.hs | 11 +- docs/users_guide/8.6.1-notes.rst | 30 +- docs/users_guide/glasgow_exts.rst | 482 +++++++++------------ libraries/base/Data/Data.hs | 4 +- libraries/base/Data/Kind.hs | 2 +- libraries/base/Data/Proxy.hs | 2 +- libraries/base/Data/Type/Equality.hs | 4 +- libraries/base/Data/Typeable.hs | 26 +- libraries/base/Data/Typeable/Internal.hs | 1 - libraries/base/GHC/Base.hs | 3 +- libraries/base/GHC/Err.hs | 2 +- libraries/base/GHC/Generics.hs | 50 +-- libraries/base/Type/Reflection/Unsafe.hs | 2 +- libraries/base/tests/CatEntail.hs | 4 +- .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + libraries/ghc-prim/GHC/Magic.hs | 3 +- libraries/ghc-prim/GHC/Types.hs | 8 +- testsuite/tests/codeGen/should_fail/T13233.hs | 2 +- testsuite/tests/dependent/ghci/T11549.script | 2 +- testsuite/tests/dependent/ghci/T14238.stdout | 2 +- testsuite/tests/dependent/should_compile/Dep1.hs | 2 +- testsuite/tests/dependent/should_compile/Dep2.hs | 2 +- testsuite/tests/dependent/should_compile/Dep3.hs | 2 +- .../tests/dependent/should_compile/DkNameRes.hs | 9 + .../dependent/should_compile/InferDependency.hs | 6 - .../dependent/should_compile/KindEqualities.hs | 2 +- .../dependent/should_compile/KindEqualities2.hs | 3 +- .../tests/dependent/should_compile/KindLevels.hs | 2 +- .../tests/dependent/should_compile/RAE_T32b.hs | 24 +- testsuite/tests/dependent/should_compile/Rae31.hs | 23 +- .../tests/dependent/should_compile/RaeBlogPost.hs | 27 +- .../tests/dependent/should_compile/RaeJobTalk.hs | 2 +- testsuite/tests/dependent/should_compile/T11405.hs | 2 +- testsuite/tests/dependent/should_compile/T11635.hs | 2 +- testsuite/tests/dependent/should_compile/T11711.hs | 1 - testsuite/tests/dependent/should_compile/T11719.hs | 6 +- testsuite/tests/dependent/should_compile/T11966.hs | 1 - testsuite/tests/dependent/should_compile/T12176.hs | 2 +- testsuite/tests/dependent/should_compile/T12442.hs | 4 +- testsuite/tests/dependent/should_compile/T12742.hs | 2 +- testsuite/tests/dependent/should_compile/T13910.hs | 9 +- testsuite/tests/dependent/should_compile/T13938.hs | 3 +- .../tests/dependent/should_compile/T13938a.hs | 3 +- testsuite/tests/dependent/should_compile/T14038.hs | 3 +- .../tests/dependent/should_compile/T14066a.hs | 2 +- testsuite/tests/dependent/should_compile/T14556.hs | 3 +- testsuite/tests/dependent/should_compile/T14720.hs | 3 +- testsuite/tests/dependent/should_compile/T14749.hs | 2 +- testsuite/tests/dependent/should_compile/T14991.hs | 3 +- testsuite/tests/dependent/should_compile/T9632.hs | 2 +- .../tests/dependent/should_compile/TypeLevelVec.hs | 2 +- testsuite/tests/dependent/should_compile/all.T | 1 + .../dependent/should_compile/dynamic-paper.hs | 27 +- .../tests/dependent/should_compile/mkGADTVars.hs | 2 +- .../tests/dependent/should_fail/BadTelescope.hs | 2 +- .../tests/dependent/should_fail/BadTelescope2.hs | 2 +- .../tests/dependent/should_fail/BadTelescope3.hs | 2 +- .../tests/dependent/should_fail/BadTelescope4.hs | 2 +- testsuite/tests/dependent/should_fail/DepFail1.hs | 2 +- .../tests/dependent/should_fail/InferDependency.hs | 2 +- .../tests/dependent/should_fail/KindLevelsB.hs | 9 - .../tests/dependent/should_fail/KindLevelsB.stderr | 5 - .../tests/dependent/should_fail/PromotedClass.hs | 2 +- testsuite/tests/dependent/should_fail/RAE_T32a.hs | 28 +- .../tests/dependent/should_fail/RAE_T32a.stderr | 6 +- .../tests/dependent/should_fail/RenamingStar.hs | 2 +- .../dependent/should_fail/RenamingStar.stderr | 10 +- testsuite/tests/dependent/should_fail/SelfDep.hs | 2 + .../tests/dependent/should_fail/SelfDep.stderr | 8 +- testsuite/tests/dependent/should_fail/T11407.hs | 2 +- testsuite/tests/dependent/should_fail/T11473.hs | 2 +- testsuite/tests/dependent/should_fail/T12081.hs | 2 +- testsuite/tests/dependent/should_fail/T12174.hs | 2 +- testsuite/tests/dependent/should_fail/T13135.hs | 4 +- testsuite/tests/dependent/should_fail/T13601.hs | 2 +- testsuite/tests/dependent/should_fail/T13780a.hs | 2 +- testsuite/tests/dependent/should_fail/T13780b.hs | 3 +- testsuite/tests/dependent/should_fail/T13780c.hs | 2 +- .../tests/dependent/should_fail/T13780c.stderr | 6 +- testsuite/tests/dependent/should_fail/T14066.hs | 4 +- testsuite/tests/dependent/should_fail/T14066c.hs | 2 +- testsuite/tests/dependent/should_fail/T14066d.hs | 2 +- testsuite/tests/dependent/should_fail/T14066e.hs | 2 +- testsuite/tests/dependent/should_fail/T14066f.hs | 2 +- testsuite/tests/dependent/should_fail/T14066g.hs | 2 +- testsuite/tests/dependent/should_fail/T14066h.hs | 2 +- testsuite/tests/dependent/should_fail/T15245.hs | 10 + .../tests/dependent/should_fail/T15245.stderr | 7 + .../tests/dependent/should_fail/TypeSkolEscape.hs | 2 +- testsuite/tests/dependent/should_fail/all.T | 2 +- testsuite/tests/dependent/should_run/T11964a.hs | 2 +- testsuite/tests/deriving/should_compile/T11416.hs | 3 +- testsuite/tests/deriving/should_compile/T11732a.hs | 2 +- testsuite/tests/deriving/should_compile/T11732b.hs | 2 +- testsuite/tests/deriving/should_compile/T11732c.hs | 2 +- testsuite/tests/deriving/should_compile/T14331.hs | 2 +- testsuite/tests/deriving/should_compile/T14579.hs | 3 +- testsuite/tests/deriving/should_compile/T14932.hs | 4 +- testsuite/tests/deriving/should_fail/T12512.hs | 2 +- testsuite/tests/deriving/should_fail/T14728a.hs | 2 +- testsuite/tests/deriving/should_fail/T14728b.hs | 2 +- testsuite/tests/deriving/should_fail/T15073.hs | 2 +- testsuite/tests/determinism/determ004/determ004.hs | 2 +- testsuite/tests/determinism/determ014/A.hs | 6 +- testsuite/tests/driver/T4437.hs | 1 + testsuite/tests/gadt/T7293.hs | 6 +- testsuite/tests/gadt/T7293.stderr | 4 +- testsuite/tests/gadt/T7294.hs | 6 +- testsuite/tests/gadt/T7294.stderr | 4 +- testsuite/tests/generics/GEq/GEq1.hs | 5 +- testsuite/tests/ghci/scripts/T10321.hs | 3 +- testsuite/tests/ghci/scripts/T11252.script | 2 +- testsuite/tests/ghci/scripts/T11376.script | 2 +- testsuite/tests/ghci/scripts/T12550.script | 2 +- testsuite/tests/ghci/scripts/T13407.script | 4 +- testsuite/tests/ghci/scripts/T13963.script | 2 +- testsuite/tests/ghci/scripts/T13988.hs | 2 +- testsuite/tests/ghci/scripts/T7873.script | 2 +- testsuite/tests/ghci/scripts/T7939.hs | 4 +- testsuite/tests/ghci/scripts/T8357.hs | 5 +- testsuite/tests/indexed-types/should_compile/HO.hs | 5 +- .../tests/indexed-types/should_compile/Numerals.hs | 7 +- .../tests/indexed-types/should_compile/T12369.hs | 4 +- .../tests/indexed-types/should_compile/T12522b.hs | 8 +- .../tests/indexed-types/should_compile/T12938.hs | 2 +- .../tests/indexed-types/should_compile/T13244.hs | 2 +- .../tests/indexed-types/should_compile/T13398b.hs | 2 +- .../tests/indexed-types/should_compile/T14162.hs | 3 +- .../tests/indexed-types/should_compile/T14554.hs | 5 +- .../tests/indexed-types/should_compile/T15122.hs | 2 +- .../tests/indexed-types/should_compile/T2219.hs | 4 +- .../tests/indexed-types/should_compile/T7585.hs | 6 +- .../tests/indexed-types/should_compile/T9747.hs | 9 +- .../tests/indexed-types/should_fail/T12522a.hs | 6 +- .../tests/indexed-types/should_fail/T12522a.stderr | 6 +- .../tests/indexed-types/should_fail/T13674.hs | 4 +- .../tests/indexed-types/should_fail/T13784.hs | 5 +- .../tests/indexed-types/should_fail/T13784.stderr | 14 +- .../tests/indexed-types/should_fail/T13877.hs | 6 +- .../tests/indexed-types/should_fail/T13972.hs | 2 +- .../tests/indexed-types/should_fail/T14175.hs | 2 +- .../tests/indexed-types/should_fail/T14246.hs | 8 +- .../tests/indexed-types/should_fail/T14246.stderr | 2 +- .../tests/indexed-types/should_fail/T14369.hs | 2 +- testsuite/tests/indexed-types/should_fail/T2544.hs | 4 +- .../tests/indexed-types/should_fail/T2544.stderr | 8 +- .../tests/indexed-types/should_fail/T3330c.hs | 6 +- .../tests/indexed-types/should_fail/T3330c.stderr | 10 +- testsuite/tests/indexed-types/should_fail/T4174.hs | 10 +- .../tests/indexed-types/should_fail/T4174.stderr | 6 +- testsuite/tests/indexed-types/should_fail/T7786.hs | 4 +- .../tests/indexed-types/should_fail/T7786.stderr | 25 +- testsuite/tests/indexed-types/should_fail/T7967.hs | 10 +- .../tests/indexed-types/should_fail/T7967.stderr | 12 +- testsuite/tests/indexed-types/should_fail/T9036.hs | 7 +- .../tests/indexed-types/should_fail/T9036.stderr | 2 +- testsuite/tests/indexed-types/should_fail/T9662.hs | 4 +- .../tests/indexed-types/should_fail/T9662.stderr | 6 +- .../tests/indexed-types/should_run/T11465a.hs | 1 - .../should_run/overloadedrecflds_generics.hs | 5 +- .../should_run/overloadedrecfldsrun07.hs | 6 +- .../parser/should_compile/DumpParsedAst.stderr | 109 ++--- .../tests/parser/should_compile/DumpRenamedAst.hs | 2 +- .../parser/should_compile/DumpRenamedAst.stderr | 62 ++- testsuite/tests/parser/should_compile/T10379.hs | 2 +- testsuite/tests/parser/should_fail/T15209.stderr | 2 +- testsuite/tests/parser/should_fail/all.T | 5 + testsuite/tests/parser/should_fail/readFail036.hs | 4 +- .../tests/parser/should_fail/readFail036.stderr | 4 +- testsuite/tests/parser/should_fail/typeops_A.hs | 1 + .../tests/parser/should_fail/typeops_A.stderr | 2 + testsuite/tests/parser/should_fail/typeops_B.hs | 1 + .../tests/parser/should_fail/typeops_B.stderr | 2 + testsuite/tests/parser/should_fail/typeops_C.hs | 1 + .../tests/parser/should_fail/typeops_C.stderr | 2 + testsuite/tests/parser/should_fail/typeops_D.hs | 1 + .../tests/parser/should_fail/typeops_D.stderr | 2 + .../tests/partial-sigs/should_compile/T15039a.hs | 12 +- .../partial-sigs/should_compile/T15039a.stderr | 11 +- .../tests/partial-sigs/should_compile/T15039b.hs | 12 +- .../partial-sigs/should_compile/T15039b.stderr | 44 +- .../tests/partial-sigs/should_compile/T15039c.hs | 12 +- .../partial-sigs/should_compile/T15039c.stderr | 11 +- .../tests/partial-sigs/should_compile/T15039d.hs | 12 +- .../partial-sigs/should_compile/T15039d.stderr | 44 +- .../tests/partial-sigs/should_fail/T14040a.hs | 2 +- testsuite/tests/partial-sigs/should_fail/T14584.hs | 2 +- .../tests/partial-sigs/should_fail/T14584.stderr | 2 +- testsuite/tests/patsyn/should_compile/T12698.hs | 2 +- testsuite/tests/patsyn/should_compile/T12968.hs | 2 +- testsuite/tests/patsyn/should_compile/T13768.hs | 8 +- testsuite/tests/patsyn/should_compile/T14058.hs | 2 +- testsuite/tests/patsyn/should_compile/T14058a.hs | 3 +- testsuite/tests/patsyn/should_fail/T14507.hs | 4 +- testsuite/tests/patsyn/should_fail/T14507.stderr | 2 +- testsuite/tests/patsyn/should_fail/T14552.hs | 2 +- testsuite/tests/perf/compiler/T12227.hs | 17 +- testsuite/tests/perf/compiler/T12545a.hs | 3 +- testsuite/tests/perf/compiler/T13035.hs | 13 +- testsuite/tests/perf/compiler/T13035.stderr | 2 +- testsuite/tests/perf/compiler/T9872d.hs | 186 ++++++-- testsuite/tests/pmcheck/complete_sigs/T14253.hs | 2 +- testsuite/tests/pmcheck/should_compile/T14086.hs | 2 +- testsuite/tests/pmcheck/should_compile/T3927b.hs | 8 +- testsuite/tests/polykinds/MonoidsTF.hs | 4 +- testsuite/tests/polykinds/PolyKinds10.hs | 27 +- testsuite/tests/polykinds/SigTvKinds3.hs | 2 +- testsuite/tests/polykinds/T10134a.hs | 3 +- testsuite/tests/polykinds/T10934.hs | 6 +- testsuite/tests/polykinds/T11142.hs | 2 +- testsuite/tests/polykinds/T11399.hs | 2 +- testsuite/tests/polykinds/T11480b.hs | 24 +- testsuite/tests/polykinds/T11520.hs | 2 +- testsuite/tests/polykinds/T11523.hs | 1 - testsuite/tests/polykinds/T11554.hs | 2 +- testsuite/tests/polykinds/T11616.hs | 2 +- testsuite/tests/polykinds/T11640.hs | 2 +- testsuite/tests/polykinds/T11648.hs | 4 +- testsuite/tests/polykinds/T11648b.hs | 2 +- testsuite/tests/polykinds/T11821a.hs | 2 +- testsuite/tests/polykinds/T12055.hs | 4 +- testsuite/tests/polykinds/T12055a.hs | 4 +- testsuite/tests/polykinds/T12593.hs | 2 +- testsuite/tests/polykinds/T12668.hs | 2 +- testsuite/tests/polykinds/T12718.hs | 2 +- testsuite/tests/polykinds/T13391.hs | 7 - testsuite/tests/polykinds/T13391.stderr | 7 - testsuite/tests/polykinds/T13625.hs | 2 +- testsuite/tests/polykinds/T13659.hs | 4 +- testsuite/tests/polykinds/T13659.stderr | 2 +- testsuite/tests/polykinds/T13738.hs | 2 +- testsuite/tests/polykinds/T13985.stderr | 10 +- testsuite/tests/polykinds/T14174.hs | 2 +- testsuite/tests/polykinds/T14174a.hs | 7 +- testsuite/tests/polykinds/T14209.hs | 2 +- testsuite/tests/polykinds/T14270.hs | 2 +- testsuite/tests/polykinds/T14450.hs | 4 +- testsuite/tests/polykinds/T14450.stderr | 2 +- testsuite/tests/polykinds/T14515.hs | 3 +- testsuite/tests/polykinds/T14520.hs | 4 +- testsuite/tests/polykinds/T14555.hs | 4 +- testsuite/tests/polykinds/T14561.hs | 2 +- testsuite/tests/polykinds/T14563.hs | 2 +- testsuite/tests/polykinds/T14580.hs | 2 +- testsuite/tests/polykinds/T14710.stderr | 8 - testsuite/tests/polykinds/T14846.hs | 2 +- testsuite/tests/polykinds/T14873.hs | 3 +- testsuite/tests/polykinds/T15170.hs | 2 +- testsuite/tests/polykinds/T5716.hs | 3 +- testsuite/tests/polykinds/T5716.stderr | 10 +- testsuite/tests/polykinds/T6021.stderr | 4 - testsuite/tests/polykinds/T6035.hs | 4 +- testsuite/tests/polykinds/T6039.stderr | 12 +- testsuite/tests/polykinds/T6093.hs | 7 +- testsuite/tests/polykinds/T7404.stderr | 4 - testsuite/tests/polykinds/T7594.hs | 6 +- testsuite/tests/polykinds/T7594.stderr | 9 +- testsuite/tests/polykinds/T8566.hs | 8 +- testsuite/tests/polykinds/T8566.stderr | 8 +- testsuite/tests/polykinds/T8566a.hs | 8 +- testsuite/tests/polykinds/T8985.hs | 8 +- testsuite/tests/polykinds/T9222.hs | 3 +- testsuite/tests/polykinds/T9222.stderr | 6 +- testsuite/tests/polykinds/all.T | 5 +- testsuite/tests/printer/Ppr040.hs | 2 +- testsuite/tests/printer/Ppr045.hs | 1 + testsuite/tests/rename/should_fail/T11592.hs | 2 +- testsuite/tests/rename/should_fail/T13947.stderr | 2 +- .../tests/simplCore/should_compile/T13025a.hs | 6 +- testsuite/tests/simplCore/should_compile/T13658.hs | 2 +- .../tests/simplCore/should_compile/T14270a.hs | 3 +- .../tests/simplCore/should_compile/T15186A.hs | 2 +- testsuite/tests/simplCore/should_compile/T4903a.hs | 10 +- testsuite/tests/simplCore/should_run/T13750a.hs | 13 +- testsuite/tests/th/T11463.hs | 2 +- testsuite/tests/th/T11484.hs | 2 +- testsuite/tests/th/T13642.hs | 2 +- testsuite/tests/th/T13781.hs | 2 +- testsuite/tests/th/T14060.hs | 2 +- testsuite/tests/th/T14869.hs | 2 +- testsuite/tests/th/T8031.hs | 4 +- testsuite/tests/th/TH_RichKinds2.hs | 5 +- testsuite/tests/th/TH_RichKinds2.stderr | 2 +- .../tests/typecheck/should_compile/SplitWD.hs | 2 +- testsuite/tests/typecheck/should_compile/T10432.hs | 5 +- testsuite/tests/typecheck/should_compile/T11237.hs | 4 +- testsuite/tests/typecheck/should_compile/T11348.hs | 1 - testsuite/tests/typecheck/should_compile/T11524.hs | 1 - testsuite/tests/typecheck/should_compile/T11723.hs | 2 +- testsuite/tests/typecheck/should_compile/T11811.hs | 2 +- testsuite/tests/typecheck/should_compile/T12133.hs | 4 +- testsuite/tests/typecheck/should_compile/T12381.hs | 2 +- testsuite/tests/typecheck/should_compile/T12734.hs | 38 +- .../tests/typecheck/should_compile/T12734a.hs | 31 +- .../tests/typecheck/should_compile/T12734a.stderr | 9 +- .../tests/typecheck/should_compile/T12785a.hs | 2 +- testsuite/tests/typecheck/should_compile/T12911.hs | 2 +- testsuite/tests/typecheck/should_compile/T12919.hs | 2 +- testsuite/tests/typecheck/should_compile/T12987.hs | 2 +- testsuite/tests/typecheck/should_compile/T13083.hs | 5 +- testsuite/tests/typecheck/should_compile/T13333.hs | 2 +- testsuite/tests/typecheck/should_compile/T13337.hs | 2 +- testsuite/tests/typecheck/should_compile/T13343.hs | 2 +- testsuite/tests/typecheck/should_compile/T13458.hs | 2 +- testsuite/tests/typecheck/should_compile/T13603.hs | 2 +- testsuite/tests/typecheck/should_compile/T13643.hs | 2 +- testsuite/tests/typecheck/should_compile/T13822.hs | 3 +- testsuite/tests/typecheck/should_compile/T13871.hs | 2 +- testsuite/tests/typecheck/should_compile/T13879.hs | 2 +- .../tests/typecheck/should_compile/T13915a.hs | 2 +- .../tests/typecheck/should_compile/T13915b.hs | 2 +- testsuite/tests/typecheck/should_compile/T13943.hs | 2 +- testsuite/tests/typecheck/should_compile/T14441.hs | 3 +- .../tests/typecheck/should_compile/T14934a.hs | 3 +- testsuite/tests/typecheck/should_compile/all.T | 4 +- testsuite/tests/typecheck/should_compile/tc191.hs | 2 +- testsuite/tests/typecheck/should_compile/tc205.hs | 4 +- testsuite/tests/typecheck/should_compile/tc269.hs | 3 +- .../should_compile/valid_hole_fits_interactions.hs | 2 +- .../tests/typecheck/should_fail/ClassOperator.hs | 4 +- .../typecheck/should_fail/ClassOperator.stderr | 16 +- .../typecheck/should_fail/CustomTypeErrors04.hs | 2 +- .../typecheck/should_fail/CustomTypeErrors05.hs | 2 +- .../tests/typecheck/should_fail/LevPolyBounded.hs | 2 +- testsuite/tests/typecheck/should_fail/T11313.hs | 2 - .../tests/typecheck/should_fail/T11313.stderr | 8 +- testsuite/tests/typecheck/should_fail/T11724.hs | 2 +- testsuite/tests/typecheck/should_fail/T11963.hs | 29 -- .../tests/typecheck/should_fail/T11963.stderr | 20 - testsuite/tests/typecheck/should_fail/T12648.hs | 6 +- testsuite/tests/typecheck/should_fail/T12709.hs | 3 +- .../tests/typecheck/should_fail/T12709.stderr | 8 +- testsuite/tests/typecheck/should_fail/T12785b.hs | 8 +- testsuite/tests/typecheck/should_fail/T12973.hs | 2 +- testsuite/tests/typecheck/should_fail/T13105.hs | 2 +- testsuite/tests/typecheck/should_fail/T13446.hs | 4 +- testsuite/tests/typecheck/should_fail/T13909.hs | 2 +- testsuite/tests/typecheck/should_fail/T13929.hs | 2 +- .../tests/typecheck/should_fail/T13983.stderr | 2 +- testsuite/tests/typecheck/should_fail/T14350.hs | 2 +- testsuite/tests/typecheck/should_fail/T14904a.hs | 2 +- testsuite/tests/typecheck/should_fail/T14904b.hs | 2 +- testsuite/tests/typecheck/should_fail/T7645.hs | 4 +- testsuite/tests/typecheck/should_fail/T7645.stderr | 5 +- testsuite/tests/typecheck/should_fail/all.T | 1 - .../tests/typecheck/should_run/EtaExpandLevPoly.hs | 4 +- .../typecheck/should_run/KindInvariant.script | 6 +- testsuite/tests/typecheck/should_run/T11120.hs | 2 +- testsuite/tests/typecheck/should_run/T12809.hs | 2 +- testsuite/tests/typecheck/should_run/T13435.hs | 3 +- testsuite/tests/typecheck/should_run/TypeOf.hs | 2 +- testsuite/tests/typecheck/should_run/TypeRep.hs | 4 +- testsuite/tests/unboxedsums/sum_rr.hs | 2 +- 391 files changed, 1865 insertions(+), 1997 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60 From git at git.haskell.org Thu Jun 14 19:34:00 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 19:34:00 +0000 (UTC) Subject: [commit: ghc] master: Revert inadvertant changes to .gitmodules (0c5aac8) Message-ID: <20180614193400.453FE3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0c5aac8a2917458d6d5fd946d690d83fcfb9866f/ghc >--------------------------------------------------------------- commit 0c5aac8a2917458d6d5fd946d690d83fcfb9866f Author: Ben Gamari Date: Thu Jun 14 15:33:33 2018 -0400 Revert inadvertant changes to .gitmodules >--------------------------------------------------------------- 0c5aac8a2917458d6d5fd946d690d83fcfb9866f .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index e190730..2125a92 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,6 @@ [submodule "libraries/binary"] path = libraries/binary - url = https://github.com/kolmodin/binary.git + url = ../packages/binary.git ignore = untracked [submodule "libraries/bytestring"] path = libraries/bytestring @@ -108,7 +108,7 @@ ignore = untracked [submodule "utils/haddock"] path = utils/haddock - url = https://github.com/int-index/haddock.git + url = ../haddock.git ignore = untracked branch = ghc-head [submodule "nofib"] From git at git.haskell.org Thu Jun 14 21:22:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:22:11 +0000 (UTC) Subject: [commit: ghc] master: Revert "rts: Don't keep findPtr symbol alive if not -DDEBUG" (8ffac59) Message-ID: <20180614212211.67D973ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ffac593d5d3b51c3b720a3a9cc55bf257446808/ghc >--------------------------------------------------------------- commit 8ffac593d5d3b51c3b720a3a9cc55bf257446808 Author: Ben Gamari Date: Thu Jun 14 17:18:29 2018 -0400 Revert "rts: Don't keep findPtr symbol alive if not -DDEBUG" This reverts commit e4c41ec2b1f2f222c9c8a83ef64d4e566aa47a44. rts.cabal.in isn't processed by CPP. >--------------------------------------------------------------- 8ffac593d5d3b51c3b720a3a9cc55bf257446808 rts/rts.cabal.in | 4 ---- 1 file changed, 4 deletions(-) diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in index ffa6282..d41135d 100644 --- a/rts/rts.cabal.in +++ b/rts/rts.cabal.in @@ -251,11 +251,9 @@ library "-Wl,-u,_hs_atomicwrite8" "-Wl,-u,_hs_atomicwrite16" "-Wl,-u,_hs_atomicwrite32" -#if defined(DEBUG) -- This symbol is useful in gdb, but not referred to anywhere, -- so we need to force it to be included in the binary. "-Wl,-u,_findPtr" -#endif else ld-options: "-Wl,-u,base_GHCziTopHandler_runIO_closure" @@ -326,11 +324,9 @@ library "-Wl,-u,hs_atomicwrite8" "-Wl,-u,hs_atomicwrite16" "-Wl,-u,hs_atomicwrite32" -#if defined(DEBUG) -- This symbol is useful in gdb, but not referred to anywhere, -- so we need to force it to be included in the binary. "-Wl,-u,findPtr" -#endif if os(osx) ld-options: "-Wl,-search_paths_first" From git at git.haskell.org Thu Jun 14 21:28:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:32 +0000 (UTC) Subject: [commit: packages/binary] master: Permit QuickCheck >= 2.9 (6da9858) Message-ID: <20180614212832.883503ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/6da9858468f50b6936c5ad64cef80098d409cbeb >--------------------------------------------------------------- commit 6da9858468f50b6936c5ad64cef80098d409cbeb Author: Lennart Kolmodin Date: Mon Nov 6 11:55:32 2017 +0100 Permit QuickCheck >= 2.9 >--------------------------------------------------------------- 6da9858468f50b6936c5ad64cef80098d409cbeb binary.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/binary.cabal b/binary.cabal index aa1561c..e8843fb 100644 --- a/binary.cabal +++ b/binary.cabal @@ -70,7 +70,7 @@ test-suite qc random>=1.0.1.0, test-framework, test-framework-quickcheck2 >= 0.3, - QuickCheck == 2.9.* + QuickCheck >= 2.9 -- build dependencies from using binary source rather than depending on the library build-depends: array, containers From git at git.haskell.org Thu Jun 14 21:28:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:34 +0000 (UTC) Subject: [commit: packages/binary] master: Add Binary instance for Identity, from base-4.8.0.0. (333f836) Message-ID: <20180614212834.8E4513ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/333f8366f86a5af86062e94897eec8ef9aee4d1d >--------------------------------------------------------------- commit 333f8366f86a5af86062e94897eec8ef9aee4d1d Author: Daniel Díaz Date: Mon Mar 12 11:14:59 2018 -0500 Add Binary instance for Identity, from base-4.8.0.0. >--------------------------------------------------------------- 333f8366f86a5af86062e94897eec8ef9aee4d1d src/Data/Binary/Class.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs index 4d1c436..2eed93e 100644 --- a/src/Data/Binary/Class.hs +++ b/src/Data/Binary/Class.hs @@ -60,6 +60,9 @@ import Data.Monoid (mempty) #endif import qualified Data.Monoid as Monoid import Data.Monoid ((<>)) +#if MIN_VERSION_base(4,8,0) +import Data.Functor.Identity (Identity (..)) +#endif #if MIN_VERSION_base(4,9,0) import qualified Data.List.NonEmpty as NE import qualified Data.Semigroup as Semigroup @@ -566,6 +569,12 @@ instance (Binary a, Binary b, Binary c, Binary d, Binary e, ------------------------------------------------------------------------ -- Container types +#if MIN_VERSION_base(4,8,0) +instance Binary a => Binary (Identity a) where + put (Identity x) = put x + get = Identity <$> get +#endif + instance Binary a => Binary [a] where put = putList get = do n <- get :: Get Int From git at git.haskell.org Thu Jun 14 21:28:36 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:36 +0000 (UTC) Subject: [commit: packages/binary] master: Fix CI (45ef7a1) Message-ID: <20180614212836.ACC823ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/45ef7a19b5031df5eb7dcc9b27726aefb2a36a73 >--------------------------------------------------------------- commit 45ef7a19b5031df5eb7dcc9b27726aefb2a36a73 Author: Vladislav Zavialov Date: Tue May 22 16:43:31 2018 +0300 Fix CI >--------------------------------------------------------------- 45ef7a19b5031df5eb7dcc9b27726aefb2a36a73 .travis.yml | 23 ++- benchmarks/Builder.hs | 2 + benchmarks/Cabal24.hs | 360 +++++++++++++++++++++++++++++++++++++++ benchmarks/GenericsBench.hs | 2 +- benchmarks/GenericsBenchCache.hs | 87 +++------- benchmarks/GenericsBenchTypes.hs | 19 +-- binary.cabal | 7 +- generics-bench.cache.gz | Bin 0 -> 7460114 bytes 8 files changed, 405 insertions(+), 95 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 45ef7a19b5031df5eb7dcc9b27726aefb2a36a73 From git at git.haskell.org Thu Jun 14 21:28:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:38 +0000 (UTC) Subject: [commit: packages/binary] master: Merge pull request #147 from int-index/fix-ci (b660e3d) Message-ID: <20180614212838.BF2C43ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/b660e3d2e4a78c6ed95f5632694c7eac6e520989 >--------------------------------------------------------------- commit b660e3d2e4a78c6ed95f5632694c7eac6e520989 Merge: 6da9858 45ef7a1 Author: Lennart Kolmodin Date: Thu Jun 7 07:18:51 2018 +0200 Merge pull request #147 from int-index/fix-ci Fix CI >--------------------------------------------------------------- b660e3d2e4a78c6ed95f5632694c7eac6e520989 .travis.yml | 23 ++- benchmarks/Builder.hs | 2 + benchmarks/Cabal24.hs | 360 +++++++++++++++++++++++++++++++++++++++ benchmarks/GenericsBench.hs | 2 +- benchmarks/GenericsBenchCache.hs | 87 +++------- benchmarks/GenericsBenchTypes.hs | 19 +-- binary.cabal | 7 +- generics-bench.cache.gz | Bin 0 -> 7460114 bytes 8 files changed, 405 insertions(+), 95 deletions(-) From git at git.haskell.org Thu Jun 14 21:28:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:40 +0000 (UTC) Subject: [commit: packages/binary] master: Don't use * as Type in the presence of TypeOperators (d0912c8) Message-ID: <20180614212840.C5B013ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/d0912c8dda8b17c75e6020a970f93d27200d118c >--------------------------------------------------------------- commit d0912c8dda8b17c75e6020a970f93d27200d118c Author: Vladislav Zavialov Date: Tue May 29 12:19:31 2018 +0300 Don't use * as Type in the presence of TypeOperators >--------------------------------------------------------------- d0912c8dda8b17c75e6020a970f93d27200d118c src/Data/Binary/Generic.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/Data/Binary/Generic.hs b/src/Data/Binary/Generic.hs index 7282ff6..feb85d7 100644 --- a/src/Data/Binary/Generic.hs +++ b/src/Data/Binary/Generic.hs @@ -3,6 +3,10 @@ {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +#if __GLASGOW_HASKELL__ >= 800 +#define HAS_DATA_KIND +#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.Binary.Generic @@ -27,6 +31,9 @@ import Data.Binary.Put import Data.Bits import Data.Word import Data.Monoid ((<>)) +#ifdef HAS_DATA_KIND +import Data.Kind +#endif import GHC.Generics import Prelude -- Silence AMP warning. @@ -136,7 +143,11 @@ instance GBinaryPut a => GSumPut (C1 c a) where class SumSize f where sumSize :: Tagged f Word64 -newtype Tagged (s :: * -> *) b = Tagged {unTagged :: b} +#ifdef HAS_DATA_KIND +newtype Tagged (s :: Type -> Type) b = Tagged {unTagged :: b} +#else +newtype Tagged (s :: * -> *) b = Tagged {unTagged :: b} +#endif instance (SumSize a, SumSize b) => SumSize (a :+: b) where sumSize = Tagged $ unTagged (sumSize :: Tagged a Word64) + From git at git.haskell.org Thu Jun 14 21:28:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:42 +0000 (UTC) Subject: [commit: packages/binary] master: Merge remote-tracking branch 'upstream/master' (d67bc13) Message-ID: <20180614212842.D40B03ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/d67bc13a3dac83ebbe232678554e24c1f1a6d548 >--------------------------------------------------------------- commit d67bc13a3dac83ebbe232678554e24c1f1a6d548 Merge: 333f836 b660e3d Author: Daniel Casanueva Date: Thu Jun 7 13:17:29 2018 +0200 Merge remote-tracking branch 'upstream/master' >--------------------------------------------------------------- d67bc13a3dac83ebbe232678554e24c1f1a6d548 .travis.yml | 23 ++- benchmarks/Builder.hs | 2 + benchmarks/Cabal24.hs | 360 +++++++++++++++++++++++++++++++++++++++ benchmarks/GenericsBench.hs | 2 +- benchmarks/GenericsBenchCache.hs | 87 +++------- benchmarks/GenericsBenchTypes.hs | 19 +-- binary.cabal | 7 +- generics-bench.cache.gz | Bin 0 -> 7460114 bytes 8 files changed, 405 insertions(+), 95 deletions(-) From git at git.haskell.org Thu Jun 14 21:28:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:44 +0000 (UTC) Subject: [commit: packages/binary] master: Merge pull request #148 from int-index/no-star (6eedd64) Message-ID: <20180614212844.DA70B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/6eedd64a9607a8ce3558977a0a585c8d8bad3d63 >--------------------------------------------------------------- commit 6eedd64a9607a8ce3558977a0a585c8d8bad3d63 Merge: b660e3d d0912c8 Author: Lennart Kolmodin Date: Thu Jun 7 21:58:05 2018 +0200 Merge pull request #148 from int-index/no-star Don't use * as Type in the presence of TypeOperators >--------------------------------------------------------------- 6eedd64a9607a8ce3558977a0a585c8d8bad3d63 src/Data/Binary/Generic.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) From git at git.haskell.org Thu Jun 14 21:28:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:28:46 +0000 (UTC) Subject: [commit: packages/binary] master: Merge pull request #146 from Daniel-Diaz/master (ecf48c4) Message-ID: <20180614212846.E0C4D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/binary On branch : master Link : http://git.haskell.org/packages/binary.git/commitdiff/ecf48c4589b927de3ae3fff8455c1c25140df7e9 >--------------------------------------------------------------- commit ecf48c4589b927de3ae3fff8455c1c25140df7e9 Merge: 6eedd64 d67bc13 Author: Lennart Kolmodin Date: Thu Jun 7 21:59:09 2018 +0200 Merge pull request #146 from Daniel-Diaz/master Add Binary instance for Identity, from base-4.8.0.0 >--------------------------------------------------------------- ecf48c4589b927de3ae3fff8455c1c25140df7e9 src/Data/Binary/Class.hs | 9 +++++++++ 1 file changed, 9 insertions(+) From git at git.haskell.org Thu Jun 14 21:31:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 21:31:28 +0000 (UTC) Subject: [commit: ghc] master: Fix binary and haddock submodule commits (8062d7f) Message-ID: <20180614213128.E14B63ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8062d7fdeeac52eb30638fe2990b74be1c5beb04/ghc >--------------------------------------------------------------- commit 8062d7fdeeac52eb30638fe2990b74be1c5beb04 Author: Ben Gamari Date: Thu Jun 14 16:25:21 2018 -0400 Fix binary and haddock submodule commits >--------------------------------------------------------------- 8062d7fdeeac52eb30638fe2990b74be1c5beb04 libraries/binary | 2 +- testsuite/tests/perf/haddock/all.T | 10 ++++++---- utils/haddock | 2 +- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/libraries/binary b/libraries/binary index d4a030a..ecf48c4 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit d4a030ab448191f664fc734bfbee61450a6fa5af +Subproject commit ecf48c4589b927de3ae3fff8455c1c25140df7e9 diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 78fd3f8..393a697 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), 21123660336, 5) + ,(wordsize(64), 24662232152, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -50,7 +50,8 @@ test('haddock.base', # 2018-04-10: 18511324808 (x86_64/Linux) - TTG HsBinds and Data instances # 2018-04-11: 20727464616 (x86_64/Linux) - Collateral of simplCast improvement (#14737) # 2018-04-20: 18971030224 (x86_64/Linux) - Cache coercion roles - # 2018-05-14: 21123660336 (amd64/Linux) D4659: strictness to fix space leaks + # 2018-05-14: 21123660336 (amd64/Linux) - D4659: strictness to fix space leaks + # 2018-06-14: 24662232152 (amd64/Linux) - Bump haddock ,(platform('i386-unknown-mingw32'), 2885173512, 5) # 2013-02-10: 3358693084 (x86/Windows) @@ -77,7 +78,7 @@ test('haddock.Cabal', [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 24519860272, 5) + [(wordsize(64), 27520214496, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -131,7 +132,8 @@ test('haddock.Cabal', # 2017-11-09: 20104611952 (amd64/Linux) - Bump Cabal # 2018-01-22: 25261834904 (amd64/Linux) - Bump Cabal # 2018-04-10: 23525241536 (amd64/Linux) - TTG HsBinds and Data instances - # 2018-05-14: 24519860272 (amd64/Linux) D4659: strictness to fix space leaks + # 2018-05-14: 24519860272 (amd64/Linux) - D4659: strictness to fix space leaks + # 2018-06-14: 27520214496 (amd64/Linux) - Bump haddock ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) diff --git a/utils/haddock b/utils/haddock index 1411044..97c6cb9 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 14110449370a77195093dd3f610ab869ab9e36cf +Subproject commit 97c6cb949ffe707865b9c46016f97b441d114e45 From git at git.haskell.org Thu Jun 14 22:57:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 22:57:50 +0000 (UTC) Subject: [commit: ghc] master: Bump haddock submodule (f9b925a) Message-ID: <20180614225750.1DCA53ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f9b925a059eb1a170a3db4f5ffceae00dc9b12d6/ghc >--------------------------------------------------------------- commit f9b925a059eb1a170a3db4f5ffceae00dc9b12d6 Author: Ben Gamari Date: Thu Jun 14 18:06:23 2018 -0400 Bump haddock submodule >--------------------------------------------------------------- f9b925a059eb1a170a3db4f5ffceae00dc9b12d6 utils/haddock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utils/haddock b/utils/haddock index 97c6cb9..2755526 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 97c6cb949ffe707865b9c46016f97b441d114e45 +Subproject commit 2755526abb478c2f51c9cf4b894de287dd318868 From git at git.haskell.org Thu Jun 14 22:58:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 22:58:05 +0000 (UTC) Subject: [commit: ghc] master: Fix broken link (3a18a82) Message-ID: <20180614225805.46D813ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3a18a82feedef756c9c2fc92dc902823b425f093/ghc >--------------------------------------------------------------- commit 3a18a82feedef756c9c2fc92dc902823b425f093 Author: Nathan Collins Date: Thu Jun 14 15:00:22 2018 -0700 Fix broken link See https://ghc.haskell.org/trac/ghc/ticket/12578. >--------------------------------------------------------------- 3a18a82feedef756c9c2fc92dc902823b425f093 docs/users_guide/glasgow_exts.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 6d7cb1d..9212eed 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -12298,7 +12298,7 @@ page on the GHC Wiki has a wealth of information. You may also consult the :th-ref:`Haddock reference documentation `. Many changes to the original design are described in `Notes on Template Haskell version -2 `__. +2 `__. Not all of these changes are in GHC, however. The first example from that paper is set out below (:ref:`th-example`) From git at git.haskell.org Thu Jun 14 23:26:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 14 Jun 2018 23:26:18 +0000 (UTC) Subject: [commit: ghc] master: Exclude libraries/libiserv/ghc.mk and other things via .gitignore. (db5ef2b) Message-ID: <20180614232618.0BFB03ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/db5ef2b4f9d22738ae75db29c3e45e370efa4169/ghc >--------------------------------------------------------------- commit db5ef2b4f9d22738ae75db29c3e45e370efa4169 Author: HE, Tao Date: Thu Jun 14 19:25:37 2018 -0400 Exclude libraries/libiserv/ghc.mk and other things via .gitignore. The ghc.mk file is generated by `./boot` and should be excluded from git via .gitignore, since the file `ghc.mk` may have different line ends on windows. The file GNUmakefile and dir dist, dist-install should also be excluded via .gitignore, just as other libraries. Test Plan: [skip ci] Reviewers: bgamari Reviewed By: bgamari Subscribers: osa1, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4814 >--------------------------------------------------------------- db5ef2b4f9d22738ae75db29c3e45e370efa4169 libraries/{ghc-compact => libiserv}/.gitignore | 0 libraries/libiserv/ghc.mk | 5 ----- 2 files changed, 5 deletions(-) diff --git a/libraries/ghc-compact/.gitignore b/libraries/libiserv/.gitignore similarity index 100% copy from libraries/ghc-compact/.gitignore copy to libraries/libiserv/.gitignore diff --git a/libraries/libiserv/ghc.mk b/libraries/libiserv/ghc.mk deleted file mode 100644 index 6dc323b..0000000 --- a/libraries/libiserv/ghc.mk +++ /dev/null @@ -1,5 +0,0 @@ -libraries/libiserv_PACKAGE = libiserv -libraries/libiserv_dist-install_GROUP = libraries -$(if $(filter libiserv,$(PACKAGES_STAGE0)),$(eval $(call build-package,libraries/libiserv,dist-boot,0))) -$(if $(filter libiserv,$(PACKAGES_STAGE1)),$(eval $(call build-package,libraries/libiserv,dist-install,1))) -$(if $(filter libiserv,$(PACKAGES_STAGE2)),$(eval $(call build-package,libraries/libiserv,dist-install,2))) From git at git.haskell.org Fri Jun 15 08:10:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 08:10:28 +0000 (UTC) Subject: [commit: ghc] branch 'bump-llvm' created Message-ID: <20180615081028.E53083ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : bump-llvm Referencing: 6e72b194f15ce028b155c97a54a66b6418d98e43 From git at git.haskell.org Fri Jun 15 08:10:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 08:10:31 +0000 (UTC) Subject: [commit: ghc] bump-llvm: Bump supported LLVM version to 6.0 (6e72b19) Message-ID: <20180615081031.B37FE3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : bump-llvm Link : http://ghc.haskell.org/trac/ghc/changeset/6e72b194f15ce028b155c97a54a66b6418d98e43/ghc >--------------------------------------------------------------- commit 6e72b194f15ce028b155c97a54a66b6418d98e43 Author: Ben Gamari Date: Thu Jun 14 21:37:05 2018 -0400 Bump supported LLVM version to 6.0 This seems to fix a number of segmentation faults. >--------------------------------------------------------------- 6e72b194f15ce028b155c97a54a66b6418d98e43 .circleci/config.yml | 4 ++-- configure.ac | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 49f145d..2caa3b4 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -189,8 +189,8 @@ jobs: - run: name: Install LLVM command: | - curl http://releases.llvm.org/5.0.0/clang+llvm-5.0.0-x86_64-linux-gnu-debian8.tar.xz | tar -xJC .. - echo "export PATH=`pwd`/../clang+llvm-5.0.0-x86_64-linux-gnu-debian8/bin:\$PATH" >> $BASH_ENV + curl http://releases.llvm.org/6.0.0/clang+llvm-6.0.0-x86_64-linux-gnu-debian8.tar.xz | tar -xJC .. + echo "export PATH=`pwd`/../clang+llvm-6.0.0-x86_64-linux-gnu-debian8/bin:\$PATH" >> $BASH_ENV - run: name: Verify that llc works command: llc diff --git a/configure.ac b/configure.ac index 21f9f16..2e6e644 100644 --- a/configure.ac +++ b/configure.ac @@ -643,7 +643,7 @@ AC_SUBST([LibtoolCmd]) # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around # 3.5/3.6 release of LLVM. -LlvmVersion=5.0 +LlvmVersion=6.0 AC_SUBST([LlvmVersion]) sUPPORTED_LLVM_VERSION=$(echo \($LlvmVersion\) | sed 's/\./,/') AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION], ${sUPPORTED_LLVM_VERSION}, [The supported LLVM version number]) From git at git.haskell.org Fri Jun 15 08:10:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 08:10:34 +0000 (UTC) Subject: [commit: ghc] master: UNREG: PprC: add support for of W16 literals (Ticket #15237) (01c9d95) Message-ID: <20180615081034.7BE153ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/01c9d95aca12caf5c954320a2a82335b32568554/ghc >--------------------------------------------------------------- commit 01c9d95aca12caf5c954320a2a82335b32568554 Author: Sergei Trofimovich Date: Thu Jun 14 23:13:16 2018 +0100 UNREG: PprC: add support for of W16 literals (Ticket #15237) Fix UNREG build failure for 32-bit targets. This change is an equivalent of commit 0238a6c78102d43dae2f56192bd3486e4f9ecf1d ("UNREG: PprC: add support for of W32 literals") The change allows combining two subwords into one word on 32-bit targets. Tested on nios2-unknown-linux-gnu. GHC Trac Issues: #15237 Signed-off-by: Sergei Trofimovich >--------------------------------------------------------------- 01c9d95aca12caf5c954320a2a82335b32568554 compiler/cmm/PprC.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index e46fff1..8b30bbf 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -546,6 +546,14 @@ pprStatics dflags (CmmStaticLit (CmmInt a W32) : rest) else pprStatics dflags (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) : rest) +pprStatics dflags (CmmStaticLit (CmmInt a W16) : + CmmStaticLit (CmmInt b W16) : rest) + | wordWidth dflags == W32 + = if wORDS_BIGENDIAN dflags + then pprStatics dflags (CmmStaticLit (CmmInt ((shiftL a 16) .|. b) W32) : + rest) + else pprStatics dflags (CmmStaticLit (CmmInt ((shiftL b 16) .|. a) W32) : + rest) pprStatics dflags (CmmStaticLit (CmmInt _ w) : _) | w /= wordWidth dflags = pprPanic "pprStatics: cannot emit a non-word-sized static literal" (ppr w) From ggreif at gmail.com Fri Jun 15 08:34:31 2018 From: ggreif at gmail.com (Gabor Greif) Date: Fri, 15 Jun 2018 10:34:31 +0200 Subject: [commit: ghc] master: Embrace -XTypeInType, add -XStarIsType (d650729) In-Reply-To: <20180614190732.057773ABA3@ghc.haskell.org> References: <20180614190732.057773ABA3@ghc.haskell.org> Message-ID: My `happy` chokes on the unicode sequence you added: (if isUnicode $1 then "★" else "*") Casn this be done with unicode escapes somehow? Cheers, Gabor PS: Happy Version 1.19.9 Copyright (c) 1993-1996 Andy Gill, Simon Marlow (c) 1997-2005 Simon Marlow On 6/14/18, git at git.haskell.org wrote: > Repository : ssh://git at git.haskell.org/ghc > > On branch : master > Link : > http://ghc.haskell.org/trac/ghc/changeset/d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60/ghc > >>--------------------------------------------------------------- > > commit d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60 > Author: Vladislav Zavialov > Date: Thu Jun 14 15:02:36 2018 -0400 > > Embrace -XTypeInType, add -XStarIsType > > Summary: > Implement the "Embrace Type :: Type" GHC proposal, > .../ghc-proposals/blob/master/proposals/0020-no-type-in-type.rst > > GHC 8.0 included a major change to GHC's type system: the Type :: Type > axiom. Though casual users were protected from this by hiding its > features behind the -XTypeInType extension, all programs written in GHC > 8+ have the axiom behind the scenes. In order to preserve backward > compatibility, various legacy features were left unchanged. For example, > with -XDataKinds but not -XTypeInType, GADTs could not be used in types. > Now these restrictions are lifted and -XTypeInType becomes a redundant > flag that will be eventually deprecated. > > * Incorporate the features currently in -XTypeInType into the > -XPolyKinds and -XDataKinds extensions. > * Introduce a new extension -XStarIsType to control how to parse * in > code and whether to print it in error messages. > > Test Plan: Validate > > Reviewers: goldfire, hvr, bgamari, alanz, simonpj > > Reviewed By: goldfire, simonpj > > Subscribers: rwbarton, thomie, mpickering, carter > > GHC Trac Issues: #15195 > > Differential Revision: https://phabricator.haskell.org/D4748 > > >>--------------------------------------------------------------- > > d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60 > .gitignore | 1 + > .gitmodules | 4 +- > compiler/basicTypes/DataCon.hs | 22 +- > compiler/basicTypes/Name.hs | 21 +- > compiler/basicTypes/RdrName.hs | 96 +++- > compiler/basicTypes/SrcLoc.hs | 5 +- > compiler/deSugar/DsMeta.hs | 7 +- > compiler/hsSyn/Convert.hs | 37 +- > compiler/hsSyn/HsDecls.hs | 9 +- > compiler/hsSyn/HsExtension.hs | 16 +- > compiler/hsSyn/HsInstances.hs | 5 - > compiler/hsSyn/HsTypes.hs | 117 +---- > compiler/iface/IfaceType.hs | 8 +- > compiler/main/DynFlags.hs | 31 ++ > compiler/main/DynFlags.hs-boot | 1 + > compiler/main/HscTypes.hs | 3 +- > compiler/parser/Lexer.x | 104 +++-- > compiler/parser/Parser.y | 88 ++-- > compiler/parser/RdrHsSyn.hs | 190 ++++---- > compiler/prelude/PrelNames.hs | 7 +- > compiler/prelude/PrelNames.hs-boot | 3 +- > compiler/prelude/TysWiredIn.hs | 24 +- > compiler/rename/RnEnv.hs | 43 +- > compiler/rename/RnSource.hs | 4 +- > compiler/rename/RnTypes.hs | 186 ++------ > compiler/typecheck/TcDeriv.hs | 14 +- > compiler/typecheck/TcHsType.hs | 82 ++-- > compiler/typecheck/TcInstDcls.hs | 4 +- > compiler/typecheck/TcMType.hs | 2 +- > compiler/typecheck/TcPatSyn.hs | 2 +- > compiler/typecheck/TcRnTypes.hs | 6 - > compiler/typecheck/TcSplice.hs | 4 +- > compiler/typecheck/TcTyClsDecls.hs | 43 +- > compiler/types/Kind.hs | 33 +- > compiler/types/TyCoRep.hs | 1 + > compiler/types/TyCon.hs | 8 +- > compiler/types/Type.hs | 11 +- > compiler/types/Unify.hs | 2 +- > compiler/utils/Outputable.hs | 11 +- > docs/users_guide/8.6.1-notes.rst | 30 +- > docs/users_guide/glasgow_exts.rst | 482 > +++++++++------------ > libraries/base/Data/Data.hs | 4 +- > libraries/base/Data/Kind.hs | 2 +- > libraries/base/Data/Proxy.hs | 2 +- > libraries/base/Data/Type/Equality.hs | 4 +- > libraries/base/Data/Typeable.hs | 26 +- > libraries/base/Data/Typeable/Internal.hs | 1 - > libraries/base/GHC/Base.hs | 3 +- > libraries/base/GHC/Err.hs | 2 +- > libraries/base/GHC/Generics.hs | 50 +-- > libraries/base/Type/Reflection/Unsafe.hs | 2 +- > libraries/base/tests/CatEntail.hs | 4 +- > .../ghc-boot-th/GHC/LanguageExtensions/Type.hs | 1 + > libraries/ghc-prim/GHC/Magic.hs | 3 +- > libraries/ghc-prim/GHC/Types.hs | 8 +- > testsuite/tests/codeGen/should_fail/T13233.hs | 2 +- > testsuite/tests/dependent/ghci/T11549.script | 2 +- > testsuite/tests/dependent/ghci/T14238.stdout | 2 +- > testsuite/tests/dependent/should_compile/Dep1.hs | 2 +- > testsuite/tests/dependent/should_compile/Dep2.hs | 2 +- > testsuite/tests/dependent/should_compile/Dep3.hs | 2 +- > .../tests/dependent/should_compile/DkNameRes.hs | 9 + > .../dependent/should_compile/InferDependency.hs | 6 - > .../dependent/should_compile/KindEqualities.hs | 2 +- > .../dependent/should_compile/KindEqualities2.hs | 3 +- > .../tests/dependent/should_compile/KindLevels.hs | 2 +- > .../tests/dependent/should_compile/RAE_T32b.hs | 24 +- > testsuite/tests/dependent/should_compile/Rae31.hs | 23 +- > .../tests/dependent/should_compile/RaeBlogPost.hs | 27 +- > .../tests/dependent/should_compile/RaeJobTalk.hs | 2 +- > testsuite/tests/dependent/should_compile/T11405.hs | 2 +- > testsuite/tests/dependent/should_compile/T11635.hs | 2 +- > testsuite/tests/dependent/should_compile/T11711.hs | 1 - > testsuite/tests/dependent/should_compile/T11719.hs | 6 +- > testsuite/tests/dependent/should_compile/T11966.hs | 1 - > testsuite/tests/dependent/should_compile/T12176.hs | 2 +- > testsuite/tests/dependent/should_compile/T12442.hs | 4 +- > testsuite/tests/dependent/should_compile/T12742.hs | 2 +- > testsuite/tests/dependent/should_compile/T13910.hs | 9 +- > testsuite/tests/dependent/should_compile/T13938.hs | 3 +- > .../tests/dependent/should_compile/T13938a.hs | 3 +- > testsuite/tests/dependent/should_compile/T14038.hs | 3 +- > .../tests/dependent/should_compile/T14066a.hs | 2 +- > testsuite/tests/dependent/should_compile/T14556.hs | 3 +- > testsuite/tests/dependent/should_compile/T14720.hs | 3 +- > testsuite/tests/dependent/should_compile/T14749.hs | 2 +- > testsuite/tests/dependent/should_compile/T14991.hs | 3 +- > testsuite/tests/dependent/should_compile/T9632.hs | 2 +- > .../tests/dependent/should_compile/TypeLevelVec.hs | 2 +- > testsuite/tests/dependent/should_compile/all.T | 1 + > .../dependent/should_compile/dynamic-paper.hs | 27 +- > .../tests/dependent/should_compile/mkGADTVars.hs | 2 +- > .../tests/dependent/should_fail/BadTelescope.hs | 2 +- > .../tests/dependent/should_fail/BadTelescope2.hs | 2 +- > .../tests/dependent/should_fail/BadTelescope3.hs | 2 +- > .../tests/dependent/should_fail/BadTelescope4.hs | 2 +- > testsuite/tests/dependent/should_fail/DepFail1.hs | 2 +- > .../tests/dependent/should_fail/InferDependency.hs | 2 +- > .../tests/dependent/should_fail/KindLevelsB.hs | 9 - > .../tests/dependent/should_fail/KindLevelsB.stderr | 5 - > .../tests/dependent/should_fail/PromotedClass.hs | 2 +- > testsuite/tests/dependent/should_fail/RAE_T32a.hs | 28 +- > .../tests/dependent/should_fail/RAE_T32a.stderr | 6 +- > .../tests/dependent/should_fail/RenamingStar.hs | 2 +- > .../dependent/should_fail/RenamingStar.stderr | 10 +- > testsuite/tests/dependent/should_fail/SelfDep.hs | 2 + > .../tests/dependent/should_fail/SelfDep.stderr | 8 +- > testsuite/tests/dependent/should_fail/T11407.hs | 2 +- > testsuite/tests/dependent/should_fail/T11473.hs | 2 +- > testsuite/tests/dependent/should_fail/T12081.hs | 2 +- > testsuite/tests/dependent/should_fail/T12174.hs | 2 +- > testsuite/tests/dependent/should_fail/T13135.hs | 4 +- > testsuite/tests/dependent/should_fail/T13601.hs | 2 +- > testsuite/tests/dependent/should_fail/T13780a.hs | 2 +- > testsuite/tests/dependent/should_fail/T13780b.hs | 3 +- > testsuite/tests/dependent/should_fail/T13780c.hs | 2 +- > .../tests/dependent/should_fail/T13780c.stderr | 6 +- > testsuite/tests/dependent/should_fail/T14066.hs | 4 +- > testsuite/tests/dependent/should_fail/T14066c.hs | 2 +- > testsuite/tests/dependent/should_fail/T14066d.hs | 2 +- > testsuite/tests/dependent/should_fail/T14066e.hs | 2 +- > testsuite/tests/dependent/should_fail/T14066f.hs | 2 +- > testsuite/tests/dependent/should_fail/T14066g.hs | 2 +- > testsuite/tests/dependent/should_fail/T14066h.hs | 2 +- > testsuite/tests/dependent/should_fail/T15245.hs | 10 + > .../tests/dependent/should_fail/T15245.stderr | 7 + > .../tests/dependent/should_fail/TypeSkolEscape.hs | 2 +- > testsuite/tests/dependent/should_fail/all.T | 2 +- > testsuite/tests/dependent/should_run/T11964a.hs | 2 +- > testsuite/tests/deriving/should_compile/T11416.hs | 3 +- > testsuite/tests/deriving/should_compile/T11732a.hs | 2 +- > testsuite/tests/deriving/should_compile/T11732b.hs | 2 +- > testsuite/tests/deriving/should_compile/T11732c.hs | 2 +- > testsuite/tests/deriving/should_compile/T14331.hs | 2 +- > testsuite/tests/deriving/should_compile/T14579.hs | 3 +- > testsuite/tests/deriving/should_compile/T14932.hs | 4 +- > testsuite/tests/deriving/should_fail/T12512.hs | 2 +- > testsuite/tests/deriving/should_fail/T14728a.hs | 2 +- > testsuite/tests/deriving/should_fail/T14728b.hs | 2 +- > testsuite/tests/deriving/should_fail/T15073.hs | 2 +- > testsuite/tests/determinism/determ004/determ004.hs | 2 +- > testsuite/tests/determinism/determ014/A.hs | 6 +- > testsuite/tests/driver/T4437.hs | 1 + > testsuite/tests/gadt/T7293.hs | 6 +- > testsuite/tests/gadt/T7293.stderr | 4 +- > testsuite/tests/gadt/T7294.hs | 6 +- > testsuite/tests/gadt/T7294.stderr | 4 +- > testsuite/tests/generics/GEq/GEq1.hs | 5 +- > testsuite/tests/ghci/scripts/T10321.hs | 3 +- > testsuite/tests/ghci/scripts/T11252.script | 2 +- > testsuite/tests/ghci/scripts/T11376.script | 2 +- > testsuite/tests/ghci/scripts/T12550.script | 2 +- > testsuite/tests/ghci/scripts/T13407.script | 4 +- > testsuite/tests/ghci/scripts/T13963.script | 2 +- > testsuite/tests/ghci/scripts/T13988.hs | 2 +- > testsuite/tests/ghci/scripts/T7873.script | 2 +- > testsuite/tests/ghci/scripts/T7939.hs | 4 +- > testsuite/tests/ghci/scripts/T8357.hs | 5 +- > testsuite/tests/indexed-types/should_compile/HO.hs | 5 +- > .../tests/indexed-types/should_compile/Numerals.hs | 7 +- > .../tests/indexed-types/should_compile/T12369.hs | 4 +- > .../tests/indexed-types/should_compile/T12522b.hs | 8 +- > .../tests/indexed-types/should_compile/T12938.hs | 2 +- > .../tests/indexed-types/should_compile/T13244.hs | 2 +- > .../tests/indexed-types/should_compile/T13398b.hs | 2 +- > .../tests/indexed-types/should_compile/T14162.hs | 3 +- > .../tests/indexed-types/should_compile/T14554.hs | 5 +- > .../tests/indexed-types/should_compile/T15122.hs | 2 +- > .../tests/indexed-types/should_compile/T2219.hs | 4 +- > .../tests/indexed-types/should_compile/T7585.hs | 6 +- > .../tests/indexed-types/should_compile/T9747.hs | 9 +- > .../tests/indexed-types/should_fail/T12522a.hs | 6 +- > .../tests/indexed-types/should_fail/T12522a.stderr | 6 +- > .../tests/indexed-types/should_fail/T13674.hs | 4 +- > .../tests/indexed-types/should_fail/T13784.hs | 5 +- > .../tests/indexed-types/should_fail/T13784.stderr | 14 +- > .../tests/indexed-types/should_fail/T13877.hs | 6 +- > .../tests/indexed-types/should_fail/T13972.hs | 2 +- > .../tests/indexed-types/should_fail/T14175.hs | 2 +- > .../tests/indexed-types/should_fail/T14246.hs | 8 +- > .../tests/indexed-types/should_fail/T14246.stderr | 2 +- > .../tests/indexed-types/should_fail/T14369.hs | 2 +- > testsuite/tests/indexed-types/should_fail/T2544.hs | 4 +- > .../tests/indexed-types/should_fail/T2544.stderr | 8 +- > .../tests/indexed-types/should_fail/T3330c.hs | 6 +- > .../tests/indexed-types/should_fail/T3330c.stderr | 10 +- > testsuite/tests/indexed-types/should_fail/T4174.hs | 10 +- > .../tests/indexed-types/should_fail/T4174.stderr | 6 +- > testsuite/tests/indexed-types/should_fail/T7786.hs | 4 +- > .../tests/indexed-types/should_fail/T7786.stderr | 25 +- > testsuite/tests/indexed-types/should_fail/T7967.hs | 10 +- > .../tests/indexed-types/should_fail/T7967.stderr | 12 +- > testsuite/tests/indexed-types/should_fail/T9036.hs | 7 +- > .../tests/indexed-types/should_fail/T9036.stderr | 2 +- > testsuite/tests/indexed-types/should_fail/T9662.hs | 4 +- > .../tests/indexed-types/should_fail/T9662.stderr | 6 +- > .../tests/indexed-types/should_run/T11465a.hs | 1 - > .../should_run/overloadedrecflds_generics.hs | 5 +- > .../should_run/overloadedrecfldsrun07.hs | 6 +- > .../parser/should_compile/DumpParsedAst.stderr | 109 ++--- > .../tests/parser/should_compile/DumpRenamedAst.hs | 2 +- > .../parser/should_compile/DumpRenamedAst.stderr | 62 ++- > testsuite/tests/parser/should_compile/T10379.hs | 2 +- > testsuite/tests/parser/should_fail/T15209.stderr | 2 +- > testsuite/tests/parser/should_fail/all.T | 5 + > testsuite/tests/parser/should_fail/readFail036.hs | 4 +- > .../tests/parser/should_fail/readFail036.stderr | 4 +- > testsuite/tests/parser/should_fail/typeops_A.hs | 1 + > .../tests/parser/should_fail/typeops_A.stderr | 2 + > testsuite/tests/parser/should_fail/typeops_B.hs | 1 + > .../tests/parser/should_fail/typeops_B.stderr | 2 + > testsuite/tests/parser/should_fail/typeops_C.hs | 1 + > .../tests/parser/should_fail/typeops_C.stderr | 2 + > testsuite/tests/parser/should_fail/typeops_D.hs | 1 + > .../tests/parser/should_fail/typeops_D.stderr | 2 + > .../tests/partial-sigs/should_compile/T15039a.hs | 12 +- > .../partial-sigs/should_compile/T15039a.stderr | 11 +- > .../tests/partial-sigs/should_compile/T15039b.hs | 12 +- > .../partial-sigs/should_compile/T15039b.stderr | 44 +- > .../tests/partial-sigs/should_compile/T15039c.hs | 12 +- > .../partial-sigs/should_compile/T15039c.stderr | 11 +- > .../tests/partial-sigs/should_compile/T15039d.hs | 12 +- > .../partial-sigs/should_compile/T15039d.stderr | 44 +- > .../tests/partial-sigs/should_fail/T14040a.hs | 2 +- > testsuite/tests/partial-sigs/should_fail/T14584.hs | 2 +- > .../tests/partial-sigs/should_fail/T14584.stderr | 2 +- > testsuite/tests/patsyn/should_compile/T12698.hs | 2 +- > testsuite/tests/patsyn/should_compile/T12968.hs | 2 +- > testsuite/tests/patsyn/should_compile/T13768.hs | 8 +- > testsuite/tests/patsyn/should_compile/T14058.hs | 2 +- > testsuite/tests/patsyn/should_compile/T14058a.hs | 3 +- > testsuite/tests/patsyn/should_fail/T14507.hs | 4 +- > testsuite/tests/patsyn/should_fail/T14507.stderr | 2 +- > testsuite/tests/patsyn/should_fail/T14552.hs | 2 +- > testsuite/tests/perf/compiler/T12227.hs | 17 +- > testsuite/tests/perf/compiler/T12545a.hs | 3 +- > testsuite/tests/perf/compiler/T13035.hs | 13 +- > testsuite/tests/perf/compiler/T13035.stderr | 2 +- > testsuite/tests/perf/compiler/T9872d.hs | 186 ++++++-- > testsuite/tests/pmcheck/complete_sigs/T14253.hs | 2 +- > testsuite/tests/pmcheck/should_compile/T14086.hs | 2 +- > testsuite/tests/pmcheck/should_compile/T3927b.hs | 8 +- > testsuite/tests/polykinds/MonoidsTF.hs | 4 +- > testsuite/tests/polykinds/PolyKinds10.hs | 27 +- > testsuite/tests/polykinds/SigTvKinds3.hs | 2 +- > testsuite/tests/polykinds/T10134a.hs | 3 +- > testsuite/tests/polykinds/T10934.hs | 6 +- > testsuite/tests/polykinds/T11142.hs | 2 +- > testsuite/tests/polykinds/T11399.hs | 2 +- > testsuite/tests/polykinds/T11480b.hs | 24 +- > testsuite/tests/polykinds/T11520.hs | 2 +- > testsuite/tests/polykinds/T11523.hs | 1 - > testsuite/tests/polykinds/T11554.hs | 2 +- > testsuite/tests/polykinds/T11616.hs | 2 +- > testsuite/tests/polykinds/T11640.hs | 2 +- > testsuite/tests/polykinds/T11648.hs | 4 +- > testsuite/tests/polykinds/T11648b.hs | 2 +- > testsuite/tests/polykinds/T11821a.hs | 2 +- > testsuite/tests/polykinds/T12055.hs | 4 +- > testsuite/tests/polykinds/T12055a.hs | 4 +- > testsuite/tests/polykinds/T12593.hs | 2 +- > testsuite/tests/polykinds/T12668.hs | 2 +- > testsuite/tests/polykinds/T12718.hs | 2 +- > testsuite/tests/polykinds/T13391.hs | 7 - > testsuite/tests/polykinds/T13391.stderr | 7 - > testsuite/tests/polykinds/T13625.hs | 2 +- > testsuite/tests/polykinds/T13659.hs | 4 +- > testsuite/tests/polykinds/T13659.stderr | 2 +- > testsuite/tests/polykinds/T13738.hs | 2 +- > testsuite/tests/polykinds/T13985.stderr | 10 +- > testsuite/tests/polykinds/T14174.hs | 2 +- > testsuite/tests/polykinds/T14174a.hs | 7 +- > testsuite/tests/polykinds/T14209.hs | 2 +- > testsuite/tests/polykinds/T14270.hs | 2 +- > testsuite/tests/polykinds/T14450.hs | 4 +- > testsuite/tests/polykinds/T14450.stderr | 2 +- > testsuite/tests/polykinds/T14515.hs | 3 +- > testsuite/tests/polykinds/T14520.hs | 4 +- > testsuite/tests/polykinds/T14555.hs | 4 +- > testsuite/tests/polykinds/T14561.hs | 2 +- > testsuite/tests/polykinds/T14563.hs | 2 +- > testsuite/tests/polykinds/T14580.hs | 2 +- > testsuite/tests/polykinds/T14710.stderr | 8 - > testsuite/tests/polykinds/T14846.hs | 2 +- > testsuite/tests/polykinds/T14873.hs | 3 +- > testsuite/tests/polykinds/T15170.hs | 2 +- > testsuite/tests/polykinds/T5716.hs | 3 +- > testsuite/tests/polykinds/T5716.stderr | 10 +- > testsuite/tests/polykinds/T6021.stderr | 4 - > testsuite/tests/polykinds/T6035.hs | 4 +- > testsuite/tests/polykinds/T6039.stderr | 12 +- > testsuite/tests/polykinds/T6093.hs | 7 +- > testsuite/tests/polykinds/T7404.stderr | 4 - > testsuite/tests/polykinds/T7594.hs | 6 +- > testsuite/tests/polykinds/T7594.stderr | 9 +- > testsuite/tests/polykinds/T8566.hs | 8 +- > testsuite/tests/polykinds/T8566.stderr | 8 +- > testsuite/tests/polykinds/T8566a.hs | 8 +- > testsuite/tests/polykinds/T8985.hs | 8 +- > testsuite/tests/polykinds/T9222.hs | 3 +- > testsuite/tests/polykinds/T9222.stderr | 6 +- > testsuite/tests/polykinds/all.T | 5 +- > testsuite/tests/printer/Ppr040.hs | 2 +- > testsuite/tests/printer/Ppr045.hs | 1 + > testsuite/tests/rename/should_fail/T11592.hs | 2 +- > testsuite/tests/rename/should_fail/T13947.stderr | 2 +- > .../tests/simplCore/should_compile/T13025a.hs | 6 +- > testsuite/tests/simplCore/should_compile/T13658.hs | 2 +- > .../tests/simplCore/should_compile/T14270a.hs | 3 +- > .../tests/simplCore/should_compile/T15186A.hs | 2 +- > testsuite/tests/simplCore/should_compile/T4903a.hs | 10 +- > testsuite/tests/simplCore/should_run/T13750a.hs | 13 +- > testsuite/tests/th/T11463.hs | 2 +- > testsuite/tests/th/T11484.hs | 2 +- > testsuite/tests/th/T13642.hs | 2 +- > testsuite/tests/th/T13781.hs | 2 +- > testsuite/tests/th/T14060.hs | 2 +- > testsuite/tests/th/T14869.hs | 2 +- > testsuite/tests/th/T8031.hs | 4 +- > testsuite/tests/th/TH_RichKinds2.hs | 5 +- > testsuite/tests/th/TH_RichKinds2.stderr | 2 +- > .../tests/typecheck/should_compile/SplitWD.hs | 2 +- > testsuite/tests/typecheck/should_compile/T10432.hs | 5 +- > testsuite/tests/typecheck/should_compile/T11237.hs | 4 +- > testsuite/tests/typecheck/should_compile/T11348.hs | 1 - > testsuite/tests/typecheck/should_compile/T11524.hs | 1 - > testsuite/tests/typecheck/should_compile/T11723.hs | 2 +- > testsuite/tests/typecheck/should_compile/T11811.hs | 2 +- > testsuite/tests/typecheck/should_compile/T12133.hs | 4 +- > testsuite/tests/typecheck/should_compile/T12381.hs | 2 +- > testsuite/tests/typecheck/should_compile/T12734.hs | 38 +- > .../tests/typecheck/should_compile/T12734a.hs | 31 +- > .../tests/typecheck/should_compile/T12734a.stderr | 9 +- > .../tests/typecheck/should_compile/T12785a.hs | 2 +- > testsuite/tests/typecheck/should_compile/T12911.hs | 2 +- > testsuite/tests/typecheck/should_compile/T12919.hs | 2 +- > testsuite/tests/typecheck/should_compile/T12987.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13083.hs | 5 +- > testsuite/tests/typecheck/should_compile/T13333.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13337.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13343.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13458.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13603.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13643.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13822.hs | 3 +- > testsuite/tests/typecheck/should_compile/T13871.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13879.hs | 2 +- > .../tests/typecheck/should_compile/T13915a.hs | 2 +- > .../tests/typecheck/should_compile/T13915b.hs | 2 +- > testsuite/tests/typecheck/should_compile/T13943.hs | 2 +- > testsuite/tests/typecheck/should_compile/T14441.hs | 3 +- > .../tests/typecheck/should_compile/T14934a.hs | 3 +- > testsuite/tests/typecheck/should_compile/all.T | 4 +- > testsuite/tests/typecheck/should_compile/tc191.hs | 2 +- > testsuite/tests/typecheck/should_compile/tc205.hs | 4 +- > testsuite/tests/typecheck/should_compile/tc269.hs | 3 +- > .../should_compile/valid_hole_fits_interactions.hs | 2 +- > .../tests/typecheck/should_fail/ClassOperator.hs | 4 +- > .../typecheck/should_fail/ClassOperator.stderr | 16 +- > .../typecheck/should_fail/CustomTypeErrors04.hs | 2 +- > .../typecheck/should_fail/CustomTypeErrors05.hs | 2 +- > .../tests/typecheck/should_fail/LevPolyBounded.hs | 2 +- > testsuite/tests/typecheck/should_fail/T11313.hs | 2 - > .../tests/typecheck/should_fail/T11313.stderr | 8 +- > testsuite/tests/typecheck/should_fail/T11724.hs | 2 +- > testsuite/tests/typecheck/should_fail/T11963.hs | 29 -- > .../tests/typecheck/should_fail/T11963.stderr | 20 - > testsuite/tests/typecheck/should_fail/T12648.hs | 6 +- > testsuite/tests/typecheck/should_fail/T12709.hs | 3 +- > .../tests/typecheck/should_fail/T12709.stderr | 8 +- > testsuite/tests/typecheck/should_fail/T12785b.hs | 8 +- > testsuite/tests/typecheck/should_fail/T12973.hs | 2 +- > testsuite/tests/typecheck/should_fail/T13105.hs | 2 +- > testsuite/tests/typecheck/should_fail/T13446.hs | 4 +- > testsuite/tests/typecheck/should_fail/T13909.hs | 2 +- > testsuite/tests/typecheck/should_fail/T13929.hs | 2 +- > .../tests/typecheck/should_fail/T13983.stderr | 2 +- > testsuite/tests/typecheck/should_fail/T14350.hs | 2 +- > testsuite/tests/typecheck/should_fail/T14904a.hs | 2 +- > testsuite/tests/typecheck/should_fail/T14904b.hs | 2 +- > testsuite/tests/typecheck/should_fail/T7645.hs | 4 +- > testsuite/tests/typecheck/should_fail/T7645.stderr | 5 +- > testsuite/tests/typecheck/should_fail/all.T | 1 - > .../tests/typecheck/should_run/EtaExpandLevPoly.hs | 4 +- > .../typecheck/should_run/KindInvariant.script | 6 +- > testsuite/tests/typecheck/should_run/T11120.hs | 2 +- > testsuite/tests/typecheck/should_run/T12809.hs | 2 +- > testsuite/tests/typecheck/should_run/T13435.hs | 3 +- > testsuite/tests/typecheck/should_run/TypeOf.hs | 2 +- > testsuite/tests/typecheck/should_run/TypeRep.hs | 4 +- > testsuite/tests/unboxedsums/sum_rr.hs | 2 +- > 391 files changed, 1865 insertions(+), 1997 deletions(-) > > Diff suppressed because of size. To see it, use: > > git diff-tree --root --patch-with-stat --no-color --find-copies-harder > --ignore-space-at-eol --cc d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60 > _______________________________________________ > ghc-commits mailing list > ghc-commits at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-commits > From ggreif at gmail.com Fri Jun 15 08:49:41 2018 From: ggreif at gmail.com (Gabor Greif) Date: Fri, 15 Jun 2018 10:49:41 +0200 Subject: [commit: ghc] master: UNREG: PprC: add support for of W16 literals (Ticket #15237) (01c9d95) In-Reply-To: <20180615081034.7BE153ABA3@ghc.haskell.org> References: <20180615081034.7BE153ABA3@ghc.haskell.org> Message-ID: Thanks for fixing this! I am in the process of building an unregisterised MIPS64 cross-compiler and just noticed this warning running by: HC [stage 1] libraries/base/dist-install/build/GHC/Show.p_o /tmp/ghc414_0/ghc_7.hc: In function '_c53i': /tmp/ghc414_0/ghc_7.hc:1483:17: error: warning: integer constant is so large that it is unsigned _s4Lo = (_s4Ld+-9223372036854775808) + (_s4Lg + _s4L9); ^ | 1483 | _s4Lo = (_s4Ld+-9223372036854775808) + (_s4Lg + _s4L9); | ^ Not sure whether I should be worried (there seem to be others of this kind) or a simple change in the datatype (int -> unsigned) could silence this. Cheers, Gabor On 6/15/18, git at git.haskell.org wrote: > Repository : ssh://git at git.haskell.org/ghc > > On branch : master > Link : > http://ghc.haskell.org/trac/ghc/changeset/01c9d95aca12caf5c954320a2a82335b32568554/ghc > >>--------------------------------------------------------------- > > commit 01c9d95aca12caf5c954320a2a82335b32568554 > Author: Sergei Trofimovich > Date: Thu Jun 14 23:13:16 2018 +0100 > > UNREG: PprC: add support for of W16 literals (Ticket #15237) > > Fix UNREG build failure for 32-bit targets. > > This change is an equivalent of commit > 0238a6c78102d43dae2f56192bd3486e4f9ecf1d > ("UNREG: PprC: add support for of W32 literals") > > The change allows combining two subwords into one word > on 32-bit targets. Tested on nios2-unknown-linux-gnu. > > GHC Trac Issues: #15237 > > Signed-off-by: Sergei Trofimovich > > >>--------------------------------------------------------------- > > 01c9d95aca12caf5c954320a2a82335b32568554 > compiler/cmm/PprC.hs | 8 ++++++++ > 1 file changed, 8 insertions(+) > > diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs > index e46fff1..8b30bbf 100644 > --- a/compiler/cmm/PprC.hs > +++ b/compiler/cmm/PprC.hs > @@ -546,6 +546,14 @@ pprStatics dflags (CmmStaticLit (CmmInt a W32) : > rest) > else pprStatics dflags (CmmStaticLit (CmmInt ((shiftL b 32) .|. a) W64) > : > rest) > +pprStatics dflags (CmmStaticLit (CmmInt a W16) : > + CmmStaticLit (CmmInt b W16) : rest) > + | wordWidth dflags == W32 > + = if wORDS_BIGENDIAN dflags > + then pprStatics dflags (CmmStaticLit (CmmInt ((shiftL a 16) .|. b) W32) > : > + rest) > + else pprStatics dflags (CmmStaticLit (CmmInt ((shiftL b 16) .|. a) W32) > : > + rest) > pprStatics dflags (CmmStaticLit (CmmInt _ w) : _) > | w /= wordWidth dflags > = pprPanic "pprStatics: cannot emit a non-word-sized static literal" (ppr > w) > > _______________________________________________ > ghc-commits mailing list > ghc-commits at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-commits > From ggreif at gmail.com Fri Jun 15 09:08:30 2018 From: ggreif at gmail.com (Gabor Greif) Date: Fri, 15 Jun 2018 11:08:30 +0200 Subject: [commit: ghc] master: UNREG: PprC: add support for of W16 literals (Ticket #15237) (01c9d95) In-Reply-To: <20180615100005.5e9a0ebb@sf> References: <20180615081034.7BE153ABA3@ghc.haskell.org> <20180615100005.5e9a0ebb@sf> Message-ID: Hi Sergei, thanks for your swift response! I did: ``` $ mips64-wrsmllib64-linux-gcc -E -dM - wrote: > On Fri, 15 Jun 2018 10:49:41 +0200 > Gabor Greif wrote: > >> Thanks for fixing this! >> >> I am in the process of building an unregisterised MIPS64 >> cross-compiler and just noticed this warning running by: >> >> HC [stage 1] libraries/base/dist-install/build/GHC/Show.p_o >> /tmp/ghc414_0/ghc_7.hc: In function '_c53i': >> >> /tmp/ghc414_0/ghc_7.hc:1483:17: error: >> warning: integer constant is so large that it is unsigned >> _s4Lo = (_s4Ld+-9223372036854775808) + (_s4Lg + _s4L9); >> ^ >> | >> 1483 | _s4Lo = (_s4Ld+-9223372036854775808) + (_s4Lg + _s4L9); >> | ^ >> >> Not sure whether I should be worried (there seem to be others of this >> kind) or a simple change in the datatype (int -> unsigned) could >> silence this. > > The overflow looks fishy. -9223372036854775808 is 0x8000000000000000. > What ABI your mips64 targets to? 64 or n32? I'd like to reproduce it > locally. > > Simplest way to check for ABI (mine is N32): > $ mips64-unknown-linux-gnu-gcc -E -dM - #define _MIPS_SIM _ABIN32 > > -- > > Sergei > From git at git.haskell.org Fri Jun 15 11:12:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 11:12:56 +0000 (UTC) Subject: [commit: ghc] master: Fix corner case in typeKind, plus refactoring (f903e55) Message-ID: <20180615111256.86FCA3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f903e5510d4562fddef1d4140971e2b93a45e45e/ghc >--------------------------------------------------------------- commit f903e5510d4562fddef1d4140971e2b93a45e45e Author: Simon Peyton Jones Date: Fri Jun 15 09:19:55 2018 +0100 Fix corner case in typeKind, plus refactoring This is a continuation of commit 9d600ea68c283b0d38ac663c3cc48baba6b94f57 Author: Simon Peyton Jones Date: Fri Jun 1 16:36:57 2018 +0100 Expand type synonyms when Linting a forall That patch pointed out that there was a lurking hole in typeKind, where it could return an ill-scoped kind, because of not expanding type synonyms enough. This patch fixes it, quite nicely * Use occCheckExpand to expand those synonyms (it was always designed for that exact purpose), and call it from Type.typeKind CoreUtils.coreAltType CoreLint.lintTYpe * Consequently, move occCheckExpand from TcUnify.hs to Type.hs, and generalise it to take a list of type variables. I also tidied up lintType a bit. >--------------------------------------------------------------- f903e5510d4562fddef1d4140971e2b93a45e45e compiler/coreSyn/CoreLint.hs | 37 ++++----- compiler/coreSyn/CoreUtils.hs | 12 +-- compiler/typecheck/TcFlatten.hs | 5 +- compiler/typecheck/TcUnify.hs | 153 ++--------------------------------- compiler/types/Coercion.hs-boot | 1 + compiler/types/Type.hs | 173 +++++++++++++++++++++++++++++++++++++--- 6 files changed, 192 insertions(+), 189 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f903e5510d4562fddef1d4140971e2b93a45e45e From git at git.haskell.org Fri Jun 15 11:12:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 11:12:59 +0000 (UTC) Subject: [commit: ghc] master: Fix the bind-recovery type (807ab22) Message-ID: <20180615111259.544EA3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/807ab222d08c11a4d00064c9835f9ed9f20ffc7c/ghc >--------------------------------------------------------------- commit 807ab222d08c11a4d00064c9835f9ed9f20ffc7c Author: Simon Peyton Jones Date: Fri Jun 15 09:08:58 2018 +0100 Fix the bind-recovery type This patch uses (forall (a::*). a) for the type to use when recovering from an error in a binding. Previously (Trac #15276) we had (forall r (a :: TYPE r). a), which is ill-kinded. It's quite hard to provoke an error arising from this, because it only happens in programs that have a type error anyway, but in a subequent patch I make typeKind fall over if it returns an ill-scoped kind, and that makes ghci/scripts/T13202 crash without this fix. >--------------------------------------------------------------- 807ab222d08c11a4d00064c9835f9ed9f20ffc7c compiler/typecheck/TcBinds.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 85c1b0c..fadf0e9 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -646,7 +646,13 @@ recoveryCode binder_names sig_fn = mkLocalId name forall_a_a forall_a_a :: TcType -forall_a_a = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar] openAlphaTy +-- At one point I had (forall r (a :: TYPE r). a), but of course +-- that type is ill-formed: its mentions 'r' which escapes r's scope. +-- Another alternative would be (forall (a :: TYPE kappa). a), where +-- kappa is a unification variable. But I don't think we need that +-- complication here. I'm going to just use (forall (a::*). a). +-- See Trac #15276 +forall_a_a = mkSpecForAllTys [alphaTyVar] alphaTy {- ********************************************************************* * * From git at git.haskell.org Fri Jun 15 11:13:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 11:13:03 +0000 (UTC) Subject: [commit: ghc] master: Make better "fake tycons" in error recovery (2f6069c) Message-ID: <20180615111303.59DEB3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f6069ccf21d7be0e09016896238f417d2492ffa/ghc >--------------------------------------------------------------- commit 2f6069ccf21d7be0e09016896238f417d2492ffa Author: Simon Peyton Jones Date: Fri Jun 15 09:46:30 2018 +0100 Make better "fake tycons" in error recovery Consider (Trac #15215) data T a = MkT ... data S a = ...T...MkT.... If there is an error in the definition of 'T' we add a "fake type constructor" to the type environment, so that we can continue to typecheck 'S'. But we /were not/ adding a fake anything for 'MkT' and so there was an internal error when we met 'MkT' in the body of 'S'. The fix is to add fake tycons for all the 'implicits' of 'T'. This is done by mk_fake_tc in TcTyClsDecls.checkValidTyCl, which now returns a /list/ of TyCons rather than just one. On the way I did some refactoring: * Rename TcTyDecls.tcAddImplicits to tcAddTyConsToGblEnv and make it /include/ the TyCons themeselves as well as their implicits * Some incidental refactoring about tcRecSelBinds. The main thing is that I've avoided creating a HsValBinds that we immediately decompose. That meant moving some deck chairs around. NB: The new error message for the regression test T15215 has the opaque error "Illegal constraint in a type:", flagged in Trac #14845. But that's the fault of the latter ticket. The fix here not to blame. >--------------------------------------------------------------- 2f6069ccf21d7be0e09016896238f417d2492ffa compiler/typecheck/TcBinds.hs | 11 +--- compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcInstDcls.hs | 12 ++-- compiler/typecheck/TcPatSyn.hs | 8 +-- compiler/typecheck/TcTyClsDecls.hs | 68 ++++++++++++++-------- compiler/typecheck/TcTyDecls.hs | 52 ++++++++++------- testsuite/tests/dependent/should_fail/T15215.hs | 12 ++++ .../tests/dependent/should_fail/T15215.stderr | 12 ++++ testsuite/tests/dependent/should_fail/all.T | 1 + 9 files changed, 111 insertions(+), 67 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2f6069ccf21d7be0e09016896238f417d2492ffa From git at git.haskell.org Fri Jun 15 16:09:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 16:09:15 +0000 (UTC) Subject: [commit: ghc] master: circleci: Remove systemd from Fedora nsswitch configuration (dbe5370) Message-ID: <20180615160915.274563ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbe5370ee4d582a45c7e94500f2acc6bf9e2b7cb/ghc >--------------------------------------------------------------- commit dbe5370ee4d582a45c7e94500f2acc6bf9e2b7cb Author: Ben Gamari Date: Fri Jun 15 10:02:06 2018 -0400 circleci: Remove systemd from Fedora nsswitch configuration Lest we end up with a non-functional user/group lookup, resulting in #15230. >--------------------------------------------------------------- dbe5370ee4d582a45c7e94500f2acc6bf9e2b7cb .circleci/images/x86_64-linux-fedora/Dockerfile | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.circleci/images/x86_64-linux-fedora/Dockerfile b/.circleci/images/x86_64-linux-fedora/Dockerfile index 761d8ca..d976950 100644 --- a/.circleci/images/x86_64-linux-fedora/Dockerfile +++ b/.circleci/images/x86_64-linux-fedora/Dockerfile @@ -4,6 +4,11 @@ ENV LANG C.UTF-8 RUN dnf -y install coreutils binutils which git make automake autoconf gcc perl python3 texinfo xz lbzip2 patch openssh-clients sudo curl zlib-devel sqlite ncurses-compat-libs gmp-devel ncurses-devel gcc-c++ findutils +# systemd isn't running so remove it from nsswitch.conf +# Failing to do this will result in testsuite failures due to +# non-functional user lookup (#15230). +RUN sed -i -e 's/systemd//g' /etc/nsswitch.conf + # Install GHC and cabal RUN cd /tmp && curl https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-deb8-linux.tar.xz | tar -Jx RUN cd /tmp/ghc-8.4.2 && ./configure --prefix=/opt/ghc/8.4.2 From git at git.haskell.org Fri Jun 15 16:09:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 16:09:29 +0000 (UTC) Subject: [commit: ghc] master: Fix documentation for `-dth-dec-file` (69954a1) Message-ID: <20180615160929.9DAAC3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/69954a125d12a1ffffcc9ce2d66bc211e3607a9a/ghc >--------------------------------------------------------------- commit 69954a125d12a1ffffcc9ce2d66bc211e3607a9a Author: Nathan Collins Date: Thu Jun 14 16:36:23 2018 -0700 Fix documentation for `-dth-dec-file` The docs said that it took a file argument, as in `-dth-dec-file=`, but it does not take a file argument! >--------------------------------------------------------------- 69954a125d12a1ffffcc9ce2d66bc211e3607a9a docs/users_guide/debugging.rst | 7 ++++--- docs/users_guide/glasgow_exts.rst | 6 +++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index a3f0be7..de69db8 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -173,11 +173,12 @@ These flags dump various information from GHC's typechecker and renamer. Dump Template Haskell expressions that we splice in, and what Haskell code the expression evaluates to. -.. ghc-flag:: -dth-dec-file=⟨file⟩ - :shortdesc: Show evaluated TH declarations in a .th.hs file +.. ghc-flag:: -dth-dec-file + :shortdesc: Dump evaluated TH declarations into `*.th.hs` files :type: dynamic - Dump expansions of all top-level Template Haskell splices into ⟨file⟩. + Dump expansions of all top-level Template Haskell splices into + :file:`{module}.th.hs` for each file :file:`{module}.hs`. .. ghc-flag:: -ddump-types :shortdesc: Dump type signatures diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 9212eed..952b16c 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -12681,9 +12681,9 @@ non-trivial program, you may be interested in combining this with the :ghc-flag:`-ddump-to-file` flag (see :ref:`dumping-output`. For each file using Template Haskell, this will show the output in a ``.dump-splices`` file. -The flag :ghc-flag:`-dth-dec-file=⟨file⟩` shows the expansions of all top-level +The flag :ghc-flag:`-dth-dec-file` dumps the expansions of all top-level TH declaration splices, both typed and untyped, in the file :file:`M.th.hs` -where M is the name of the module being compiled. Note that other types of +for each module `M` being compiled. Note that other types of splices (expressions, types, and patterns) are not shown. Application developers can check this into their repository so that they can grep for identifiers that were defined in Template Haskell. This is similar to using @@ -12702,7 +12702,7 @@ Below is a sample output of :ghc-flag:`-ddump-splices` :: foo :: Int -> Int foo x = (x + 1) -Below is the output of the same sample using :ghc-flag:`-dth-dec-file=⟨file⟩` :: +Below is the output of the same sample using :ghc-flag:`-dth-dec-file` :: -- TH_pragma.hs:(6,4)-(8,26): Splicing declarations foo :: Int -> Int From git at git.haskell.org Fri Jun 15 17:02:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 17:02:52 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Make T4442 compile on i386 and mark as broken (b7deeed) Message-ID: <20180615170252.8BC803ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b7deeed00d93c306e55572c9c1c09ced4be61eef/ghc >--------------------------------------------------------------- commit b7deeed00d93c306e55572c9c1c09ced4be61eef Author: Ben Gamari Date: Fri Jun 15 12:58:59 2018 -0400 testsuite: Make T4442 compile on i386 and mark as broken There are some rather suspicious failures in the 64-bit case. See #15184 for details. >--------------------------------------------------------------- b7deeed00d93c306e55572c9c1c09ced4be61eef testsuite/tests/primops/should_run/T4442.hs | 33 +++++++++++++++++++++++++---- testsuite/tests/primops/should_run/all.T | 4 +++- 2 files changed, 32 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/primops/should_run/T4442.hs b/testsuite/tests/primops/should_run/T4442.hs index 40d7879..d9e6500 100644 --- a/testsuite/tests/primops/should_run/T4442.hs +++ b/testsuite/tests/primops/should_run/T4442.hs @@ -10,6 +10,7 @@ import GHC.Exts import Data.Char(ord) #if WORD_SIZE_IN_BITS < 64 import GHC.Int (Int64(..)) +import GHC.Word (Word64(..)) #endif assertEqual :: (Show a, Eq a) => a -> a -> IO () @@ -124,20 +125,21 @@ testInt64Array :: -> (# State# RealWorld, Int64# #)) -> (MutableByteArray# RealWorld -> Int# -> Int64# -> State# RealWorld -> State# RealWorld) - -> Int + -> Int64 -> Int -> IO () testInt64Array name0 index read write val0 len = do doOne (name0 ++ " positive") val0 doOne (name0 ++ " negative") (negate val0) where + doOne :: String -> Int64 -> IO () doOne name val = test name (\arr i -> I64# (index arr i)) - (\arr i s -> case read arr i s of (# s', a #) -> (# s', I# a #)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', I64# a #)) (\arr i (I64# a) s -> write arr i a s) val - (intToBytes val len) + (intToBytes (fromIntegral val) len) len #endif @@ -160,6 +162,29 @@ testWordArray name index read write val len = test (intToBytes (fromIntegral val) len) len +#if WORD_SIZE_IN_BITS == 64 +testWord64Array = testWordArray +#else +testWord64Array :: + String + -> (ByteArray# -> Int# -> Word64#) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, Word64# #)) + -> (MutableByteArray# RealWorld -> Int# -> Word64# -> State# RealWorld + -> State# RealWorld) + -> Word64 + -> Int + -> IO () +testWord64Array name index read write val len = test + name + (\arr i -> W64# (index arr i)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', W64# a #)) + (\arr i (W64# a) s -> write arr i a s) + val + (intToBytes (fromIntegral val) len) + len +#endif + wordSizeInBytes :: Int wordSizeInBytes = WORD_SIZE_IN_BITS `div` 8 @@ -218,7 +243,7 @@ main = do testWordArray "Word32#" indexWord8ArrayAsWord32# readWord8ArrayAsWord32# writeWord8ArrayAsWord32# 12345678 4 - testWordArray "Word64#" + testWord64Array "Word64#" indexWord8ArrayAsWord64# readWord8ArrayAsWord64# writeWord8ArrayAsWord64# 1234567890123 8 testWordArray "Word#" diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index 53d875b..742206d 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -2,7 +2,9 @@ test('T6135', normal, compile_and_run, ['']) test('T7689', normal, compile_and_run, ['']) # These tests are using unboxed tuples, so omit ghci test('T9430', omit_ways(['ghci']), compile_and_run, ['']) -test('T4442', omit_ways(['ghci']), compile_and_run, ['']) +test('T4442', + [omit_ways(['ghci']), when(wordsize(32), expect_broken(15184))], + compile_and_run, ['']) test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', [stats_num_field('bytes allocated', From git at git.haskell.org Fri Jun 15 17:23:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 17:23:15 +0000 (UTC) Subject: [commit: ghc] master: Bump supported LLVM version to 6.0 (e6498d6) Message-ID: <20180615172315.648AD3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e6498d67768eb4657b766f226a8b1ebad6e00a4f/ghc >--------------------------------------------------------------- commit e6498d67768eb4657b766f226a8b1ebad6e00a4f Author: Ben Gamari Date: Thu Jun 14 21:37:05 2018 -0400 Bump supported LLVM version to 6.0 This seems to fix a number of segmentation faults. >--------------------------------------------------------------- e6498d67768eb4657b766f226a8b1ebad6e00a4f .circleci/config.yml | 4 ++-- configure.ac | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 49f145d..2caa3b4 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -189,8 +189,8 @@ jobs: - run: name: Install LLVM command: | - curl http://releases.llvm.org/5.0.0/clang+llvm-5.0.0-x86_64-linux-gnu-debian8.tar.xz | tar -xJC .. - echo "export PATH=`pwd`/../clang+llvm-5.0.0-x86_64-linux-gnu-debian8/bin:\$PATH" >> $BASH_ENV + curl http://releases.llvm.org/6.0.0/clang+llvm-6.0.0-x86_64-linux-gnu-debian8.tar.xz | tar -xJC .. + echo "export PATH=`pwd`/../clang+llvm-6.0.0-x86_64-linux-gnu-debian8/bin:\$PATH" >> $BASH_ENV - run: name: Verify that llc works command: llc diff --git a/configure.ac b/configure.ac index 21f9f16..2e6e644 100644 --- a/configure.ac +++ b/configure.ac @@ -643,7 +643,7 @@ AC_SUBST([LibtoolCmd]) # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around # 3.5/3.6 release of LLVM. -LlvmVersion=5.0 +LlvmVersion=6.0 AC_SUBST([LlvmVersion]) sUPPORTED_LLVM_VERSION=$(echo \($LlvmVersion\) | sed 's/\./,/') AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION], ${sUPPORTED_LLVM_VERSION}, [The supported LLVM version number]) From git at git.haskell.org Fri Jun 15 18:21:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 18:21:11 +0000 (UTC) Subject: [commit: ghc] branch 'bump-llvm' deleted Message-ID: <20180615182111.D09F53ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: bump-llvm From git at git.haskell.org Fri Jun 15 18:58:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 18:58:43 +0000 (UTC) Subject: [commit: ghc] master: No Unicode in Parser.y (78f5344) Message-ID: <20180615185843.2F1FD3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/78f5344e856d8b908209d93f685230ae617e53a2/ghc >--------------------------------------------------------------- commit 78f5344e856d8b908209d93f685230ae617e53a2 Author: Vladislav Zavialov Date: Fri Jun 15 13:45:03 2018 -0400 No Unicode in Parser.y Unicode characters in Parser.y cause build failures on systems where the locale does not support Unicode. See https://mail.haskell.org/pipermail/ghc-devs/2018-June/015874.html Test Plan: ./validate Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, mpickering, carter Differential Revision: https://phabricator.haskell.org/D4850 >--------------------------------------------------------------- 78f5344e856d8b908209d93f685230ae617e53a2 compiler/parser/Parser.y | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index c1ee8a4..d4caf76 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -3368,7 +3368,7 @@ special_id special_sym :: { Located FastString } special_sym : '!' {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] } | '.' { sL1 $1 (fsLit ".") } - | '*' { sL1 $1 (fsLit (if isUnicode $1 then "★" else "*")) } + | '*' { sL1 $1 (fsLit (if isUnicode $1 then "\x2605" else "*")) } ----------------------------------------------------------------------------- -- Data constructors From git at git.haskell.org Fri Jun 15 18:58:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 18:58:45 +0000 (UTC) Subject: [commit: ghc] master: Make NameSort note into proper Note (b67b971) Message-ID: <20180615185845.EE6233ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b67b971740e77ba5e9e2892ac0f668d41c38381f/ghc >--------------------------------------------------------------- commit b67b971740e77ba5e9e2892ac0f668d41c38381f Author: Matthew Pickering Date: Fri Jun 15 13:45:17 2018 -0400 Make NameSort note into proper Note Reviewers: adamgundry, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4826 >--------------------------------------------------------------- b67b971740e77ba5e9e2892ac0f668d41c38381f compiler/basicTypes/Name.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 564e0e3..d9eacd9 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -115,6 +115,7 @@ data Name = Name { -- (and real!) space leaks, due to the fact that we don't look at -- the SrcLoc in a Name all that often. +-- See Note [About the NameSorts] data NameSort = External Module @@ -151,7 +152,7 @@ instance NFData NameSort where data BuiltInSyntax = BuiltInSyntax | UserSyntax {- -Notes about the NameSorts: +Note [About the NameSorts] 1. Initially, top-level Ids (including locally-defined ones) get External names, and all other local Ids get Internal names From git at git.haskell.org Fri Jun 15 18:58:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 18:58:49 +0000 (UTC) Subject: [commit: ghc] master: Add "quantified constraint" context in error message, fix #15231. (91822e4) Message-ID: <20180615185849.92B9C3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/91822e4eee295a42f69489c7e9e878b296e897bc/ghc >--------------------------------------------------------------- commit 91822e4eee295a42f69489c7e9e878b296e897bc Author: HE, Tao Date: Fri Jun 15 13:45:42 2018 -0400 Add "quantified constraint" context in error message, fix #15231. This patch adds "quantified constraint" context in error message when UndecidableInstances checking fails for quantified constraints. See Trac #15231:comment#1. This patch also pretty-prints the instance head for better error messages. Test Plan: make test TEST="T15231" Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #15231 Differential Revision: https://phabricator.haskell.org/D4819 >--------------------------------------------------------------- 91822e4eee295a42f69489c7e9e878b296e897bc compiler/typecheck/TcValidity.hs | 30 ++++++++++++---------- .../tests/deriving/should_fail/T8165_fail2.stderr | 2 +- .../should_fail/NotRelaxedExamples.stderr | 4 +-- .../tests/indexed-types/should_fail/T10817.stderr | 2 +- .../indexed-types/should_fail/TyFamUndec.stderr | 5 ++-- testsuite/tests/quantified-constraints/T15231.hs | 15 +++++++++++ .../tests/quantified-constraints/T15231.stderr | 7 +++++ testsuite/tests/quantified-constraints/all.T | 1 + .../tests/typecheck/should_fail/fd-loop.stderr | 4 +-- .../tests/typecheck/should_fail/tcfail108.stderr | 3 ++- .../tests/typecheck/should_fail/tcfail154.stderr | 2 +- .../tests/typecheck/should_fail/tcfail157.stderr | 6 +++-- 12 files changed, 56 insertions(+), 25 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 91822e4eee295a42f69489c7e9e878b296e897bc From git at git.haskell.org Fri Jun 15 18:58:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 18:58:52 +0000 (UTC) Subject: [commit: ghc] master: Make dtrace enabled GHC work as a bootstrap compiler on FreeBSD (9c89ef3) Message-ID: <20180615185852.6E1FF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9c89ef39f54943dd3fcd9d196ce1a5bdf7f5f94b/ghc >--------------------------------------------------------------- commit 9c89ef39f54943dd3fcd9d196ce1a5bdf7f5f94b Author: Ben Gamari Date: Fri Jun 15 14:07:51 2018 -0400 Make dtrace enabled GHC work as a bootstrap compiler on FreeBSD Fixes #15040. Reviewers: bgamari, simonmar Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4772 >--------------------------------------------------------------- 9c89ef39f54943dd3fcd9d196ce1a5bdf7f5f94b rts/ghc.mk | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/rts/ghc.mk b/rts/ghc.mk index e96e147..6154720 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -46,6 +46,7 @@ ALL_DIRS += posix endif rts_C_SRCS := $(wildcard rts/*.c $(foreach dir,$(ALL_DIRS),rts/$(dir)/*.c)) +rts_C_HOOK_SRCS := $(wildcard rts/hooks/*.c) rts_CMM_SRCS := $(wildcard rts/*.cmm) # Don't compile .S files when bootstrapping a new arch @@ -171,9 +172,10 @@ $(call cmm-suffix-rules,rts,dist,$1) rts_$1_LIB_FILE = libHSrts$$($1_libsuf) rts_$1_LIB = rts/dist/build/$$(rts_$1_LIB_FILE) -rts_$1_C_OBJS = $$(patsubst rts/%.c,rts/dist/build/%.$$($1_osuf),$$(rts_C_SRCS)) $$(patsubst %.c,%.$$($1_osuf),$$(rts_$1_EXTRA_C_SRCS)) -rts_$1_S_OBJS = $$(patsubst rts/%.S,rts/dist/build/%.$$($1_osuf),$$(rts_S_SRCS)) -rts_$1_CMM_OBJS = $$(patsubst rts/%.cmm,rts/dist/build/%.$$($1_osuf),$$(rts_CMM_SRCS)) $$(patsubst %.cmm,%.$$($1_osuf),$$(rts_AUTO_APPLY_CMM)) +rts_$1_C_OBJS = $$(patsubst rts/%.c,rts/dist/build/%.$$($1_osuf),$$(rts_C_SRCS)) $$(patsubst %.c,%.$$($1_osuf),$$(rts_$1_EXTRA_C_SRCS)) +rts_$1_C_HOOK_OBJS = $$(patsubst rts/hooks/%.c,rts/dist/build/hooks/%.$$($1_osuf),$$(rts_C_HOOK_SRCS)) +rts_$1_S_OBJS = $$(patsubst rts/%.S,rts/dist/build/%.$$($1_osuf),$$(rts_S_SRCS)) +rts_$1_CMM_OBJS = $$(patsubst rts/%.cmm,rts/dist/build/%.$$($1_osuf),$$(rts_CMM_SRCS)) $$(patsubst %.cmm,%.$$($1_osuf),$$(rts_AUTO_APPLY_CMM)) rts_$1_OBJS = $$(rts_$1_C_OBJS) $$(rts_$1_S_OBJS) $$(rts_$1_CMM_OBJS) @@ -254,9 +256,21 @@ else ifeq "$(USE_DTRACE)" "YES" ifeq "$(NEED_DTRACE_PROBES_OBJ)" "YES" +# A list of objects that do not get included in the RTS object that is created +# during the linking step. To prevent future linking errors, especially when +# using the compiler as a bootstrap compiler, we need to exclude the hook +# objects from being re-linked into the single LINKED_OBJS object file. When the +# hooks are being linked into the RTS object this will result in duplicated +# symbols causing the linker to fail (e.g. `StackOverflowHook` in RTS.o and +# hschooks.o). The excluded objects do not get relinked into the RTS object but +# get included separately so prevent linker errors. +# (see issue #15040) +rts_$1_EXCLUDED_OBJS = $$(rts_$1_C_HOOK_OBJS) +# The RTS object that gets generated to package up all of the runtime system +# with the dtrace probe code. rts_$1_LINKED_OBJS = rts/dist/build/RTS.$$($1_osuf) -$$(rts_$1_LINKED_OBJS) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) +$$(rts_$1_LINKED_OBJS) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) $$(rts_$1_C_HOOK_OBJS) "$$(RM)" $$(RM_OPTS) $$@ # When linking an archive the linker will only include the object files that @@ -264,11 +278,17 @@ $$(rts_$1_LINKED_OBJS) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) # specific code for initializing the probes. By creating a single object that # also includes the probe object code we force the linker to include the # probes when linking the static runtime. - $(LD) -r -o $$(rts_$1_LINKED_OBJS) $$(rts_$1_DTRACE_OBJS) $$(rts_$1_OBJS) + # + # The reason why we are re-linking all the objects into a single object file + # is stated in this thread: + # https://thr3ads.net/dtrace-discuss/2005/08/384778-Problem-with-probes-defined-in-static-libraries + $(LD) -r -o $$(rts_$1_LINKED_OBJS) $$(rts_$1_DTRACE_OBJS) $$(filter-out $$(rts_$1_EXCLUDED_OBJS), $$(rts_$1_OBJS)) else +rts_$1_EXCLUDED_OBJS = rts_$1_LINKED_OBJS = $$(rts_$1_OBJS) endif else +rts_$1_EXCLUDED_OBJS = rts_$1_LINKED_OBJS = $$(rts_$1_OBJS) endif @@ -276,7 +296,7 @@ endif $$(rts_$1_LIB) : $$(rts_$1_LINKED_OBJS) "$$(RM)" $$(RM_OPTS) $$@ - echo $$(rts_$1_LINKED_OBJS) | "$$(XARGS)" $$(XARGS_OPTS) "$$(AR_STAGE1)" \ + echo $$(rts_$1_LINKED_OBJS) $$(rts_$1_EXCLUDED_OBJS) | "$$(XARGS)" $$(XARGS_OPTS) "$$(AR_STAGE1)" \ $$(AR_OPTS_STAGE1) $$(EXTRA_AR_ARGS_STAGE1) $$@ ifneq "$$(UseSystemLibFFI)" "YES" From git at git.haskell.org Fri Jun 15 18:58:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 18:58:56 +0000 (UTC) Subject: [commit: ghc] master: Use data con name instead of parent in lookupRecFieldOcc (7100850) Message-ID: <20180615185856.1EDF83ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7100850eebb1c1aec0aaabca08915bac8b90e188/ghc >--------------------------------------------------------------- commit 7100850eebb1c1aec0aaabca08915bac8b90e188 Author: Adam Gundry Date: Fri Jun 15 14:11:22 2018 -0400 Use data con name instead of parent in lookupRecFieldOcc Test Plan: new tests rename/should_compile/{T14747,T15149} Reviewers: simonpj, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #14747, #15149 Differential Revision: https://phabricator.haskell.org/D4821 >--------------------------------------------------------------- 7100850eebb1c1aec0aaabca08915bac8b90e188 compiler/rename/RnEnv.hs | 131 +++++++++++++++++++---- compiler/rename/RnPat.hs | 71 ++---------- testsuite/tests/rename/should_compile/T14747.hs | 9 ++ testsuite/tests/rename/should_compile/T14747A.hs | 5 + testsuite/tests/rename/should_compile/T15149.hs | 5 + testsuite/tests/rename/should_compile/T15149A.hs | 4 + testsuite/tests/rename/should_compile/T15149B.hs | 4 + testsuite/tests/rename/should_compile/T15149C.hs | 4 + testsuite/tests/rename/should_compile/all.T | 2 + testsuite/tests/rename/should_fail/T8448.stderr | 6 +- 10 files changed, 157 insertions(+), 84 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7100850eebb1c1aec0aaabca08915bac8b90e188 From git at git.haskell.org Fri Jun 15 18:58:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 18:58:59 +0000 (UTC) Subject: [commit: ghc] master: Fix #13833: accept type literals with no FlexibleInstances (42f3b53) Message-ID: <20180615185859.7C0E03ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/42f3b53b5bc4674e41f16de08094821fe1aaec00/ghc >--------------------------------------------------------------- commit 42f3b53b5bc4674e41f16de08094821fe1aaec00 Author: Kirill Zaborsky Date: Fri Jun 15 14:12:58 2018 -0400 Fix #13833: accept type literals with no FlexibleInstances Test Plan: ./validate Reviewers: bgamari, simonpj Reviewed By: bgamari, simonpj Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #13833 Differential Revision: https://phabricator.haskell.org/D4823 >--------------------------------------------------------------- 42f3b53b5bc4674e41f16de08094821fe1aaec00 compiler/typecheck/TcValidity.hs | 5 +++-- docs/users_guide/8.6.1-notes.rst | 5 +++++ testsuite/tests/typecheck/should_compile/T13833.hs | 12 ++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 21 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 84309db..6d866f7 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1121,12 +1121,13 @@ tcInstHeadTyNotSynonym ty tcInstHeadTyAppAllTyVars :: Type -> Bool -- Used in Haskell-98 mode, for the argument types of an instance head --- These must be a constructor applied to type variable arguments. +-- These must be a constructor applied to type variable arguments +-- or a type-level literal. -- But we allow kind instantiations. tcInstHeadTyAppAllTyVars ty | Just (tc, tys) <- tcSplitTyConApp_maybe (dropCasts ty) = ok (filterOutInvisibleTypes tc tys) -- avoid kinds - + | LitTy _ <- ty = True -- accept type literals (Trac #13833) | otherwise = False where diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index 147558e..4bc01c9 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. +- Type literals now could be used in type class instances without the extension + :extension:`FlexibleInstances`. + + See :ghc-ticket:`13833`. + Compiler ~~~~~~~~ diff --git a/testsuite/tests/typecheck/should_compile/T13833.hs b/testsuite/tests/typecheck/should_compile/T13833.hs new file mode 100644 index 0000000..266b00b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13833.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, KindSignatures #-} + +import GHC.TypeLits (Nat, Symbol) + +class A (n::Nat) +instance A 0 + +class B (s::Symbol) +instance B "B" + +main :: IO () +main = return () diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 8a7a7da..beaea5d 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -623,3 +623,4 @@ test('T15050', [expect_broken(15050)], compile, ['']) test('T14735', normal, compile, ['']) test('T15180', normal, compile, ['']) test('T15232', normal, compile, ['']) +test('T13833', normal, compile, ['']) \ No newline at end of file From git at git.haskell.org Fri Jun 15 21:01:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 15 Jun 2018 21:01:19 +0000 (UTC) Subject: [commit: ghc] master: Built-in Natural literals in Core (fe770c2) Message-ID: <20180615210119.54B6D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fe770c211631e7b4c9b0b1e88ef9b6046c6585ef/ghc >--------------------------------------------------------------- commit fe770c211631e7b4c9b0b1e88ef9b6046c6585ef Author: Sylvain Henry Date: Fri Jun 15 16:23:53 2018 -0400 Built-in Natural literals in Core Add support for built-in Natural literals in Core. - Replace MachInt,MachWord, LitInteger, etc. with a single LitNumber constructor with a LitNumType field - Support built-in Natural literals - Add desugar warning for negative literals - Move Maybe(..) from GHC.Base to GHC.Maybe for module dependency reasons This patch introduces only a few rules for Natural literals (compared to Integer's rules). Factorization of the built-in rules for numeric literals will be done in another patch as this one is already big to review. Test Plan: validate test build with integer-simple Reviewers: hvr, bgamari, goldfire, Bodigrim, simonmar Reviewed By: bgamari Subscribers: phadej, simonpj, RyanGlScott, carter, hsyl20, rwbarton, thomie GHC Trac Issues: #14170, #14465 Differential Revision: https://phabricator.haskell.org/D4212 >--------------------------------------------------------------- fe770c211631e7b4c9b0b1e88ef9b6046c6585ef compiler/basicTypes/Literal.hs | 409 ++++++----- compiler/codeGen/StgCmmCon.hs | 2 +- compiler/codeGen/StgCmmUtils.hs | 11 +- compiler/coreSyn/CorePrep.hs | 76 +- compiler/coreSyn/CoreUnfold.hs | 3 +- compiler/coreSyn/CoreUtils.hs | 19 +- compiler/coreSyn/MkCore.hs | 10 +- compiler/deSugar/MatchLit.hs | 86 ++- compiler/ghci/ByteCodeAsm.hs | 12 +- compiler/ghci/ByteCodeGen.hs | 42 +- compiler/iface/TcIface.hs | 8 +- compiler/main/TidyPgm.hs | 103 +-- compiler/prelude/PrelNames.hs | 39 +- compiler/prelude/PrelRules.hs | 220 ++++-- compiler/prelude/TysWiredIn.hs | 6 +- compiler/simplStg/UnariseStg.hs | 12 +- compiler/stgSyn/CoreToStg.hs | 7 +- libraries/base/Data/Bits.hs | 68 ++ libraries/base/Data/Data.hs | 1 - libraries/base/GHC/Arr.hs | 9 + libraries/base/GHC/Base.hs | 28 +- libraries/base/GHC/Base.hs-boot | 5 +- libraries/base/GHC/Enum.hs | 73 ++ libraries/base/GHC/Err.hs | 4 +- libraries/base/GHC/Exception.hs | 161 +---- libraries/base/GHC/Exception.hs-boot | 16 +- .../base/GHC/{Exception.hs => Exception/Type.hs} | 91 +-- libraries/base/GHC/Exception/Type.hs-boot | 16 + libraries/base/GHC/Int.hs | 30 + libraries/base/GHC/Maybe.hs | 31 + libraries/base/GHC/Natural.hs | 764 ++++++++++----------- libraries/base/GHC/Num.hs | 43 +- libraries/base/GHC/Read.hs | 14 + libraries/base/GHC/Real.hs | 69 +- libraries/base/GHC/Show.hs | 7 + libraries/base/GHC/Stack/Types.hs | 1 + libraries/base/GHC/Word.hs | 30 + libraries/base/Unsafe/Coerce.hs | 1 + libraries/base/base.cabal | 2 + .../template-haskell/Language/Haskell/TH/Syntax.hs | 4 +- testsuite/tests/ado/T13242a.stderr | 4 +- testsuite/tests/generics/GenDerivOutput.stderr | 16 +- testsuite/tests/generics/GenDerivOutput1_0.stderr | 4 +- testsuite/tests/generics/GenDerivOutput1_1.stderr | 32 +- .../tests/generics/T10604/T10604_deriving.stderr | 40 +- .../tests/ghci.debugger/scripts/break006.stderr | 4 +- .../tests/ghci.debugger/scripts/print019.stderr | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 1 + testsuite/tests/ghci/scripts/T10963.stderr | 2 +- testsuite/tests/ghci/scripts/T4175.stdout | 6 +- .../tests/indexed-types/should_fail/T12522a.stderr | 2 +- testsuite/tests/numeric/should_compile/Makefile | 8 + testsuite/tests/numeric/should_compile/T14170.hs | 12 + .../tests/numeric/should_compile/T14170.stdout | 59 ++ testsuite/tests/numeric/should_compile/T14465.hs | 26 + .../tests/numeric/should_compile/T14465.stderr | 3 + .../tests/numeric/should_compile/T14465.stdout | 104 +++ testsuite/tests/numeric/should_compile/all.T | 2 + .../should_fail/overloadedlistsfail01.stderr | 3 +- .../tests/partial-sigs/should_fail/T10999.stderr | 2 +- testsuite/tests/plugins/plugins09.stdout | 1 + testsuite/tests/plugins/plugins11.stdout | 1 + .../simplCore/should_compile/spec-inline.stderr | 8 +- testsuite/tests/th/ClosedFam1TH.stderr | 4 +- testsuite/tests/th/T14060.stdout | 4 +- testsuite/tests/th/T4135.stderr | 4 +- testsuite/tests/th/T5037.stderr | 6 +- testsuite/tests/th/T8953.stderr | 2 +- testsuite/tests/th/TH_RichKinds2.stderr | 6 +- testsuite/tests/th/TH_reifyDecl2.stderr | 4 +- testsuite/tests/th/TH_repGuard.stderr | 4 +- .../tests/typecheck/should_compile/T14273.stderr | 4 +- .../tests/typecheck/should_compile/holes2.stderr | 2 +- .../should_compile/valid_hole_fits.stderr | 8 +- .../tests/typecheck/should_fail/T14884.stderr | 2 +- testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- .../tests/typecheck/should_fail/tcfail008.stderr | 35 +- .../tests/typecheck/should_fail/tcfail072.stderr | 4 +- .../tests/typecheck/should_fail/tcfail133.stderr | 2 +- .../tests/typecheck/should_fail/tcfail182.stderr | 3 +- 80 files changed, 1764 insertions(+), 1207 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fe770c211631e7b4c9b0b1e88ef9b6046c6585ef From git at git.haskell.org Sat Jun 16 01:33:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 01:33:12 +0000 (UTC) Subject: [commit: ghc] master: Quantify unfixed kind variables in CUSKs (1279428) Message-ID: <20180616013312.5E2E53ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12794287174146f982257cdeffd491e3e23838dc/ghc >--------------------------------------------------------------- commit 12794287174146f982257cdeffd491e3e23838dc Author: Richard Eisenberg Date: Thu Jun 14 08:50:06 2018 -0400 Quantify unfixed kind variables in CUSKs This is a small change in user-facing behavior. When we have a unification variable left over in a CUSK, we previously would issue an error. But, we can just quantify. This also teaches kcLHsQTyVars to use quantifyTyVars instead of its own, ad-hoc quantification scheme. Fixes #15273. test case: polykinds/T11648b >--------------------------------------------------------------- 12794287174146f982257cdeffd491e3e23838dc compiler/typecheck/TcHsType.hs | 69 ++++++---------------- docs/users_guide/glasgow_exts.rst | 10 +--- .../{should_fail => should_compile}/T13777.hs | 2 + testsuite/tests/indexed-types/should_compile/all.T | 1 + .../tests/indexed-types/should_fail/T13777.stderr | 20 ------- testsuite/tests/indexed-types/should_fail/all.T | 1 - testsuite/tests/polykinds/T11648b.stderr | 9 --- testsuite/tests/polykinds/T6039.stderr | 10 ---- testsuite/tests/polykinds/all.T | 4 +- .../tests/typecheck/should_fail/T14904a.stderr | 9 --- 10 files changed, 24 insertions(+), 111 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 12794287174146f982257cdeffd491e3e23838dc From git at git.haskell.org Sat Jun 16 16:32:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 16:32:20 +0000 (UTC) Subject: [commit: nofib] master: Use /usr/bin/env to get perl path instead of using a hardcoded path. (f7de4c9) Message-ID: <20180616163220.652663ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f7de4c92475aaaa59b3484a8d54fd8115f284036/nofib >--------------------------------------------------------------- commit f7de4c92475aaaa59b3484a8d54fd8115f284036 Author: klebinger.andreas at gmx.at Date: Sat Jun 16 12:31:09 2018 -0400 Use /usr/bin/env to get perl path instead of using a hardcoded path. Summary: This makes it easier to run nofib using nix. Test Plan: Using it. Reviewers: O26 nofib, bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D4756 >--------------------------------------------------------------- f7de4c92475aaaa59b3484a8d54fd8115f284036 mk/boilerplate.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mk/boilerplate.mk b/mk/boilerplate.mk index fa8b635..9d0b6c6 100644 --- a/mk/boilerplate.mk +++ b/mk/boilerplate.mk @@ -18,7 +18,7 @@ show: RM = rm -f SIZE = size STRIP = strip -PERL = /usr/bin/perl +PERL = /usr/bin/env perl CONTEXT_DIFF_RAW = diff -U 1 EXECUTABLE_FILE = chmod +x From git at git.haskell.org Sat Jun 16 17:27:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:27:08 +0000 (UTC) Subject: [commit: ghc] master: Amend configure script to support lndir build tree (8ee9c57) Message-ID: <20180616172708.BAABC3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8ee9c574a6d2105ace858f0fee31750acafe0a0f/ghc >--------------------------------------------------------------- commit 8ee9c574a6d2105ace858f0fee31750acafe0a0f Author: Adam Gundry Date: Sat Jun 16 11:32:55 2018 -0400 Amend configure script to support lndir build tree Test Plan: ./validate Reviewers: bgamari Subscribers: rwbarton, thomie, erikd, carter GHC Trac Issues: #15257 Differential Revision: https://phabricator.haskell.org/D4853 >--------------------------------------------------------------- 8ee9c574a6d2105ace858f0fee31750acafe0a0f configure.ac | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/configure.ac b/configure.ac index 2e6e644..cf30311 100644 --- a/configure.ac +++ b/configure.ac @@ -673,11 +673,11 @@ dnl -------------------------------------------------------------- dnl ** Copy the files from the "fs" utility into the right folders. dnl -------------------------------------------------------------- AC_MSG_NOTICE([Creating links for in-tree file handling routines.]) -ln -f -v utils/fs/fs.* utils/lndir/ -ln -f -v utils/fs/fs.* utils/unlit/ -ln -f -v utils/fs/fs.* rts/ -ln -f -v utils/fs/fs.h libraries/base/include/ -ln -f -v utils/fs/fs.c libraries/base/cbits/ +ln -f -v -L utils/fs/fs.* utils/lndir/ +ln -f -v -L utils/fs/fs.* utils/unlit/ +ln -f -v -L utils/fs/fs.* rts/ +ln -f -v -L utils/fs/fs.h libraries/base/include/ +ln -f -v -L utils/fs/fs.c libraries/base/cbits/ AC_MSG_NOTICE([Routines in place. Packages can now be build normally.]) dnl -------------------------------------------------------------- From git at git.haskell.org Sat Jun 16 17:27:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:27:23 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark num009 as broken due to #15062 (1ab2dcb) Message-ID: <20180616172723.CB6803ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1ab2dcb04d96e72b4e8e921efd19f8e70d19f8ba/ghc >--------------------------------------------------------------- commit 1ab2dcb04d96e72b4e8e921efd19f8e70d19f8ba Author: Ben Gamari Date: Sat Jun 16 11:33:11 2018 -0400 testsuite: Mark num009 as broken due to #15062 Test Plan: Validate Reviewers: hvr Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15062 Differential Revision: https://phabricator.haskell.org/D4854 >--------------------------------------------------------------- 1ab2dcb04d96e72b4e8e921efd19f8e70d19f8ba libraries/base/tests/Numeric/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/libraries/base/tests/Numeric/all.T b/libraries/base/tests/Numeric/all.T index 7b63cda..c4c9bb4 100644 --- a/libraries/base/tests/Numeric/all.T +++ b/libraries/base/tests/Numeric/all.T @@ -13,6 +13,7 @@ if config.arch == 'i386': else: opts = '' test('num009', [ when(fast(), skip) + , when(wordsize(32), expect_broken(15062)) , when(platform('i386-apple-darwin'), expect_broken(2370)) , when(platform('powerpc64le-unknown-linux'), expect_broken(13634)) , when(opsys('mingw32'), omit_ways(['ghci'])) ], From git at git.haskell.org Sat Jun 16 17:27:38 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:27:38 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark overflow1 as broken on 32-bit platforms due to #15255 (1f2ed99) Message-ID: <20180616172738.2E0293ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1f2ed994de558924e3acb7578b1dca2ee52f5b14/ghc >--------------------------------------------------------------- commit 1f2ed994de558924e3acb7578b1dca2ee52f5b14 Author: Ben Gamari Date: Sat Jun 16 11:33:18 2018 -0400 testsuite: Mark overflow1 as broken on 32-bit platforms due to #15255 Test Plan: Validate on i386 Reviewers: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15255 Differential Revision: https://phabricator.haskell.org/D4855 >--------------------------------------------------------------- 1f2ed994de558924e3acb7578b1dca2ee52f5b14 testsuite/tests/rts/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index a08003d..dd4d9a1 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -304,7 +304,8 @@ test('ListStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['']) # 251 = RTS exit code for "out of memory" -test('overflow1', [ exit_code(251) ], compile_and_run, ['']) +test('overflow1', [ exit_code(251), when(wordsize(32), expect_broken(15255)) ], + compile_and_run, ['']) test('overflow2', [ exit_code(251) ], compile_and_run, ['']) test('overflow3', [ exit_code(251) ], compile_and_run, ['']) From git at git.haskell.org Sat Jun 16 17:27:52 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:27:52 +0000 (UTC) Subject: [commit: ghc] master: rts: Use .cfi_{start|end}proc directives (86210b2) Message-ID: <20180616172752.BA4633ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/86210b238b86d810874a2315d1715546a4006cea/ghc >--------------------------------------------------------------- commit 86210b238b86d810874a2315d1715546a4006cea Author: Ben Gamari Date: Sat Jun 16 11:34:28 2018 -0400 rts: Use .cfi_{start|end}proc directives Test Plan: Validate using LLVM assembler Reviewers: carter, erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, thomie GHC Trac Issues: #15207 Differential Revision: https://phabricator.haskell.org/D4781 >--------------------------------------------------------------- 86210b238b86d810874a2315d1715546a4006cea rts/StgCRun.c | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/rts/StgCRun.c b/rts/StgCRun.c index 92b0696..8fea23d 100644 --- a/rts/StgCRun.c +++ b/rts/StgCRun.c @@ -363,6 +363,15 @@ saved on the stack by the call instruction. Then we perform regular Haskell stack unwinding. */ +/* + * gcc automatically inserts .cfi_startproc/.cfi_endproc directives around + * inline assembler but clang does not. This caused the build to fail with + * Clang (see #15207). + */ + +#if defined(__clang__) +#define NEED_EXPLICIT_CFI_START_END +#endif static void GNUC3_ATTRIBUTE(used) StgRunIsImplementedInAssembler(void) @@ -376,6 +385,10 @@ StgRunIsImplementedInAssembler(void) STG_HIDDEN STG_RUN "\n" #endif STG_RUN ":\n\t" + +#if defined(NEED_EXPLICIT_CFI_START_END) + ".cfi_startproc simple\n\t" +#endif "subq %1, %%rsp\n\t" "movq %%rsp, %%rax\n\t" "subq %0, %%rsp\n\t" @@ -462,6 +475,10 @@ StgRunIsImplementedInAssembler(void) #if !defined(mingw32_HOST_OS) STG_HIDDEN xstr(STG_RUN_JMP) "\n" #endif +#if defined(NEED_EXPLICIT_CFI_START_END) + ".cfi_endproc\n\t" +#endif + #if HAVE_SUBSECTIONS_VIA_SYMBOLS // If we have deadstripping enabled and a label is detected as unused // the code gets nop'd out. @@ -500,7 +517,7 @@ StgRunIsImplementedInAssembler(void) "movq 136(%%rax),%%xmm15\n\t" #endif "addq %1, %%rsp\n\t" - "retq" + "retq\n\t" : : "i"(RESERVED_C_STACK_BYTES), From git at git.haskell.org Sat Jun 16 17:28:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:28:10 +0000 (UTC) Subject: [commit: ghc] master: Preserve parenthesis in function application in typechecker (cd95c2f) Message-ID: <20180616172810.046D23ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cd95c2ffdc5143acd3ae341ff6a19fc603b98db3/ghc >--------------------------------------------------------------- commit cd95c2ffdc5143acd3ae341ff6a19fc603b98db3 Author: Zubin Duggal Date: Sat Jun 16 12:19:43 2018 -0400 Preserve parenthesis in function application in typechecker Preserve HsPars while typechecking Test Plan: T15242 Reviewers: bgamari, alanz, simonpj Reviewed By: alanz, simonpj Subscribers: simonpj, AndreasK, rwbarton, thomie, carter GHC Trac Issues: #15242 Differential Revision: https://phabricator.haskell.org/D4822 >--------------------------------------------------------------- cd95c2ffdc5143acd3ae341ff6a19fc603b98db3 compiler/typecheck/TcExpr.hs | 55 +++++++++++++++++++--- testsuite/tests/typecheck/should_compile/T15242.hs | 6 +++ .../tests/typecheck/should_compile/T15242.stderr | 34 +++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 16 +++++++ 4 files changed, 105 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 9d75b5a..5d08389 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1098,6 +1098,21 @@ arithSeqEltType (Just fl) res_ty data HsArg tm ty = HsValArg tm -- Argument is an ordinary expression (f arg) | HsTypeArg ty -- Argument is a visible type application (f @ty) + | HsArgPar SrcSpan -- See Note [HsArgPar] + +{- +Note [HsArgPar] +A HsArgPar indicates that everything to the left of this in the argument list is +enclosed in parenthesis together with the function itself. It is necessary so +that we can recreate the parenthesis structure in the original source after +typechecking the arguments. + +The SrcSpan is the span of the original HsPar + +((f arg1) arg2 arg3) results in an input argument list of +[HsValArg arg1, HsArgPar span1, HsValArg arg2, HsValArg arg3, HsArgPar span2] + +-} wrapHsArgs :: (XAppTypeE (GhcPass id) ~ LHsWcType GhcRn) => LHsExpr (GhcPass id) @@ -1106,14 +1121,26 @@ wrapHsArgs :: (XAppTypeE (GhcPass id) ~ LHsWcType GhcRn) wrapHsArgs f [] = f wrapHsArgs f (HsValArg a : args) = wrapHsArgs (mkHsApp f a) args wrapHsArgs f (HsTypeArg t : args) = wrapHsArgs (mkHsAppType f t) args +wrapHsArgs f (HsArgPar sp : args) = wrapHsArgs (L sp $ HsPar noExt f) args instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where ppr (HsValArg tm) = text "HsValArg" <> ppr tm ppr (HsTypeArg ty) = text "HsTypeArg" <> ppr ty + ppr (HsArgPar sp) = text "HsArgPar" <> ppr sp isHsValArg :: HsArg tm ty -> Bool -isHsValArg (HsValArg {}) = True +isHsValArg (HsValArg {}) = True isHsValArg (HsTypeArg {}) = False +isHsValArg (HsArgPar {}) = False + +isArgPar :: HsArg tm ty -> Bool +isArgPar (HsArgPar {}) = True +isArgPar (HsValArg {}) = False +isArgPar (HsTypeArg {}) = False + +isArgPar_maybe :: HsArg a b -> Maybe (HsArg c d) +isArgPar_maybe (HsArgPar sp) = Just $ HsArgPar sp +isArgPar_maybe _ = Nothing type LHsExprArgIn = HsArg (LHsExpr GhcRn) (LHsWcType GhcRn) type LHsExprArgOut = HsArg (LHsExpr GhcTcId) (LHsWcType GhcRn) @@ -1133,8 +1160,8 @@ tcApp :: Maybe SDoc -- like "The function `f' is applied to" -- But OpApp is slightly different, so that's why the caller -- must assemble -tcApp m_herald (L _ (HsPar _ fun)) args res_ty - = tcApp m_herald fun args res_ty +tcApp m_herald (L sp (HsPar _ fun)) args res_ty + = tcApp m_herald fun (HsArgPar sp : args) res_ty tcApp m_herald (L _ (HsApp _ fun arg1)) args res_ty = tcApp m_herald fun (HsValArg arg1 : args) res_ty @@ -1144,7 +1171,7 @@ tcApp m_herald (L _ (HsAppType ty1 fun)) args res_ty tcApp m_herald fun@(L loc (HsRecFld _ fld_lbl)) args res_ty | Ambiguous _ lbl <- fld_lbl -- Still ambiguous - , HsValArg (L _ arg) : _ <- args -- A value arg is first + , HsValArg (L _ arg) : _ <- filterOut isArgPar args -- A value arg is first , Just sig_ty <- obviousSig arg -- A type sig on the arg disambiguates = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty ; sel_name <- disambiguateSelector lbl sig_tc_ty @@ -1294,6 +1321,11 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald go _ _ fun_ty [] = return (idHsWrapper, [], fun_ty) + go acc_args n fun_ty (HsArgPar sp : args) + = do { (inner_wrap, args', res_ty) <- go acc_args n fun_ty args + ; return (inner_wrap, HsArgPar sp : args', res_ty) + } + go acc_args n fun_ty (HsTypeArg hs_ty_arg : args) = do { (wrap1, upsilon_ty) <- topInstantiateInferred fun_orig fun_ty -- wrap1 :: fun_ty "->" upsilon_ty @@ -1881,7 +1913,12 @@ tcTagToEnum :: SrcSpan -> Name -> [LHsExprArgIn] -> ExpRhoType tcTagToEnum loc fun_name args res_ty = do { fun <- tcLookupId fun_name - ; arg <- case args of + ; let pars1 = mapMaybe isArgPar_maybe before + pars2 = mapMaybe isArgPar_maybe after + -- args contains exactly one HsValArg + (before, _:after) = break isHsValArg args + + ; arg <- case filterOut isArgPar args of [HsTypeArg hs_ty_arg, HsValArg term_arg] -> do { ty_arg <- tcHsTypeApp hs_ty_arg liftedTypeKind ; _ <- tcSubTypeDS (OccurrenceOf fun_name) GenSigCtxt ty_arg res_ty @@ -1914,8 +1951,13 @@ tcTagToEnum loc fun_name args res_ty ; arg' <- tcMonoExpr arg (mkCheckExpType intPrimTy) ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar noExt (L loc fun))) rep_ty = mkTyConApp rep_tc rep_args + out_args = concat + [ pars1 + , [HsValArg arg'] + , pars2 + ] - ; return (mkWpCastR (mkTcSymCo coi), fun', [HsValArg arg']) } + ; return (mkWpCastR (mkTcSymCo coi), fun', out_args) } -- coi is a Representational coercion where doc1 = vcat [ text "Specify the type by giving a type signature" @@ -1937,6 +1979,7 @@ too_many_args fun args pp (HsValArg e) = ppr e pp (HsTypeArg (HsWC { hswc_body = L _ t })) = pprHsType t pp (HsTypeArg (XHsWildCardBndrs _)) = panic "too_many_args" + pp (HsArgPar _) = empty {- diff --git a/testsuite/tests/typecheck/should_compile/T15242.hs b/testsuite/tests/typecheck/should_compile/T15242.hs new file mode 100644 index 0000000..aa95139 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15242.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -ddump-tc-ast #-} + +module T15242 where + +f = (((const) 3)) ((((seq) 'a')) 'b') +g = ((((((((((id id)) id) id) id))) id))) id diff --git a/testsuite/tests/typecheck/should_compile/T15242.stderr b/testsuite/tests/typecheck/should_compile/T15242.stderr new file mode 100644 index 0000000..0435a64 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15242.stderr @@ -0,0 +1,34 @@ +({ T15242.hs:6:5-41 } +(HsPar +({ T15242.hs:6:6-40 } +(HsPar +({ T15242.hs:6:7-39 } +(HsPar +({ T15242.hs:6:8-35 } +(HsPar +({ T15242.hs:6:9-34 } +(HsPar +({ T15242.hs:6:10-33 } +(HsPar +({ T15242.hs:6:11-29 } +(HsPar +({ T15242.hs:6:12-25 } +(HsPar +({ T15242.hs:6:13-21 } +(HsPar +({ T15242.hs:6:14-20 } +(HsPar +({ T15242.hs:5:5-17 } +(HsPar +({ T15242.hs:5:6-16 } +(HsPar +({ T15242.hs:5:7-13 } +(HsPar +({ T15242.hs:5:19-37 } +(HsPar +({ T15242.hs:5:20-32 } +(HsPar +({ T15242.hs:5:21-31 } +(HsPar +({ T15242.hs:5:22-26 } +(HsPar diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index beaea5d..d14e416 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -624,3 +624,19 @@ test('T14735', normal, compile, ['']) test('T15180', normal, compile, ['']) test('T15232', normal, compile, ['']) test('T13833', normal, compile, ['']) + +def onlyHsParLocs(x): + """ + We only want to check that all the parenthesis are present with the correct location, + not compare the entire typechecked AST. + Located (HsPar GhcTc) are pretty printed with the form + ({ + (HsPar + This function tries to extract all such location infos from the typechecked AST. + """ + ls = x.split("\n") + filteredLines = (loc.strip() for (loc,hspar) in zip(ls,ls[1:]) + if hspar.strip().startswith("(HsPar") + and not "" in loc) + return '\n'.join(filteredLines) +test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) From git at git.haskell.org Sat Jun 16 17:29:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:29:27 +0000 (UTC) Subject: [commit: nofib] master: Don't use binary output for real/eff. (3ef116a) Message-ID: <20180616172927.D5ABE3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3ef116aa7ed572b8ee32223a18bce8d61a635b02/nofib >--------------------------------------------------------------- commit 3ef116aa7ed572b8ee32223a18bce8d61a635b02 Author: klebinger.andreas at gmx.at Date: Sat Jun 16 12:36:35 2018 -0400 Don't use binary output for real/eff. These use putStrLn so clearly we are not producing binary data. This caused failures on windows. Reviewers: O26 nofib, bgamari Reviewed By: bgamari Subscribers: bgamari GHC Trac Issues: #14656 Differential Revision: https://phabricator.haskell.org/D4705 >--------------------------------------------------------------- 3ef116aa7ed572b8ee32223a18bce8d61a635b02 real/eff/CS/Makefile | 2 -- real/eff/CSD/Makefile | 2 -- real/eff/FS/Makefile | 2 -- real/eff/S/Makefile | 2 -- real/eff/VS/Makefile | 2 -- real/eff/VSD/Makefile | 2 -- real/eff/VSM/Makefile | 2 -- 7 files changed, 14 deletions(-) diff --git a/real/eff/CS/Makefile b/real/eff/CS/Makefile index 7b43fb5..f5b54db 100644 --- a/real/eff/CS/Makefile +++ b/real/eff/CS/Makefile @@ -1,8 +1,6 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_RUNTEST_OPTS += -stdout-binary - SRC_HC_OPTS += -fglasgow-exts -package transformers include $(TOP)/mk/target.mk diff --git a/real/eff/CSD/Makefile b/real/eff/CSD/Makefile index 646e3d2..be2979b 100644 --- a/real/eff/CSD/Makefile +++ b/real/eff/CSD/Makefile @@ -1,8 +1,6 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_RUNTEST_OPTS += -stdout-binary - SRC_HC_OPTS += -fglasgow-exts include $(TOP)/mk/target.mk diff --git a/real/eff/FS/Makefile b/real/eff/FS/Makefile index 646e3d2..be2979b 100644 --- a/real/eff/FS/Makefile +++ b/real/eff/FS/Makefile @@ -1,8 +1,6 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_RUNTEST_OPTS += -stdout-binary - SRC_HC_OPTS += -fglasgow-exts include $(TOP)/mk/target.mk diff --git a/real/eff/S/Makefile b/real/eff/S/Makefile index dc665af..dd62b77 100644 --- a/real/eff/S/Makefile +++ b/real/eff/S/Makefile @@ -1,8 +1,6 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_RUNTEST_OPTS += -stdout-binary - SRC_HC_OPTS += -fglasgow-exts -package transformers -package mtl -O2 include $(TOP)/mk/target.mk diff --git a/real/eff/VS/Makefile b/real/eff/VS/Makefile index 7b43fb5..f5b54db 100644 --- a/real/eff/VS/Makefile +++ b/real/eff/VS/Makefile @@ -1,8 +1,6 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_RUNTEST_OPTS += -stdout-binary - SRC_HC_OPTS += -fglasgow-exts -package transformers include $(TOP)/mk/target.mk diff --git a/real/eff/VSD/Makefile b/real/eff/VSD/Makefile index 85f14b2..50c3e71 100644 --- a/real/eff/VSD/Makefile +++ b/real/eff/VSD/Makefile @@ -1,8 +1,6 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_RUNTEST_OPTS += -stdout-binary - SRC_HC_OPTS += -fglasgow-exts -package transformers -package mtl include $(TOP)/mk/target.mk diff --git a/real/eff/VSM/Makefile b/real/eff/VSM/Makefile index 85f14b2..50c3e71 100644 --- a/real/eff/VSM/Makefile +++ b/real/eff/VSM/Makefile @@ -1,8 +1,6 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_RUNTEST_OPTS += -stdout-binary - SRC_HC_OPTS += -fglasgow-exts -package transformers -package mtl include $(TOP)/mk/target.mk From git at git.haskell.org Sat Jun 16 17:29:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:29:29 +0000 (UTC) Subject: [commit: nofib] master: Several fixes to work with ghc-head (cf032a2) Message-ID: <20180616172929.DDE6F3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cf032a225ce9e896f6a0ecadc6fd09969ade6249/nofib >--------------------------------------------------------------- commit cf032a225ce9e896f6a0ecadc6fd09969ade6249 Author: Douglas Wilson Date: Sat Jun 16 12:37:03 2018 -0400 Several fixes to work with ghc-head Reviewers: O26 nofib, michalt Reviewed By: O26 nofib, michalt Subscribers: michalt Differential Revision: https://phabricator.haskell.org/D4391 >--------------------------------------------------------------- cf032a225ce9e896f6a0ecadc6fd09969ade6249 gc/hash/HashTable.hs | 2 +- parallel/minimax/Tree.hs | 3 +-- smp/threads006/Main.hs | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/gc/hash/HashTable.hs b/gc/hash/HashTable.hs index 84fc85c..97ebd0b 100644 --- a/gc/hash/HashTable.hs +++ b/gc/hash/HashTable.hs @@ -37,7 +37,7 @@ module HashTable ) where #ifdef __GLASGOW_HASKELL__ -import GHC.Base +import GHC.Base hiding (mapM) #else import Prelude hiding ( lookup ) #endif diff --git a/parallel/minimax/Tree.hs b/parallel/minimax/Tree.hs index 3483868..88e1631 100644 --- a/parallel/minimax/Tree.hs +++ b/parallel/minimax/Tree.hs @@ -18,7 +18,7 @@ mapTree f (Branch a l) = fa `par` Branch fa (map (mapTree f) l `using` myParList) where fa = f a -#else {- SEQ -} +#else /* SEQ */ mapTree :: (a -> b) -> (Tree a) -> (Tree b) mapTree f (Branch a l) = Branch (f a) (map (mapTree f) l) @@ -38,4 +38,3 @@ parTree n (Branch a xs) = a `par` mySeqList (map (parTree (n-1)) xs) prune :: Int -> (Tree a) -> (Tree a) prune 0 (Branch a l) = Branch a [] prune n (Branch a l) = Branch a (map (prune (n-1)) l) - diff --git a/smp/threads006/Main.hs b/smp/threads006/Main.hs index 42a74d9..11d7505 100644 --- a/smp/threads006/Main.hs +++ b/smp/threads006/Main.hs @@ -59,7 +59,7 @@ main :: IO () main = do hSetBuffering stdout NoBuffering [nthreads] <- fmap (map read) getArgs - tids <- replicateM nthreads . mask $ \_ -> forkIO $ return () + tids <- replicateM nthreads . mask_ $ forkIO $ return () m <- newEmptyMVar -- do it in a subthread to avoid bound-thread overhead forkIO $ do mapM_ killThread tids; putMVar m () From git at git.haskell.org Sat Jun 16 17:29:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:29:32 +0000 (UTC) Subject: [commit: nofib] master: Eliminate trailing whitespace (22240ca) Message-ID: <20180616172932.3A30A3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22240ca8034d8cf55535688a6e4c9fb3fda577ff/nofib >--------------------------------------------------------------- commit 22240ca8034d8cf55535688a6e4c9fb3fda577ff Author: Matthew Pickering Date: Sat Jun 16 12:37:26 2018 -0400 Eliminate trailing whitespace Reviewers: michalt, bgamari, O26 nofib, goldfire Reviewed By: michalt, O26 nofib Differential Revision: https://phabricator.haskell.org/D4045 >--------------------------------------------------------------- 22240ca8034d8cf55535688a6e4c9fb3fda577ff gc/cacheprof/Arch_x86.hs | 0 gc/cacheprof/Generics.hs | 0 gc/cacheprof/Main.hs | 0 gc/circsim/Main.lhs | 0 gc/constraints/Main.hs | 0 gc/fibheaps/Main.lhs | 0 gc/fulsom/Csg.hs | 0 gc/fulsom/Interval.hs | 0 gc/fulsom/Kolor.hs | 0 gc/fulsom/Main.hs | 0 gc/fulsom/Matrix.hs | 0 gc/fulsom/Oct.hs | 0 gc/fulsom/Patchlevel.hs | 0 gc/fulsom/Quad.hs | 0 gc/fulsom/Raster.hs | 0 gc/fulsom/Shapes.hs | 0 gc/fulsom/Types.hs | 0 gc/fulsom/Vector.hs | 0 gc/gc_bench/gc_bench.hs | 0 gc/happy/AbsSyn.lhs | 0 gc/happy/AttrGrammar.lhs | 0 gc/happy/AttrGrammarParser.hs | 0 gc/happy/First.lhs | 0 gc/happy/GenUtils.lhs | 0 gc/happy/Grammar.lhs | 0 gc/happy/Info.lhs | 0 gc/happy/LALR.lhs | 0 gc/happy/Lexer.lhs | 0 gc/happy/Parser.hs | 0 gc/happy/ProduceCode.lhs | 0 gc/happy/ProduceGLRCode.lhs | 0 gc/happy/Set.hs | 0 gc/happy/TestInput.hs | 0 gc/happy/happy.lhs | 0 gc/hash/HashTable.hs | 0 gc/lcss/Main.hs | 0 gc/linear/AbsCg.lhs | 0 gc/linear/AbsDensematrix.lhs | 0 gc/linear/Cg.lhs | 0 gc/linear/Densematrix.lhs | 0 gc/linear/Input.lhs | 0 gc/linear/Matlib.lhs | 0 gc/linear/Matrix.lhs | 0 gc/linear/Misc.lhs | 0 gc/linear/Utils.lhs | 0 gc/linear/linear.lhs | 0 gc/mutstore1/Main.hs | 0 gc/mutstore2/Main.hs | 0 gc/power/Main.hs | 0 gc/treejoin/Main.hs | 0 imaginary/bernouilli/Main.hs | 0 imaginary/digits-of-e1/Main.lhs | 0 imaginary/digits-of-e2/Main.lhs | 0 imaginary/exp3_8/Main.hs | 0 imaginary/gen_regexps/Main.hs | 0 imaginary/integrate/Main.hs | 0 imaginary/paraffins/Main.hs | 0 imaginary/tak/Main.hs | 0 imaginary/wheel-sieve1/Main.hs | 0 imaginary/wheel-sieve2/Main.hs | 0 nofib-analyse/Main.hs | 0 nofib-analyse/Slurp.hs | 0 parallel/OLD/NESL/GranRandom.hs | 0 parallel/OLD/NESL/Strategies.lhs | 0 parallel/OLD/NESL/fft.lhs | 0 parallel/OLD/NESL/integrate.lhs | 0 parallel/OLD/NESL/matrix-inverse.lhs | 0 parallel/OLD/NESL/quick_hull.lhs | 0 parallel/OLD/NESL/sieve.lhs | 0 parallel/OLD/bom/GranRandom.hs | 0 parallel/OLD/bom/Strategies.lhs | 0 parallel/OLD/bom/bom.hs | 0 parallel/OLD/bom/dateNaiveAhead.hs | 0 parallel/OLD/bom/dateNaiveChunk.hs | 0 parallel/OLD/parfact/parfact.hs | 0 parallel/OLD/soda/Main.hs | 0 parallel/OLD/soda7/Main.hs | 0 parallel/blackscholes/blackscholes.hs | 0 parallel/cfd/C_matrix.hs | 0 parallel/cfd/Data8.hs | 0 parallel/cfd/Gen_net.hs | 0 parallel/cfd/S_Array.hs | 0 parallel/coins/coins.hs | 0 parallel/dcbm/DCBM.hs | 0 parallel/dcbm/Fwif.hs | 0 parallel/dcbm/Types.hs | 0 parallel/gray/Data.hs | 0 parallel/gray/Eval.hs | 0 parallel/gray/Geometry.hs | 0 parallel/gray/Illumination.hs | 0 parallel/gray/Intersections.hs | 0 parallel/gray/Parse.hs | 0 parallel/linsolv/CRA.hs | 0 parallel/linsolv/Main.hs | 0 parallel/linsolv/Matrix.hs | 0 parallel/linsolv/ModArithm.hs | 0 parallel/matmult/MatMult.hs | 0 parallel/minimax/Board.hs | 0 parallel/minimax/Game.hs | 0 parallel/minimax/Prog.hs | 0 parallel/minimax/Wins.hs | 0 parallel/nbody/nbody.hs | 0 parallel/partak/Main.hs | 0 parallel/partree/Tree.hs | 0 parallel/partree/partree.hs | 0 parallel/queens/Main.hs | 0 parallel/ray/Main.lhs | 0 parallel/sumeuler/SumEuler.hs | 0 parallel/transclos/Main.hs | 0 parallel/transclos/TransClos.hs | 0 parallel/warshall/warshall.hs | 0 real/anna/AbsConc3.hs | 0 real/anna/AbstractEval2.hs | 0 real/anna/AbstractMisc.hs | 0 real/anna/AbstractVals2.hs | 0 real/anna/Apply.hs | 0 real/anna/BarakiConc3.hs | 0 real/anna/BarakiMeet.hs | 0 real/anna/BaseDefs.hs | 0 real/anna/Constructors.hs | 0 real/anna/Dependancy.hs | 0 real/anna/DomainExpr.hs | 0 real/anna/EtaAbstract.hs | 0 real/anna/FrontierDATAFN2.hs | 0 real/anna/FrontierGENERIC2.hs | 0 real/anna/FrontierMisc2.hs | 0 real/anna/Inverse.hs | 0 real/anna/LambdaLift5.hs | 0 real/anna/Main.hs | 0 real/anna/MakeDomains.hs | 0 real/anna/Monster.hs | 0 real/anna/MyUtils.hs | 0 real/anna/Parser2.hs | 0 real/anna/PrettyPrint.hs | 0 real/anna/PrintResults.hs | 0 real/anna/ReadTable.hs | 0 real/anna/Simplify.hs | 0 real/anna/SmallerLattice.hs | 0 real/anna/StrictAn6.hs | 0 real/anna/SuccsAndPreds2.hs | 0 real/anna/TExpr2DExpr.hs | 0 real/anna/TypeCheck5.hs | 0 real/anna/Utils.hs | 0 real/bspt/BSPT.lhs | 0 real/bspt/Euclid.lhs | 0 real/bspt/EuclidGMS.lhs | 0 real/bspt/GeomNum.lhs | 0 real/bspt/Init.lhs | 0 real/bspt/Input.lhs | 0 real/bspt/Interface.lhs | 0 real/bspt/Interpret.lhs | 0 real/bspt/Libfuns.lhs | 0 real/bspt/MGRlib.lhs | 0 real/bspt/Merge.lhs | 0 real/bspt/Params.lhs | 0 real/bspt/Prog.lhs | 0 real/bspt/Rationals.lhs | 0 real/bspt/Render.lhs | 0 real/bspt/Stdlib.lhs | 0 real/cacheprof/Arch_x86.hs | 0 real/cacheprof/Generics.hs | 0 real/cacheprof/Main.hs | 0 real/compress/BinConv.hs | 0 real/compress/Decode.hs | 0 real/compress/Encode.hs | 0 real/compress/Lzw.hs | 0 real/compress/Lzw2.hs | 0 real/compress/Main.hs | 0 real/compress/PTTrees.hs | 0 real/compress/Uncompress.hs | 0 real/compress2/Encode.hs | 0 real/compress2/Main.hs | 0 real/fem/Assemble_loadvec.hs | 0 real/fem/Assemble_stiffness.hs | 0 real/fem/DB_interface.hs | 0 real/fem/Database.hs | 0 real/fem/Degrees.hs | 0 real/fem/Displacement.hs | 0 real/fem/Elemforce.hs | 0 real/fem/Elemstif.hs | 0 real/fem/Main.hs | 0 real/fem/Matrix.hs | 0 real/fem/Pre_assemble.hs | 0 real/fem/PrintSource.hs | 0 real/fem/Printuvwforce.hs | 0 real/fem/VBlldecomp.hs | 0 real/fem/VBmatrix.hs | 0 real/fem/Vector.hs | 0 real/fluid/C_matrix.hs | 0 real/fluid/Chl_decomp.hs | 0 real/fluid/Chl_method.hs | 0 real/fluid/Chl_routs.hs | 0 real/fluid/Elefac.hs | 0 real/fluid/Input_proc.hs | 0 real/fluid/Jcb_method.hs | 0 real/fluid/Min_degree.hs | 0 real/fulsom/Csg.hs | 0 real/fulsom/Interval.hs | 0 real/fulsom/Kolor.hs | 0 real/fulsom/Main.hs | 0 real/fulsom/Matrix.hs | 0 real/fulsom/Oct.hs | 0 real/fulsom/Patchlevel.hs | 0 real/fulsom/Quad.hs | 0 real/fulsom/Raster.hs | 0 real/fulsom/Shapes.hs | 0 real/fulsom/Types.hs | 0 real/fulsom/Vector.hs | 0 real/gamteb/Compton.hs | 0 real/gamteb/Consts.hs | 0 real/gamteb/Distance.hs | 0 real/gamteb/GamtebMain.hs | 0 real/gamteb/GamtebType.hs | 0 real/gamteb/InitTable.hs | 0 real/gamteb/Main.hs | 0 real/gamteb/Output.hs | 0 real/gamteb/Pair.hs | 0 real/gamteb/PhotoElec.hs | 0 real/gamteb/RoulSplit.hs | 0 real/gamteb/TransPort.hs | 0 real/gamteb/Utils.hs | 0 real/gg/Activity.hs | 0 real/gg/GRIP.hs | 0 real/gg/Graph.hs | 0 real/gg/Main.hs | 0 real/gg/PSlib.hs | 0 real/gg/Pool.hs | 0 real/gg/Spark.hs | 0 real/gg/StdLib.hs | 0 real/grep/Main.lhs | 0 real/grep/Parsers.hs | 0 real/grep/StringMatch.hs | 0 real/hidden/Main.hs | 0 real/hidden/MyIO.hs | 0 real/hpg/Env.lhs | 0 real/hpg/GenType.lhs | 0 real/infer/Parse.hs | 0 real/infer/Substitution.hs | 0 real/lift/LambdaLift.lhs | 0 real/lift/Main.lhs | 0 real/lift/Print.lhs | 0 real/lift/Utilities.lhs | 0 real/linear/AbsCg.lhs | 0 real/linear/AbsDensematrix.lhs | 0 real/linear/Cg.lhs | 0 real/linear/Densematrix.lhs | 0 real/linear/Input.lhs | 0 real/linear/Main.lhs | 0 real/linear/Matlib.lhs | 0 real/linear/Matrix.lhs | 0 real/linear/Misc.lhs | 0 real/linear/Utils.lhs | 0 real/maillist/Main.hs | 0 real/mkhprog/Main.lhs | 0 real/parser/Main.hs | 0 real/parser/big_big_test.hs | 0 real/pic/ChargeDensity.hs | 0 real/pic/ElecField.hs | 0 real/pic/Main.hs | 0 real/pic/Pic.hs | 0 real/pic/PicType.hs | 0 real/pic/Potential.hs | 0 real/pic/PushParticle.hs | 0 real/pic/Utils.hs | 0 real/prolog/Engine.hs | 0 real/prolog/Interact.hs | 0 real/prolog/Parse.hs | 0 real/prolog/PureEngine.hs | 0 real/prolog/StackEngine.hs | 0 real/prolog/Subst.hs | 0 real/reptile/Auxprogfuns.hs | 0 real/reptile/Drawfuns.hs | 0 real/reptile/Geomfuns.hs | 0 real/reptile/Help.hs | 0 real/reptile/Layout.hs | 0 real/reptile/Main.hs | 0 real/reptile/Mgrfuns.hs | 0 real/reptile/Progfuns.hs | 0 real/reptile/Psfuns.hs | 0 real/reptile/Rational.hs | 0 real/reptile/Tilefuns.hs | 0 real/rsa/Main.hs | 0 real/rsa/Rsa.hs | 0 real/scs/Main.hs | 0 real/scs/RandomFix.hs | 0 real/scs/Simulate.hs | 0 real/symalg/BasicNumber.hs | 0 real/symalg/BasicNumberApprox.hs | 0 real/symalg/Eval.hs | 0 real/symalg/Lexer.hs | 0 real/symalg/Main.hs | 0 real/symalg/Parser.hs | 0 real/symalg/Print.hs | 0 real/symalg/RealM.hs | 0 real/veritas/Auto.hs | 0 real/veritas/Build_Tm.lhs | 0 real/veritas/Build_itrm.lhs | 0 real/veritas/Core_database.hs | 0 real/veritas/Core_datatype.hs | 0 real/veritas/Dcore.hs | 0 real/veritas/DerivedRules.hs | 0 real/veritas/Display.hs | 0 real/veritas/Editor.hs | 0 real/veritas/Edlib.lhs | 0 real/veritas/Getops.hs | 0 real/veritas/Goals.hs | 0 real/veritas/Kernel.hs | 0 real/veritas/Lookup.hs | 0 real/veritas/Main.hs | 0 real/veritas/Parse.lhs | 0 real/veritas/Sub_Core1.hs | 0 real/veritas/Sub_Core2.hs | 0 real/veritas/Sub_Core3.hs | 0 real/veritas/Sub_Core4.hs | 0 real/veritas/Tacticals.hs | 0 real/veritas/Tactics.hs | 0 real/veritas/Tags.hs | 0 real/veritas/ThmTactics.hs | 0 real/veritas/Token.lhs | 0 real/veritas/Tree.hs | 0 real/veritas/Type_defs.lhs | 0 real/veritas/Unparse.lhs | 0 real/veritas/Vtslib.hs | 0 real/veritas/X_interface.hs | 0 shootout/binary-trees/Main.hs | 0 shootout/fannkuch-redux/Main.hs | 0 shootout/fasta/Main.hs | 0 shootout/k-nucleotide/Main.hs | 0 shootout/n-body/Main.hs | 0 shootout/reverse-complement/Main.hs | 0 shootout/spectral-norm/Main.hs | 0 smp/chan/chan.hs | 0 smp/sieve/sieve.hs | 0 smp/stm002/StmTest2.hs | 0 smp/systolic/Main.hs | 0 smp/tchan/tchan.hs | 0 smp/threads001/Main.hs | 0 smp/threads002/Main.hs | 0 smp/threads003/Main.hs | 0 smp/threads004/Main.hs | 0 smp/threads005/Main.hs | 0 smp/threads006/Main.hs | 0 smp/threads007/Main.hs | 0 spectral/ansi/Main.hs | 0 spectral/atom/Main.hs | 0 spectral/awards/Main.hs | 0 spectral/awards/QSort.hs | 0 spectral/boyer/Main.lhs | 0 spectral/boyer2/Checker.hs | 0 spectral/boyer2/Lisplikefns.hs | 0 spectral/boyer2/Main.hs | 0 spectral/boyer2/Rewritefns.hs | 0 spectral/calendar/Main.hs | 0 spectral/cichelli/Auxil.hs | 0 spectral/cichelli/Key.lhs | 0 spectral/cichelli/Prog.hs | 0 spectral/circsim/Main.lhs | 0 spectral/clausify/Main.hs | 0 spectral/constraints/Main.hs | 0 spectral/cryptarithm1/Main.hs | 0 spectral/cryptarithm2/Main.hs | 0 spectral/cse/Main.hs | 0 spectral/eliza/Main.hs | 0 spectral/exact-reals/Era.hs | 0 spectral/fft2/Complex_Vectors.lhs | 0 spectral/fft2/Fourier.lhs | 0 spectral/fft2/Main.lhs | 0 spectral/fibheaps/Main.lhs | 0 spectral/fish/Main.hs | 0 spectral/gcd/Main.hs | 0 spectral/hartel/comp_lab_zift/Main.hs | 0 spectral/hartel/event/Main.hs | 0 spectral/hartel/fft/Main.hs | 0 spectral/hartel/genfft/Main.hs | 0 spectral/hartel/ida/Main.hs | 0 spectral/hartel/listcompr/Main.hs | 0 spectral/hartel/listcopy/Main.hs | 0 spectral/hartel/nucleic2/Main.hs | 0 spectral/hartel/nucleic2/RA.hs | 0 spectral/hartel/nucleic2/RC.hs | 0 spectral/hartel/nucleic2/RG.hs | 0 spectral/hartel/nucleic2/RU.hs | 0 spectral/hartel/parstof/Main.hs | 0 spectral/hartel/sched/Main.hs | 0 spectral/hartel/solid/Main.hs | 0 spectral/hartel/transform/Main.hs | 0 spectral/hartel/typecheck/Main.hs | 0 spectral/hartel/wang/Main.hs | 0 spectral/hartel/wave4main/Main.hs | 0 spectral/integer/Main.hs | 0 spectral/knights/ChessSetArray.lhs | 0 spectral/knights/ChessSetList.lhs | 0 spectral/knights/KnightHeuristic.lhs | 0 spectral/knights/Main.lhs | 0 spectral/knights/Queue.lhs | 0 spectral/knights/Sort.lhs | 0 spectral/lambda/Main.hs | 0 spectral/last-piece/Main.hs | 0 spectral/lcss/Main.hs | 0 spectral/life/Main.hs | 0 spectral/mandel/MandelOld.lhs | 0 spectral/mandel2/Main.hs | 0 spectral/mate/Board.hs | 0 spectral/mate/Main.hs | 0 spectral/mate/Move.hs | 0 spectral/mate/Problem.hs | 0 spectral/mate/Solution.hs | 0 spectral/minimax/Board.hs | 0 spectral/minimax/Prog.hs | 0 spectral/minimax/Wins.hs | 0 spectral/multiplier/Main.hs | 0 spectral/para/Main.lhs | 0 spectral/power/Main.hs | 0 spectral/pretty/Pretty.hs | 0 spectral/primetest/IntLib.lhs | 0 spectral/primetest/Main.lhs | 0 spectral/rewrite/Main.lhs | 0 spectral/secretary/Main.lhs | 0 spectral/simple/Main.hs | 0 spectral/sphere/Main.lhs | 0 spectral/treejoin/Main.hs | 0 421 files changed, 0 insertions(+), 0 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 22240ca8034d8cf55535688a6e4c9fb3fda577ff From git at git.haskell.org Sat Jun 16 17:29:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 17:29:34 +0000 (UTC) Subject: [commit: nofib] master: Set -O2 via NoFibHcOpts instead of individual Makefiles. (a3b0f2b) Message-ID: <20180616172934.422AF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a3b0f2b2cff8babbb85cbbe1e7515905ffb444a8/nofib >--------------------------------------------------------------- commit a3b0f2b2cff8babbb85cbbe1e7515905ffb444a8 Author: klebinger.andreas at gmx.at Date: Sat Jun 16 12:37:41 2018 -0400 Set -O2 via NoFibHcOpts instead of individual Makefiles. We set -O2 in NoFibHcOpts which is then applied to all benchmarks run. Adding -O2 in individual benchmarks is therefore redundant. It also leads to issues when testing performance flags via EXTRA_HC_OPTS. Individual Makefiles attach -O2 last. This means all flags set by -O2 could not be disabled with -fno- as they were reenabled by the later -O2 switch. Test Plan: Using Reviewers: bgamari, jmct, O26 nofib Differential Revision: https://phabricator.haskell.org/D4829 >--------------------------------------------------------------- a3b0f2b2cff8babbb85cbbe1e7515905ffb444a8 real/eff/S/Makefile | 2 +- shootout/binary-trees/Makefile | 2 +- shootout/fannkuch-redux/Makefile | 3 ++- shootout/fasta/Makefile | 2 +- shootout/k-nucleotide/Makefile | 2 +- shootout/n-body/Makefile | 2 +- shootout/pidigits/Makefile | 1 - shootout/reverse-complement/Makefile | 2 +- shootout/spectral-norm/Makefile | 2 +- smp/threads005/Main.hs | 2 -- smp/threads006/Main.hs | 1 - 11 files changed, 9 insertions(+), 12 deletions(-) diff --git a/real/eff/S/Makefile b/real/eff/S/Makefile index dd62b77..50c3e71 100644 --- a/real/eff/S/Makefile +++ b/real/eff/S/Makefile @@ -1,7 +1,7 @@ TOP = ../../.. include $(TOP)/mk/boilerplate.mk -SRC_HC_OPTS += -fglasgow-exts -package transformers -package mtl -O2 +SRC_HC_OPTS += -fglasgow-exts -package transformers -package mtl include $(TOP)/mk/target.mk diff --git a/shootout/binary-trees/Makefile b/shootout/binary-trees/Makefile index 8a27f6d..6d944e8 100644 --- a/shootout/binary-trees/Makefile +++ b/shootout/binary-trees/Makefile @@ -8,5 +8,5 @@ SLOW_OPTS = 20 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -XBangPatterns -O2 -funbox-strict-fields +HC_OPTS += -XBangPatterns -funbox-strict-fields SRC_RUNTEST_OPTS += +RTS -K128M -H -RTS diff --git a/shootout/fannkuch-redux/Makefile b/shootout/fannkuch-redux/Makefile index facb262..729955f 100644 --- a/shootout/fannkuch-redux/Makefile +++ b/shootout/fannkuch-redux/Makefile @@ -8,4 +8,5 @@ SLOW_OPTS = 12 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -XBangPatterns -O2 +HC_OPTS += -XBangPatterns + diff --git a/shootout/fasta/Makefile b/shootout/fasta/Makefile index 97a8b17..e61f95c 100644 --- a/shootout/fasta/Makefile +++ b/shootout/fasta/Makefile @@ -13,7 +13,7 @@ SLOW_OPTS = 25000000 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -O2 -XBangPatterns -XOverloadedStrings -package bytestring +HC_OPTS += -XBangPatterns -XOverloadedStrings -package bytestring #------------------------------------------------------------------ # Create output to validate against diff --git a/shootout/k-nucleotide/Makefile b/shootout/k-nucleotide/Makefile index a37cbad..8e1e714 100644 --- a/shootout/k-nucleotide/Makefile +++ b/shootout/k-nucleotide/Makefile @@ -9,7 +9,7 @@ SLOW_OPTS = 25000000 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -O2 -XBangPatterns -package bytestring +HC_OPTS += -XBangPatterns -package bytestring #------------------------------------------------------------------ # Create input diff --git a/shootout/n-body/Makefile b/shootout/n-body/Makefile index 1ea0b09..2290826 100644 --- a/shootout/n-body/Makefile +++ b/shootout/n-body/Makefile @@ -8,4 +8,4 @@ SLOW_OPTS = 50000000 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -O2 -XBangPatterns -fexcess-precision +HC_OPTS += -XBangPatterns -fexcess-precision diff --git a/shootout/pidigits/Makefile b/shootout/pidigits/Makefile index fa2edca..fb3fc93 100644 --- a/shootout/pidigits/Makefile +++ b/shootout/pidigits/Makefile @@ -8,4 +8,3 @@ SLOW_OPTS = 10000 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -O2 diff --git a/shootout/reverse-complement/Makefile b/shootout/reverse-complement/Makefile index c165f2f..0b51e16 100644 --- a/shootout/reverse-complement/Makefile +++ b/shootout/reverse-complement/Makefile @@ -13,7 +13,7 @@ SLOW_OPTS = 25000000 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -O2 -XBangPatterns -funfolding-use-threshold=32 -XMagicHash \ +HC_OPTS += -XBangPatterns -funfolding-use-threshold=32 -XMagicHash \ -XUnboxedTuples #------------------------------------------------------------------ diff --git a/shootout/spectral-norm/Makefile b/shootout/spectral-norm/Makefile index fd5dbfb..a0728d9 100644 --- a/shootout/spectral-norm/Makefile +++ b/shootout/spectral-norm/Makefile @@ -8,4 +8,4 @@ SLOW_OPTS = 5500 # official shootout setting # The benchmark game also uses -fllvm, which we can't since it might # not be available on the developer's machine. -HC_OPTS += -XBangPatterns -XMagicHash -O2 -fexcess-precision +HC_OPTS += -XBangPatterns -XMagicHash -fexcess-precision diff --git a/smp/threads005/Main.hs b/smp/threads005/Main.hs index 970b3e1..24bb719 100644 --- a/smp/threads005/Main.hs +++ b/smp/threads005/Main.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -O2 #-} - -- Program from GHC ticket #1589, to test scaling of the RTS with many threads. {- diff --git a/smp/threads006/Main.hs b/smp/threads006/Main.hs index 565213c..c92e312 100644 --- a/smp/threads006/Main.hs +++ b/smp/threads006/Main.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -O2 #-} import System.IO import System.Environment import System.CPUTime From git at git.haskell.org Sat Jun 16 19:13:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 19:13:59 +0000 (UTC) Subject: [commit: ghc] master: Bump nofib submodule (a81b99d) Message-ID: <20180616191359.385A33ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a81b99d0b14b92529736a11255305e711293aa55/ghc >--------------------------------------------------------------- commit a81b99d0b14b92529736a11255305e711293aa55 Author: Ben Gamari Date: Sat Jun 16 12:35:16 2018 -0400 Bump nofib submodule >--------------------------------------------------------------- a81b99d0b14b92529736a11255305e711293aa55 nofib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nofib b/nofib index 1364fe6..a3b0f2b 160000 --- a/nofib +++ b/nofib @@ -1 +1 @@ -Subproject commit 1364fe623f9216108a285a8804a27bdd8dfea3c4 +Subproject commit a3b0f2b2cff8babbb85cbbe1e7515905ffb444a8 From git at git.haskell.org Sat Jun 16 19:14:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 19:14:13 +0000 (UTC) Subject: [commit: ghc] master: base: Improve the documentation of the enumFrom series of functions (dbc8c0f) Message-ID: <20180616191413.B647E3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dbc8c0f8a9a5c307a54f40b51819cc88c1377485/ghc >--------------------------------------------------------------- commit dbc8c0f8a9a5c307a54f40b51819cc88c1377485 Author: ARJANEN Loïc Jean David Date: Sat Jun 16 13:00:33 2018 -0400 base: Improve the documentation of the enumFrom series of functions Fixes #15134. Reviewers: dfeuer, hvr, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15134 Differential Revision: https://phabricator.haskell.org/D4737 >--------------------------------------------------------------- dbc8c0f8a9a5c307a54f40b51819cc88c1377485 libraries/base/GHC/Enum.hs | 46 ++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 42 insertions(+), 4 deletions(-) diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index 234ccb3..af74f7c 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -92,13 +92,51 @@ class Enum a where -- applied to a value that is too large to fit in an 'Int'. fromEnum :: a -> Int - -- | Used in Haskell's translation of @[n..]@. + -- | Used in Haskell's translation of @[n..]@ with @[n..] = enumFrom n@, + -- a possible implementation being @enumFrom n = n : enumFrom (succ n)@. + -- For example: + -- + -- * @enumFrom 4 :: [Integer] = [4,5,6,7,...]@ + -- * @enumFrom 6 :: [Int] = [6,7,8,9,...,maxBound :: Int]@ enumFrom :: a -> [a] - -- | Used in Haskell's translation of @[n,n'..]@. + -- | Used in Haskell's translation of @[n,n'..]@ + -- with @[n,n'..] = enumFromThen n n'@, a possible implementation being + -- @enumFromThen n n' = n : n' : worker (f x) (f x n')@, + -- @worker s v = v : worker s (s v)@, @x = fromEnum n' - fromEnum n@ and + -- @f n y + -- | n > 0 = f (n - 1) (succ y) + -- | n < 0 = f (n + 1) (pred y) + -- | otherwise = y@ + -- For example: + -- + -- * @enumFromThen 4 6 :: [Integer] = [4,6,8,10...]@ + -- * @enumFromThen 6 2 :: [Int] = [6,2,-2,-6,...,minBound :: Int]@ enumFromThen :: a -> a -> [a] - -- | Used in Haskell's translation of @[n..m]@. + -- | Used in Haskell's translation of @[n..m]@ with + -- @[n..m] = enumFromTo n m@, a possible implementation being + -- @enumFromTo n m + -- | n <= m = n : enumFromTo (succ n) m + -- | otherwise = []@. + -- For example: + -- + -- * @enumFromTo 6 10 :: [Int] = [6,7,8,9,10]@ + -- * @enumFromTo 42 1 :: [Integer] = []@ enumFromTo :: a -> a -> [a] - -- | Used in Haskell's translation of @[n,n'..m]@. + -- | Used in Haskell's translation of @[n,n'..m]@ with + -- @[n,n'..m] = enumFromThenTo n n' m@, a possible implementation + -- being @enumFromThenTo n n' m = worker (f x) (c x) n m@, + -- @x = fromEnum n' - fromEnum n@, @c x = bool (>=) (<=) (x > 0)@ + -- @f n y + -- | n > 0 = f (n - 1) (succ y) + -- | n < 0 = f (n + 1) (pred y) + -- | otherwise = y@ and + -- @worker s c v m + -- | c v m = v : worker s c (s v) m + -- | otherwise = []@ + -- For example: + -- + -- * @enumFromThenTo 4 2 -6 :: [Integer] = [4,2,0,-2,-4,-6]@ + -- * @enumFromThenTo 6 8 2 :: [Int] = []@ enumFromThenTo :: a -> a -> a -> [a] succ = toEnum . (+ 1) . fromEnum From git at git.haskell.org Sat Jun 16 19:14:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 19:14:28 +0000 (UTC) Subject: [commit: ghc] master: rts: Remove use of __USE_MINGW_ANSI_STDIO (de34a71) Message-ID: <20180616191428.3208D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de34a71460a920e836b7057b4aac76d6202be890/ghc >--------------------------------------------------------------- commit de34a71460a920e836b7057b4aac76d6202be890 Author: Ben Gamari Date: Sat Jun 16 13:22:31 2018 -0400 rts: Remove use of __USE_MINGW_ANSI_STDIO As pointed out in #12951, this was a temporary measure to allow GHC to be bootstrapped on Windows with GHC 7.10. This release is now out of our bootstrap support window so let's remove it. >--------------------------------------------------------------- de34a71460a920e836b7057b4aac76d6202be890 rts/PosixSource.h | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/rts/PosixSource.h b/rts/PosixSource.h index edee5fa..13fd7b0 100644 --- a/rts/PosixSource.h +++ b/rts/PosixSource.h @@ -36,16 +36,3 @@ #define _POSIX_C_SOURCE 200809L #define _XOPEN_SOURCE 700 #endif - -#if defined(mingw32_HOST_OS) -/* Without this gcc will warn about %ull and the like since some msvcrt versions - do not support them. See - https://sourceforge.net/p/mingw-w64/mailman/message/28557333/ - - Note that this is implied by _POSIX_C_SOURCE in the msys2 toolchain that we - now use. However, we retain this explicit #define to preserve the ability to - bootstrap GHC with compilers still using msys (e.g. GHC 7.10.1 and 7.10.2). - This can be removed in for GHC 8.4. See #12951. - */ -#define __USE_MINGW_ANSI_STDIO 1 -#endif From git at git.haskell.org Sat Jun 16 19:18:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 19:18:40 +0000 (UTC) Subject: [commit: ghc] ghc-8.6's head updated: rts: Remove use of __USE_MINGW_ANSI_STDIO (de34a71) Message-ID: <20180616191840.5BC0F3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.6' now includes: 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 From git at git.haskell.org Sat Jun 16 19:22:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 19:22:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.6, master: circleci: Bump fedora docker image tag (819d8ef) Message-ID: <20180616192235.CA2843ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branches: ghc-8.6,master Link : http://ghc.haskell.org/trac/ghc/changeset/819d8efd568e8138e514fd3b82660a3cab3e2db2/ghc >--------------------------------------------------------------- commit 819d8efd568e8138e514fd3b82660a3cab3e2db2 Author: Ben Gamari Date: Sat Jun 16 15:21:49 2018 -0400 circleci: Bump fedora docker image tag >--------------------------------------------------------------- 819d8efd568e8138e514fd3b82660a3cab3e2db2 .circleci/config.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 2caa3b4..79630d7 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -242,7 +242,7 @@ jobs: "validate-x86_64-fedora": resource_class: xlarge docker: - - image: ghcci/x86_64-linux-fedora:0.0.3 + - image: ghcci/x86_64-linux-fedora:0.0.4 environment: <<: *buildenv GHC_COLLECTOR_FLAVOR: x86_64-fedora From git at git.haskell.org Sat Jun 16 19:36:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 16 Jun 2018 19:36:54 +0000 (UTC) Subject: [commit: ghc] ghc-8.6, master: circleci: Add a reference to the documentation on the Wiki (f998947) Message-ID: <20180616193654.979AF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branches: ghc-8.6,master Link : http://ghc.haskell.org/trac/ghc/changeset/f998947fe93a87e91a701d48cd38ddc433a8f9e1/ghc >--------------------------------------------------------------- commit f998947fe93a87e91a701d48cd38ddc433a8f9e1 Author: Ben Gamari Date: Sat Jun 16 15:36:09 2018 -0400 circleci: Add a reference to the documentation on the Wiki >--------------------------------------------------------------- f998947fe93a87e91a701d48cd38ddc433a8f9e1 .circleci/config.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index 79630d7..e52d38d 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,3 +1,6 @@ +# Questions about this file? +# See https://ghc.haskell.org/trac/ghc/wiki/ContinuousIntegration/Usage. + version: 2 aliases: From git at git.haskell.org Sun Jun 17 03:26:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 03:26:46 +0000 (UTC) Subject: [commit: ghc] master: Enhanced constant folding (60e4bb4) Message-ID: <20180617032646.1BE683ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60e4bb4d305bc1a65457ee79b1e69c11b9ed747d/ghc >--------------------------------------------------------------- commit 60e4bb4d305bc1a65457ee79b1e69c11b9ed747d Author: Sylvain Henry Date: Fri Apr 13 13:29:07 2018 -0400 Enhanced constant folding Until now GHC only supported basic constant folding (lit op lit, expr op 0, etc.). This patch uses laws of +/-/* (associativity, commutativity, distributivity) to support some constant folding into nested expressions. Examples of new transformations: - simple nesting: (10 + x) + 10 becomes 20 + x - deep nesting: 5 + x + (y + (z + (t + 5))) becomes 10 + (x + (y + (z + t))) - distribution: (5 + x) * 6 becomes 30 + 6*x - simple factorization: 5 + x + (x + (x + (x + 5))) becomes 10 + (4 *x) - siblings: (5 + 4*x) - (3*x + 2) becomes 3 + x Test Plan: validate Reviewers: simonpj, austin, bgamari Reviewed By: bgamari Subscribers: thomie GHC Trac Issues: #9136 Differential Revision: https://phabricator.haskell.org/D2858 (cherry picked from commit fea04defa64871caab6339ff3fc5511a272f37c7) >--------------------------------------------------------------- 60e4bb4d305bc1a65457ee79b1e69c11b9ed747d compiler/main/DynFlags.hs | 3 + compiler/prelude/PrelRules.hs | 305 ++++++++++++++++++++- .../simplCore/should_compile/spec-inline.stderr | 38 +-- 3 files changed, 309 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 60e4bb4d305bc1a65457ee79b1e69c11b9ed747d From git at git.haskell.org Sun Jun 17 03:33:30 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 03:33:30 +0000 (UTC) Subject: [commit: ghc] master: Revert "Amend configure script to support lndir build tree" (d55035f) Message-ID: <20180617033330.A13F23ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d55035f5fe1312f81a7d3af397d117820e85ad57/ghc >--------------------------------------------------------------- commit d55035f5fe1312f81a7d3af397d117820e85ad57 Author: Ben Gamari Date: Sat Jun 16 23:31:07 2018 -0400 Revert "Amend configure script to support lndir build tree" This appears to inexplicably break the OS X build, which fails with: ``` make[1]: *** No rule to make target `utils/unlit/fs.c', needed by `utils/unlit/dist/build/.depend.c_asm'. Stop. make[1]: *** Waiting for unfinished jobs.... make: *** [all] Error 2 ``` This reverts commit 8ee9c574a6d2105ace858f0fee31750acafe0a0f. >--------------------------------------------------------------- d55035f5fe1312f81a7d3af397d117820e85ad57 configure.ac | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/configure.ac b/configure.ac index cf30311..2e6e644 100644 --- a/configure.ac +++ b/configure.ac @@ -673,11 +673,11 @@ dnl -------------------------------------------------------------- dnl ** Copy the files from the "fs" utility into the right folders. dnl -------------------------------------------------------------- AC_MSG_NOTICE([Creating links for in-tree file handling routines.]) -ln -f -v -L utils/fs/fs.* utils/lndir/ -ln -f -v -L utils/fs/fs.* utils/unlit/ -ln -f -v -L utils/fs/fs.* rts/ -ln -f -v -L utils/fs/fs.h libraries/base/include/ -ln -f -v -L utils/fs/fs.c libraries/base/cbits/ +ln -f -v utils/fs/fs.* utils/lndir/ +ln -f -v utils/fs/fs.* utils/unlit/ +ln -f -v utils/fs/fs.* rts/ +ln -f -v utils/fs/fs.h libraries/base/include/ +ln -f -v utils/fs/fs.c libraries/base/cbits/ AC_MSG_NOTICE([Routines in place. Packages can now be build normally.]) dnl -------------------------------------------------------------- From git at git.haskell.org Sun Jun 17 03:38:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 03:38:53 +0000 (UTC) Subject: [commit: ghc] ghc-8.6's head updated: Revert "Amend configure script to support lndir build tree" (d55035f) Message-ID: <20180617033853.C801B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.6' now includes: 60e4bb4 Enhanced constant folding d55035f Revert "Amend configure script to support lndir build tree" From git at git.haskell.org Sun Jun 17 03:45:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 03:45:50 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: base: Add default implementation for Data.Bits.bitSize (4cd5521) Message-ID: <20180617034550.842F93ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/4cd552184cbc5bed33da21497537df4e400a1a2f/ghc >--------------------------------------------------------------- commit 4cd552184cbc5bed33da21497537df4e400a1a2f Author: Ben Gamari Date: Sat Jun 16 23:44:03 2018 -0400 base: Add default implementation for Data.Bits.bitSize Fixes #12970 and will provide a reasonable migration path for the eventual remove of this function. Test Plan: Validate Reviewers: ekmett, hvr Subscribers: rwbarton, thomie, carter GHC Trac Issues: #12970 Differential Revision: https://phabricator.haskell.org/D4857 >--------------------------------------------------------------- 4cd552184cbc5bed33da21497537df4e400a1a2f libraries/base/Data/Bits.hs | 4 ++++ libraries/base/changelog.md | 3 +++ 2 files changed, 7 insertions(+) diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs index 60edf78..18110b5 100644 --- a/libraries/base/Data/Bits.hs +++ b/libraries/base/Data/Bits.hs @@ -190,8 +190,12 @@ class Eq a => Bits a where {-| Return the number of bits in the type of the argument. The actual value of the argument is ignored. The function 'bitSize' is undefined for types that do not have a fixed bitsize, like 'Integer'. + + Default implementation based upon 'bitSizeMaybe' provided since + 4.12.0.0. -} bitSize :: a -> Int + bitSize b = fromMaybe (error "bitSize is undefined") (bitSizeMaybe b) {-| Return 'True' if the argument is a signed type. The actual value of the argument is ignored -} diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 5188fa9..9e896d3 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -325,6 +325,9 @@ * New `Control.Exception.TypeError` datatype, which is thrown when an expression fails to typecheck when run using `-fdefer-type-errors` (#10284) + * The `bitSize` method of `Data.Bits.Bits` now has a (partial!) + default implementation based on `bitSizeMaybe`. (#12970) + ### New instances * `Alt`, `Dual`, `First`, `Last`, `Product`, and `Sum` now have `Data`, From git at git.haskell.org Sun Jun 17 03:46:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 03:46:02 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Warn about implicit kind variables with -Wcompat (8df2447) Message-ID: <20180617034602.1CD043ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/8df24474d0194d28b8273c1539af05793156e23f/ghc >--------------------------------------------------------------- commit 8df24474d0194d28b8273c1539af05793156e23f Author: Vladislav Zavialov Date: Sat Jun 16 23:44:39 2018 -0400 Warn about implicit kind variables with -Wcompat According to an accepted proposal https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/002 4-no-kind-vars.rst With -Wcompat, warn if a kind variable is brought into scope implicitly in a type with an explicit forall. This applies to type signatures and to other contexts that allow a forall with the forall-or-nothing rule in effect (for example, class instances). Test Plan: Validate Reviewers: goldfire, hvr, bgamari, RyanGlScott Reviewed By: goldfire Subscribers: RyanGlScott, rwbarton, thomie, carter GHC Trac Issues: #15264 Differential Revision: https://phabricator.haskell.org/D4834 >--------------------------------------------------------------- 8df24474d0194d28b8273c1539af05793156e23f compiler/main/DynFlags.hs | 3 ++ compiler/rename/RnTypes.hs | 15 ++++++ docs/users_guide/8.6.1-notes.rst | 6 +++ docs/users_guide/using-warnings.rst | 53 ++++++++++++++++++++++ libraries/base/Data/Typeable/Internal.hs | 9 ++-- testsuite/tests/dependent/should_compile/T15264.hs | 15 ++++++ .../tests/dependent/should_compile/T15264.stderr | 10 ++++ testsuite/tests/dependent/should_compile/all.T | 1 + 8 files changed, 108 insertions(+), 4 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8df24474d0194d28b8273c1539af05793156e23f From git at git.haskell.org Sun Jun 17 03:46:27 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 03:46:27 +0000 (UTC) Subject: [commit: ghc] master's head updated: Warn about implicit kind variables with -Wcompat (8df2447) Message-ID: <20180617034627.7C96B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 4cd5521 base: Add default implementation for Data.Bits.bitSize 8df2447 Warn about implicit kind variables with -Wcompat From git at git.haskell.org Sun Jun 17 14:29:18 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 14:29:18 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Revert "rts: Use .cfi_{start|end}proc directives" (76b343f) Message-ID: <20180617142918.054E23ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/76b343f5d2e98eb02fc91ff6fd3ea06e0159713c/ghc >--------------------------------------------------------------- commit 76b343f5d2e98eb02fc91ff6fd3ea06e0159713c Author: Ben Gamari Date: Sun Jun 17 09:41:46 2018 -0400 Revert "rts: Use .cfi_{start|end}proc directives" This reverts commit 86210b238b86d810874a2315d1715546a4006cea. >--------------------------------------------------------------- 76b343f5d2e98eb02fc91ff6fd3ea06e0159713c rts/StgCRun.c | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/rts/StgCRun.c b/rts/StgCRun.c index 8fea23d..92b0696 100644 --- a/rts/StgCRun.c +++ b/rts/StgCRun.c @@ -363,15 +363,6 @@ saved on the stack by the call instruction. Then we perform regular Haskell stack unwinding. */ -/* - * gcc automatically inserts .cfi_startproc/.cfi_endproc directives around - * inline assembler but clang does not. This caused the build to fail with - * Clang (see #15207). - */ - -#if defined(__clang__) -#define NEED_EXPLICIT_CFI_START_END -#endif static void GNUC3_ATTRIBUTE(used) StgRunIsImplementedInAssembler(void) @@ -385,10 +376,6 @@ StgRunIsImplementedInAssembler(void) STG_HIDDEN STG_RUN "\n" #endif STG_RUN ":\n\t" - -#if defined(NEED_EXPLICIT_CFI_START_END) - ".cfi_startproc simple\n\t" -#endif "subq %1, %%rsp\n\t" "movq %%rsp, %%rax\n\t" "subq %0, %%rsp\n\t" @@ -475,10 +462,6 @@ StgRunIsImplementedInAssembler(void) #if !defined(mingw32_HOST_OS) STG_HIDDEN xstr(STG_RUN_JMP) "\n" #endif -#if defined(NEED_EXPLICIT_CFI_START_END) - ".cfi_endproc\n\t" -#endif - #if HAVE_SUBSECTIONS_VIA_SYMBOLS // If we have deadstripping enabled and a label is detected as unused // the code gets nop'd out. @@ -517,7 +500,7 @@ StgRunIsImplementedInAssembler(void) "movq 136(%%rax),%%xmm15\n\t" #endif "addq %1, %%rsp\n\t" - "retq\n\t" + "retq" : : "i"(RESERVED_C_STACK_BYTES), From git at git.haskell.org Sun Jun 17 14:29:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 14:29:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Bump process submodule (0db05ad) Message-ID: <20180617142920.C3A973ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/0db05ad9e4d2737e69e640a82f809a5cf8e253ad/ghc >--------------------------------------------------------------- commit 0db05ad9e4d2737e69e640a82f809a5cf8e253ad Author: Ben Gamari Date: Sun Jun 17 08:44:25 2018 -0400 Bump process submodule >--------------------------------------------------------------- 0db05ad9e4d2737e69e640a82f809a5cf8e253ad libraries/process | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/process b/libraries/process index 78c338b..36a3ad5 160000 --- a/libraries/process +++ b/libraries/process @@ -1 +1 @@ -Subproject commit 78c338b2ad06f0a3ed4ace7d95cc68ddb87ab207 +Subproject commit 36a3ad577e31e8c3336c7464b252fc2c9b01a20c From git at git.haskell.org Sun Jun 17 14:29:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 14:29:23 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: configure: Fail when bootstrapping with GHC 8.2.1 (d1c7239) Message-ID: <20180617142923.8CD163ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/d1c7239c037e267873658160b5c290f08f0d6502/ghc >--------------------------------------------------------------- commit d1c7239c037e267873658160b5c290f08f0d6502 Author: Ben Gamari Date: Sun Jun 17 09:54:18 2018 -0400 configure: Fail when bootstrapping with GHC 8.2.1 See #15281 >--------------------------------------------------------------- d1c7239c037e267873658160b5c290f08f0d6502 configure.ac | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/configure.ac b/configure.ac index 2e6e644..09889ab 100644 --- a/configure.ac +++ b/configure.ac @@ -132,6 +132,11 @@ AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)]) if test "$WithGhc" != ""; then FPTOOLS_GHC_VERSION([GhcVersion], [GhcMajVersion], [GhcMinVersion], [GhcPatchLevel])dnl + # See #15281 + if test "$GhcMajVersion" = "8" && test "$GhcMinVersion" = "2" && test "$GhcPatchLevel" = "1"; then + AC_MSG_ERROR([GHC 8.2.1 is known to be buggy and cannot bootstrap this GHC release (See Trac 15281); please use GHC 8.2.2 or later.]) + fi + if test "$GhcMajVersion" = "unknown" || test "$GhcMinVersion" = "unknown"; then AC_MSG_ERROR([Cannot determine the version of $WithGhc. Is it really GHC?]) fi From git at git.haskell.org Sun Jun 17 15:17:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 15:17:56 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark T3001-2 as broken on 32-bit platforms (749bc1a) Message-ID: <20180617151756.822D63ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/749bc1a0b08c75b69b5ea7d6faab3626b1d75c03/ghc >--------------------------------------------------------------- commit 749bc1a0b08c75b69b5ea7d6faab3626b1d75c03 Author: Ben Gamari Date: Sun Jun 17 10:31:34 2018 -0400 testsuite: Mark T3001-2 as broken on 32-bit platforms Due to #15063. >--------------------------------------------------------------- 749bc1a0b08c75b69b5ea7d6faab3626b1d75c03 testsuite/tests/profiling/should_run/all.T | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 7904de8..75882a3 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -33,7 +33,9 @@ test('T2592', test('T3001', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['']) -test('T3001-2', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], +test('T3001-2', + [only_ways(['prof_hb']), extra_ways(['prof_hb']), + when(wordsize(32), expect_broken(15063))], compile_and_run, ['-package bytestring']) # For profasm/profthreaded, the answer is correct but the ordering of some From git at git.haskell.org Sun Jun 17 15:17:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 15:17:59 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Mark print022 as broken on 32-bit platforms (9897440) Message-ID: <20180617151759.4E6373ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9897440ec9fbf17fb609e9a0d9456861c5f7f24a/ghc >--------------------------------------------------------------- commit 9897440ec9fbf17fb609e9a0d9456861c5f7f24a Author: Ben Gamari Date: Sun Jun 17 10:33:00 2018 -0400 testsuite: Mark print022 as broken on 32-bit platforms Due to #15061. >--------------------------------------------------------------- 9897440ec9fbf17fb609e9a0d9456861c5f7f24a testsuite/tests/ghci.debugger/scripts/all.T | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index a24a254..88acdb0 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -21,8 +21,10 @@ test('print018', extra_files(['../Test.hs']), ghci_script, ['print018.script']) 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)), ghci_script, - ['print022.script']) +test('print022', + [when(arch('powerpc64'), expect_broken(14455)), + when(wordsize(32), expect_broken(15061))], + ghci_script, ['print022.script']) test('print023', extra_files(['../Test.hs']), ghci_script, ['print023.script']) test('print024', extra_files(['../Test.hs']), ghci_script, ['print024.script']) test('print025', normal, ghci_script, ['print025.script']) From git at git.haskell.org Sun Jun 17 15:18:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 15:18:03 +0000 (UTC) Subject: [commit: ghc] master: Handle DuplicateRecordFields correctly in filterImports (fixes #14487) (ccd8ce4) Message-ID: <20180617151803.443FA3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ccd8ce405db89142932daea3fdace8814b110798/ghc >--------------------------------------------------------------- commit ccd8ce405db89142932daea3fdace8814b110798 Author: Adam Gundry Date: Sun Jun 17 10:47:57 2018 -0400 Handle DuplicateRecordFields correctly in filterImports (fixes #14487) filterImports needed a small adjustment to correctly handle record field definitions arising from modules with DuplicateRecordFields enabled. Previously hiding fields was not possible with DuplicateRecordFields enabled. Test Plan: new test rename/should_compile/T14487 Reviewers: bgamari Subscribers: simonpj, rwbarton, thomie, carter GHC Trac Issues: #14487 Differential Revision: https://phabricator.haskell.org/D4805 >--------------------------------------------------------------- ccd8ce405db89142932daea3fdace8814b110798 compiler/basicTypes/Avail.hs | 18 +++++++++++++++ compiler/rename/RnNames.hs | 7 +++--- compiler/typecheck/TcRnExports.hs | 27 ++++++++++------------ .../should_fail/DuplicateExports.hs | 9 ++++++++ .../should_fail/DuplicateExports.stderr | 3 +++ .../tests/overloadedrecflds/should_fail/all.T | 1 + testsuite/tests/rename/should_compile/T14487.hs | 7 ++++++ testsuite/tests/rename/should_compile/T14487A.hs | 7 ++++++ testsuite/tests/rename/should_compile/all.T | 1 + 9 files changed, 62 insertions(+), 18 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc ccd8ce405db89142932daea3fdace8814b110798 From git at git.haskell.org Sun Jun 17 15:18:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 15:18:05 +0000 (UTC) Subject: [commit: ghc] master's head updated: Handle DuplicateRecordFields correctly in filterImports (fixes #14487) (ccd8ce4) Message-ID: <20180617151805.D3F913ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'master' now includes: 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) From git at git.haskell.org Sun Jun 17 15:18:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 15:18:20 +0000 (UTC) Subject: [commit: ghc] ghc-8.6's head updated: Handle DuplicateRecordFields correctly in filterImports (fixes #14487) (ccd8ce4) Message-ID: <20180617151820.C033B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.6' now includes: 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) From git at git.haskell.org Sun Jun 17 16:42:14 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 16:42:14 +0000 (UTC) Subject: [commit: ghc] master: Improve error message when importing an unusable package (df0f148) Message-ID: <20180617164214.F1E7D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/df0f148feae4c3b9653260edff843d561d6d5918/ghc >--------------------------------------------------------------- commit df0f148feae4c3b9653260edff843d561d6d5918 Author: Sean D Gillespie Date: Sun Jun 17 11:22:20 2018 -0400 Improve error message when importing an unusable package If a module cannot be found because it is ignored or from an unusable package, report this to the user and the reason it is unusable. Currently, GHC displays the standard "Cannot find module error". For example: ``` : error: Could not find module ‘Control.Monad.Random’ Perhaps you meant Control.Monad.Reader (from mtl-2.2.2) Control.Monad.Cont (from mtl-2.2.2) Control.Monad.Error (from mtl-2.2.2) ``` GHC does, however, indicate unusable/ignored packages with the -v flag: ``` package MonadRandom-0.5.1-1421RgpXdhC8e8UI7D3emA is unusable due to missing dependencies: fail-4.9.0.0-BAHmj60kS5K7NVhhKpm9J5 ``` With this change, I took that message and added it to the output of the "Cannot find module" message. Reviewers: bgamari, dfeuer Reviewed By: bgamari Subscribers: Phyx, dfeuer, rwbarton, thomie, carter GHC Trac Issues: #4806 Differential Revision: https://phabricator.haskell.org/D4783 >--------------------------------------------------------------- df0f148feae4c3b9653260edff843d561d6d5918 compiler/main/Finder.hs | 61 ++++++++++++---- compiler/main/HscTypes.hs | 3 + compiler/main/Packages.hs | 96 ++++++++++++++++++++------ testsuite/tests/ghci/should_fail/T15055.stderr | 4 +- testsuite/tests/package/T4806.hs | 1 + testsuite/tests/package/T4806.stderr | 6 ++ testsuite/tests/package/T4806a.hs | 1 + testsuite/tests/package/T4806a.stderr | 7 ++ testsuite/tests/package/all.T | 3 + testsuite/tests/package/package01e.stderr | 4 +- testsuite/tests/package/package06e.stderr | 8 +-- testsuite/tests/package/package07e.stderr | 6 +- testsuite/tests/package/package08e.stderr | 6 +- testsuite/tests/plugins/T11244.stderr | 2 +- 14 files changed, 161 insertions(+), 47 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc df0f148feae4c3b9653260edff843d561d6d5918 From git at git.haskell.org Sun Jun 17 16:42:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 16:42:17 +0000 (UTC) Subject: [commit: ghc] master: Improve documentation of Eq, Ord instances for Float and Double (793902e) Message-ID: <20180617164217.CA6DF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/793902e6891c30150fd3ac1e0e471269a4766780/ghc >--------------------------------------------------------------- commit 793902e6891c30150fd3ac1e0e471269a4766780 Author: ARJANEN Loïc Jean David Date: Sun Jun 17 11:30:28 2018 -0400 Improve documentation of Eq, Ord instances for Float and Double Reviewers: sjakobi, dfeuer, bgamari, hvr Reviewed By: sjakobi, bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15078 Differential Revision: https://phabricator.haskell.org/D4736 >--------------------------------------------------------------- 793902e6891c30150fd3ac1e0e471269a4766780 libraries/base/Data/Complex.hs | 4 ++ libraries/base/Foreign/C/Types.hs | 6 ++- libraries/base/GHC/Float.hs | 41 ++++++++++++++++- libraries/base/GHC/Num.hs | 27 ++++++++++- libraries/base/GHC/Real.hs | 27 +++++++++++ libraries/ghc-prim/GHC/Classes.hs | 94 ++++++++++++++++++++++++++++++++++++--- 6 files changed, 190 insertions(+), 9 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 793902e6891c30150fd3ac1e0e471269a4766780 From git at git.haskell.org Sun Jun 17 18:40:50 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 18:40:50 +0000 (UTC) Subject: [commit: ghc] master: Provide a better error message for unpromotable data constructor contexts (c637541) Message-ID: <20180617184050.6F8313ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c63754118cf6c3d0947d0c611f1db39c78acf1b7/ghc >--------------------------------------------------------------- commit c63754118cf6c3d0947d0c611f1db39c78acf1b7 Author: Ryan Scott Date: Sun Jun 17 12:28:23 2018 -0400 Provide a better error message for unpromotable data constructor contexts Trac #14845 brought to light a corner case where a data constructor could not be promoted (even with `-XTypeInType`) due to an unpromotable constraint in its context. However, the error message was less than helpful, so this patch adds an additional check to `tcTyVar` catch unpromotable data constructors like these //before// they're promoted, and to give a sensible error message in such cases. Test Plan: make test TEST="T13895 T14845" Reviewers: simonpj, goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13895, #14845 Differential Revision: https://phabricator.haskell.org/D4728 >--------------------------------------------------------------- c63754118cf6c3d0947d0c611f1db39c78acf1b7 compiler/typecheck/Inst.hs | 15 ++------ compiler/typecheck/TcHsType.hs | 40 +++++++++++++++++++++- compiler/typecheck/TcRnTypes.hs | 39 ++++++++++++--------- docs/users_guide/glasgow_exts.rst | 22 +++++++++--- .../dependent/should_compile/T14845_compile.hs | 16 +++++++++ testsuite/tests/dependent/should_compile/all.T | 1 + .../dependent/should_fail/PromotedClass.stderr | 3 +- testsuite/tests/dependent/should_fail/T13895.hs | 15 ++++++++ .../tests/dependent/should_fail/T13895.stderr | 20 +++++++++++ .../tests/dependent/should_fail/T14845.stderr | 7 ++++ .../tests/dependent/should_fail/T14845_fail1.hs | 10 ++++++ .../dependent/should_fail/T14845_fail1.stderr | 7 ++++ .../should_fail/{T15215.hs => T14845_fail2.hs} | 6 ++-- .../dependent/should_fail/T14845_fail2.stderr | 7 ++++ .../tests/dependent/should_fail/T15215.stderr | 2 +- testsuite/tests/dependent/should_fail/all.T | 3 ++ 16 files changed, 174 insertions(+), 39 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c63754118cf6c3d0947d0c611f1db39c78acf1b7 From git at git.haskell.org Sun Jun 17 18:40:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 18:40:53 +0000 (UTC) Subject: [commit: ghc] master: UNREG: fix CmmRegOff large offset handling on W64 platforms (b8e3499) Message-ID: <20180617184053.3D9173ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b8e349922b4841771a59e264183219e6cad3e942/ghc >--------------------------------------------------------------- commit b8e349922b4841771a59e264183219e6cad3e942 Author: Sergei Trofimovich Date: Sun Jun 17 12:49:51 2018 -0400 UNREG: fix CmmRegOff large offset handling on W64 platforms Gabor noticed C warning when building unregisterised 64-bit compiler on GHC.Integer.Types (from integer-simple). Minimised example with a warning: ```haskell {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wall #-} module M (bug) where import GHC.Prim (Word#, minusWord#, ltWord#) import GHC.Types (isTrue#) -- assume Word = Word64 bug :: Word# -> Word# bug x = if isTrue# (x `ltWord#` 0x8000000000000000##) then 0## else x `minusWord#` 0x8000000000000000## ``` ``` $ LANG=C x86_64-UNREG-linux-gnu-ghc -O1 -c M.hs -fforce-recomp /tmp/ghc30219_0/ghc_1.hc: In function 'M_bug_entry': /tmp/ghc30219_0/ghc_1.hc:20:14: error: warning: integer constant is so large that it is unsigned ``` It's caused by limited handling of integer literals in CmmRegOff. This change switches to use standard integer literal pretty-printer. C code before the change: ```c FN_(M_bug_entry) { W_ _sAg; _cAr: _sAg = *Sp; switch ((W_)(_sAg < 0x8000000000000000UL)) { case 0x1UL: goto _cAq; default: goto _cAp; } _cAp: R1.w = _sAg+-9223372036854775808; // ... ``` C code after the change: ```c FN_(M_bug_entry) { W_ _sAg; _cAr: _sAg = *Sp; switch ((W_)(_sAg < 0x8000000000000000UL)) { case 0x1UL: goto _cAq; default: goto _cAp; } _cAp: R1.w = _sAg+(-0x8000000000000000UL); ``` URL: https://mail.haskell.org/pipermail/ghc-devs/2018-June/015875.html Reported-by: Gabor Greif Signed-off-by: Sergei Trofimovich Test Plan: test generated code on unregisterised mips64 and amd64 Reviewers: simonmar, ggreif, bgamari Reviewed By: ggreif, bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4856 >--------------------------------------------------------------- b8e349922b4841771a59e264183219e6cad3e942 compiler/cmm/PprC.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 8b30bbf..9e8ced8 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -379,14 +379,10 @@ pprExpr e = case e of CmmReg reg -> pprCastReg reg CmmRegOff reg 0 -> pprCastReg reg - CmmRegOff reg i - | i < 0 && negate_ok -> pprRegOff (char '-') (-i) - | otherwise -> pprRegOff (char '+') i - where - pprRegOff op i' = pprCastReg reg <> op <> int i' - negate_ok = negate (fromIntegral i :: Integer) < - fromIntegral (maxBound::Int) - -- overflow is undefined; see #7620 + -- CmmRegOff is an alias of MO_Add + CmmRegOff reg i -> sdocWithDynFlags $ \dflags -> + pprCastReg reg <> char '+' <> + pprHexVal (fromIntegral i) (wordWidth dflags) CmmMachOp mop args -> pprMachOpApp mop args From git at git.haskell.org Sun Jun 17 18:40:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 18:40:56 +0000 (UTC) Subject: [commit: ghc] master: Use __FILE__ for Cmm assertion locations, fix #8619 (008ea12) Message-ID: <20180617184056.0F0803ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/008ea12dd93b9f9104f0b532b278a31b719bafb8/ghc >--------------------------------------------------------------- commit 008ea12dd93b9f9104f0b532b278a31b719bafb8 Author: Ömer Sinan Ağacan Date: Sun Jun 17 12:50:18 2018 -0400 Use __FILE__ for Cmm assertion locations, fix #8619 It seems like we currently support string literals in Cmm, so we can use __LINE__ CPP macro in assertion macros. This improves error messages that previously looked like ASSERTION FAILED: file (null), line 1302 (null) part now shows the actual file name. Also inline some single-use string literals in PrimOps.cmm. Reviewers: bgamari, simonmar, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4862 >--------------------------------------------------------------- 008ea12dd93b9f9104f0b532b278a31b719bafb8 compiler/cmm/CmmParse.y | 2 -- includes/Cmm.h | 2 +- rts/PrimOps.cmm | 21 ++++++--------------- 3 files changed, 7 insertions(+), 18 deletions(-) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 2113f20..4d7e288 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -402,8 +402,6 @@ statics :: { [CmmParse [CmmStatic]] } : {- empty -} { [] } | static statics { $1 : $2 } --- Strings aren't used much in the RTS HC code, so it doesn't seem --- worth allowing inline strings. C-- doesn't allow them anyway. static :: { CmmParse [CmmStatic] } : type expr ';' { do e <- $2; return [CmmStaticLit (getLit e)] } diff --git a/includes/Cmm.h b/includes/Cmm.h index 1306a22..059220a 100644 --- a/includes/Cmm.h +++ b/includes/Cmm.h @@ -211,7 +211,7 @@ if (predicate) { \ /*null*/; \ } else { \ - foreign "C" _assertFail(NULL, __LINE__) never returns; \ + foreign "C" _assertFail(__FILE__, __LINE__) never returns; \ } #else #define ASSERT(p) /* nothing */ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 6986d9b..6081fab 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -646,8 +646,6 @@ stg_atomicModifyMutVarzh ( gcptr mv, gcptr f ) Weak Pointer Primitives -------------------------------------------------------------------------- */ -STRING(stg_weak_msg,"New weak pointer at %p\n") - stg_mkWeakzh ( gcptr key, gcptr value, gcptr finalizer /* or stg_NO_FINALIZER_closure */ ) @@ -670,7 +668,7 @@ stg_mkWeakzh ( gcptr key, Capability_weak_ptr_list_tl(MyCapability()) = w; } - IF_DEBUG(weak, ccall debugBelch(stg_weak_msg,w)); + IF_DEBUG(weak, ccall debugBelch("New weak pointer at %p\n",w)); return (w); } @@ -680,8 +678,6 @@ stg_mkWeakNoFinalizzerzh ( gcptr key, gcptr value ) jump stg_mkWeakzh (key, value, stg_NO_FINALIZER_closure); } -STRING(stg_cfinalizer_msg,"Adding a finalizer to %p\n") - stg_addCFinalizzerToWeakzh ( W_ fptr, // finalizer W_ ptr, W_ flag, // has environment (0 or 1) @@ -715,7 +711,7 @@ stg_addCFinalizzerToWeakzh ( W_ fptr, // finalizer recordMutable(w); - IF_DEBUG(weak, ccall debugBelch(stg_cfinalizer_msg,w)); + IF_DEBUG(weak, ccall debugBelch("Adding a finalizer to %p\n",w)); return (1); } @@ -2037,8 +2033,6 @@ stg_waitWritezh ( W_ fd ) #endif } - -STRING(stg_delayzh_malloc_str, "stg_delayzh") stg_delayzh ( W_ us_delay ) { #if defined(mingw32_HOST_OS) @@ -2059,7 +2053,7 @@ stg_delayzh ( W_ us_delay ) /* could probably allocate this on the heap instead */ ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - stg_delayzh_malloc_str); + "stg_delayzh"); (reqID) = ccall addDelayRequest(us_delay); StgAsyncIOResult_reqID(ares) = reqID; StgAsyncIOResult_len(ares) = 0; @@ -2104,7 +2098,6 @@ while: #if defined(mingw32_HOST_OS) -STRING(stg_asyncReadzh_malloc_str, "stg_asyncReadzh") stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) { W_ ares; @@ -2119,7 +2112,7 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) /* could probably allocate this on the heap instead */ ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - stg_asyncReadzh_malloc_str); + "stg_asyncReadzh"); (reqID) = ccall addIORequest(fd, 0/*FALSE*/,is_sock,len,buf "ptr"); StgAsyncIOResult_reqID(ares) = reqID; StgAsyncIOResult_len(ares) = 0; @@ -2130,7 +2123,6 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) #endif } -STRING(stg_asyncWritezh_malloc_str, "stg_asyncWritezh") stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) { W_ ares; @@ -2144,7 +2136,7 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I16; ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - stg_asyncWritezh_malloc_str); + "stg_asyncWritezh"); (reqID) = ccall addIORequest(fd, 1/*TRUE*/,is_sock,len,buf "ptr"); StgAsyncIOResult_reqID(ares) = reqID; @@ -2156,7 +2148,6 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) #endif } -STRING(stg_asyncDoProczh_malloc_str, "stg_asyncDoProczh") stg_asyncDoProczh ( W_ proc, W_ param ) { W_ ares; @@ -2171,7 +2162,7 @@ stg_asyncDoProczh ( W_ proc, W_ param ) /* could probably allocate this on the heap instead */ ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - stg_asyncDoProczh_malloc_str); + "stg_asyncDoProczh"); (reqID) = ccall addDoProcRequest(proc "ptr",param "ptr"); StgAsyncIOResult_reqID(ares) = reqID; StgAsyncIOResult_len(ares) = 0; From git at git.haskell.org Sun Jun 17 18:40:58 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 18:40:58 +0000 (UTC) Subject: [commit: ghc] master: Add -Werror=compat (04e9fe5) Message-ID: <20180617184058.D456F3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/04e9fe5c7d3c2bac46933e3d647e561cb741edf4/ghc >--------------------------------------------------------------- commit 04e9fe5c7d3c2bac46933e3d647e561cb741edf4 Author: Vladislav Zavialov Date: Sun Jun 17 12:51:06 2018 -0400 Add -Werror=compat Add a flag `-Werror=compat` to GHC which has the effect of `-Werror=x -Werror=y ...`, where `x, y, ...` are warnings from the `-Wcompat` option group. Test Plan: ./validate Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15278 Differential Revision: https://phabricator.haskell.org/D4860 >--------------------------------------------------------------- 04e9fe5c7d3c2bac46933e3d647e561cb741edf4 compiler/main/DynFlags.hs | 16 ++++++++++++---- docs/users_guide/using-warnings.rst | 6 ++++++ 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 485eb72..fa210dc 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3522,10 +3522,7 @@ dynamic_flags_deps = [ ++ map (mkFlag turnOff "fno-" unSetGeneralFlag ) fFlagsDeps ++ map (mkFlag turnOn "W" setWarningFlag ) wWarningFlagsDeps ++ map (mkFlag turnOff "Wno-" unSetWarningFlag ) wWarningFlagsDeps - ++ map (mkFlag turnOn "Werror=" (\flag -> do { - ; setWarningFlag flag - ; setFatalWarningFlag flag })) - wWarningFlagsDeps + ++ map (mkFlag turnOn "Werror=" setWErrorFlag ) wWarningFlagsDeps ++ map (mkFlag turnOn "Wwarn=" unSetFatalWarningFlag ) wWarningFlagsDeps ++ map (mkFlag turnOn "Wno-error=" unSetFatalWarningFlag ) @@ -3537,6 +3534,12 @@ dynamic_flags_deps = [ ++ [ (NotDeprecated, unrecognisedWarning "W"), (Deprecated, unrecognisedWarning "fwarn-"), (Deprecated, unrecognisedWarning "fno-warn-") ] + ++ [ make_ord_flag defFlag "Werror=compat" + (NoArg (mapM_ setWErrorFlag minusWcompatOpts)) + , make_ord_flag defFlag "Wno-error=compat" + (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts)) + , make_ord_flag defFlag "Wwarn=compat" + (NoArg (mapM_ unSetFatalWarningFlag minusWcompatOpts)) ] ++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlagsDeps ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlagsDeps ++ map (mkFlag turnOn "X" setExtensionFlag ) xFlagsDeps @@ -4802,6 +4805,11 @@ setFatalWarningFlag, unSetFatalWarningFlag :: WarningFlag -> DynP () setFatalWarningFlag f = upd (\dfs -> wopt_set_fatal dfs f) unSetFatalWarningFlag f = upd (\dfs -> wopt_unset_fatal dfs f) +setWErrorFlag :: WarningFlag -> DynP () +setWErrorFlag flag = + do { setWarningFlag flag + ; setFatalWarningFlag flag } + -------------------------- setExtensionFlag, unSetExtensionFlag :: LangExt.Extension -> DynP () setExtensionFlag f = upd (setExtensionFlag' f) diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 7dc4a3b..510b56a 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -151,6 +151,9 @@ to abort. Makes a specific warning into a fatal error. The warning will be enabled if it hasn't been enabled yet. + ``-Werror=compat`` has the same effect as ``-Werror=...`` for each warning + flag in the :ghc-flag:`-Wcompat` option group. + .. ghc-flag:: -Wwarn :shortdesc: make warnings non-fatal :type: dynamic @@ -172,6 +175,9 @@ to abort. Note that it doesn't fully negate the effects of ``-Werror=`` - the warning will still be enabled. + ``-Wwarn=compat`` has the same effect as ``-Wwarn=...`` for each warning + flag in the :ghc-flag:`-Wcompat` option group. + When a warning is emitted, the specific warning flag which controls it is shown. From git at git.haskell.org Sun Jun 17 19:33:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 17 Jun 2018 19:33:11 +0000 (UTC) Subject: [commit: ghc] master: Remove accidentally checked-in T14845.stderr (50d7b2a) Message-ID: <20180617193311.B0CE23ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/50d7b2ac2fcfe954455f0bc9081e1dd3a2eef51d/ghc >--------------------------------------------------------------- commit 50d7b2ac2fcfe954455f0bc9081e1dd3a2eef51d Author: Ryan Scott Date: Sun Jun 17 15:31:14 2018 -0400 Remove accidentally checked-in T14845.stderr This was a stderr file for a WIP test in D4728. I ended up removing the test, but forgot to remove the stderr file. >--------------------------------------------------------------- 50d7b2ac2fcfe954455f0bc9081e1dd3a2eef51d testsuite/tests/dependent/should_fail/T14845.stderr | 7 ------- 1 file changed, 7 deletions(-) diff --git a/testsuite/tests/dependent/should_fail/T14845.stderr b/testsuite/tests/dependent/should_fail/T14845.stderr deleted file mode 100644 index 3c11d15..0000000 --- a/testsuite/tests/dependent/should_fail/T14845.stderr +++ /dev/null @@ -1,7 +0,0 @@ - -T14845.hs:19:16: error: - • Data constructor ‘MkA3’ cannot be used here - (it has an unpromotable context ‘Coercible a Int’) - • In the first argument of ‘SA’, namely ‘(MkA3 :: A Int)’ - In the type ‘SA (MkA3 :: A Int)’ - In the definition of data constructor ‘SMkA3’ From git at git.haskell.org Mon Jun 18 07:23:51 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Jun 2018 07:23:51 +0000 (UTC) Subject: [commit: ghc] master: Fix an infinite loop in niFixTCvSubst (d621644) Message-ID: <20180618072351.30A483ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d6216443c61cee94d8ffc31ca8510a534d9406b9/ghc >--------------------------------------------------------------- commit d6216443c61cee94d8ffc31ca8510a534d9406b9 Author: Simon Peyton Jones Date: Sat Jun 16 23:25:53 2018 +0100 Fix an infinite loop in niFixTCvSubst Trac #14164 made GHC loop, a pretty serious error. It turned out that Unify.niFixTCvSubst was looping forever, because we had a substitution like a :-> ....(b :: (c :: d)).... d :-> ... We correctly recognised that d was free in the range of the substitution, but then failed to apply it "deeeply enough" to the range of the substiuttion, so d was /still/ free in the range, and we kept on going. Trac #9106 was caused by a similar problem, but alas my fix to Trac #9106 was inadequate when the offending type variable is more deeply buried. Urk. This time I think I've fixed it! It's much more subtle than I though, and it took most of a long train journey to figure it out. I wrote a long note to explain: Note [Finding the substitution fixpoint] >--------------------------------------------------------------- d6216443c61cee94d8ffc31ca8510a534d9406b9 compiler/types/Unify.hs | 116 +++++++++++++++------ .../tests/indexed-types/should_compile/T14164.hs | 10 ++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 97 insertions(+), 30 deletions(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 9833f8e..8f69172 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -37,6 +37,7 @@ import Type hiding ( getTvSubstEnv ) import Coercion hiding ( getCvSubstEnv ) import TyCon import TyCoRep hiding ( getTvSubstEnv, getCvSubstEnv ) +import FV( FV, fvVarSet, fvVarList ) import Util import Pair import Outputable @@ -546,7 +547,7 @@ During unification we use a TvSubstEnv/CvSubstEnv pair that is Note [Finding the substitution fixpoint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Finding the fixpoint of a non-idempotent substitution arising from a -unification is harder than it looks, because of kinds. Consider +unification is much trickier than it looks, because of kinds. Consider T k (H k (f:k)) ~ T * (g:*) If we unify, we get the substitution [ k -> * @@ -561,41 +562,96 @@ If we don't do this, we may apply the substitution to something, and get an ill-formed type, i.e. one where typeKind will fail. This happened, for example, in Trac #9106. -This is the reason for extending env with [f:k -> f:*], in the -definition of env' in niFixTvSubst +It gets worse. In Trac #14164 we wanted to take the fixpoint of +this substitution + [ xs_asV :-> F a_aY6 (z_aY7 :: a_aY6) + (rest_aWF :: G a_aY6 (z_aY7 :: a_aY6)) + , a_aY6 :-> a_aXQ ] + +We have to apply the substitution for a_aY6 two levels deep inside +the invocation of F! We don't have a function that recursively +applies substitutions inside the kinds of variable occurrences (and +probably rightly so). + +So, we work as follows: + + 1. Start with the current substitution (which we are + trying to fixpoint + [ xs :-> F a (z :: a) (rest :: G a (z :: a)) + , a :-> b ] + + 2. Take all the free vars of the range of the substitution: + {a, z, rest, b} + NB: the free variable finder closes over + the kinds of variable occurrences + + 3. If none are in the domain of the substitution, stop. + We have found a fixpoint. + + 4. Remove the variables that are bound by the substitution, leaving + {z, rest, b} + + 5. Do a topo-sort to put them in dependency order: + [ b :: *, z :: a, rest :: G a z ] + + 6. Apply the substitution left-to-right to the kinds of these + tyvars, extendinng it each time with a new binding, so we + finish up with + [ xs :-> ..as before.. + , a :-> ..as before.. + , b :-> b :: * + , z :-> z :: b + , rest :-> rest :: G a (z :: b) ] + Note that rest now has the right kind + + 7. Apply this extended substution (once) to the range of + the /original/ substituion. (Note that we do the + extended substitution would go on forever if you tried + to find its fixpoint, becuase it maps z to z.) + + 8. And go back to step 1 + +In Step 6 we use the free vars from Step 2 as the initial +in-scope set, because all of those variables appear in the +range of the substitution, so they must all be in the in-scope +set. But NB that the type substitution engine does not look up +variables in the in-scope set; it is used only to ensure no +shadowing. -} niFixTCvSubst :: TvSubstEnv -> TCvSubst -- Find the idempotent fixed point of the non-idempotent substitution --- See Note [Finding the substitution fixpoint] +-- This is surprisingly tricky: +-- see Note [Finding the substitution fixpoint] -- ToDo: use laziness instead of iteration? -niFixTCvSubst tenv = f tenv +niFixTCvSubst tenv + | not_fixpoint = niFixTCvSubst (mapVarEnv (substTy subst) tenv) + | otherwise = subst where - f tenv - | not_fixpoint = f (mapVarEnv (substTy subst') tenv) - | otherwise = subst - where - not_fixpoint = anyVarSet in_domain range_tvs - in_domain tv = tv `elemVarEnv` tenv - - range_tvs = nonDetFoldUFM (unionVarSet . tyCoVarsOfType) emptyVarSet tenv - -- It's OK to use nonDetFoldUFM here because we - -- forget the order immediately by creating a set - subst = mkTvSubst (mkInScopeSet range_tvs) tenv - - -- env' extends env by replacing any free type with - -- that same tyvar with a substituted kind - -- See note [Finding the substitution fixpoint] - tenv' = extendVarEnvList tenv [ (rtv, mkTyVarTy $ - setTyVarKind rtv $ - substTy subst $ - tyVarKind rtv) - | rtv <- nonDetEltsUniqSet range_tvs - -- It's OK to use nonDetEltsUniqSet here - -- because we forget the order - -- immediatedly by putting it in VarEnv - , not (in_domain rtv) ] - subst' = mkTvSubst (mkInScopeSet range_tvs) tenv' + range_fvs :: FV + range_fvs = tyCoFVsOfTypes (nonDetEltsUFM tenv) + -- It's OK to use nonDetEltsUFM here because the + -- order of range_fvs, range_tvs is immaterial + + range_tvs :: [TyVar] + range_tvs = fvVarList range_fvs + + not_fixpoint = any in_domain range_tvs + in_domain tv = tv `elemVarEnv` tenv + + free_tvs = toposortTyVars (filterOut in_domain range_tvs) + + -- See Note [Finding the substitution fixpoint], Step 6 + init_in_scope = mkInScopeSet (fvVarSet range_fvs) + subst = foldl add_free_tv + (mkTvSubst init_in_scope tenv) + free_tvs + + add_free_tv :: TCvSubst -> TyVar -> TCvSubst + add_free_tv subst tv + = extendTvSubst subst tv (mkTyVarTy tv') + where + tv' = updateTyVarKind (substTy subst) tv niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet -- Apply the non-idempotent substitution to a set of type variables, diff --git a/testsuite/tests/indexed-types/should_compile/T14164.hs b/testsuite/tests/indexed-types/should_compile/T14164.hs new file mode 100644 index 0000000..1cf6f2d --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14164.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +module T14164 where + +data G (x :: a) = GNil | GCons (G x) + +type family F (xs :: [a]) (g :: G (z :: a)) = (res :: [a]) | res -> a where + F (x:xs) GNil = x:xs + F (x:xs) (GCons rest) = x:F xs rest diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index c58424f..56448ac 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -283,3 +283,4 @@ test('T15057', normal, compile, ['']) test('T15144', normal, compile, ['']) test('T15122', normal, compile, ['']) test('T13777', normal, compile, ['']) +test('T14164', normal, compile, ['']) From git at git.haskell.org Mon Jun 18 07:23:54 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Jun 2018 07:23:54 +0000 (UTC) Subject: [commit: ghc] master: Two small refactorings (850ae8c) Message-ID: <20180618072354.16C563ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/850ae8c5343b46ce519a35dd9526d7d6f9454455/ghc >--------------------------------------------------------------- commit 850ae8c5343b46ce519a35dd9526d7d6f9454455 Author: Simon Peyton Jones Date: Sat Jun 16 23:30:26 2018 +0100 Two small refactorings * Define Type.substTyVarBndrs, and use it * Rename substTyVarBndrCallback to substTyVarBndrUsing, and other analogous higher order functions. I kept stumbling over the name. >--------------------------------------------------------------- 850ae8c5343b46ce519a35dd9526d7d6f9454455 compiler/basicTypes/DataCon.hs | 4 ++-- compiler/typecheck/TcDeriv.hs | 8 +++----- compiler/typecheck/TcDerivInfer.hs | 2 +- compiler/typecheck/TcSplice.hs | 5 ++--- compiler/typecheck/TcTyClsDecls.hs | 3 +-- compiler/types/Coercion.hs | 16 ++++++++-------- compiler/types/FamInstEnv.hs | 4 ++-- compiler/types/OptCoercion.hs | 2 +- compiler/types/TyCoRep.hs | 37 ++++++++++++++++++++----------------- compiler/types/Type.hs | 8 ++++---- 10 files changed, 44 insertions(+), 45 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 850ae8c5343b46ce519a35dd9526d7d6f9454455 From git at git.haskell.org Mon Jun 18 07:23:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Jun 2018 07:23:57 +0000 (UTC) Subject: [commit: ghc] master: Fix typechecking of kind signatures (30b029b) Message-ID: <20180618072357.90E2D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30b029bea9abe1f5f2855d9e7f0ae26a18cf049b/ghc >--------------------------------------------------------------- commit 30b029bea9abe1f5f2855d9e7f0ae26a18cf049b Author: Simon Peyton Jones Date: Sat Jun 16 23:50:02 2018 +0100 Fix typechecking of kind signatures When typechecking a type like Maybe (a :: ) with a kind signature, we were using tc_lhs_kind to typecheck the signature. But that's utterly wrong; we need the signature to be fully solid (non unresolved equalities) before using it. In the case of Trac #14904 we went on to instantiate the kind signature, when it still had embedded unsolved constraints. This tripped the level-checking assertion when unifying a variable. The fix looks pretty easy to me: just call tcLHsKind instead. I had to add KindSigCtxt to >--------------------------------------------------------------- 30b029bea9abe1f5f2855d9e7f0ae26a18cf049b compiler/typecheck/TcHsType.hs | 6 +++++- compiler/typecheck/TcType.hs | 2 ++ compiler/typecheck/TcValidity.hs | 3 +++ testsuite/tests/indexed-types/should_fail/T14904.hs | 8 ++++++++ .../T14904b.stderr => indexed-types/should_fail/T14904.stderr} | 2 +- testsuite/tests/indexed-types/should_fail/all.T | 1 + 6 files changed, 20 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 03d3866..90fa869 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -587,7 +587,11 @@ tc_infer_hs_type mode (HsOpTy _ lhs lhs_op@(L _ hs_op) rhs) [lhs, rhs] } tc_infer_hs_type mode (HsKindSig _ ty sig) - = do { sig' <- tc_lhs_kind (kindLevel mode) sig + = do { sig' <- tcLHsKindSig KindSigCtxt sig + -- We must typeckeck the kind signature, and solve all + -- its equalities etc; from this point on we may do + -- things like instantiate its foralls, so it needs + -- to be fully determined (Trac #149904) ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr sig') ; ty' <- tc_lhs_type mode ty sig' ; return (ty', sig') } diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 21d030c..26fc9fe 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -594,6 +594,7 @@ data UserTypeCtxt | InfSigCtxt Name -- Inferred type for function | ExprSigCtxt -- Expression type signature + | KindSigCtxt -- Kind signature | TypeAppCtxt -- Visible type application | ConArgCtxt Name -- Data constructor argument | TySynCtxt Name -- RHS of a type synonym decl @@ -644,6 +645,7 @@ pprUserTypeCtxt (FunSigCtxt n _) = text "the type signature for" <+> quotes (pp pprUserTypeCtxt (InfSigCtxt n) = text "the inferred type for" <+> quotes (ppr n) pprUserTypeCtxt (RuleSigCtxt n) = text "a RULE for" <+> quotes (ppr n) pprUserTypeCtxt ExprSigCtxt = text "an expression type signature" +pprUserTypeCtxt KindSigCtxt = text "a kind signature" pprUserTypeCtxt TypeAppCtxt = text "a type argument" pprUserTypeCtxt (ConArgCtxt c) = text "the type of the constructor" <+> quotes (ppr c) pprUserTypeCtxt (TySynCtxt c) = text "the RHS of the type synonym" <+> quotes (ppr c) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 6d866f7..0dc5664 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -336,6 +336,7 @@ checkValidType ctxt ty TySynCtxt _ -> rank0 ExprSigCtxt -> rank1 + KindSigCtxt -> rank1 TypeAppCtxt | impred_flag -> ArbitraryRank | otherwise -> tyConArgMonoType -- Normally, ImpredicativeTypes is handled in check_arg_type, @@ -932,6 +933,8 @@ okIPCtxt (DataTyCtxt {}) = True okIPCtxt (PatSynCtxt {}) = True okIPCtxt (TySynCtxt {}) = True -- e.g. type Blah = ?x::Int -- Trac #11466 + +okIPCtxt (KindSigCtxt {}) = False okIPCtxt (ClassSCCtxt {}) = False okIPCtxt (InstDeclCtxt {}) = False okIPCtxt (SpecInstCtxt {}) = False diff --git a/testsuite/tests/indexed-types/should_fail/T14904.hs b/testsuite/tests/indexed-types/should_fail/T14904.hs new file mode 100644 index 0000000..db7f1f4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14904.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeInType, TypeFamilies, RankNTypes #-} + +module T14904 where + +import Data.Kind + +type family F f :: Type where + F ((f :: forall a. g a) :: forall a. g a) = Int diff --git a/testsuite/tests/typecheck/should_fail/T14904b.stderr b/testsuite/tests/indexed-types/should_fail/T14904.stderr similarity index 91% copy from testsuite/tests/typecheck/should_fail/T14904b.stderr copy to testsuite/tests/indexed-types/should_fail/T14904.stderr index fff6942..dd5506c 100644 --- a/testsuite/tests/typecheck/should_fail/T14904b.stderr +++ b/testsuite/tests/indexed-types/should_fail/T14904.stderr @@ -1,5 +1,5 @@ -T14904b.hs:9:7: error: +T14904.hs:8:8: error: • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ • In the first argument of ‘F’, namely ‘((f :: forall a. g a) :: forall a. g a)’ diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index ef5eee2..b877555 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -144,3 +144,4 @@ test('T14179', normal, compile_fail, ['']) test('T14246', normal, compile_fail, ['']) test('T14369', normal, compile_fail, ['']) test('T15172', normal, compile_fail, ['']) +test('T14904', normal, compile_fail, ['']) From git at git.haskell.org Mon Jun 18 12:46:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Jun 2018 12:46:16 +0000 (UTC) Subject: [commit: ghc] master: Typofixes in docs and comments [ci skip] (6ac8a72) Message-ID: <20180618124616.AF6323ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6ac8a72f7a044f44734a0270487c3bb6fb186d53/ghc >--------------------------------------------------------------- commit 6ac8a72f7a044f44734a0270487c3bb6fb186d53 Author: Gabor Greif Date: Mon Jun 18 14:22:54 2018 +0200 Typofixes in docs and comments [ci skip] >--------------------------------------------------------------- 6ac8a72f7a044f44734a0270487c3bb6fb186d53 compiler/basicTypes/MkId.hs | 2 +- compiler/coreSyn/CoreLint.hs | 2 +- compiler/coreSyn/CoreSyn.hs | 2 +- compiler/iface/BinIface.hs | 2 +- compiler/main/DynFlags.hs | 2 +- compiler/main/TidyPgm.hs | 2 +- compiler/rename/RnSource.hs | 2 +- compiler/simplCore/SimplUtils.hs | 4 ++-- compiler/specialise/Rules.hs | 2 +- compiler/typecheck/TcDerivInfer.hs | 2 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcHsType.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 2 +- compiler/typecheck/TcSimplify.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/types/TyCon.hs | 2 +- compiler/types/Unify.hs | 8 ++++---- docs/users_guide/debug-info.rst | 4 ++-- docs/users_guide/debugging.rst | 4 ++-- docs/users_guide/extending_ghc.rst | 2 +- libraries/base/Data/Monoid.hs | 4 ++-- testsuite/tests/simplCore/should_run/T13429a.hs | 2 +- testsuite/tests/typecheck/should_compile/all.T | 2 +- utils/llvm-targets/gen-data-layout.sh | 2 +- 24 files changed, 31 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 6ac8a72f7a044f44734a0270487c3bb6fb186d53 From git at git.haskell.org Mon Jun 18 15:18:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Jun 2018 15:18:46 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in comment only (de692fd) Message-ID: <20180618151846.0229F3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de692fd54a000fab2e5787b63b9b6c62168ef4d5/ghc >--------------------------------------------------------------- commit de692fd54a000fab2e5787b63b9b6c62168ef4d5 Author: Richard Eisenberg Date: Mon Jun 18 11:18:15 2018 -0400 Fix typo in comment only [skip ci] >--------------------------------------------------------------- de692fd54a000fab2e5787b63b9b6c62168ef4d5 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 c590f0a..4167acf 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -591,7 +591,7 @@ tc_infer_hs_type mode (HsKindSig _ ty sig) -- We must typecheck the kind signature, and solve all -- its equalities etc; from this point on we may do -- things like instantiate its foralls, so it needs - -- to be fully determined (Trac #149904) + -- to be fully determined (Trac #14904) ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr sig') ; ty' <- tc_lhs_type mode ty sig' ; return (ty', sig') } From git at git.haskell.org Mon Jun 18 16:21:40 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 18 Jun 2018 16:21:40 +0000 (UTC) Subject: [commit: packages/hpc] master: Bump containers upper bound (85e04ed) Message-ID: <20180618162140.5307A3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/85e04edd6e29de549301cf10d2c725cbf29b2098 >--------------------------------------------------------------- commit 85e04edd6e29de549301cf10d2c725cbf29b2098 Author: Ben Gamari Date: Mon Jun 18 12:21:16 2018 -0400 Bump containers upper bound >--------------------------------------------------------------- 85e04edd6e29de549301cf10d2c725cbf29b2098 hpc.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hpc.cabal b/hpc.cabal index baebc38..ba676a7 100644 --- a/hpc.cabal +++ b/hpc.cabal @@ -36,7 +36,7 @@ Library Build-Depends: base >= 4.4.1 && < 4.13, - containers >= 0.4.1 && < 0.6, + containers >= 0.4.1 && < 0.7, directory >= 1.1 && < 1.4, filepath >= 1 && < 1.5, time >= 1.2 && < 1.9 From git at git.haskell.org Tue Jun 19 07:17:15 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Jun 2018 07:17:15 +0000 (UTC) Subject: [commit: ghc] master: Mark some TH tests as req_interp (a9b01c0) Message-ID: <20180619071715.A2BD83ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a9b01c08aab02a8f00cbaf49a99eff0a7b0d19e4/ghc >--------------------------------------------------------------- commit a9b01c08aab02a8f00cbaf49a99eff0a7b0d19e4 Author: Ömer Sinan Ağacan Date: Tue Jun 19 10:16:54 2018 +0300 Mark some TH tests as req_interp - dataToExpQUnit - qq005 - qq006 - qq007 - qq008 - qq009 - T13949 - T8025 >--------------------------------------------------------------- a9b01c08aab02a8f00cbaf49a99eff0a7b0d19e4 libraries/template-haskell/tests/all.T | 2 +- testsuite/tests/quasiquotation/qq005/test.T | 3 ++- testsuite/tests/quasiquotation/qq006/test.T | 3 ++- testsuite/tests/quasiquotation/qq007/test.T | 3 ++- testsuite/tests/quasiquotation/qq008/test.T | 3 ++- testsuite/tests/quasiquotation/qq009/test.T | 3 ++- testsuite/tests/th/should_compile/T13949/all.T | 2 +- testsuite/tests/th/should_compile/T8025/all.T | 2 +- 8 files changed, 13 insertions(+), 8 deletions(-) diff --git a/libraries/template-haskell/tests/all.T b/libraries/template-haskell/tests/all.T index 716742a..1d48d41 100644 --- a/libraries/template-haskell/tests/all.T +++ b/libraries/template-haskell/tests/all.T @@ -1,2 +1,2 @@ # difficult to test TH with profiling, because we have to build twice -test('dataToExpQUnit', omit_ways(prof_ways), compile, ['-v0']) +test('dataToExpQUnit', [omit_ways(prof_ways), req_interp], compile, ['-v0']) diff --git a/testsuite/tests/quasiquotation/qq005/test.T b/testsuite/tests/quasiquotation/qq005/test.T index 4e38138..6e7ec8d 100644 --- a/testsuite/tests/quasiquotation/qq005/test.T +++ b/testsuite/tests/quasiquotation/qq005/test.T @@ -5,6 +5,7 @@ test('qq005', # profiling ways, due to the TH use, so for now we just # omit the profiling ways omit_ways(prof_ways), - extra_clean(['Expr.hi', 'Expr.o', 'Main.hi', 'Main.o'])], + extra_clean(['Expr.hi', 'Expr.o', 'Main.hi', 'Main.o']), + req_interp], multimod_compile_and_run, ['Main', '']) diff --git a/testsuite/tests/quasiquotation/qq006/test.T b/testsuite/tests/quasiquotation/qq006/test.T index a76cd70..13e6530 100644 --- a/testsuite/tests/quasiquotation/qq006/test.T +++ b/testsuite/tests/quasiquotation/qq006/test.T @@ -1,3 +1,4 @@ test('qq006', [extra_files(['Expr.hs', 'Main.hs']), - when(fast(), skip)], multimod_compile_fail, + when(fast(), skip), + req_interp], multimod_compile_fail, ['Main', '-v0']) diff --git a/testsuite/tests/quasiquotation/qq007/test.T b/testsuite/tests/quasiquotation/qq007/test.T index edb3554..7e8251a 100644 --- a/testsuite/tests/quasiquotation/qq007/test.T +++ b/testsuite/tests/quasiquotation/qq007/test.T @@ -1,5 +1,6 @@ test('qq007', [extra_files(['QQ.hs', 'Test.hs']), when(fast(), skip), pre_cmd('$MAKE -s --no-print-directory TH_QQ'), - omit_ways(prof_ways)], + omit_ways(prof_ways), + req_interp], multimod_compile, ['Test', '-v0 ' + config.ghc_th_way_flags]) diff --git a/testsuite/tests/quasiquotation/qq008/test.T b/testsuite/tests/quasiquotation/qq008/test.T index 9d83f34..d17ce0d 100644 --- a/testsuite/tests/quasiquotation/qq008/test.T +++ b/testsuite/tests/quasiquotation/qq008/test.T @@ -1,5 +1,6 @@ test('qq008', [extra_files(['QQ.hs', 'Test.hs']), when(fast(), skip), pre_cmd('$MAKE -s --no-print-directory TH_QQ'), - omit_ways(prof_ways)], + omit_ways(prof_ways), + req_interp], multimod_compile, ['Test', '-v0 ' + config.ghc_th_way_flags]) diff --git a/testsuite/tests/quasiquotation/qq009/test.T b/testsuite/tests/quasiquotation/qq009/test.T index 1f108a6..2dfb976 100644 --- a/testsuite/tests/quasiquotation/qq009/test.T +++ b/testsuite/tests/quasiquotation/qq009/test.T @@ -1,5 +1,6 @@ test('qq009', [extra_files(['QQ.hs', 'Test.hs']), when(fast(), skip), pre_cmd('$MAKE -s --no-print-directory TH_QQ'), - omit_ways(prof_ways)], + omit_ways(prof_ways), + req_interp], multimod_compile, ['Test', '-v0 ' + config.ghc_th_way_flags]) diff --git a/testsuite/tests/th/should_compile/T13949/all.T b/testsuite/tests/th/should_compile/T13949/all.T index 193b06f..edd3fe5 100644 --- a/testsuite/tests/th/should_compile/T13949/all.T +++ b/testsuite/tests/th/should_compile/T13949/all.T @@ -7,6 +7,6 @@ # (1) Use -fexternal-interpreter, or # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. -test('T13949', [extra_files(['ASCII.hs', 'PatternGenerator.hs', 'These.hs', 'Tree.hs']), +test('T13949', [extra_files(['ASCII.hs', 'PatternGenerator.hs', 'These.hs', 'Tree.hs']), req_interp, omit_ways(['profasm'])], multimod_compile, ['ASCII PatternGenerator These Tree', '-fno-code -v0']) diff --git a/testsuite/tests/th/should_compile/T8025/all.T b/testsuite/tests/th/should_compile/T8025/all.T index 2eb42ac..4cdf19c 100644 --- a/testsuite/tests/th/should_compile/T8025/all.T +++ b/testsuite/tests/th/should_compile/T8025/all.T @@ -5,5 +5,5 @@ # (1) Use -fexternal-interpreter, or # (2) Build the program twice: once with -dynamic, and then # with -prof using -osuf to set a different object file suffix. -test('T8025', [extra_files(['A.hs', 'B.hs']), omit_ways(['profasm'])], +test('T8025', [extra_files(['A.hs', 'B.hs']), omit_ways(['profasm']), req_interp], multimod_compile, ['A B', '-fno-code -v0']) From git at git.haskell.org Tue Jun 19 09:43:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Jun 2018 09:43:33 +0000 (UTC) Subject: [commit: ghc] master: Adjust comments (Trac #14164) (83a7b1c) Message-ID: <20180619094333.9C96E3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/83a7b1cf5f24eccc54016034d8a6d31dbbc2c263/ghc >--------------------------------------------------------------- commit 83a7b1cf5f24eccc54016034d8a6d31dbbc2c263 Author: Simon Peyton Jones Date: Tue Jun 19 10:43:01 2018 +0100 Adjust comments (Trac #14164) >--------------------------------------------------------------- 83a7b1cf5f24eccc54016034d8a6d31dbbc2c263 compiler/types/Unify.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 94ee3f8..edd82ba 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -598,10 +598,10 @@ So, we work as follows: tyvars, extending it each time with a new binding, so we finish up with [ xs :-> ..as before.. - , a :-> ..as before.. + , a :-> b , b :-> b :: * , z :-> z :: b - , rest :-> rest :: G a (z :: b) ] + , rest :-> rest :: G b (z :: b) ] Note that rest now has the right kind 7. Apply this extended substitution (once) to the range of From git at git.haskell.org Tue Jun 19 11:22:44 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Jun 2018 11:22:44 +0000 (UTC) Subject: [commit: ghc] master: Fix API Annotations for GADT constructors (676c575) Message-ID: <20180619112244.B5C1B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/676c5754e3f9e1beeb5f01e0265ffbdc0e6f49e9/ghc >--------------------------------------------------------------- commit 676c5754e3f9e1beeb5f01e0265ffbdc0e6f49e9 Author: Alan Zimmerman Date: Mon Jun 18 10:18:21 2018 +0200 Fix API Annotations for GADT constructors Summary: This patch completes the work for #14529 by making sure that all API Annotations end up attached to a SrcSpan that appears in the final ParsedSource. Updates Haddock submodule Test Plan: ./validate Reviewers: goldfire, bgamari Subscribers: rwbarton, thomie, mpickering, carter GHC Trac Issues: #14529 Differential Revision: https://phabricator.haskell.org/D4867 >--------------------------------------------------------------- 676c5754e3f9e1beeb5f01e0265ffbdc0e6f49e9 compiler/deSugar/DsMeta.hs | 4 +- compiler/hsSyn/Convert.hs | 8 ++-- compiler/hsSyn/HsDecls.hs | 7 +++- compiler/parser/Parser.y | 5 ++- compiler/parser/RdrHsSyn.hs | 48 ++++++++++++---------- compiler/rename/RnSource.hs | 2 +- testsuite/tests/ghc-api/annotations/T10399.stdout | 43 ++++++++++++------- testsuite/tests/ghc-api/annotations/Test10399.hs | 1 + testsuite/tests/ghc-api/annotations/all.T | 6 +-- .../parser/should_compile/DumpParsedAst.stderr | 6 ++- .../parser/should_compile/DumpRenamedAst.stderr | 9 ++-- .../tests/parser/should_compile/T14189.stderr | 9 ++-- utils/haddock | 2 +- 13 files changed, 90 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 676c5754e3f9e1beeb5f01e0265ffbdc0e6f49e9 From git at git.haskell.org Tue Jun 19 16:11:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 19 Jun 2018 16:11:12 +0000 (UTC) Subject: [commit: ghc] master: Document and simplify tcInstTyBinders (26e9806) Message-ID: <20180619161112.4B28E3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/26e9806ada8823160dd63ca2c34556e5848b2f45/ghc >--------------------------------------------------------------- commit 26e9806ada8823160dd63ca2c34556e5848b2f45 Author: Richard Eisenberg Date: Mon Jun 18 22:36:08 2018 -0400 Document and simplify tcInstTyBinders This fixes #15282. >--------------------------------------------------------------- 26e9806ada8823160dd63ca2c34556e5848b2f45 compiler/typecheck/Inst.hs | 128 +++++++++++++++++++++++++++++++++-------- compiler/typecheck/TcHsType.hs | 8 +-- compiler/typecheck/TcMType.hs | 2 +- 3 files changed, 108 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 26e9806ada8823160dd63ca2c34556e5848b2f45 From git at git.haskell.org Wed Jun 20 00:16:01 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:01 +0000 (UTC) Subject: [commit: ghc] master: configure: Bump version to 8.6.0 (4cdd574) Message-ID: <20180620001601.471D53ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4cdd574abb156e0f527cea31db056686a8d3b2fa/ghc >--------------------------------------------------------------- commit 4cdd574abb156e0f527cea31db056686a8d3b2fa Author: Richard Eisenberg Date: Mon Jun 18 22:36:08 2018 -0400 configure: Bump version to 8.6.0 Bumps haddock submodule. >--------------------------------------------------------------- 4cdd574abb156e0f527cea31db056686a8d3b2fa configure.ac | 2 +- libraries/libiserv/libiserv.cabal | 4 ++-- libraries/template-haskell/template-haskell.cabal | 2 +- testsuite/tests/ghci/should_fail/all.T | 2 +- utils/haddock | 2 +- utils/iserv-proxy/iserv-proxy.cabal | 6 +++--- utils/iserv/iserv.cabal | 6 +++--- 7 files changed, 12 insertions(+), 12 deletions(-) diff --git a/configure.ac b/configure.ac index 09889ab..622ec96 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.6.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index dc3076d..8cf7c41 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -1,5 +1,5 @@ Name: libiserv -Version: 8.5 +Version: 8.6.1 Copyright: XXX License: BSD3 License-File: LICENSE @@ -25,7 +25,7 @@ Library bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.5.* + ghci == 8.6.* if flag(network) Exposed-Modules: Remote.Message , Remote.Slave diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index f265e07..590babd 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -52,7 +52,7 @@ Library build-depends: base >= 4.9 && < 4.13, - ghc-boot-th == 8.5, + ghc-boot-th == 8.6.*, pretty == 1.1.* ghc-options: -Wall diff --git a/testsuite/tests/ghci/should_fail/all.T b/testsuite/tests/ghci/should_fail/all.T index d62c3ba..01e5c36 100644 --- a/testsuite/tests/ghci/should_fail/all.T +++ b/testsuite/tests/ghci/should_fail/all.T @@ -1,4 +1,4 @@ test('T10549', [], ghci_script, ['T10549.script']) test('T10549a', [], ghci_script, ['T10549a.script']) test('T14608', [], ghci_script, ['T14608.script']) -test('T15055', [], ghci_script, ['T15055.script']) +test('T15055', normalise_version('ghc'), ghci_script, ['T15055.script']) diff --git a/utils/haddock b/utils/haddock index d58fff7..5e3cf5d 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d58fff78de7d48546a22392cefdd0abab1f1ccec +Subproject commit 5e3cf5d8868323079ff5494a8225b0467404a5d1 diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal index 1d1a2d4..5d276b2 100644 --- a/utils/iserv-proxy/iserv-proxy.cabal +++ b/utils/iserv-proxy/iserv-proxy.cabal @@ -1,5 +1,5 @@ Name: iserv-proxy -Version: 8.5 +Version: 8.6 Copyright: XXX License: BSD3 -- XXX License-File: LICENSE @@ -71,8 +71,8 @@ Executable iserv-proxy bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.5, directory >= 1.3 && < 1.4, network >= 2.6, filepath >= 1.4 && < 1.5, - libiserv == 8.5 + ghci == 8.6.*, + libiserv == 8.6.* diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal index f02d208..405b26f 100644 --- a/utils/iserv/iserv.cabal +++ b/utils/iserv/iserv.cabal @@ -1,5 +1,5 @@ Name: iserv -Version: 8.5 +Version: 8.6.1 Copyright: XXX License: BSD3 -- XXX License-File: LICENSE @@ -35,8 +35,8 @@ Executable iserv bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.6, deepseq >= 1.4 && < 1.5, - ghci == 8.5.*, - libiserv == 8.5 + ghci == 8.6.*, + libiserv == 8.6.* if os(windows) Cpp-Options: -DWINDOWS From git at git.haskell.org Wed Jun 20 00:16:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:04 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Bump metrics for T5631 and T6048 (000ac86) Message-ID: <20180620001604.13BAC3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/000ac86c034f72f57804ccd684fbd3d32ec0b94a/ghc >--------------------------------------------------------------- commit 000ac86c034f72f57804ccd684fbd3d32ec0b94a Author: Ben Gamari Date: Mon Jun 18 12:08:15 2018 -0400 testsuite: Bump metrics for T5631 and T6048 It's unclear what these are due to but they are causing the Darwin builds to fail. >--------------------------------------------------------------- 000ac86c034f72f57804ccd684fbd3d32ec0b94a testsuite/tests/perf/compiler/all.T | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 346fa23..dfb8613 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -449,7 +449,7 @@ test('T5631', # 2014-04-04: 346389856 (x86 Windows, 64 bit machine) # 2014-12-01: 390199244 (Windows laptop) # 2016-04-06: 570137436 (amd64/Linux) many reasons - (wordsize(64), 1106015512, 5)]), + (wordsize(64), 1161885448, 5)]), # expected value: 774595008 (amd64/Linux): # expected value: 735486328 (amd64/Linux) 2012/12/12: # expected value: 690742040 (amd64/Linux) Call Arity improvements @@ -464,8 +464,9 @@ test('T5631', # 2017-02-17: 1517484488 (amd64/Linux) Type-indexed Typeable # 2017-03-03: 1065147968 (amd64/Linux) Share Typeable KindReps # 2017-03-31: 1037482512 (amd64/Linux) Fix memory leak in simplifier - # 2017-07-27: 1106015512 (Mac) Regresssion from tracking visibility in TypeEqOrigin - # should be fixed by #14037 + # 2017-07-27: 1106015512 (Mac) Regresssion from tracking visibility in TypeEqOrigin + # should be fixed by #14037 + # 2018-06-18: 1161885448 (Mac) Not entirely clear only_ways(['normal']) ], compile, @@ -723,7 +724,7 @@ test('T6048', # 2014-12-01: 49987836 (x86 Windows) # 2016-04-06: 55701280 (x86/Linux, 64-bit machine) - (wordsize(64), 90996312, 10)]) + (wordsize(64), 100574504, 10)]) # 2012-09-18 97247032 amd64/Linux # 2014-01-16 108578664 amd64/Linux (unknown, likely foldl-via-foldr) # 2014-01-18 95960720 amd64/Linux Call Arity improvements @@ -736,7 +737,8 @@ test('T6048', # 2016-03-11 108225624 amd64/Linux unknown reason sadly; likely gradual creep. # 2016-11-25 94327392 amd64/Linux Back down again hooray; still not sure why # 2017-02-17 115715592 amd64/Linux Type-indexed Typeable - # 2017-04-28 90996312 Join point refactoring + # 2017-04-28 90996312 Join point refactoring + # 2018-06-18 100574504 Darwin Unclear ], compile,['']) From git at git.haskell.org Wed Jun 20 00:16:07 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:07 +0000 (UTC) Subject: [commit: ghc] master: containers: Bump to 0.6.0.1 (50e7bff) Message-ID: <20180620001607.0C7B83ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/50e7bff7514ebbd74976c1a9fa0db7a8275178ae/ghc >--------------------------------------------------------------- commit 50e7bff7514ebbd74976c1a9fa0db7a8275178ae Author: Ben Gamari Date: Mon Jun 18 11:58:43 2018 -0400 containers: Bump to 0.6.0.1 Bumps containers submodule, among others. >--------------------------------------------------------------- 50e7bff7514ebbd74976c1a9fa0db7a8275178ae compiler/ghc.cabal.in | 2 +- ghc/ghc-bin.cabal.in | 2 +- libraries/Cabal | 2 +- libraries/containers | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/hpc | 2 +- libraries/libiserv/libiserv.cabal | 2 +- libraries/parallel | 2 +- testsuite/tests/backpack/should_run/bkprun05.bkp | 6 ++---- testsuite/tests/backpack/should_run/bkprun05.stderr | 4 ++-- testsuite/tests/backpack/should_run/bkprun06.bkp | 6 ++---- testsuite/tests/driver/T10970.stdout | 2 +- testsuite/tests/package/all.T | 6 +++--- utils/hpc/hpc-bin.cabal | 2 +- utils/hsc2hs | 2 +- utils/iserv/iserv.cabal | 2 +- 16 files changed, 21 insertions(+), 25 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 50e7bff7514ebbd74976c1a9fa0db7a8275178ae From git at git.haskell.org Wed Jun 20 00:16:10 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:10 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Add broken test for #15289 (7b8dcd9) Message-ID: <20180620001610.A69273ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7b8dcd90c5a622146dfdd3b162a1f1b1d262d5cf/ghc >--------------------------------------------------------------- commit 7b8dcd90c5a622146dfdd3b162a1f1b1d262d5cf Author: Ben Gamari Date: Mon Jun 18 19:10:10 2018 -0400 testsuite: Add broken test for #15289 The stderr output is merely a guess at what we should expect, but currently this is certainly broken. >--------------------------------------------------------------- 7b8dcd90c5a622146dfdd3b162a1f1b1d262d5cf testsuite/tests/patsyn/should_fail/T15289.hs | 5 +++++ testsuite/tests/patsyn/should_fail/T15289.stderr | 8 ++++++++ testsuite/tests/patsyn/should_fail/all.T | 1 + 3 files changed, 14 insertions(+) diff --git a/testsuite/tests/patsyn/should_fail/T15289.hs b/testsuite/tests/patsyn/should_fail/T15289.hs new file mode 100644 index 0000000..bc9143a --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T15289.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Oops where + +pattern What = True :: Maybe diff --git a/testsuite/tests/patsyn/should_fail/T15289.stderr b/testsuite/tests/patsyn/should_fail/T15289.stderr new file mode 100644 index 0000000..b19d7a0 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T15289.stderr @@ -0,0 +1,8 @@ + T15289.hs:5:16: error: + • Couldn't match expected type ‘Maybe’ with actual type ‘Bool’ + • In the pattern: True + In the pattern: True :: Maybe + In the declaration for pattern synonym ‘What’ + | + 5 | pattern What = True :: Maybe + | ^^^^ diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index d3a0a9b..269dc8d 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -42,3 +42,4 @@ test('T14380', normal, compile_fail, ['']) test('T14498', normal, compile_fail, ['']) test('T14552', normal, compile_fail, ['']) test('T14507', normal, compile_fail, ['-dsuppress-uniques']) +test('T15289', expect_broken(15289), compile_fail, ['']) From git at git.haskell.org Wed Jun 20 00:16:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:13 +0000 (UTC) Subject: [commit: ghc] master: testsuite: Skip T11627a and T11627b on Darwin (f0179e3) Message-ID: <20180620001613.7AFD73ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f0179e3adf6677243f587a05307a4a42833aa8d1/ghc >--------------------------------------------------------------- commit f0179e3adf6677243f587a05307a4a42833aa8d1 Author: Ben Gamari Date: Mon Jun 18 18:34:07 2018 -0400 testsuite: Skip T11627a and T11627b on Darwin Darwin tends to give us a very small stack which the retainer profiler tends to overflow. Strangely, this manifested on CircleCI yet not Harbormaster. See #15287 and #11627. >--------------------------------------------------------------- f0179e3adf6677243f587a05307a4a42833aa8d1 testsuite/tests/profiling/should_run/all.T | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 75882a3..5ee45c3 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -114,10 +114,16 @@ test('T5363', [], compile_and_run, ['']) test('profinline001', [], compile_and_run, ['']) -test('T11627a', [extra_ways(extra_prof_ways)], compile_and_run, ['']) +# Skip T11627a and T11627b on Darwin as it tends to give us a very small stack +# which the retainer profiler tends to overflow. See #15287 and #11627. +test('T11627a', [ extra_ways(extra_prof_ways) + , when(opsys('darwin'), skip) + ], + compile_and_run, ['']) test('T11627b', [ extra_run_opts('+RTS -i0 -RTS') # census after each GC , extra_ways(extra_prof_ways) + , when(opsys('darwin'), skip) , when(opsys('mingw32'), expect_broken_for(12236, ['prof_hc_hb'])) ] From git at git.haskell.org Wed Jun 20 00:16:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:16 +0000 (UTC) Subject: [commit: ghc] master: findPtr: don't search the nursery (436c0e9) Message-ID: <20180620001616.443C03ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/436c0e9b5e201b9121e4b48a7351dd42800eb7f3/ghc >--------------------------------------------------------------- commit 436c0e9b5e201b9121e4b48a7351dd42800eb7f3 Author: Simon Marlow Date: Tue Jun 19 17:10:55 2018 -0400 findPtr: don't search the nursery Test Plan: Used it in anger Reviewers: bgamari, erikd Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4873 >--------------------------------------------------------------- 436c0e9b5e201b9121e4b48a7351dd42800eb7f3 rts/Printer.c | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/rts/Printer.c b/rts/Printer.c index 4019ef1..291f529 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -13,6 +13,7 @@ #include "rts/Bytecodes.h" /* for InstrPtr */ #include "sm/Storage.h" +#include "sm/GCThread.h" #include "Hash.h" #include "Printer.h" #include "RtsUtils.h" @@ -825,11 +826,16 @@ findPtr(P_ p, int follow) int i = 0; searched = 0; +#if 0 + // We can't search the nursery, because we don't know which blocks contain + // valid data, because the bd->free pointers in the nursery are only reset + // just before a block is used. for (n = 0; n < n_capabilities; n++) { bd = nurseries[i].blocks; i = findPtrBlocks(p,bd,arr,arr_size,i); if (i >= arr_size) return; } +#endif for (g = 0; g < RtsFlags.GcFlags.generations; g++) { bd = generations[g].blocks; @@ -837,6 +843,13 @@ findPtr(P_ p, int follow) bd = generations[g].large_objects; i = findPtrBlocks(p,bd,arr,arr_size,i); if (i >= arr_size) return; + for (n = 0; n < n_capabilities; n++) { + i = findPtrBlocks(p, gc_threads[n]->gens[g].part_list, + arr, arr_size, i); + i = findPtrBlocks(p, gc_threads[n]->gens[g].todo_bd, + arr, arr_size, i); + } + if (i >= arr_size) return; } if (follow && i == 1) { debugBelch("-->\n"); From git at git.haskell.org Wed Jun 20 00:16:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:19 +0000 (UTC) Subject: [commit: ghc] master: Tweak wording in documentation (a5eaa0f) Message-ID: <20180620001619.141933ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a5eaa0f9371df8ca0c733ffe56fc1eb59d8ad6a4/ghc >--------------------------------------------------------------- commit a5eaa0f9371df8ca0c733ffe56fc1eb59d8ad6a4 Author: Victor Nawothnig Date: Tue Jun 19 17:10:28 2018 -0400 Tweak wording in documentation Reviewers: hvr, bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4871 >--------------------------------------------------------------- a5eaa0f9371df8ca0c733ffe56fc1eb59d8ad6a4 libraries/base/Control/Monad.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 09066c7..dd87418 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -139,11 +139,12 @@ filterM p = foldr (\ x -> liftA2 (\ flg -> if flg then (x:) else id) (p x infixr 1 <=<, >=> --- | Left-to-right Kleisli composition of monads. +-- | Left-to-right composition of Kleisli arrows. (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) f >=> g = \x -> f x >>= g --- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped. +-- | Right-to-left composition of Kleisli arrows. @('>=>')@, with the arguments +-- flipped. -- -- Note how this operator resembles function composition @('.')@: -- From git at git.haskell.org Wed Jun 20 00:16:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 00:16:21 +0000 (UTC) Subject: [commit: ghc] master: base: Add missing instances for Data.Ord.Down (21fa62f) Message-ID: <20180620001621.DF7BE3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/21fa62feace8524cbf4559ccfcc96b22cb07879f/ghc >--------------------------------------------------------------- commit 21fa62feace8524cbf4559ccfcc96b22cb07879f Author: Ben Gamari Date: Tue Jun 19 17:11:05 2018 -0400 base: Add missing instances for Data.Ord.Down Specifically: * MonadFix * MonadZip * Data * Foldable * Traversable * Eq1 * Ord1 * Read1 * Show1 * Generic * Generic1 Fixes #15098. Reviewers: RyanGlScott, hvr Reviewed By: RyanGlScott Subscribers: sjakobi, rwbarton, thomie, ekmett, carter GHC Trac Issues: #15098 Differential Revision: https://phabricator.haskell.org/D4870 >--------------------------------------------------------------- 21fa62feace8524cbf4559ccfcc96b22cb07879f libraries/base/Control/Monad/Fix.hs | 8 ++++++++ libraries/base/Control/Monad/Zip.hs | 7 +++++++ libraries/base/Data/Data.hs | 6 ++++++ libraries/base/Data/Foldable.hs | 4 ++++ libraries/base/Data/Functor/Classes.hs | 19 +++++++++++++++++++ libraries/base/Data/Traversable.hs | 5 +++++ libraries/base/GHC/Generics.hs | 7 +++++++ libraries/base/changelog.md | 5 +++++ .../tests/annotations/should_fail/annfail10.stderr | 4 ++-- testsuite/tests/ghci/scripts/T10963.stderr | 2 +- testsuite/tests/polykinds/T13393.stderr | 2 +- .../tests/typecheck/should_compile/T14273.stderr | 4 ++-- .../tests/typecheck/should_compile/holes2.stderr | 2 +- .../typecheck/should_compile/valid_hole_fits.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/T10971b.stderr | 8 ++++---- testsuite/tests/typecheck/should_fail/T12921.stderr | 2 +- testsuite/tests/typecheck/should_fail/T14884.stderr | 2 +- 17 files changed, 76 insertions(+), 15 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 21fa62feace8524cbf4559ccfcc96b22cb07879f From git at git.haskell.org Wed Jun 20 01:44:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 01:44:57 +0000 (UTC) Subject: [commit: ghc] master: Revert "containers: Bump to 0.6.0.1" (7363ba4) Message-ID: <20180620014457.055073ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7363ba4561d4c224efd73542e1e3f7fd524e6d6d/ghc >--------------------------------------------------------------- commit 7363ba4561d4c224efd73542e1e3f7fd524e6d6d Author: Ben Gamari Date: Tue Jun 19 21:40:55 2018 -0400 Revert "containers: Bump to 0.6.0.1" This reverts commit 50e7bff7514ebbd74976c1a9fa0db7a8275178ae. Reverts submodule changes. Sigh, the haskeline commit isn't quite upstream yet. >--------------------------------------------------------------- 7363ba4561d4c224efd73542e1e3f7fd524e6d6d compiler/ghc.cabal.in | 2 +- ghc/ghc-bin.cabal.in | 2 +- libraries/Cabal | 2 +- libraries/containers | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/hpc | 2 +- libraries/libiserv/libiserv.cabal | 2 +- libraries/parallel | 2 +- testsuite/tests/backpack/should_run/bkprun05.bkp | 6 ++++-- testsuite/tests/backpack/should_run/bkprun05.stderr | 4 ++-- testsuite/tests/backpack/should_run/bkprun06.bkp | 6 ++++-- testsuite/tests/driver/T10970.stdout | 2 +- testsuite/tests/package/all.T | 6 +++--- utils/hpc/hpc-bin.cabal | 2 +- utils/hsc2hs | 2 +- utils/iserv/iserv.cabal | 2 +- 16 files changed, 25 insertions(+), 21 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7363ba4561d4c224efd73542e1e3f7fd524e6d6d From git at git.haskell.org Wed Jun 20 13:42:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 13:42:45 +0000 (UTC) Subject: [commit: nofib] master: Typofix [ci skip] (f481777) Message-ID: <20180620134245.98E883ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/nofib On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f481777acf608c132db47cb8badb618ef39a0d6f/nofib >--------------------------------------------------------------- commit f481777acf608c132db47cb8badb618ef39a0d6f Author: Gabor Greif Date: Wed Jun 20 15:32:37 2018 +0200 Typofix [ci skip] >--------------------------------------------------------------- f481777acf608c132db47cb8badb618ef39a0d6f Simon-nofib-notes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Simon-nofib-notes b/Simon-nofib-notes index 9527859..0cc74f5 100644 --- a/Simon-nofib-notes +++ b/Simon-nofib-notes @@ -430,7 +430,7 @@ Same issue with GHC.IO.Encoding.UTF8 as treejoin cacheprof ~~~~~~~~~ -Sucessive runs with the same data can yield different allocation +Successive runs with the same data can yield different allocation totals, for some reason. Reported at https://ghc.haskell.org/trac/ghc/ticket/8611 From git at git.haskell.org Wed Jun 20 14:32:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 14:32:35 +0000 (UTC) Subject: [commit: ghc] master: A few more typofixes in docs/comments [ci skip] (e839ee2) Message-ID: <20180620143235.6D4783ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e839ee2f91f9bcd390ead98e830b9e1d7d7b9240/ghc >--------------------------------------------------------------- commit e839ee2f91f9bcd390ead98e830b9e1d7d7b9240 Author: Gabor Greif Date: Wed Jun 20 16:00:50 2018 +0200 A few more typofixes in docs/comments [ci skip] >--------------------------------------------------------------- e839ee2f91f9bcd390ead98e830b9e1d7d7b9240 compiler/basicTypes/MkId.hs | 2 +- compiler/main/SysTools/BaseDir.hs | 2 +- compiler/typecheck/TcMatches.hs | 2 +- compiler/utils/Pair.hs | 2 +- docs/users_guide/glasgow_exts.rst | 2 +- libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 772bce4..d6a52b4d 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -124,7 +124,7 @@ Note [magicIds] ~~~~~~~~~~~~~~~ The magicIds - * Are exported from GHC.Maic + * Are exported from GHC.Magic * Can be defined in Haskell (and are, in ghc-prim:GHC/Magic.hs). This definition at least generates Haddock documentation for them. diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index 7cd1998..85635df 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -201,7 +201,7 @@ foreign import WINDOWS_CCONV unsafe "dynamic" makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath #elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) -- on unix, this is a bit more confusing. --- The layout right now is somehting like +-- The layout right now is something like -- -- /bin/ghc-X.Y.Z <- wrapper script (1) -- /bin/ghc <- symlink to wrapper script (2) diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index e2c29ca..4ddf862 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -986,7 +986,7 @@ When typechecking we want to typecheck 'bar' in the knowledge that it should be an IO thing, pushing info from the context into the RHS. To do this, we check the rebindable syntax first, and push that information into (tcMonoExprNC rhs). -Otherwise the error shows up when cheking the rebindable syntax, and +Otherwise the error shows up when checking the rebindable syntax, and the expected/inferred stuff is back to front (see Trac #3613). Note [typechecking ApplicativeStmt] diff --git a/compiler/utils/Pair.hs b/compiler/utils/Pair.hs index 08b19be..036dab0 100644 --- a/compiler/utils/Pair.hs +++ b/compiler/utils/Pair.hs @@ -18,7 +18,7 @@ data Pair a = Pair { pFst :: a, pSnd :: a } -- Note that Pair is a *unary* type constructor -- whereas (,) is binary --- The important thing about Pair is that it has a *homogenous* +-- The important thing about Pair is that it has a *homogeneous* -- Functor instance, so you can easily apply the same function -- to both components instance Functor Pair where diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 1b19b4c..4a860ac 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -540,7 +540,7 @@ corresponds closely to the underlying bit-encoding of the number. In this notation floating point numbers are written using hexadecimal digits, and so the digits are interpreted using base 16, rather then the usual 10. This means that digits left of the decimal point correspond to positive -powers of 16, while the ones to the right correspond to negaitve ones. +powers of 16, while the ones to the right correspond to negative ones. You may also write an explicit exponent, which is similar to the exponent in decimal notation with the following differences: diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index eb517a9..b6f7c34 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -494,7 +494,7 @@ addForeignSource lang src = do runIO $ writeFile path src addForeignFilePath lang path --- | Same as 'addForeignSource', but expects to recieve a path pointing to the +-- | Same as 'addForeignSource', but expects to receive a path pointing to the -- foreign file instead of a 'String' of its contents. Consider using this in -- conjunction with 'addTempFile'. -- From git at git.haskell.org Wed Jun 20 15:51:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 15:51:53 +0000 (UTC) Subject: [commit: ghc] master: Fix gcc.exe: error: CreateProcess: No such file or directory (227ede4) Message-ID: <20180620155153.C622A3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/227ede4aa0b6df1a2b5a95dbba9f3cabc88bc15e/ghc >--------------------------------------------------------------- commit 227ede4aa0b6df1a2b5a95dbba9f3cabc88bc15e Author: Moritz Angermann Date: Tue Jun 19 23:27:53 2018 -0400 Fix gcc.exe: error: CreateProcess: No such file or directory When GHC links binaries on windows, we pass a -L and -l flag to gcc for each dependency in the transitive dependency closure. As this will usually overflow the command argument limit on windows, we use response files to pass all arguments to gcc. gcc however internally passes only the -l flags via a response file to the collect2 command, but puts the -L flags on the command line. As such if we pass enough -L flags to gcc--even via a response file--we will eventually overflow the command line argument length limit due to gcc passing them to collect2 without resorting to a response file. To prevent this from happening we move all lirbaries into a shared temporary folder, and only need to pass a single -L flag to gcc. Ideally however this was fixed in gcc. Reviewers: bgamari, Phyx Reviewed By: bgamari Subscribers: erikd, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4762 >--------------------------------------------------------------- 227ede4aa0b6df1a2b5a95dbba9f3cabc88bc15e compiler/main/DriverPipeline.hs | 10 ++++++++++ compiler/main/DynFlags.hs | 9 +++++++++ compiler/main/FileCleanup.hs | 17 ++++++++++++++++- compiler/main/Packages.hs | 10 +++++++++- 4 files changed, 44 insertions(+), 2 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index e4a9fa2..92e3455 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1744,6 +1744,16 @@ linkBinary' staticLink dflags o_files dep_packages = do in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath] | otherwise = ["-L" ++ l] + pkg_lib_path_opts <- + if gopt Opt_SingleLibFolder dflags + then do + libs <- getLibs dflags dep_packages + tmpDir <- newTempDir dflags + sequence_ [ copyFile lib (tmpDir basename) + | (lib, basename) <- libs] + return [ "-L" ++ tmpDir ] + else pure pkg_lib_path_opts + let dead_strip | gopt Opt_WholeArchiveHsLibs dflags = [] diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 77a6185..b10740b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -557,6 +557,13 @@ data GeneralFlag | Opt_OptimalApplicativeDo | Opt_VersionMacros | Opt_WholeArchiveHsLibs + -- copy all libs into a single folder prior to linking binaries + -- this should elivate the excessive command line limit restrictions + -- on windows, by only requiring a single -L argument instead of + -- one for each dependency. At the time of this writing, gcc + -- forwards all -L flags to the collect2 command without using a + -- response file and as such breaking apart. + | Opt_SingleLibFolder -- output style opts | Opt_ErrorSpans -- Include full span info in error messages, @@ -2820,6 +2827,8 @@ dynamic_flags_deps = [ #endif , make_ord_flag defGhcFlag "relative-dynlib-paths" (NoArg (setGeneralFlag Opt_RelativeDynlibPaths)) + , make_ord_flag defGhcFlag "copy-libs-when-linking" + (NoArg (setGeneralFlag Opt_SingleLibFolder)) , make_ord_flag defGhcFlag "pie" (NoArg (setGeneralFlag Opt_PICExecutable)) , make_ord_flag defGhcFlag "no-pie" (NoArg (unSetGeneralFlag Opt_PICExecutable)) diff --git a/compiler/main/FileCleanup.hs b/compiler/main/FileCleanup.hs index 5150b81..35bed61 100644 --- a/compiler/main/FileCleanup.hs +++ b/compiler/main/FileCleanup.hs @@ -3,7 +3,7 @@ module FileCleanup ( TempFileLifetime(..) , cleanTempDirs, cleanTempFiles, cleanCurrentModuleTempFiles , addFilesToClean, changeTempFilesLifetime - , newTempName, newTempLibName + , newTempName, newTempLibName, newTempDir , withSystemTempDirectory, withTempDirectory ) where @@ -132,6 +132,21 @@ newTempName dflags lifetime extn addFilesToClean dflags lifetime [filename] return filename +newTempDir :: DynFlags -> IO FilePath +newTempDir dflags + = do d <- getTempDir dflags + findTempDir (d "ghc_") + where + findTempDir :: FilePath -> IO FilePath + findTempDir prefix + = do n <- newTempSuffix dflags + let filename = prefix ++ show n + b <- doesDirectoryExist filename + if b then findTempDir prefix + else do createDirectory filename + -- see mkTempDir below; this is wrong: -> consIORef (dirsToClean dflags) filename + return filename + newTempLibName :: DynFlags -> TempFileLifetime -> Suffix -> IO (FilePath, FilePath, String) newTempLibName dflags lifetime extn diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index d9c198a..71354b1 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -50,7 +50,7 @@ module Packages ( collectArchives, collectIncludeDirs, collectLibraryPaths, collectLinkOpts, - packageHsLibs, + packageHsLibs, getLibs, -- * Utils unwireUnitId, @@ -1761,6 +1761,14 @@ collectArchives dflags pc = where searchPaths = nub . filter notNull . libraryDirsForWay dflags $ pc libs = packageHsLibs dflags pc ++ extraLibraries pc +getLibs :: DynFlags -> [PreloadUnitId] -> IO [(String,String)] +getLibs dflags pkgs = do + ps <- getPreloadPackagesAnd dflags pkgs + fmap concat . forM ps $ \p -> do + let candidates = [ (l f, f) | l <- collectLibraryPaths dflags [p] + , f <- (\n -> "lib" ++ n ++ ".a") <$> packageHsLibs dflags p ] + filterM (doesFileExist . fst) candidates + packageHsLibs :: DynFlags -> PackageConfig -> [String] packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) where From git at git.haskell.org Wed Jun 20 15:51:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 15:51:56 +0000 (UTC) Subject: [commit: ghc] master: rts: A bit of cleanup of posix itimer implementation (76e110f) Message-ID: <20180620155156.92DC53ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/76e110fb3219f4e4b3d3fdef42f0027cbd13d49c/ghc >--------------------------------------------------------------- commit 76e110fb3219f4e4b3d3fdef42f0027cbd13d49c Author: Ben Gamari Date: Tue Jun 19 23:18:12 2018 -0400 rts: A bit of cleanup of posix itimer implementation * Use bool instead of HsBool * Use barf instead of sysErrorBelch; stg_exit Test Plan: Validate Reviewers: erikd, simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4874 >--------------------------------------------------------------- 76e110fb3219f4e4b3d3fdef42f0027cbd13d49c rts/posix/itimer/Pthread.c | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/rts/posix/itimer/Pthread.c b/rts/posix/itimer/Pthread.c index c45d57e..f591d5e 100644 --- a/rts/posix/itimer/Pthread.c +++ b/rts/posix/itimer/Pthread.c @@ -84,11 +84,11 @@ static Time itimer_interval = DEFAULT_TICK_INTERVAL; // Should we be firing ticks? // Writers to this must hold the mutex below. -static volatile HsBool stopped = 0; +static volatile bool stopped = false; // should the ticker thread exit? // This can be set without holding the mutex. -static volatile HsBool exited = 1; +static volatile bool exited = true; // Signaled when we want to (re)start the timer static Condition start_cond; @@ -109,15 +109,13 @@ static void *itimer_thread_func(void *_handle_tick) timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC); if (timerfd == -1) { - sysErrorBelch("timerfd_create"); - stg_exit(EXIT_FAILURE); + barf("timerfd_create"); } if (!TFD_CLOEXEC) { - fcntl(timerfd, F_SETFD, FD_CLOEXEC); + fcntl(timerfd, F_SETFD, FD_CLOEXEC); } if (timerfd_settime(timerfd, 0, &it, NULL)) { - sysErrorBelch("timerfd_settime"); - stg_exit(EXIT_FAILURE); + barf("timerfd_settime"); } #endif @@ -158,8 +156,8 @@ void initTicker (Time interval, TickProc handle_tick) { itimer_interval = interval; - stopped = 0; - exited = 0; + stopped = false; + exited = false; initCondition(&start_cond); initMutex(&mutex); @@ -173,8 +171,7 @@ initTicker (Time interval, TickProc handle_tick) pthread_setname_np(thread, "ghc_ticker"); #endif } else { - sysErrorBelch("Itimer: Failed to spawn thread"); - stg_exit(EXIT_FAILURE); + barf("Itimer: Failed to spawn thread"); } } @@ -201,7 +198,7 @@ void exitTicker (bool wait) { ASSERT(!exited); - exited = 1; + exited = true; // ensure that ticker wakes up if stopped startTicker(); From git at git.haskell.org Wed Jun 20 15:51:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 15:51:59 +0000 (UTC) Subject: [commit: ghc] master: configure: Fix libnuma detection logic (942e6c9) Message-ID: <20180620155159.5FBE73ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/942e6c9ecaf12d2834ca5352c6f51e8419efc57c/ghc >--------------------------------------------------------------- commit 942e6c9ecaf12d2834ca5352c6f51e8419efc57c Author: Ben Gamari Date: Tue Jun 19 23:16:26 2018 -0400 configure: Fix libnuma detection logic Test Plan: Validate with numa support Subscribers: rwbarton, thomie, erikd, carter Differential Revision: https://phabricator.haskell.org/D4869 >--------------------------------------------------------------- 942e6c9ecaf12d2834ca5352c6f51e8419efc57c configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 622ec96..1f98407 100644 --- a/configure.ac +++ b/configure.ac @@ -1263,7 +1263,7 @@ if test "$ac_cv_header_numa_h$ac_cv_header_numaif_h" = "yesyes" ; then AC_CHECK_LIB(numa, numa_available,HaveLibNuma=1) fi AC_DEFINE_UNQUOTED([HAVE_LIBNUMA], [$HaveLibNuma], [Define to 1 if you have libnuma]) -if test $HaveLibNuma = "YES" ; then +if test $HaveLibNuma = "1" ; then AC_SUBST([CabalHaveLibNuma],[True]) else AC_SUBST([CabalHaveLibNuma],[False]) From git at git.haskell.org Wed Jun 20 15:52:03 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 15:52:03 +0000 (UTC) Subject: [commit: ghc] master: Allow :info for (~) in GHCi (f4dce6c) Message-ID: <20180620155203.0E00A3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f4dce6cfd71d2a1dc2e281f19cae85e62aaf6b8e/ghc >--------------------------------------------------------------- commit f4dce6cfd71d2a1dc2e281f19cae85e62aaf6b8e Author: Ryan Scott Date: Tue Jun 19 23:16:39 2018 -0400 Allow :info for (~) in GHCi `(~)` is not an identifier according to GHC's parser, which is why GHCi's `:info` command wouldn't work on it. To rectify this, we apply the same fix that was put in place for `(->)`: add `(~)` to GHC's `identifier` parser production. Test Plan: make test TEST=T10059 Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, mpickering, carter GHC Trac Issues: #10059 Differential Revision: https://phabricator.haskell.org/D4877 >--------------------------------------------------------------- f4dce6cfd71d2a1dc2e281f19cae85e62aaf6b8e compiler/parser/Parser.y | 4 +++- testsuite/tests/ghci/scripts/T10059.script | 5 +++++ testsuite/tests/ghci/scripts/T10059.stdout | 9 +++++++++ testsuite/tests/ghci/scripts/all.T | 1 + 4 files changed, 18 insertions(+), 1 deletion(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 066ee42..0e93dd0 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -626,7 +626,9 @@ identifier :: { Located RdrName } | qvarop { $1 } | qconop { $1 } | '(' '->' ')' {% ams (sLL $1 $> $ getRdrName funTyCon) - [mj AnnOpenP $1,mu AnnRarrow $2,mj AnnCloseP $3] } + [mop $1,mu AnnRarrow $2,mcp $3] } + | '(' '~' ')' {% ams (sLL $1 $> $ eqTyCon_RDR) + [mop $1,mj AnnTilde $2,mcp $3] } ----------------------------------------------------------------------------- -- Backpack stuff diff --git a/testsuite/tests/ghci/scripts/T10059.script b/testsuite/tests/ghci/scripts/T10059.script new file mode 100644 index 0000000..d352b9f --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10059.script @@ -0,0 +1,5 @@ +:set -XTypeOperators +:i (~) +:k (~) +:set -fprint-equality-relations +:i (~) diff --git a/testsuite/tests/ghci/scripts/T10059.stdout b/testsuite/tests/ghci/scripts/T10059.stdout new file mode 100644 index 0000000..26e1e7e2 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10059.stdout @@ -0,0 +1,9 @@ +class (a ~ b) => (~) (a :: k) (b :: k) + -- Defined in ‘Data.Type.Equality’ +instance [incoherent] forall k (a :: k) (b :: k). (a ~ b) => a ~ b + -- Defined in ‘Data.Type.Equality’ +(~) :: k -> k -> Constraint +class (a ~~ b) => (~) (a :: k) (b :: k) + -- Defined in ‘Data.Type.Equality’ +instance [incoherent] forall k (a :: k) (b :: k). (a ~~ b) => a ~ b + -- Defined in ‘Data.Type.Equality’ diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 163ff0c..29fbdf8 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -201,6 +201,7 @@ test('T9878', [], ghci_script, ['T9878.script']) test('T9878b', [extra_run_opts('-fobject-code')], ghci_script, ['T9878b.script']) test('T10018', normal, ghci_script, ['T10018.script']) +test('T10059', normal, ghci_script, ['T10059.script']) test('T10122', normal, ghci_script, ['T10122.script']) test('T10321', normal, ghci_script, ['T10321.script']) From git at git.haskell.org Wed Jun 20 15:52:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 15:52:05 +0000 (UTC) Subject: [commit: ghc] master: Remove HsEqTy and XEqTy (b948398) Message-ID: <20180620155205.E597E3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b9483981d128f55d8dae3f434f49fa6b5b30c779/ghc >--------------------------------------------------------------- commit b9483981d128f55d8dae3f434f49fa6b5b30c779 Author: Ryan Scott Date: Tue Jun 19 23:17:02 2018 -0400 Remove HsEqTy and XEqTy After commit d650729f9a0f3b6aa5e6ef2d5fba337f6f70fa60, the `HsEqTy` constructor of `HsType` is essentially dead code. Given that we want to remove `HsEqTy` anyway as a part of #10056 (comment:27), let's just rip it out. Bumps the haddock submodule. Test Plan: ./validate Reviewers: goldfire, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #10056 Differential Revision: https://phabricator.haskell.org/D4876 >--------------------------------------------------------------- b9483981d128f55d8dae3f434f49fa6b5b30c779 compiler/deSugar/DsMeta.hs | 5 ----- compiler/hsSyn/Convert.hs | 7 ++++--- compiler/hsSyn/HsExtension.hs | 2 -- compiler/hsSyn/HsTypes.hs | 17 ----------------- compiler/rename/RnTypes.hs | 9 --------- compiler/typecheck/TcHsType.hs | 8 -------- utils/haddock | 2 +- 7 files changed, 5 insertions(+), 45 deletions(-) diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 832473e..bb3c46b 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1121,11 +1121,6 @@ repTy (HsSumTy _ tys) = do tys1 <- repLTys tys repTy (HsOpTy _ ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1) `nlHsAppTy` ty2) repTy (HsParTy _ t) = repLTy t -repTy (HsEqTy _ t1 t2) = do - t1' <- repLTy t1 - t2' <- repLTy t2 - eq <- repTequality - repTapps eq [t1', t2'] repTy (HsStarTy _ _) = repTStar repTy (HsKindSig _ t k) = do t1 <- repLTy t diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 3da163c..329d000 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -18,6 +18,7 @@ import GhcPrelude import HsSyn as Hs import qualified Class +import PrelNames import RdrName import qualified Name import Module @@ -28,7 +29,6 @@ import SrcLoc import Type import qualified Coercion ( Role(..) ) import TysWiredIn -import TysPrim (eqPrimTyCon) import BasicTypes as Hs import ForeignCall import Unique @@ -1378,10 +1378,11 @@ cvtTypeKind ty_str ty (noLoc (getRdrName constraintKindTyCon))) EqualityT - | [x',y'] <- tys' -> returnL (HsEqTy noExt x' y') + | [x',y'] <- tys' -> + returnL (HsOpTy noExt x' (noLoc eqTyCon_RDR) y') | otherwise -> mk_apps (HsTyVar noExt NotPromoted - (noLoc (getRdrName eqPrimTyCon))) tys' + (noLoc eqTyCon_RDR)) tys' _ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty)) } diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index 7243a65..52e19b9 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -910,7 +910,6 @@ type family XSumTy x type family XOpTy x type family XParTy x type family XIParamTy x -type family XEqTy x type family XStarTy x type family XKindSig x type family XSpliceTy x @@ -937,7 +936,6 @@ type ForallXType (c :: * -> Constraint) (x :: *) = , c (XOpTy x) , c (XParTy x) , c (XIParamTy x) - , c (XEqTy x) , c (XStarTy x) , c (XKindSig x) , c (XSpliceTy x) diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 8e959f7..6d14d7d 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -548,18 +548,6 @@ data HsType pass -- For details on above see note [Api annotations] in ApiAnnotation - | HsEqTy (XEqTy pass) - (LHsType pass) -- ty1 ~ ty2 - (LHsType pass) -- Always allowed even without - -- TypeOperators, and has special - -- kinding rule - -- ^ - -- > ty1 ~ ty2 - -- - -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde' - - -- For details on above see note [Api annotations] in ApiAnnotation - | HsStarTy (XStarTy pass) Bool -- Is this the Unicode variant? -- Note [HsStarTy] @@ -665,7 +653,6 @@ type instance XSumTy (GhcPass _) = NoExt type instance XOpTy (GhcPass _) = NoExt type instance XParTy (GhcPass _) = NoExt type instance XIParamTy (GhcPass _) = NoExt -type instance XEqTy (GhcPass _) = NoExt type instance XStarTy (GhcPass _) = NoExt type instance XKindSig (GhcPass _) = NoExt @@ -1395,9 +1382,6 @@ ppr_mono_ty (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys) ppr_mono_ty (HsTyLit _ t) = ppr_tylit t ppr_mono_ty (HsWildCardTy {}) = char '_' -ppr_mono_ty (HsEqTy _ ty1 ty2) - = ppr_mono_lty ty1 <+> char '~' <+> ppr_mono_lty ty2 - ppr_mono_ty (HsStarTy _ isUni) = char (if isUni then '★' else '*') ppr_mono_ty (HsAppTy _ fun_ty arg_ty) @@ -1457,7 +1441,6 @@ hsTypeNeedsParens p = go go (HsExplicitTupleTy{}) = False go (HsTyLit{}) = False go (HsWildCardTy{}) = False - go (HsEqTy{}) = p >= opPrec go (HsStarTy{}) = False go (HsAppTy{}) = p >= appPrec go (HsOpTy{}) = p >= opPrec diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index ca4986f..c8ddd0a 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -629,12 +629,6 @@ rnHsTyKi env t@(HsIParamTy _ n ty) ; (ty', fvs) <- rnLHsTyKi env ty ; return (HsIParamTy noExt n ty', fvs) } -rnHsTyKi env t@(HsEqTy _ ty1 ty2) - = do { checkPolyKinds env t - ; (ty1', fvs1) <- rnLHsTyKi env ty1 - ; (ty2', fvs2) <- rnLHsTyKi env ty2 - ; return (HsEqTy noExt ty1' ty2', fvs1 `plusFV` fvs2) } - rnHsTyKi _ (HsStarTy _ isUni) = return (HsStarTy noExt isUni, emptyFVs) @@ -1064,7 +1058,6 @@ collectAnonWildCards lty = go lty HsOpTy _ ty1 _ ty2 -> go ty1 `mappend` go ty2 HsParTy _ ty -> go ty HsIParamTy _ _ ty -> go ty - HsEqTy _ ty1 ty2 -> go ty1 `mappend` go ty2 HsKindSig _ ty kind -> go ty `mappend` go kind HsDocTy _ ty _ -> go ty HsBangTy _ _ ty -> go ty @@ -1745,8 +1738,6 @@ extract_lty t_or_k (L _ ty) acc HsFunTy _ ty1 ty2 -> extract_lty t_or_k ty1 =<< extract_lty t_or_k ty2 acc HsIParamTy _ _ ty -> extract_lty t_or_k ty acc - HsEqTy _ ty1 ty2 -> extract_lty t_or_k ty1 =<< - extract_lty t_or_k ty2 acc HsOpTy _ ty1 tv ty2 -> extract_tv t_or_k tv =<< extract_lty t_or_k ty1 =<< extract_lty t_or_k ty2 acc diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 20bfc95..205ec9e 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -796,14 +796,6 @@ tc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind ; checkExpectedKind rn_ty (mkClassPred ipClass [n',ty']) constraintKind exp_kind } -tc_hs_type mode rn_ty@(HsEqTy _ ty1 ty2) exp_kind - = do { (ty1', kind1) <- tc_infer_lhs_type mode ty1 - ; (ty2', kind2) <- tc_infer_lhs_type mode ty2 - ; ty2'' <- checkExpectedKind (unLoc ty2) ty2' kind2 kind1 - ; eq_tc <- tcLookupTyCon eqTyConName - ; let ty' = mkNakedTyConApp eq_tc [kind1, ty1', ty2''] - ; checkExpectedKind rn_ty ty' constraintKind exp_kind } - tc_hs_type _ rn_ty@(HsStarTy _ _) exp_kind -- Desugaring 'HsStarTy' to 'Data.Kind.Type' here means that we don't have to -- handle it in 'coreView' and 'tcView'. diff --git a/utils/haddock b/utils/haddock index 5e3cf5d..679f612 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 5e3cf5d8868323079ff5494a8225b0467404a5d1 +Subproject commit 679f61210b18acd6299687fca66c81196ca358a5 From git at git.haskell.org Wed Jun 20 19:25:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 19:25:46 +0000 (UTC) Subject: [commit: packages/haskeline] master: Bump upper bound on containers (8b73041) Message-ID: <20180620192546.F24C13ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/8b7304146156089cd3d11ee1d809982fc0870a01 >--------------------------------------------------------------- commit 8b7304146156089cd3d11ee1d809982fc0870a01 Author: Ben Gamari Date: Mon Jun 18 12:33:26 2018 -0400 Bump upper bound on containers >--------------------------------------------------------------- 8b7304146156089cd3d11ee1d809982fc0870a01 haskeline.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskeline.cabal b/haskeline.cabal index 6620f53..1750d40 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -43,7 +43,7 @@ Library -- We require ghc>=7.4.1 (base>=4.5) to use the base library encodings, even -- though it was implemented in earlier releases, due to GHC bug #5436 which -- wasn't fixed until 7.4.1 - Build-depends: base >=4.5 && < 4.13, containers>=0.4 && < 0.6, + Build-depends: base >=4.5 && < 4.13, containers>=0.4 && < 0.7, directory>=1.1 && < 1.4, bytestring>=0.9 && < 0.11, filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.6, process >= 1.0 && < 1.7, stm >= 2.4 && < 2.6 From git at git.haskell.org Wed Jun 20 19:25:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 19:25:49 +0000 (UTC) Subject: [commit: packages/haskeline] master: Merge pull request #86 from bgamari/patch-2 (19b0be5) Message-ID: <20180620192549.03D2C3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/haskeline On branch : master Link : http://git.haskell.org/packages/haskeline.git/commitdiff/19b0be5687e933494c462a72cd7348c397aa3406 >--------------------------------------------------------------- commit 19b0be5687e933494c462a72cd7348c397aa3406 Merge: 4168a4a 8b73041 Author: Judah Jacobson Date: Wed Jun 20 09:46:15 2018 -0700 Merge pull request #86 from bgamari/patch-2 Bump upper bound on containers >--------------------------------------------------------------- 19b0be5687e933494c462a72cd7348c397aa3406 haskeline.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) From git at git.haskell.org Wed Jun 20 19:26:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 19:26:02 +0000 (UTC) Subject: [commit: ghc] master: containers: Bump to 0.6.0.1 (c35ad6e) Message-ID: <20180620192602.D1B703ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c35ad6e0b3c62976e6251f1e9c47fe83ff15f4ce/ghc >--------------------------------------------------------------- commit c35ad6e0b3c62976e6251f1e9c47fe83ff15f4ce Author: Ben Gamari Date: Mon Jun 18 11:58:43 2018 -0400 containers: Bump to 0.6.0.1 Bumps containers submodule, among others. >--------------------------------------------------------------- c35ad6e0b3c62976e6251f1e9c47fe83ff15f4ce compiler/ghc.cabal.in | 2 +- ghc/ghc-bin.cabal.in | 2 +- libraries/Cabal | 2 +- libraries/containers | 2 +- libraries/ghci/ghci.cabal.in | 2 +- libraries/haskeline | 2 +- libraries/hpc | 2 +- libraries/libiserv/libiserv.cabal | 2 +- libraries/parallel | 2 +- testsuite/tests/backpack/should_run/bkprun05.bkp | 6 ++---- testsuite/tests/backpack/should_run/bkprun05.stderr | 4 ++-- testsuite/tests/backpack/should_run/bkprun06.bkp | 6 ++---- testsuite/tests/driver/T10970.stdout | 2 +- testsuite/tests/package/all.T | 6 +++--- utils/hpc/hpc-bin.cabal | 2 +- utils/hsc2hs | 2 +- utils/iserv/iserv.cabal | 2 +- 17 files changed, 22 insertions(+), 26 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc c35ad6e0b3c62976e6251f1e9c47fe83ff15f4ce From git at git.haskell.org Wed Jun 20 22:27:12 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 22:27:12 +0000 (UTC) Subject: [commit: ghc] ghc-8.6's head updated: containers: Bump to 0.6.0.1 (c35ad6e) Message-ID: <20180620222712.C57123ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'ghc-8.6' now includes: 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 From git at git.haskell.org Wed Jun 20 22:27:28 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 20 Jun 2018 22:27:28 +0000 (UTC) Subject: [commit: ghc] master: configure: Set version to 8.7 (c7cd5a6) Message-ID: <20180620222728.35CF33ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c7cd5a643557a80fbeb96663281f2ab7523a2055/ghc >--------------------------------------------------------------- commit c7cd5a643557a80fbeb96663281f2ab7523a2055 Author: Ben Gamari Date: Wed Jun 20 17:11:20 2018 -0400 configure: Set version to 8.7 Bumps haddock submodule. >--------------------------------------------------------------- c7cd5a643557a80fbeb96663281f2ab7523a2055 configure.ac | 2 +- libraries/libiserv/libiserv.cabal | 4 ++-- libraries/template-haskell/template-haskell.cabal | 2 +- utils/haddock | 2 +- utils/iserv/iserv.cabal | 6 +++--- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/configure.ac b/configure.ac index 1f98407..5301a6e 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.6.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.7.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} diff --git a/libraries/libiserv/libiserv.cabal b/libraries/libiserv/libiserv.cabal index 183e777..f29875c 100644 --- a/libraries/libiserv/libiserv.cabal +++ b/libraries/libiserv/libiserv.cabal @@ -1,5 +1,5 @@ Name: libiserv -Version: 8.6.1 +Version: 8.7.1 Copyright: XXX License: BSD3 License-File: LICENSE @@ -25,7 +25,7 @@ Library bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, - ghci == 8.6.* + ghci == 8.7.* if flag(network) Exposed-Modules: Remote.Message , Remote.Slave diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index 590babd..6cd156c 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -52,7 +52,7 @@ Library build-depends: base >= 4.9 && < 4.13, - ghc-boot-th == 8.6.*, + ghc-boot-th == 8.7.*, pretty == 1.1.* ghc-options: -Wall diff --git a/utils/haddock b/utils/haddock index 679f612..3266a96 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 679f61210b18acd6299687fca66c81196ca358a5 +Subproject commit 3266a962f7b6083b4b48cb66e70c62e3157df930 diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal index 684da94..af0e385 100644 --- a/utils/iserv/iserv.cabal +++ b/utils/iserv/iserv.cabal @@ -1,5 +1,5 @@ Name: iserv -Version: 8.6.1 +Version: 8.7.1 Copyright: XXX License: BSD3 -- XXX License-File: LICENSE @@ -35,8 +35,8 @@ Executable iserv bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, - ghci == 8.6.*, - libiserv == 8.6.* + ghci == 8.7.*, + libiserv == 8.7.* if os(windows) Cpp-Options: -DWINDOWS From git at git.haskell.org Thu Jun 21 07:56:23 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Jun 2018 07:56:23 +0000 (UTC) Subject: [commit: ghc] master: Fix incorrect GHC versioning (3048a87) Message-ID: <20180621075623.3EED63ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3048a87a3f2ef97d9f6559064d7a32ec7566542b/ghc >--------------------------------------------------------------- commit 3048a87a3f2ef97d9f6559064d7a32ec7566542b Author: Herbert Valerio Riedel Date: Thu Jun 21 09:54:50 2018 +0200 Fix incorrect GHC versioning This is an unstable release, hence it must be x.y.$DATE, rather than x.y.0.$DATE which would denote a stable pre-release snapshot. >--------------------------------------------------------------- 3048a87a3f2ef97d9f6559064d7a32ec7566542b configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 5301a6e..ac464b6 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.7.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.7], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} From git at git.haskell.org Thu Jun 21 15:31:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 21 Jun 2018 15:31:16 +0000 (UTC) Subject: [commit: ghc] master: Drop redundant Note (50a35e5) Message-ID: <20180621153116.77B773ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/50a35e59034c8616ce5b0fcd3ca2b1757273a552/ghc >--------------------------------------------------------------- commit 50a35e59034c8616ce5b0fcd3ca2b1757273a552 Author: Ryan Scott Date: Thu Jun 21 11:29:53 2018 -0400 Drop redundant Note Richard added a much better version of this Note in commit 26e9806ada8823160dd63ca2c34556e5848b2f45, so I've decided to point to that instead. >--------------------------------------------------------------- 50a35e59034c8616ce5b0fcd3ca2b1757273a552 compiler/typecheck/TcHsType.hs | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 205ec9e..322863f 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1204,7 +1204,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon -- We cannot promote a data constructor with a context that contains -- constraints other than equalities, so error if we find one. - -- See Note [Don't promote data constructors with non-equality contexts] + -- See Note [Constraints handled in types] in Inst. dc_theta_illegal_constraint :: ThetaType -> Maybe PredType dc_theta_illegal_constraint = find go where @@ -1378,25 +1378,6 @@ in the e2 example, we'll desugar the type, zonking the kind unification variables as we go. When we encounter the unconstrained kappa, we want to default it to '*', not to (Any *). -Note [Don't promote data constructors with non-equality contexts] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -With -XTypeInType, one can promote almost any data constructor. There is a -notable exception to this rule, however: data constructors that contain -non-equality constraints, such as: - - data Foo a where - MkFoo :: Show a => Foo a - -MkFoo cannot be promoted since GHC cannot produce evidence for (Show a) at the -kind level. Therefore, we check the context of each data constructor before -promotion, and give a sensible error message if the context contains an illegal -constraint. - -Note that equality constraints (i.e, (~) and (~~)) /are/ -permitted inside data constructor contexts. All other constraints are -off-limits, however (and likely will remain off-limits until dependent types -become a reality in GHC). - Help functions for type applications ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -} From git at git.haskell.org Fri Jun 22 12:11:37 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 12:11:37 +0000 (UTC) Subject: [commit: ghc] master: Instances in no-evidence implications (32eb419) Message-ID: <20180622121137.31E323ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/32eb41994f7448caf5fb6b06ed0678d79d029deb/ghc >--------------------------------------------------------------- commit 32eb41994f7448caf5fb6b06ed0678d79d029deb Author: Simon Peyton Jones Date: Fri Jun 22 11:27:47 2018 +0100 Instances in no-evidence implications Trac #15290 showed that it's possible that we might attempt to use a quantified constraint to solve an equality in a situation where we don't have anywhere to put the evidence bindings. This made GHC crash. This patch stops the crash, but still rejects the pogram. See Note [Instances in no-evidence implications] in TcInteract. Finding this bug revealed another lurking bug: * An infelicity in the treatment of superclasses -- we were expanding them locally at the leaves, rather than at their binding site; see (3a) in Note [The superclass story]. As a consequence, TcRnTypes.superclassesMightHelp must look inside implications. In more detail: * Stop the crash, by making TcInteract.chooseInstance test for the no-evidence-bindings case. In that case we simply don't use the instance. This entailed a slight change to the type of chooseInstance. * Make TcSMonad.getPendingScDicts (now renamed getPendingGivenScs) return only Givens from the /current level/; and make TcRnTypes.superClassesMightHelp look inside implications. * Refactor the simpl_loop and superclass-expansion stuff in TcSimplify. The logic is much easier to understand now, and has less duplication. >--------------------------------------------------------------- 32eb41994f7448caf5fb6b06ed0678d79d029deb compiler/typecheck/TcCanonical.hs | 9 ++ compiler/typecheck/TcInteract.hs | 46 +++++-- compiler/typecheck/TcRnTypes.hs | 28 ++++- compiler/typecheck/TcSMonad.hs | 46 ++++--- compiler/typecheck/TcSimplify.hs | 134 +++++++++------------ testsuite/tests/quantified-constraints/T15290.hs | 35 ++++++ testsuite/tests/quantified-constraints/T15290a.hs | 35 ++++++ .../tests/quantified-constraints/T15290a.stderr | 22 ++++ testsuite/tests/quantified-constraints/all.T | 3 + .../typecheck/should_fail/TcCoercibleFail.stderr | 3 +- 10 files changed, 252 insertions(+), 109 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 32eb41994f7448caf5fb6b06ed0678d79d029deb From git at git.haskell.org Fri Jun 22 12:11:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 12:11:39 +0000 (UTC) Subject: [commit: ghc] master: Refactor try_solve_fromInstance in shortCutSolver (e065369) Message-ID: <20180622121139.EF94B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e0653697366670cd65ecedf680c2aa131821d68f/ghc >--------------------------------------------------------------- commit e0653697366670cd65ecedf680c2aa131821d68f Author: Simon Peyton Jones Date: Fri Jun 22 11:28:37 2018 +0100 Refactor try_solve_fromInstance in shortCutSolver This patch just removes the CtLoc parameter from trySolveFromInstance, since it can just as easily (and more uniformly) be gotten from the CtEvidence it is trying to solve. >--------------------------------------------------------------- e0653697366670cd65ecedf680c2aa131821d68f compiler/typecheck/TcInteract.hs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 2ad93b0..97d1dde 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -563,7 +563,7 @@ solveOneFromTheOther ev_i ev_w ; return (same_level_strategy binds) } | otherwise -- Both are Given, levels differ - = return (different_level_strategy) + = return different_level_strategy where pred = ctEvPred ev_i loc_i = ctEvLoc ev_i @@ -573,12 +573,12 @@ solveOneFromTheOther ev_i ev_w ev_id_i = ctEvEvId ev_i ev_id_w = ctEvEvId ev_w - different_level_strategy + different_level_strategy -- Both Given | isIPPred pred, lvl_w > lvl_i = KeepWork | lvl_w < lvl_i = KeepWork | otherwise = KeepInert - same_level_strategy binds -- Both Given + same_level_strategy binds -- Both Given | GivenOrigin (InstSC s_i) <- ctLocOrigin loc_i = case ctLocOrigin loc_w of GivenOrigin (InstSC s_w) | s_w < s_i -> KeepWork @@ -1012,8 +1012,7 @@ IncoherentInstances is `1`. If we were to do the optimization, the output of Note [Shortcut try_solve_from_instance] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The workhorse of the short-cut solver is - try_solve_from_instance :: CtLoc - -> (EvBindMap, DictMap CtEvidence) + try_solve_from_instance :: (EvBindMap, DictMap CtEvidence) -> CtEvidence -- Solve this -> MaybeT TcS (EvBindMap, DictMap CtEvidence) Note that: @@ -1103,7 +1102,7 @@ shortCutSolver dflags ev_w ev_i getTcEvBindsMap ev_binds_var ; solved_dicts <- getSolvedDicts - ; mb_stuff <- runMaybeT $ try_solve_from_instance loc_w + ; mb_stuff <- runMaybeT $ try_solve_from_instance (ev_binds, solved_dicts) ev_w ; case mb_stuff of @@ -1122,12 +1121,13 @@ shortCutSolver dflags ev_w ev_i loc_w = ctEvLoc ev_w try_solve_from_instance -- See Note [Shortcut try_solve_from_instance] - :: CtLoc -> (EvBindMap, DictMap CtEvidence) -> CtEvidence + :: (EvBindMap, DictMap CtEvidence) -> CtEvidence -> MaybeT TcS (EvBindMap, DictMap CtEvidence) - try_solve_from_instance loc (ev_binds, solved_dicts) ev + try_solve_from_instance (ev_binds, solved_dicts) ev | let pred = ctEvPred ev + loc = ctEvLoc ev , ClassPred cls tys <- classifyPredType pred - = do { inst_res <- lift $ matchGlobalInst dflags True cls tys loc_w + = do { inst_res <- lift $ matchGlobalInst dflags True cls tys loc ; case inst_res of OneInst { lir_new_theta = preds , lir_mk_ev = mk_ev @@ -1141,9 +1141,9 @@ shortCutSolver dflags ev_w ev_i -- up in a loop while solving recursive dictionaries. ; lift $ traceTcS "shortCutSolver: found instance" (ppr preds) - ; lift $ checkReductionDepth loc' pred + ; lift $ checkReductionDepth loc pred - ; evc_vs <- mapM (new_wanted_cached solved_dicts') preds + ; evc_vs <- mapM (new_wanted_cached loc' solved_dicts') preds -- Emit work for subgoals but use our local cache -- so we can solve recursive dictionaries. @@ -1151,7 +1151,7 @@ shortCutSolver dflags ev_w ev_i ev_binds' = extendEvBinds ev_binds $ mkWantedEvBind (ctEvEvId ev) ev_tm - ; foldlM (try_solve_from_instance loc') + ; foldlM try_solve_from_instance (ev_binds', solved_dicts') (freshGoals evc_vs) } @@ -1162,12 +1162,12 @@ shortCutSolver dflags ev_w ev_i -- Use a local cache of solved dicts while emitting EvVars for new work -- We bail out of the entire computation if we need to emit an EvVar for -- a subgoal that isn't a ClassPred. - new_wanted_cached :: DictMap CtEvidence -> TcPredType -> MaybeT TcS MaybeNew - new_wanted_cached cache pty + new_wanted_cached :: CtLoc -> DictMap CtEvidence -> TcPredType -> MaybeT TcS MaybeNew + new_wanted_cached loc cache pty | ClassPred cls tys <- classifyPredType pty = lift $ case findDict cache loc_w cls tys of Just ctev -> return $ Cached (ctEvExpr ctev) - Nothing -> Fresh <$> newWantedNC loc_w pty + Nothing -> Fresh <$> newWantedNC loc pty | otherwise = mzero addFunDepWork :: InertCans -> CtEvidence -> Class -> TcS () From git at git.haskell.org Fri Jun 22 12:11:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 12:11:42 +0000 (UTC) Subject: [commit: ghc] master: Remove unnecessary call to checkReductionDepth (d5459a3) Message-ID: <20180622121142.BD9BF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d5459a3356e84226e779706eda2d733960d6e54e/ghc >--------------------------------------------------------------- commit d5459a3356e84226e779706eda2d733960d6e54e Author: Simon Peyton Jones Date: Fri Jun 22 11:30:10 2018 +0100 Remove unnecessary call to checkReductionDepth We call checkReductionDepth in chooseInstance, so there's no need to call it in selectNextWorkItem too >--------------------------------------------------------------- d5459a3356e84226e779706eda2d733960d6e54e compiler/typecheck/TcSMonad.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 965bf5f..9aafbf3 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -367,7 +367,8 @@ selectNextWorkItem ; case selectWorkItem wl of { Nothing -> return Nothing ; Just (ct, new_wl) -> - do { checkReductionDepth (ctLoc ct) (ctPred ct) + do { -- checkReductionDepth (ctLoc ct) (ctPred ct) + -- This is done by TcInteract.chooseInstance ; wrapTcS (TcM.writeTcRef wl_var new_wl) ; return (Just ct) } } } From git at git.haskell.org Fri Jun 22 12:11:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 12:11:45 +0000 (UTC) Subject: [commit: ghc] master: Move a Note to the module that refers to it (122ba98) Message-ID: <20180622121145.8F0813ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/122ba98af22c2b016561433dfa55bbabba98d972/ghc >--------------------------------------------------------------- commit 122ba98af22c2b016561433dfa55bbabba98d972 Author: Simon Peyton Jones Date: Fri Jun 22 13:10:48 2018 +0100 Move a Note to the module that refers to it >--------------------------------------------------------------- 122ba98af22c2b016561433dfa55bbabba98d972 compiler/typecheck/TcSimplify.hs | 13 ------------- compiler/typecheck/TcType.hs | 13 +++++++++++++ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index c6e5a6e..4024098 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1207,19 +1207,6 @@ sure to quantify over them. This leads to several wrinkles: refrain from bogusly quantifying, in TcSimplify.decideMonoTyVars. We report the error later, in TcBinds.chooseInferredQuantifiers. -Note [Quantifying over equality constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Should we quantify over an equality constraint (s ~ t)? In general, we don't. -Doing so may simply postpone a type error from the function definition site to -its call site. (At worst, imagine (Int ~ Bool)). - -However, consider this - forall a. (F [a] ~ Int) => blah -Should we quantify over the (F [a] ~ Int)? Perhaps yes, because at the call -site we will know 'a', and perhaps we have instance F [Bool] = Int. -So we *do* quantify over a type-family equality where the arguments mention -the quantified variables. - Note [Growing the tau-tvs using constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (growThetaTyVars insts tvs) is the result of extending the set diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 26fc9fe..092c5a1 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -2128,6 +2128,19 @@ Notice that See also TcTyDecls.checkClassCycles. +Note [Quantifying over equality constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Should we quantify over an equality constraint (s ~ t)? In general, we don't. +Doing so may simply postpone a type error from the function definition site to +its call site. (At worst, imagine (Int ~ Bool)). + +However, consider this + forall a. (F [a] ~ Int) => blah +Should we quantify over the (F [a] ~ Int)? Perhaps yes, because at the call +site we will know 'a', and perhaps we have instance F [Bool] = Int. +So we *do* quantify over a type-family equality where the arguments mention +the quantified variables. + Note [Inheriting implicit parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this: From git at git.haskell.org Fri Jun 22 19:35:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 19:35:31 +0000 (UTC) Subject: [commit: ghc] master: TTG for IPBind had wrong extension name (5f06cf6) Message-ID: <20180622193531.F0F003ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5f06cf6b6199c8f0e4921f4126f6eb15e2ff18ac/ghc >--------------------------------------------------------------- commit 5f06cf6b6199c8f0e4921f4126f6eb15e2ff18ac Author: Alan Zimmerman Date: Fri Jun 22 21:32:19 2018 +0200 TTG for IPBind had wrong extension name The standard[1] for extension naming is to use the XC prefix for the internal extension points, rather than for a new constructor. This is violated for IPBind, having data IPBind id = IPBind (XIPBind id) (Either (Located HsIPName) (IdP id)) (LHsExpr id) | XCIPBind (XXIPBind id) Swap the usage of XIPBind and XCIPBind [1] https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow#Namingconventions Closes #15302 >--------------------------------------------------------------- 5f06cf6b6199c8f0e4921f4126f6eb15e2ff18ac compiler/deSugar/Coverage.hs | 2 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/hsSyn/HsBinds.hs | 8 ++++---- compiler/hsSyn/HsExtension.hs | 4 ++-- compiler/rename/RnBinds.hs | 2 +- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 2 +- 7 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index ac02989..b5c18e5 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -810,7 +810,7 @@ addTickIPBind (IPBind x nm e) = liftM2 (IPBind x) (return nm) (addTickLHsExpr e) -addTickIPBind (XCIPBind x) = return (XCIPBind x) +addTickIPBind (XIPBind x) = return (XIPBind x) -- There is no location here, so we might need to use a context location?? addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index b6337e4..7767dfc 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -96,7 +96,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body ds_ip_bind (L _ (IPBind _ ~(Right n) e)) body = do e' <- dsLExpr e return (Let (NonRec n e') body) - ds_ip_bind (L _ (XCIPBind _)) _ = panic "dsIPBinds" + ds_ip_bind (L _ (XIPBind _)) _ = panic "dsIPBinds" dsIPBinds (XHsIPBinds _) _ = panic "dsIPBinds" ------------------------- diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index e4a6906..98f503b 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -859,12 +859,12 @@ type LIPBind id = Located (IPBind id) -- For details on above see note [Api annotations] in ApiAnnotation data IPBind id = IPBind - (XIPBind id) + (XCIPBind id) (Either (Located HsIPName) (IdP id)) (LHsExpr id) - | XCIPBind (XXIPBind id) + | XIPBind (XXIPBind id) -type instance XIPBind (GhcPass p) = NoExt +type instance XCIPBind (GhcPass p) = NoExt type instance XXIPBind (GhcPass p) = NoExt instance (p ~ GhcPass pass, OutputableBndrId p) @@ -878,7 +878,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where where name = case lr of Left (L _ ip) -> pprBndr LetBind ip Right id -> pprBndr LetBind id - ppr (XCIPBind x) = ppr x + ppr (XIPBind x) = ppr x {- ************************************************************************ diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index 52e19b9..a23b973 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -156,11 +156,11 @@ type ForallXHsIPBinds (c :: * -> Constraint) (x :: *) = ) -- IPBind type families -type family XIPBind x +type family XCIPBind x type family XXIPBind x type ForallXIPBind (c :: * -> Constraint) (x :: *) = - ( c (XIPBind x) + ( c (XCIPBind x) , c (XXIPBind x) ) diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 79b5502..a2218e4 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -226,7 +226,7 @@ rnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars) rnIPBind (IPBind _ ~(Left n) expr) = do (expr',fvExpr) <- rnLExpr expr return (IPBind noExt (Left n) expr', fvExpr) -rnIPBind (XCIPBind _) = panic "rnIPBind" +rnIPBind (XIPBind _) = panic "rnIPBind" {- ************************************************************************ diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 468950a..7060c35 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -361,7 +361,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside ; let d = toDict ipClass p ty `fmap` expr' ; return (ip_id, (IPBind noExt (Right ip_id) d)) } tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind" - tc_ip_bind _ (XCIPBind _) = panic "tc_ip_bind" + tc_ip_bind _ (XIPBind _) = panic "tc_ip_bind" -- Coerces a `t` into a dictionry for `IP "x" t`. -- co : t -> IP "x" t diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 8cabd0c..73fdda9 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -436,7 +436,7 @@ zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do = do n' <- mapIPNameTc (zonkIdBndr env) n e' <- zonkLExpr env e return (IPBind x n' e') - zonk_ip_bind (XCIPBind _) = panic "zonkLocalBinds : XCIPBind" + zonk_ip_bind (XIPBind _) = panic "zonkLocalBinds : XCIPBind" zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _)) = panic "zonkLocalBinds" -- Not in typechecker output From git at git.haskell.org Fri Jun 22 19:59:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 19:59:20 +0000 (UTC) Subject: [commit: ghc] master: Explain why opt-cmm is not dumped by ddump-cmm-verbose. (391b0ca) Message-ID: <20180622195920.7ED5D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/391b0caf0211c8f7968d60468e0512116015a10e/ghc >--------------------------------------------------------------- commit 391b0caf0211c8f7968d60468e0512116015a10e Author: klebinger.andreas at gmx.at Date: Thu Jun 21 16:59:46 2018 -0400 Explain why opt-cmm is not dumped by ddump-cmm-verbose. We just update the docs to reflect the state of affairs. opt-cmm is run by the NCG backend so not always run. ddump-cmm-verbose only dumps passes of the cmm pipeline so it's not included there. [skip-ci] Test Plan: doc change Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4879 >--------------------------------------------------------------- 391b0caf0211c8f7968d60468e0512116015a10e docs/users_guide/debugging.rst | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index 8cd7fd9..1a37eae 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -376,12 +376,14 @@ C-\\- representation These flags dump various phases of GHC's C-\\- pipeline. .. ghc-flag:: -ddump-cmm-verbose - :shortdesc: Show output from each C-\\- pipeline pass + :shortdesc: Show output from main C-\\- pipeline passes :type: dynamic - Dump output from all C-\\- pipeline stages. In case of + Dump output from main C-\\- pipeline stages. In case of ``.cmm`` compilation this also dumps the result of - file parsing. + file parsing. Not included are passes run by + the chosen backend. Currently only the NCG backends runs + additional passes ( :ghc-flag:`-ddump-opt-cmm` ). Cmm dumps don't include unreachable blocks since we print blocks in reverse post-order. From git at git.haskell.org Fri Jun 22 19:59:34 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 19:59:34 +0000 (UTC) Subject: [commit: ghc] master: Include ghc-heap and libiserv in the "package" file. (63d474b) Message-ID: <20180622195934.D84953ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/63d474bb4af80c1282ee4a4da136ac4518d98bff/ghc >--------------------------------------------------------------- commit 63d474bb4af80c1282ee4a4da136ac4518d98bff Author: HE, Tao Date: Thu Jun 21 17:00:17 2018 -0400 Include ghc-heap and libiserv in the "package" file. Previously, the `make clean` (as well as `make dist-clean`) doesn't work for ghc-heap and libiserv, due to these two libraries are not presented in the "packages" file. Test Plan: [skip ci] Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4878 >--------------------------------------------------------------- 63d474bb4af80c1282ee4a4da136ac4518d98bff packages | 2 ++ 1 file changed, 2 insertions(+) diff --git a/packages b/packages index 94dad9e..8a6ff29 100644 --- a/packages +++ b/packages @@ -45,12 +45,14 @@ libraries/binary - - https:/ libraries/bytestring - - https://github.com/haskell/bytestring.git libraries/Cabal - - https://github.com/haskell/cabal.git libraries/ghc-compact - - - +libraries/ghc-heap - - - libraries/containers - - https://github.com/haskell/containers.git libraries/deepseq - - ssh://git at github.com/haskell/deepseq.git libraries/directory - - ssh://git at github.com/haskell/directory.git libraries/filepath - - ssh://git at github.com/haskell/filepath.git libraries/haskeline - - https://github.com/judah/haskeline.git libraries/hpc - - - +libraries/libiserv - - - libraries/mtl - - https://github.com/haskell/mtl.git libraries/parsec - - https://github.com/haskell/parsec.git libraries/pretty - - https://github.com/haskell/pretty.git From git at git.haskell.org Fri Jun 22 19:59:49 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 19:59:49 +0000 (UTC) Subject: [commit: ghc] master: rts: Abort if timerfd read fails (c7b1e93) Message-ID: <20180622195949.984653ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c7b1e93b47915a5276dfdb04f09030f5abaed290/ghc >--------------------------------------------------------------- commit c7b1e93b47915a5276dfdb04f09030f5abaed290 Author: Ben Gamari Date: Thu Jun 21 17:00:32 2018 -0400 rts: Abort if timerfd read fails Currently we belch some output to stderr but fail to abort, resulting in a busy loop. Fixes #15292. Test Plan: * Validate * try running program under environment without timerfd capabilities; ensure we don't busy-loop Reviewers: simonmar, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #15929 Differential Revision: https://phabricator.haskell.org/D4875 >--------------------------------------------------------------- c7b1e93b47915a5276dfdb04f09030f5abaed290 rts/posix/itimer/Pthread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/posix/itimer/Pthread.c b/rts/posix/itimer/Pthread.c index f591d5e..d8f2497 100644 --- a/rts/posix/itimer/Pthread.c +++ b/rts/posix/itimer/Pthread.c @@ -123,7 +123,7 @@ static void *itimer_thread_func(void *_handle_tick) if (USE_TIMERFD_FOR_ITIMER) { if (read(timerfd, &nticks, sizeof(nticks)) != sizeof(nticks)) { if (errno != EINTR) { - sysErrorBelch("Itimer: read(timerfd) failed"); + barf("Itimer: read(timerfd) failed"); } } } else { From git at git.haskell.org Fri Jun 22 20:00:04 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 20:00:04 +0000 (UTC) Subject: [commit: ghc] master: rts/linker/{SymbolExtras, elf_got}.c: map code as read-only (67c422c) Message-ID: <20180622200004.7B7273ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/67c422ca0e7b94e021430e3dfc9b19f3de21ed16/ghc >--------------------------------------------------------------- commit 67c422ca0e7b94e021430e3dfc9b19f3de21ed16 Author: Santiago Munín Date: Thu Jun 21 17:00:58 2018 -0400 rts/linker/{SymbolExtras,elf_got}.c: map code as read-only protect mmaped addresses from writes after being initially manipulated Test Plan: ./validate Reviewers: bgamari, erikd, simonmar Reviewed By: bgamari Subscribers: angerman, carlostome, rwbarton, thomie, carter GHC Trac Issues: #14069 Differential Revision: https://phabricator.haskell.org/D4817 >--------------------------------------------------------------- 67c422ca0e7b94e021430e3dfc9b19f3de21ed16 rts/linker/SymbolExtras.c | 8 ++++++-- rts/linker/elf_got.c | 3 +++ 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/rts/linker/SymbolExtras.c b/rts/linker/SymbolExtras.c index 486fa4a..88541f4 100644 --- a/rts/linker/SymbolExtras.c +++ b/rts/linker/SymbolExtras.c @@ -51,8 +51,9 @@ int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first ) n = roundUpToPage(oc->fileSize); /* Keep image and symbol_extras contiguous */ - void *new = mmapForLinker(n + (sizeof(SymbolExtra) * count), - MAP_ANONYMOUS, -1, 0); + + size_t allocated_size = n + (sizeof(SymbolExtra) * count); + void *new = mmapForLinker(allocated_size, MAP_ANONYMOUS, -1, 0); if (new) { memcpy(new, oc->image, oc->fileSize); if (oc->imageMapped) { @@ -62,6 +63,9 @@ int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first ) oc->imageMapped = true; oc->fileSize = n + (sizeof(SymbolExtra) * count); oc->symbol_extras = (SymbolExtra *) (oc->image + n); + if(mprotect(new, allocated_size, PROT_READ | PROT_EXEC) != 0) { + sysErrorBelch("unable to protect memory"); + } } else { oc->symbol_extras = NULL; diff --git a/rts/linker/elf_got.c b/rts/linker/elf_got.c index 0395d16..10ea25b 100644 --- a/rts/linker/elf_got.c +++ b/rts/linker/elf_got.c @@ -62,6 +62,9 @@ makeGot(ObjectCode * oc) { symTab->symbols[i].got_addr = (uint8_t *)oc->info->got_start + (slot++ * sizeof(void*)); + if(mprotect(mem, oc->info->got_size, PROT_READ) != 0) { + sysErrorBelch("unable to protect memory"); + } } return EXIT_SUCCESS; } From git at git.haskell.org Fri Jun 22 20:00:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 22 Jun 2018 20:00:21 +0000 (UTC) Subject: [commit: ghc] master: Remove -Wamp flag (33724fc) Message-ID: <20180622200021.E099A3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/33724fc75499a3dfaf2ffcc4bf5db6d505df58f4/ghc >--------------------------------------------------------------- commit 33724fc75499a3dfaf2ffcc4bf5db6d505df58f4 Author: roland Date: Thu Jun 21 17:01:39 2018 -0400 Remove -Wamp flag Test Plan: "ghc -Wamp XXX.hs" should give "unrecognised warning flag" Reviewers: bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie, carter GHC Trac Issues: #11477 Differential Revision: https://phabricator.haskell.org/D4785 >--------------------------------------------------------------- 33724fc75499a3dfaf2ffcc4bf5db6d505df58f4 compiler/main/DynFlags.hs | 3 --- docs/users_guide/using-warnings.rst | 16 ---------------- 2 files changed, 19 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index b10740b..2ecbd6e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -772,7 +772,6 @@ data WarningFlag = | Opt_WarnUnusedForalls | Opt_WarnWarningsDeprecations | Opt_WarnDeprecatedFlags - | Opt_WarnAMP -- Introduced in GHC 7.8, obsolete since 7.10 | Opt_WarnMissingMonadFailInstances -- since 8.0 | Opt_WarnSemigroup -- since 8.0 | Opt_WarnDodgyExports @@ -3774,8 +3773,6 @@ wWarningFlagsDeps = [ -- Please keep the list of flags below sorted alphabetically flagSpec "alternative-layout-rule-transitional" Opt_WarnAlternativeLayoutRuleTransitional, - depFlagSpec "amp" Opt_WarnAMP - "it has no effect", depFlagSpec "auto-orphans" Opt_WarnAutoOrphans "it has no effect", flagSpec "cpp-undef" Opt_WarnCPPUndef, diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst index 510b56a..575e281 100644 --- a/docs/users_guide/using-warnings.rst +++ b/docs/users_guide/using-warnings.rst @@ -410,22 +410,6 @@ of ``-W(no-)*``. This option is on by default. -.. ghc-flag:: -Wamp - :shortdesc: *(deprecated)* warn on definitions conflicting with the - Applicative-Monad Proposal (AMP) - :type: dynamic - :reverse: -Wno-amp - :category: - - .. index:: - single: AMP - single: Applicative-Monad Proposal - - This option is deprecated. - - Caused a warning to be emitted when a definition was in conflict with - the AMP (Applicative-Monad proosal). - .. ghc-flag:: -Wnoncanonical-monad-instances :shortdesc: warn when ``Applicative`` or ``Monad`` instances have noncanonical definitions of ``return``, ``pure``, ``(>>)``, From git at git.haskell.org Sun Jun 24 20:42:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 24 Jun 2018 20:42:42 +0000 (UTC) Subject: [commit: ghc] master: Tweak API Annotations for ConDeclGADT (5db9f91) Message-ID: <20180624204242.4A46E3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5db9f9129e7519db0c9841fbe7c14f350c23284c/ghc >--------------------------------------------------------------- commit 5db9f9129e7519db0c9841fbe7c14f350c23284c Author: Alan Zimmerman Date: Sun Jun 24 22:00:22 2018 +0200 Tweak API Annotations for ConDeclGADT >--------------------------------------------------------------- 5db9f9129e7519db0c9841fbe7c14f350c23284c compiler/parser/Parser.y | 3 ++- compiler/parser/RdrHsSyn.hs | 11 +++++------ testsuite/tests/ghc-api/annotations/T10255.stdout | 1 + testsuite/tests/ghc-api/annotations/T10278.stdout | 1 + testsuite/tests/ghc-api/annotations/T10312.stdout | 1 + testsuite/tests/ghc-api/annotations/T10399.stdout | 4 ++++ testsuite/tests/ghc-api/annotations/T11018.stdout | 2 ++ testsuite/tests/ghc-api/annotations/exampleTest.stdout | 1 + testsuite/tests/ghc-api/annotations/parseTree.stdout | 2 ++ 9 files changed, 19 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 5db9f9129e7519db0c9841fbe7c14f350c23284c From git at git.haskell.org Mon Jun 25 14:35:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Jun 2018 14:35:13 +0000 (UTC) Subject: [commit: ghc] master: Fix error recovery for pattern synonyms (2896082) Message-ID: <20180625143513.4F89D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2896082ec79f02b6388e038a8dae6cb22fe72dfc/ghc >--------------------------------------------------------------- commit 2896082ec79f02b6388e038a8dae6cb22fe72dfc Author: Simon Peyton Jones Date: Mon Jun 25 11:42:46 2018 +0100 Fix error recovery for pattern synonyms As Trac #15289 showed, we were carrying on after a type error in a pattern synonym, and then crashing. This patch improves error handling for pattern synonyms. I also moved a bit of code from TcBinds into TcPatSyn, which helpfully narrows the API. >--------------------------------------------------------------- 2896082ec79f02b6388e038a8dae6cb22fe72dfc compiler/typecheck/TcBinds.hs | 11 +-- compiler/typecheck/TcPatSyn.hs | 86 ++++++++++++++++++++---- compiler/typecheck/TcPatSyn.hs-boot | 12 ++-- testsuite/tests/patsyn/should_fail/T15289.stderr | 21 +++--- testsuite/tests/patsyn/should_fail/all.T | 2 +- 5 files changed, 95 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 2896082ec79f02b6388e038a8dae6cb22fe72dfc From git at git.haskell.org Mon Jun 25 14:35:16 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Jun 2018 14:35:16 +0000 (UTC) Subject: [commit: ghc] master: Improve tc-tracing a bit (95324f0) Message-ID: <20180625143516.1E0EC3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/95324f01636d0d15a94742b2f4ce43cf4c8af3e2/ghc >--------------------------------------------------------------- commit 95324f01636d0d15a94742b2f4ce43cf4c8af3e2 Author: Simon Peyton Jones Date: Mon Jun 25 11:46:29 2018 +0100 Improve tc-tracing a bit >--------------------------------------------------------------- 95324f01636d0d15a94742b2f4ce43cf4c8af3e2 compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcExpr.hs | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 4ea49ad..a703e57 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -567,7 +567,7 @@ tc_extend_local_env top_lvl extra_env thing_inside -- The second argument of type TyVarSet is a set of type variables -- that are bound together with extra_env and should not be regarded -- as free in the types of extra_env. - = do { traceTc "env2" (ppr extra_env) + = do { traceTc "tc_extend_local_env" (ppr extra_env) ; env0 <- getLclEnv ; env1 <- tcExtendLocalTypeEnv env0 extra_env ; stage <- getStage diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index a4a005c..c638ab9 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1636,6 +1636,10 @@ tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) = setSrcSpan loc $ -- Sets the location for the implication constraint do { (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id ; given <- newEvVars theta + ; traceTc "tcExprSig: CompleteSig" $ + vcat [ text "poly_id:" <+> ppr poly_id <+> dcolon <+> ppr (idType poly_id) + , text "tv_prs:" <+> ppr tv_prs ] + ; let skol_info = SigSkol ExprSigCtxt (idType poly_id) tv_prs skol_tvs = map snd tv_prs ; (ev_binds, expr') <- checkConstraints skol_info skol_tvs given $ From git at git.haskell.org Mon Jun 25 14:35:19 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Jun 2018 14:35:19 +0000 (UTC) Subject: [commit: ghc] master: Refactor the kind-checking of tyvar binders (9fc40c7) Message-ID: <20180625143519.01DEF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9fc40c733ba8822a04bd92883801b214dee099ca/ghc >--------------------------------------------------------------- commit 9fc40c733ba8822a04bd92883801b214dee099ca Author: Simon Peyton Jones Date: Mon Jun 25 13:20:59 2018 +0100 Refactor the kind-checking of tyvar binders The refactoring here is driven by the ghastly mess described in comment:24 of Trac #1520. The overall goal is to simplify the kind-checking of typev-variable binders, and in particular to narrow the use of the "in-scope tyvar binder" stuff, which is needed only for associated types: see the new Note [Kind-checking tyvar binders for associated types] in TcHsType. Now * The "in-scope tyvar binder" stuff is done only in - kcLHsQTyVars, which is used for the LHsQTyVars of a data/newtype, or type family declaration. - tcFamTyPats, which is used for associated family instances; it now calls tcImplicitQTKBndrs, which in turn usese newFlexiKindedQTyVar * tcExpicitTKBndrs (which is used only for function signatures, data con signatures, pattern synonym signatures, and expression type signatures) now does not go via the "in-scope tyvar binder" stuff at all. While I'm still not happy with all this code, the code is generally simpler, and I think this is a useful step forward. It does cure the problem too. (It's hard to trigger the problem in vanilla Haskell code, because the renamer would normally use different names for nested binders, so I can't offer a test.) >--------------------------------------------------------------- 9fc40c733ba8822a04bd92883801b214dee099ca compiler/hsSyn/HsDecls.hs | 43 +++++-- compiler/typecheck/TcHsType.hs | 258 +++++++++++++++++++++---------------- compiler/typecheck/TcTyClsDecls.hs | 3 +- 3 files changed, 178 insertions(+), 126 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9fc40c733ba8822a04bd92883801b214dee099ca From git at git.haskell.org Mon Jun 25 16:46:02 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Jun 2018 16:46:02 +0000 (UTC) Subject: [commit: ghc] master: Record some notes about "innocuous" transformations (1c2c2d3) Message-ID: <20180625164602.7C1963ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c2c2d3dfd4c36884b22163872feb87122b4528d/ghc >--------------------------------------------------------------- commit 1c2c2d3dfd4c36884b22163872feb87122b4528d Author: Simon Peyton Jones Date: Thu Jun 7 09:25:33 2018 +0100 Record some notes about "innocuous" transformations I wondered if some transformations (ticks) might be "innocuous", in the sense that they do not unlock a later transformation that does not occur in the same pass. If so, we could refrain from bumping the overall tick-count for such innocuous transformations, and perhaps terminate the simplifier one pass earlier. BUt alas I found that virtually nothing was innocuous! This commit just adds a Note to record what I learned, in case anyone wants to try again. >--------------------------------------------------------------- 1c2c2d3dfd4c36884b22163872feb87122b4528d compiler/simplCore/CoreMonad.hs | 75 ++++++++++++++++++++++++++++++++++++++++- compiler/simplCore/SimplCore.hs | 1 + 2 files changed, 75 insertions(+), 1 deletion(-) diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 4deee37..6b7393c 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -343,6 +343,79 @@ pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 }) else Outputable.empty ] +{- Note [Which transformations are innocuous] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At one point (Jun 18) I wondered if some transformations (ticks) +might be "innocuous", in the sense that they do not unlock a later +transformation that does not occur in the same pass. If so, we could +refrain from bumping the overall tick-count for such innocuous +transformations, and perhaps terminate the simplifier one pass +earlier. + +BUt alas I found that virtually nothing was innocuous! This Note +just records what I learned, in case anyone wants to try again. + +These transformations are not innocuous: + +*** NB: I think these ones could be made innocuous + EtaExpansion + LetFloatFromLet + +LetFloatFromLet + x = K (let z = e2 in Just z) + prepareRhs transforms to + x2 = let z=e2 in Just z + x = K xs + And now more let-floating can happen in the + next pass, on x2 + +PreInlineUnconditionally + Example in spectral/cichelli/Auxil + hinsert = ...let lo = e in + let j = ...lo... in + case x of + False -> () + True -> case lo of I# lo' -> + ...j... + When we PreInlineUnconditionally j, lo's occ-info changes to once, + so it can be PreInlineUnconditionally in the next pass, and a + cascade of further things can happen. + +PostInlineUnconditionally + let x = e in + let y = ...x.. in + case .. of { A -> ...x...y... + B -> ...x...y... } + Current postinlineUnconditinaly will inline y, and then x; sigh. + + But PostInlineUnconditionally might also unlock subsequent + transformations for the same reason as PreInlineUnconditionally, + so it's probably not innocuous anyway. + +KnownBranch, BetaReduction: + May drop chunks of code, and thereby enable PreInlineUnconditionally + for some let-binding which now occurs once + +EtaExpansion: + Example in imaginary/digits-of-e1 + fail = \void. e where e :: IO () + --> etaExpandRhs + fail = \void. (\s. (e |> g) s) |> sym g where g :: IO () ~ S -> (S,()) + --> Next iteration of simplify + fail1 = \void. \s. (e |> g) s + fail = fail1 |> Void#->sym g + And now inline 'fail' + +CaseMerge: + case x of y { + DEFAULT -> case y of z { pi -> ei } + alts2 } + ---> CaseMerge + case x of { pi -> let z = y in ei + ; alts2 } + The "let z=y" case-binder-swap gets dealt with in the next pass +-} + pprTickCounts :: Map Tick Int -> SDoc pprTickCounts counts = vcat (map pprTickGroup groups) @@ -360,7 +433,7 @@ pprTickGroup group@((tick1,_):_) | (tick,n) <- sortBy (flip (comparing snd)) group]) pprTickGroup [] = panic "pprTickGroup" -data Tick +data Tick -- See Note [Which transformations are innocuous] = PreInlineUnconditionally Id | PostInlineUnconditionally Id diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index d461b99..168ece9 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -723,6 +723,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) ; return (getTopFloatBinds floats, rules1) } ; -- Stop if nothing happened; don't dump output + -- See Note [Which transformations are innocuous] in CoreMonad if isZeroSimplCount counts1 then return ( "Simplifier reached fixed point", iteration_no , totalise (counts1 : counts_so_far) -- Include "free" ticks From git at git.haskell.org Mon Jun 25 16:46:05 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Jun 2018 16:46:05 +0000 (UTC) Subject: [commit: ghc] master: Coments and debug tracing only (577399c) Message-ID: <20180625164605.5092A3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/577399c0dfd544a613e69f0760046ec0769f33a2/ghc >--------------------------------------------------------------- commit 577399c0dfd544a613e69f0760046ec0769f33a2 Author: Simon Peyton Jones Date: Thu May 31 12:50:36 2018 +0100 Coments and debug tracing only See Trac #15205 >--------------------------------------------------------------- 577399c0dfd544a613e69f0760046ec0769f33a2 compiler/typecheck/TcSimplify.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 4024098..da78075 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1696,6 +1696,7 @@ neededEvVars implic@(Implic { ic_given = givens ; traceTcS "neededEvVars" $ vcat [ text "old_needs:" <+> ppr old_needs , text "seeds3:" <+> ppr seeds3 + , text "tcvs:" <+> ppr tcvs , text "ev_binds:" <+> ppr ev_binds , text "live_ev_binds:" <+> ppr live_ev_binds ] @@ -1756,6 +1757,9 @@ all done by neededEvVars. This led to a remarkable 25% overall compiler allocation decrease in test T12227. +But we don't get to discard all redundant equality superclasses, alas; +see Trac #15205. + Note [Tracking redundant constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ With Opt_WarnRedundantConstraints, GHC can report which From git at git.haskell.org Mon Jun 25 16:46:08 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Jun 2018 16:46:08 +0000 (UTC) Subject: [commit: ghc] master: More misc comments (b4d5459) Message-ID: <20180625164608.2B0273ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4d545904ed7f883ad03b8746a610ae2f3640437/ghc >--------------------------------------------------------------- commit b4d545904ed7f883ad03b8746a610ae2f3640437 Author: Simon Peyton Jones Date: Thu Jun 7 09:17:22 2018 +0100 More misc comments ... plus, reorder equations in toIfaceVar to improve legibility. No change in behaviour. >--------------------------------------------------------------- b4d545904ed7f883ad03b8746a610ae2f3640437 compiler/basicTypes/MkId.hs | 7 +++---- compiler/iface/ToIface.hs | 15 +++++++++------ compiler/simplCore/OccurAnal.hs | 3 +++ 3 files changed, 15 insertions(+), 10 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index d6a52b4d..602cd3d 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1183,7 +1183,7 @@ proxyName = mkWiredInIdName gHC_PRIM (fsLit "proxy#") proxyHash lazyIdName, oneShotName, noinlineIdName :: Name lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey lazyId oneShotName = mkWiredInIdName gHC_MAGIC (fsLit "oneShot") oneShotKey oneShotId -noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId +noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId ------------------------------------------------ proxyHashId :: Id @@ -1431,9 +1431,8 @@ a little bit of magic to optimize away 'noinline' after we are done running the simplifier. 'noinline' needs to be wired-in because it gets inserted automatically -when we serialize an expression to the interface format, and we DON'T -want use its fingerprints. - +when we serialize an expression to the interface format. See +Note [Inlining and hs-boot files] in ToIface Note [The oneShot function] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index d148e9a..4b810fa 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -535,14 +535,17 @@ mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as --------------------- toIfaceVar :: Id -> IfaceExpr toIfaceVar v - | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v)) - -- Foreign calls have special syntax | isBootUnfolding (idUnfolding v) - = IfaceApp (IfaceApp (IfaceExt noinlineIdName) (IfaceType (toIfaceType (idType v)))) + = -- See Note [Inlining and hs-boot files] + IfaceApp (IfaceApp (IfaceExt noinlineIdName) + (IfaceType (toIfaceType (idType v)))) (IfaceExt name) -- don't use mkIfaceApps, or infinite loop - -- See Note [Inlining and hs-boot files] - | isExternalName name = IfaceExt name - | otherwise = IfaceLcl (getOccFS name) + + | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v)) + -- Foreign calls have special syntax + + | isExternalName name = IfaceExt name + | otherwise = IfaceLcl (getOccFS name) where name = idName v diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index a8cfbc0..5c0c3b1 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2295,6 +2295,9 @@ Core Lint never expects to find an *occurrence* of an Id marked as Dead, so we must zap the OccInfo on cb before making the binding x = cb. See Trac #5028. +NB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier +doesn't use it. So this is only to satisfy the perhpas-over-picky Lint. + Historical note [no-case-of-case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We *used* to suppress the binder-swap in case expressions when From git at git.haskell.org Mon Jun 25 16:46:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 25 Jun 2018 16:46:11 +0000 (UTC) Subject: [commit: ghc] master: Remove unused BottomFound from Tick (cea409a) Message-ID: <20180625164611.646F03ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cea409a399f606ec42114b5b149c8345ca6d9571/ghc >--------------------------------------------------------------- commit cea409a399f606ec42114b5b149c8345ca6d9571 Author: Simon Peyton Jones Date: Thu Jun 7 09:19:36 2018 +0100 Remove unused BottomFound from Tick >--------------------------------------------------------------- cea409a399f606ec42114b5b149c8345ca6d9571 compiler/simplCore/CoreMonad.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 912ff99..4deee37 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -381,7 +381,6 @@ data Tick | CaseIdentity Id -- Case binder | FillInCaseDefault Id -- Case binder - | BottomFound | SimplifierDone -- Ticked at each iteration of the simplifier instance Outputable Tick where @@ -410,7 +409,6 @@ tickToTag (CaseMerge _) = 10 tickToTag (CaseElim _) = 11 tickToTag (CaseIdentity _) = 12 tickToTag (FillInCaseDefault _) = 13 -tickToTag BottomFound = 14 tickToTag SimplifierDone = 16 tickToTag (AltMerge _) = 17 @@ -430,7 +428,6 @@ tickString (AltMerge _) = "AltMerge" tickString (CaseElim _) = "CaseElim" tickString (CaseIdentity _) = "CaseIdentity" tickString (FillInCaseDefault _) = "FillInCaseDefault" -tickString BottomFound = "BottomFound" tickString SimplifierDone = "SimplifierDone" pprTickCts :: Tick -> SDoc From git at git.haskell.org Tue Jun 26 09:10:33 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Jun 2018 09:10:33 +0000 (UTC) Subject: [commit: ghc] master: API Annotations when parsing typapp (e53c113) Message-ID: <20180626091033.17DA13ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e53c113dcfeca9ee957722ede3d8b6a2c4c751a1/ghc >--------------------------------------------------------------- commit e53c113dcfeca9ee957722ede3d8b6a2c4c751a1 Author: Alan Zimmerman Date: Tue Jun 26 11:07:07 2018 +0200 API Annotations when parsing typapp Make sure the original annotations are still accessible for a promoted type. Closes #15303 >--------------------------------------------------------------- e53c113dcfeca9ee957722ede3d8b6a2c4c751a1 compiler/parser/Parser.y | 4 +-- testsuite/tests/ghc-api/annotations/Makefile | 4 +++ testsuite/tests/ghc-api/annotations/T15303.stdout | 35 +++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test15303.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 2 ++ 5 files changed, 49 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 6b0317b..d038562 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1930,9 +1930,9 @@ tyapp :: { Located TyEl } | qtyconop { sL1 $1 $ TyElOpr (unLoc $1) } | tyvarop { sL1 $1 $ TyElOpr (unLoc $1) } | SIMPLEQUOTE qconop {% ams (sLL $1 $> $ TyElOpr (unLoc $2)) - [mj AnnSimpleQuote $1] } + [mj AnnSimpleQuote $1,mj AnnVal $2] } | SIMPLEQUOTE varop {% ams (sLL $1 $> $ TyElOpr (unLoc $2)) - [mj AnnSimpleQuote $1] } + [mj AnnSimpleQuote $1,mj AnnVal $2] } atype_docs :: { LHsType GhcPs } : atype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 } diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 2da5fc0..98b4574 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -141,3 +141,7 @@ T12417: .PHONY: T13163 T13163: $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test13163.hs + +.PHONY: T15303 +T15303: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test15303.hs diff --git a/testsuite/tests/ghc-api/annotations/T15303.stdout b/testsuite/tests/ghc-api/annotations/T15303.stdout new file mode 100644 index 0000000..003dab5 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T15303.stdout @@ -0,0 +1,35 @@ +---Problems (should be empty list)--- +[] +---Annotations----------------------- +-- SrcSpan the annotation is attached to, AnnKeywordId, +-- list of locations the keyword item appears in +[ +((Test15303.hs:4:1-4,AnnCloseP), [Test15303.hs:4:4]), +((Test15303.hs:4:1-4,AnnOpenP), [Test15303.hs:4:1]), +((Test15303.hs:4:1-4,AnnVal), [Test15303.hs:4:2-3]), +((Test15303.hs:4:1-66,AnnDcolon), [Test15303.hs:4:6-7]), +((Test15303.hs:4:1-66,AnnSemi), [Test15303.hs:5:1]), +((Test15303.hs:4:9-17,AnnDarrow), [Test15303.hs:4:19-20]), +((Test15303.hs:4:22-41,AnnRarrow), [Test15303.hs:4:43-44]), +((Test15303.hs:4:22-66,AnnRarrow), [Test15303.hs:4:43-44]), +((Test15303.hs:4:33-41,AnnCloseP), [Test15303.hs:4:41]), +((Test15303.hs:4:33-41,AnnOpenP), [Test15303.hs:4:33]), +((Test15303.hs:4:36-37,AnnSimpleQuote), [Test15303.hs:4:36]), +((Test15303.hs:4:36-37,AnnVal), [Test15303.hs:4:37]), +((Test15303.hs:4:46-48,AnnRarrow), [Test15303.hs:4:50-51]), +((Test15303.hs:4:46-66,AnnRarrow), [Test15303.hs:4:50-51]), +((Test15303.hs:4:58-66,AnnCloseP), [Test15303.hs:4:66]), +((Test15303.hs:4:58-66,AnnOpenP), [Test15303.hs:4:58]), +((Test15303.hs:4:61-62,AnnSimpleQuote), [Test15303.hs:4:61]), +((Test15303.hs:4:61-62,AnnVal), [Test15303.hs:4:62]), +((Test15303.hs:5:1-4,AnnCloseP), [Test15303.hs:5:4]), +((Test15303.hs:5:1-4,AnnOpenP), [Test15303.hs:5:1]), +((Test15303.hs:5:1-4,AnnVal), [Test15303.hs:5:2-3]), +((Test15303.hs:5:1-15,AnnEqual), [Test15303.hs:5:6]), +((Test15303.hs:5:1-15,AnnFunId), [Test15303.hs:5:1-4]), +((Test15303.hs:5:1-15,AnnSemi), [Test15303.hs:6:1]), +((Test15303.hs:6:1-11,AnnInfix), [Test15303.hs:6:1-6]), +((Test15303.hs:6:1-11,AnnSemi), [Test15303.hs:7:1]), +((Test15303.hs:6:1-11,AnnVal), [Test15303.hs:6:8]), +((,AnnEofPos), [Test15303.hs:7:1]) +] diff --git a/testsuite/tests/ghc-api/annotations/Test15303.hs b/testsuite/tests/ghc-api/annotations/Test15303.hs new file mode 100644 index 0000000..212e9da --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test15303.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +(~#) :: Comonad w => CascadeW w (t ': ts) -> w t -> Last (t ': ts) +(~#) = cascadeW +infixr 0 ~# diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index adc0d14..666cb3f 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -57,3 +57,5 @@ test('T12417', [extra_files(['Test12417.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T12417']) test('T13163', [extra_files(['Test13163.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T13163']) +test('T15303', [extra_files(['Test15303.hs']), + ignore_stderr], run_command, ['$MAKE -s --no-print-directory T15303']) From git at git.haskell.org Tue Jun 26 11:09:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Jun 2018 11:09:53 +0000 (UTC) Subject: [commit: ghc] master: Fix TcLevel manipulation in TcDerivInfer.simplifyDeriv (261dd83) Message-ID: <20180626110953.DBBA13ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/261dd83cacec71edd551e9c581d05285c9ea3226/ghc >--------------------------------------------------------------- commit 261dd83cacec71edd551e9c581d05285c9ea3226 Author: Simon Peyton Jones Date: Mon Jun 25 17:42:57 2018 +0100 Fix TcLevel manipulation in TcDerivInfer.simplifyDeriv The level numbers we were getting simply didn't obey the invariant (ImplicInv) in TcType Note [TcLevel and untouchable type variables] That leads to chaos. Easy to fix. I improved the documentation. I also added an assertion in TcSimplify that checks that level numbers go up by 1 as we dive inside implications, so that we catch the problem at source rather than than through its obscure consequences. That in turn showed up that TcRules was also generating constraints that didn't obey (ImplicInv), so I fixed that too. I have no idea what consequences were lurking behing that bug, but anyway now it's fixed. Hooray. >--------------------------------------------------------------- 261dd83cacec71edd551e9c581d05285c9ea3226 compiler/typecheck/TcDerivInfer.hs | 73 ++++++++++--------- compiler/typecheck/TcRules.hs | 81 +++++++++++++--------- compiler/typecheck/TcSimplify.hs | 11 +++ testsuite/tests/quantified-constraints/T15290b.hs | 28 ++++++++ .../tests/quantified-constraints/T15290b.stderr | 14 ++++ testsuite/tests/quantified-constraints/all.T | 1 + 6 files changed, 144 insertions(+), 64 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 261dd83cacec71edd551e9c581d05285c9ea3226 From git at git.haskell.org Tue Jun 26 11:09:56 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Jun 2018 11:09:56 +0000 (UTC) Subject: [commit: ghc] master: A bit more tc-tracking in TcUnify.uUnfilledVar (7a2b5d0) Message-ID: <20180626110956.AC1113ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7a2b5d0c97da71f5e5a7d82b28e8a734b0ff95df/ghc >--------------------------------------------------------------- commit 7a2b5d0c97da71f5e5a7d82b28e8a734b0ff95df Author: Simon Peyton Jones Date: Tue Jun 26 12:07:08 2018 +0100 A bit more tc-tracking in TcUnify.uUnfilledVar >--------------------------------------------------------------- 7a2b5d0c97da71f5e5a7d82b28e8a734b0ff95df compiler/typecheck/TcUnify.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index fa845bb..9b32c3c 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -1571,19 +1571,25 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2 | canSolveByUnification cur_lvl tv1 ty2 , Just ty2' <- metaTyVarUpdateOK dflags tv1 ty2 = do { co_k <- uType KindLevel kind_origin (typeKind ty2') (tyVarKind tv1) + ; traceTc "uUnfilledVar2 ok" $ + vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) + , ppr ty2 <+> dcolon <+> ppr (typeKind ty2) + , ppr (isTcReflCo co_k), ppr co_k ] + ; if isTcReflCo co_k -- only proceed if the kinds matched. then do { writeMetaTyVar tv1 ty2' ; return (mkTcNomReflCo ty2') } - else defer } -- this cannot be solved now. - -- See Note [Equalities with incompatible kinds] - -- in TcCanonical + + else defer } -- This cannot be solved now. See TcCanonical + -- Note [Equalities with incompatible kinds] | otherwise - = defer + = do { traceTc "uUnfilledVar2 not ok" (ppr tv1 $$ ppr ty2) -- Occurs check or an untouchable: just defer -- NB: occurs check isn't necessarily fatal: -- eg tv1 occured in type family parameter + ; defer } ty1 = mkTyVarTy tv1 kind_origin = KindEqOrigin ty1 (Just ty2) origin (Just t_or_k) From git at git.haskell.org Tue Jun 26 11:09:59 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Jun 2018 11:09:59 +0000 (UTC) Subject: [commit: ghc] master: Remove dead code (bb50eca) Message-ID: <20180626110959.770CF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bb50ecaf2930455a6ecb7268f9c0f2ee909f5361/ghc >--------------------------------------------------------------- commit bb50ecaf2930455a6ecb7268f9c0f2ee909f5361 Author: Simon Peyton Jones Date: Tue Jun 26 12:07:27 2018 +0100 Remove dead code >--------------------------------------------------------------- bb50ecaf2930455a6ecb7268f9c0f2ee909f5361 compiler/typecheck/TcMType.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index ae498b2..8a96cb0 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -37,10 +37,6 @@ module TcMType ( tauifyExpType, inferResultToType, -------------------------------- - -- Creating fresh type variables for pm checking - genInstSkolTyVarsX, - - -------------------------------- -- Creating new evidence variables newEvVar, newEvVars, newDict, newWanted, newWanteds, cloneWanted, cloneWC, @@ -777,14 +773,6 @@ See Note [TcLevel assignment] in TcType. % Generating fresh variables for pattern match check -} --- UNINSTANTIATED VERSION OF tcInstSkolTyCoVars -genInstSkolTyVarsX :: SrcSpan -> TCvSubst -> [TyVar] - -> TcRnIf gbl lcl (TCvSubst, [TcTyVar]) --- Precondition: tyvars should be scoping-ordered --- see Note [Kind substitution when instantiating] --- Get the location from the monad; this is a complete freshening operation -genInstSkolTyVarsX loc subst tvs - = instSkolTyCoVarsX (mkTcSkolTyVar topTcLevel loc False) subst tvs {- ************************************************************************ From git at git.haskell.org Tue Jun 26 13:33:20 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Jun 2018 13:33:20 +0000 (UTC) Subject: [commit: ghc] master: Typofixes in comments and whitespace only [ci skip] (629d01a) Message-ID: <20180626133320.8CE113ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/629d01a436d8041d44ed2826eb3f75e3f2d9ab47/ghc >--------------------------------------------------------------- commit 629d01a436d8041d44ed2826eb3f75e3f2d9ab47 Author: Gabor Greif Date: Tue Jun 26 15:29:14 2018 +0200 Typofixes in comments and whitespace only [ci skip] >--------------------------------------------------------------- 629d01a436d8041d44ed2826eb3f75e3f2d9ab47 compiler/cmm/CmmType.hs | 2 +- compiler/main/TidyPgm.hs | 4 ++-- compiler/nativeGen/RegAlloc/Graph/Stats.hs | 12 ++++++------ compiler/types/TyCon.hs | 2 +- libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 2 +- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs index 0538b9f..97b181a 100644 --- a/compiler/cmm/CmmType.hs +++ b/compiler/cmm/CmmType.hs @@ -70,7 +70,7 @@ instance Outputable CmmCat where -- Why is CmmType stratified? For native code generation, -- most of the time you just want to know what sort of register -- to put the thing in, and for this you need to know how --- many bits thing has and whether it goes in a floating-point +-- many bits thing has, and whether it goes in a floating-point -- register. By contrast, the distinction between GcPtr and -- GcNonPtr is of interest to only a few parts of the code generator. diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index b67ade2..4e93439 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -450,7 +450,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod tidyTypeEnv :: Bool -- Compiling without -O, so omit prags -> TypeEnv -> TypeEnv --- The competed type environment is gotten from +-- The completed type environment is gotten from -- a) the types and classes defined here (plus implicit things) -- b) adding Ids with correct IdInfo, including unfoldings, -- gotten from the bindings @@ -617,7 +617,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_ -- deterministic, tidy, renaming for all external Ids in this -- module. -- - -- It is sorted, so that it has adeterministic order (i.e. it's the + -- It is sorted, so that it has a deterministic order (i.e. it's the -- same list every time this module is compiled), in contrast to the -- bindings, which are ordered non-deterministically. init_work_list = zip init_ext_ids init_ext_ids diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs index e3ff226..ba51a4c 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs @@ -267,8 +267,8 @@ pprStatsConflict stats $$ text "\n") --- | For every vreg, dump it's how many conflicts it has and its lifetime --- good for making a scatter plot. +-- | For every vreg, dump how many conflicts it has, and its lifetime. +-- Good for making a scatter plot. pprStatsLifeConflict :: [RegAllocStats statics instr] -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph @@ -279,10 +279,10 @@ pprStatsLifeConflict stats graph $ foldl' plusSpillCostInfo zeroSpillCostInfo $ [ raSpillCosts s | s at RegAllocStatsStart{} <- stats ] - scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of - Just (_, l) -> l - Nothing -> 0 - Just node = Color.lookupNode graph r + scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of + Just (_, l) -> l + Nothing -> 0 + Just node = Color.lookupNode graph r in parens $ hcat $ punctuate (text ", ") [ doubleQuotes $ ppr $ Color.nodeId node , ppr $ sizeUniqSet (Color.nodeConflicts node) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 3f91e77..3801137 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -1420,7 +1420,7 @@ So we compromise, and move their Kind calculation to the call site. -} -- | Given the name of the function type constructor and it's kind, create the --- corresponding 'TyCon'. It is recomended to use 'TyCoRep.funTyCon' if you want +-- corresponding 'TyCon'. It is recommended to use 'TyCoRep.funTyCon' if you want -- this functionality mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon mkFunTyCon name binders rep_nm diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index b6f7c34..9665c65 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -473,7 +473,7 @@ addForeignFile = addForeignSource -- Note that for non-C languages (for example C++) @extern "C"@ directives -- must be used to get symbols that we can access from Haskell. -- --- To get better errors, it is reccomended to use #line pragmas when +-- To get better errors, it is recommended to use #line pragmas when -- emitting C files, e.g. -- -- > {-# LANGUAGE CPP #-} From git at git.haskell.org Tue Jun 26 14:13:46 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Jun 2018 14:13:46 +0000 (UTC) Subject: [commit: ghc] master: Typo fix in rts [skip ci] (5865e9a) Message-ID: <20180626141346.C63043ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5865e9a75c26a887838a1e858bed3e894a1a8eea/ghc >--------------------------------------------------------------- commit 5865e9a75c26a887838a1e858bed3e894a1a8eea Author: Ömer Sinan Ağacan Date: Tue Jun 26 17:13:17 2018 +0300 Typo fix in rts [skip ci] >--------------------------------------------------------------- 5865e9a75c26a887838a1e858bed3e894a1a8eea rts/sm/Storage.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 52dab73..cea7635 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1264,7 +1264,7 @@ W_ gcThreadLiveBlocks (uint32_t i, uint32_t g) * to store bitmaps and the mark stack. Note: blocks_needed does not * include the blocks in the nursery. * - * Assume: all data currently live will remain live. Generationss + * Assume: all data currently live will remain live. Generations * that will be collected next time will therefore need twice as many * blocks since all the data will be copied. */ From git at git.haskell.org Tue Jun 26 14:45:09 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 26 Jun 2018 14:45:09 +0000 (UTC) Subject: [commit: ghc] master: Add commnent about binder order (3d00208) Message-ID: <20180626144509.622853ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3d002087dce9c61932dd17047902baa83581f4df/ghc >--------------------------------------------------------------- commit 3d002087dce9c61932dd17047902baa83581f4df Author: Simon Peyton Jones Date: Tue Jun 26 15:44:12 2018 +0100 Add commnent about binder order ...provoked by Trac #15308 >--------------------------------------------------------------- 3d002087dce9c61932dd17047902baa83581f4df 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 Wed Jun 27 07:37:11 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 07:37:11 +0000 (UTC) Subject: [commit: ghc] master: rts: Update some comments, minor refactoring (4168ee3) Message-ID: <20180627073711.0F9E33ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4168ee3a503f716076ae1c182952c44289fdc5a0/ghc >--------------------------------------------------------------- commit 4168ee3a503f716076ae1c182952c44289fdc5a0 Author: Ömer Sinan Ağacan Date: Wed Jun 27 10:31:29 2018 +0300 rts: Update some comments, minor refactoring >--------------------------------------------------------------- 4168ee3a503f716076ae1c182952c44289fdc5a0 includes/rts/storage/GC.h | 7 ++++++- rts/Capability.h | 2 +- rts/sm/Storage.c | 17 ++++++++--------- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h index d4182dd..1571975 100644 --- a/includes/rts/storage/GC.h +++ b/includes/rts/storage/GC.h @@ -109,7 +109,12 @@ typedef struct generation_ { memcount n_compact_blocks_in_import; // no. of blocks used by compacts // being imported - memcount max_blocks; // max blocks + // Max blocks to allocate in this generation before collecting it. Collect + // this generation when + // + // n_blocks + n_large_blocks + n_compact_blocks > max_blocks + // + memcount max_blocks; StgTSO * threads; // threads in this gen // linked via global_link diff --git a/rts/Capability.h b/rts/Capability.h index e4df0b8..250ec22 100644 --- a/rts/Capability.h +++ b/rts/Capability.h @@ -109,7 +109,7 @@ struct Capability_ { int interrupt; // Total words allocated by this cap since rts start - // See [Note allocation accounting] in Storage.c + // See Note [allocation accounting] in Storage.c W_ total_allocated; #if defined(THREADED_RTS) diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index cea7635..dcc5b3a 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -1158,7 +1158,7 @@ dirty_MVAR(StgRegTable *reg, StgClosure *p) * -------------------------------------------------------------------------- */ /* ----------------------------------------------------------------------------- - * [Note allocation accounting] + * Note [allocation accounting] * * - When cap->r.rCurrentNusery moves to a new block in the nursery, * we add the size of the used portion of the previous block to @@ -1271,9 +1271,8 @@ W_ gcThreadLiveBlocks (uint32_t i, uint32_t g) extern W_ calcNeeded (bool force_major, memcount *blocks_needed) { - W_ needed = 0, blocks; - uint32_t g, N; - generation *gen; + W_ needed = 0; + uint32_t N; if (force_major) { N = RtsFlags.GcFlags.generations - 1; @@ -1281,12 +1280,12 @@ calcNeeded (bool force_major, memcount *blocks_needed) N = 0; } - for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - gen = &generations[g]; + for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { + generation *gen = &generations[g]; - blocks = gen->n_blocks // or: gen->n_words / BLOCK_SIZE_W (?) - + gen->n_large_blocks - + gen->n_compact_blocks; + W_ blocks = gen->n_blocks // or: gen->n_words / BLOCK_SIZE_W (?) + + gen->n_large_blocks + + gen->n_compact_blocks; // we need at least this much space needed += blocks; From git at git.haskell.org Wed Jun 27 07:37:13 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 07:37:13 +0000 (UTC) Subject: [commit: ghc] master: Show addresses of live objects in GHCi leak check (a54c94f) Message-ID: <20180627073713.CD9FA3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a54c94f08b938c02cbaf003e23a7ef3352eee19a/ghc >--------------------------------------------------------------- commit a54c94f08b938c02cbaf003e23a7ef3352eee19a Author: Ömer Sinan Ağacan Date: Wed Jun 27 10:32:31 2018 +0300 Show addresses of live objects in GHCi leak check Reviewers: simonmar, bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4892 >--------------------------------------------------------------- a54c94f08b938c02cbaf003e23a7ef3352eee19a ghc/GHCi/Leak.hs | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs index 3f64b5d..6d1bc58 100644 --- a/ghc/GHCi/Leak.hs +++ b/ghc/GHCi/Leak.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, LambdaCase #-} +{-# LANGUAGE RecordWildCards, LambdaCase, MagicHash, UnboxedTuples #-} module GHCi.Leak ( LeakIndicators , getLeakIndicators @@ -6,12 +6,19 @@ module GHCi.Leak ) where import Control.Monad +import Data.Bits +import DynFlags (settings, sTargetPlatform) +import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import GHC -import Outputable +import GHC.Exts (anyToAddr#, State#, RealWorld) +import GHC.Ptr (Ptr (..)) import HscTypes -import UniqDFM +import Outputable +import Platform (target32Bit) import System.Mem import System.Mem.Weak +import UniqDFM +import Unsafe.Coerce (unsafeCoerce) -- Checking for space leaks in GHCi. See #15111, and the -- -fghci-leak-check flag. @@ -55,5 +62,19 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do where report :: String -> Maybe a -> IO () report _ Nothing = return () - report msg (Just _) = - putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive!") + report msg (Just a) = do + addr <- mkIO (\s -> case anyToAddr# a s of + (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ()) + putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++ + show (maskTagBits addr)) + + -- We don't have access to ghc-prim here so using `unsafeCoerce` for `IO` + mkIO :: (State# RealWorld -> (# State# RealWorld, a #)) -> IO a + mkIO = unsafeCoerce + + tagBits + | target32Bit (sTargetPlatform (settings dflags)) = 2 + | otherwise = 3 + + maskTagBits :: Ptr a -> Ptr a + maskTagBits p = intPtrToPtr (ptrToIntPtr p .&. complement (shiftL 1 tagBits - 1)) From git at git.haskell.org Wed Jun 27 10:05:17 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 10:05:17 +0000 (UTC) Subject: [commit: ghc] master: Add ghc-prim as dependency to ghc-bin (437ff69) Message-ID: <20180627100517.74E893ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/437ff69e2f4d53f2ca6d0a07f86276fd53c27ef4/ghc >--------------------------------------------------------------- commit 437ff69e2f4d53f2ca6d0a07f86276fd53c27ef4 Author: Ömer Sinan Ağacan Date: Wed Jun 27 13:04:47 2018 +0300 Add ghc-prim as dependency to ghc-bin Remove unsafeCoerce introduced by a54c94f08b Reviewers: simonmar, bgamari Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4901 >--------------------------------------------------------------- 437ff69e2f4d53f2ca6d0a07f86276fd53c27ef4 ghc/GHCi/Leak.hs | 12 ++++-------- ghc/ghc-bin.cabal.in | 1 + 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs index 6d1bc58..aec1ab5 100644 --- a/ghc/GHCi/Leak.hs +++ b/ghc/GHCi/Leak.hs @@ -10,15 +10,15 @@ import Data.Bits import DynFlags (settings, sTargetPlatform) import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import GHC -import GHC.Exts (anyToAddr#, State#, RealWorld) +import GHC.Exts (anyToAddr#) import GHC.Ptr (Ptr (..)) +import GHC.Types (IO (..)) import HscTypes import Outputable import Platform (target32Bit) import System.Mem import System.Mem.Weak import UniqDFM -import Unsafe.Coerce (unsafeCoerce) -- Checking for space leaks in GHCi. See #15111, and the -- -fghci-leak-check flag. @@ -63,15 +63,11 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do report :: String -> Maybe a -> IO () report _ Nothing = return () report msg (Just a) = do - addr <- mkIO (\s -> case anyToAddr# a s of - (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ()) + addr <- IO (\s -> case anyToAddr# a s of + (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ()) putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++ show (maskTagBits addr)) - -- We don't have access to ghc-prim here so using `unsafeCoerce` for `IO` - mkIO :: (State# RealWorld -> (# State# RealWorld, a #)) -> IO a - mkIO = unsafeCoerce - tagBits | target32Bit (sTargetPlatform (settings dflags)) = 2 | otherwise = 3 diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index d3cc402..85a9250 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -54,6 +54,7 @@ Executable ghc Build-depends: containers >= 0.5 && < 0.7, deepseq == 1.4.*, + ghc-prim == 0.5.*, ghci == @ProjectVersionMunged@, haskeline == 0.7.*, time == 1.8.*, From git at git.haskell.org Wed Jun 27 21:09:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:21 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: TTG for IPBind had wrong extension name (0c701b6) Message-ID: <20180627210922.005D03ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/0c701b69bcef0c6c4c2a3ef083bf6b6fa062a8a6/ghc >--------------------------------------------------------------- commit 0c701b69bcef0c6c4c2a3ef083bf6b6fa062a8a6 Author: Alan Zimmerman Date: Fri Jun 22 21:32:19 2018 +0200 TTG for IPBind had wrong extension name The standard[1] for extension naming is to use the XC prefix for the internal extension points, rather than for a new constructor. This is violated for IPBind, having data IPBind id = IPBind (XIPBind id) (Either (Located HsIPName) (IdP id)) (LHsExpr id) | XCIPBind (XXIPBind id) Swap the usage of XIPBind and XCIPBind [1] https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow#Namingconventions Closes #15302 (cherry picked from commit 5f06cf6b6199c8f0e4921f4126f6eb15e2ff18ac) >--------------------------------------------------------------- 0c701b69bcef0c6c4c2a3ef083bf6b6fa062a8a6 compiler/deSugar/Coverage.hs | 2 +- compiler/deSugar/DsExpr.hs | 2 +- compiler/hsSyn/HsBinds.hs | 8 ++++---- compiler/hsSyn/HsExtension.hs | 4 ++-- compiler/rename/RnBinds.hs | 2 +- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 2 +- 7 files changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index ac02989..b5c18e5 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -810,7 +810,7 @@ addTickIPBind (IPBind x nm e) = liftM2 (IPBind x) (return nm) (addTickLHsExpr e) -addTickIPBind (XCIPBind x) = return (XCIPBind x) +addTickIPBind (XIPBind x) = return (XIPBind x) -- There is no location here, so we might need to use a context location?? addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index b6337e4..7767dfc 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -96,7 +96,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body ds_ip_bind (L _ (IPBind _ ~(Right n) e)) body = do e' <- dsLExpr e return (Let (NonRec n e') body) - ds_ip_bind (L _ (XCIPBind _)) _ = panic "dsIPBinds" + ds_ip_bind (L _ (XIPBind _)) _ = panic "dsIPBinds" dsIPBinds (XHsIPBinds _) _ = panic "dsIPBinds" ------------------------- diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index e4a6906..98f503b 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -859,12 +859,12 @@ type LIPBind id = Located (IPBind id) -- For details on above see note [Api annotations] in ApiAnnotation data IPBind id = IPBind - (XIPBind id) + (XCIPBind id) (Either (Located HsIPName) (IdP id)) (LHsExpr id) - | XCIPBind (XXIPBind id) + | XIPBind (XXIPBind id) -type instance XIPBind (GhcPass p) = NoExt +type instance XCIPBind (GhcPass p) = NoExt type instance XXIPBind (GhcPass p) = NoExt instance (p ~ GhcPass pass, OutputableBndrId p) @@ -878,7 +878,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where where name = case lr of Left (L _ ip) -> pprBndr LetBind ip Right id -> pprBndr LetBind id - ppr (XCIPBind x) = ppr x + ppr (XIPBind x) = ppr x {- ************************************************************************ diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs index 52e19b9..a23b973 100644 --- a/compiler/hsSyn/HsExtension.hs +++ b/compiler/hsSyn/HsExtension.hs @@ -156,11 +156,11 @@ type ForallXHsIPBinds (c :: * -> Constraint) (x :: *) = ) -- IPBind type families -type family XIPBind x +type family XCIPBind x type family XXIPBind x type ForallXIPBind (c :: * -> Constraint) (x :: *) = - ( c (XIPBind x) + ( c (XCIPBind x) , c (XXIPBind x) ) diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index 79b5502..a2218e4 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -226,7 +226,7 @@ rnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars) rnIPBind (IPBind _ ~(Left n) expr) = do (expr',fvExpr) <- rnLExpr expr return (IPBind noExt (Left n) expr', fvExpr) -rnIPBind (XCIPBind _) = panic "rnIPBind" +rnIPBind (XIPBind _) = panic "rnIPBind" {- ************************************************************************ diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 468950a..7060c35 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -361,7 +361,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside ; let d = toDict ipClass p ty `fmap` expr' ; return (ip_id, (IPBind noExt (Right ip_id) d)) } tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind" - tc_ip_bind _ (XCIPBind _) = panic "tc_ip_bind" + tc_ip_bind _ (XIPBind _) = panic "tc_ip_bind" -- Coerces a `t` into a dictionry for `IP "x" t`. -- co : t -> IP "x" t diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 8cabd0c..73fdda9 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -436,7 +436,7 @@ zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do = do n' <- mapIPNameTc (zonkIdBndr env) n e' <- zonkLExpr env e return (IPBind x n' e') - zonk_ip_bind (XCIPBind _) = panic "zonkLocalBinds : XCIPBind" + zonk_ip_bind (XIPBind _) = panic "zonkLocalBinds : XCIPBind" zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _)) = panic "zonkLocalBinds" -- Not in typechecker output From git at git.haskell.org Wed Jun 27 21:09:26 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:26 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Do not imply NoStarIsType by TypeOperators/TypeInType (abd6622) Message-ID: <20180627210926.6582C3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/abd6622324733c67b05e0cbd0c8c3d12c6332f61/ghc >--------------------------------------------------------------- commit abd6622324733c67b05e0cbd0c8c3d12c6332f61 Author: Vladislav Zavialov Date: Sun Jun 24 15:02:34 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 Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4865 >--------------------------------------------------------------- abd6622324733c67b05e0cbd0c8c3d12c6332f61 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, 101 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 abd6622324733c67b05e0cbd0c8c3d12c6332f61 From git at git.haskell.org Wed Jun 27 21:09:29 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:29 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Tweak API Annotations for ConDeclGADT (867e861) Message-ID: <20180627210929.411A73ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/867e861ba06f6cbc2e0c303e79b1ce928477ff90/ghc >--------------------------------------------------------------- commit 867e861ba06f6cbc2e0c303e79b1ce928477ff90 Author: Alan Zimmerman Date: Sun Jun 24 22:00:22 2018 +0200 Tweak API Annotations for ConDeclGADT (cherry picked from commit 5db9f9129e7519db0c9841fbe7c14f350c23284c) >--------------------------------------------------------------- 867e861ba06f6cbc2e0c303e79b1ce928477ff90 compiler/parser/Parser.y | 3 ++- compiler/parser/RdrHsSyn.hs | 11 +++++------ testsuite/tests/ghc-api/annotations/T10255.stdout | 1 + testsuite/tests/ghc-api/annotations/T10278.stdout | 1 + testsuite/tests/ghc-api/annotations/T10312.stdout | 1 + testsuite/tests/ghc-api/annotations/T10399.stdout | 4 ++++ testsuite/tests/ghc-api/annotations/T11018.stdout | 2 ++ testsuite/tests/ghc-api/annotations/exampleTest.stdout | 1 + testsuite/tests/ghc-api/annotations/parseTree.stdout | 2 ++ 9 files changed, 19 insertions(+), 7 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 867e861ba06f6cbc2e0c303e79b1ce928477ff90 From git at git.haskell.org Wed Jun 27 21:09:32 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:32 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Refactor the kind-checking of tyvar binders (7e19610) Message-ID: <20180627210932.1B47D3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/7e19610c925c45ade589b573a7e1c247cd8265ef/ghc >--------------------------------------------------------------- commit 7e19610c925c45ade589b573a7e1c247cd8265ef Author: Simon Peyton Jones Date: Mon Jun 25 13:20:59 2018 +0100 Refactor the kind-checking of tyvar binders The refactoring here is driven by the ghastly mess described in comment:24 of Trac #1520. The overall goal is to simplify the kind-checking of typev-variable binders, and in particular to narrow the use of the "in-scope tyvar binder" stuff, which is needed only for associated types: see the new Note [Kind-checking tyvar binders for associated types] in TcHsType. Now * The "in-scope tyvar binder" stuff is done only in - kcLHsQTyVars, which is used for the LHsQTyVars of a data/newtype, or type family declaration. - tcFamTyPats, which is used for associated family instances; it now calls tcImplicitQTKBndrs, which in turn usese newFlexiKindedQTyVar * tcExpicitTKBndrs (which is used only for function signatures, data con signatures, pattern synonym signatures, and expression type signatures) now does not go via the "in-scope tyvar binder" stuff at all. While I'm still not happy with all this code, the code is generally simpler, and I think this is a useful step forward. It does cure the problem too. (It's hard to trigger the problem in vanilla Haskell code, because the renamer would normally use different names for nested binders, so I can't offer a test.) (cherry picked from commit 9fc40c733ba8822a04bd92883801b214dee099ca) >--------------------------------------------------------------- 7e19610c925c45ade589b573a7e1c247cd8265ef compiler/hsSyn/HsDecls.hs | 43 +++++-- compiler/typecheck/TcHsType.hs | 258 +++++++++++++++++++++---------------- compiler/typecheck/TcTyClsDecls.hs | 3 +- 3 files changed, 178 insertions(+), 126 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 7e19610c925c45ade589b573a7e1c247cd8265ef From git at git.haskell.org Wed Jun 27 21:09:35 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:35 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Instances in no-evidence implications (61adfbe) Message-ID: <20180627210935.876EF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/61adfbe6f9926daf06031b7da2522f73addf75dc/ghc >--------------------------------------------------------------- commit 61adfbe6f9926daf06031b7da2522f73addf75dc Author: Simon Peyton Jones Date: Fri Jun 22 11:27:47 2018 +0100 Instances in no-evidence implications Trac #15290 showed that it's possible that we might attempt to use a quantified constraint to solve an equality in a situation where we don't have anywhere to put the evidence bindings. This made GHC crash. This patch stops the crash, but still rejects the pogram. See Note [Instances in no-evidence implications] in TcInteract. Finding this bug revealed another lurking bug: * An infelicity in the treatment of superclasses -- we were expanding them locally at the leaves, rather than at their binding site; see (3a) in Note [The superclass story]. As a consequence, TcRnTypes.superclassesMightHelp must look inside implications. In more detail: * Stop the crash, by making TcInteract.chooseInstance test for the no-evidence-bindings case. In that case we simply don't use the instance. This entailed a slight change to the type of chooseInstance. * Make TcSMonad.getPendingScDicts (now renamed getPendingGivenScs) return only Givens from the /current level/; and make TcRnTypes.superClassesMightHelp look inside implications. * Refactor the simpl_loop and superclass-expansion stuff in TcSimplify. The logic is much easier to understand now, and has less duplication. (cherry picked from commit 32eb41994f7448caf5fb6b06ed0678d79d029deb) >--------------------------------------------------------------- 61adfbe6f9926daf06031b7da2522f73addf75dc compiler/typecheck/TcCanonical.hs | 9 ++ compiler/typecheck/TcInteract.hs | 46 +++++-- compiler/typecheck/TcRnTypes.hs | 28 ++++- compiler/typecheck/TcSMonad.hs | 46 ++++--- compiler/typecheck/TcSimplify.hs | 134 +++++++++------------ testsuite/tests/quantified-constraints/T15290.hs | 35 ++++++ testsuite/tests/quantified-constraints/T15290a.hs | 35 ++++++ .../tests/quantified-constraints/T15290a.stderr | 22 ++++ testsuite/tests/quantified-constraints/all.T | 3 + 9 files changed, 251 insertions(+), 107 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 61adfbe6f9926daf06031b7da2522f73addf75dc From git at git.haskell.org Wed Jun 27 21:09:39 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:39 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix TcLevel manipulation in TcDerivInfer.simplifyDeriv (145f7c6) Message-ID: <20180627210939.098533ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/145f7c663e6df4ecfa848c0e2e478454cf9fb1d9/ghc >--------------------------------------------------------------- commit 145f7c663e6df4ecfa848c0e2e478454cf9fb1d9 Author: Simon Peyton Jones Date: Mon Jun 25 17:42:57 2018 +0100 Fix TcLevel manipulation in TcDerivInfer.simplifyDeriv The level numbers we were getting simply didn't obey the invariant (ImplicInv) in TcType Note [TcLevel and untouchable type variables] That leads to chaos. Easy to fix. I improved the documentation. I also added an assertion in TcSimplify that checks that level numbers go up by 1 as we dive inside implications, so that we catch the problem at source rather than than through its obscure consequences. That in turn showed up that TcRules was also generating constraints that didn't obey (ImplicInv), so I fixed that too. I have no idea what consequences were lurking behing that bug, but anyway now it's fixed. Hooray. (cherry picked from commit 261dd83cacec71edd551e9c581d05285c9ea3226) >--------------------------------------------------------------- 145f7c663e6df4ecfa848c0e2e478454cf9fb1d9 compiler/typecheck/TcDerivInfer.hs | 73 ++++++++++--------- compiler/typecheck/TcRules.hs | 81 +++++++++++++--------- compiler/typecheck/TcSimplify.hs | 11 +++ testsuite/tests/quantified-constraints/T15290b.hs | 28 ++++++++ .../tests/quantified-constraints/T15290b.stderr | 14 ++++ testsuite/tests/quantified-constraints/all.T | 1 + 6 files changed, 144 insertions(+), 64 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 145f7c663e6df4ecfa848c0e2e478454cf9fb1d9 From git at git.haskell.org Wed Jun 27 21:09:42 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:42 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: API Annotations when parsing typapp (4cfeca0) Message-ID: <20180627210942.986873ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/4cfeca02a0a9283e8c9f9ccd9373bc1f2fd8db0a/ghc >--------------------------------------------------------------- commit 4cfeca02a0a9283e8c9f9ccd9373bc1f2fd8db0a Author: Alan Zimmerman Date: Tue Jun 26 11:07:07 2018 +0200 API Annotations when parsing typapp Make sure the original annotations are still accessible for a promoted type. Closes #15303 (cherry picked from commit e53c113dcfeca9ee957722ede3d8b6a2c4c751a1) >--------------------------------------------------------------- 4cfeca02a0a9283e8c9f9ccd9373bc1f2fd8db0a compiler/parser/Parser.y | 4 +-- testsuite/tests/ghc-api/annotations/Makefile | 4 +++ testsuite/tests/ghc-api/annotations/T15303.stdout | 35 +++++++++++++++++++++++ testsuite/tests/ghc-api/annotations/Test15303.hs | 6 ++++ testsuite/tests/ghc-api/annotations/all.T | 2 ++ 5 files changed, 49 insertions(+), 2 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 6b0317b..d038562 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1930,9 +1930,9 @@ tyapp :: { Located TyEl } | qtyconop { sL1 $1 $ TyElOpr (unLoc $1) } | tyvarop { sL1 $1 $ TyElOpr (unLoc $1) } | SIMPLEQUOTE qconop {% ams (sLL $1 $> $ TyElOpr (unLoc $2)) - [mj AnnSimpleQuote $1] } + [mj AnnSimpleQuote $1,mj AnnVal $2] } | SIMPLEQUOTE varop {% ams (sLL $1 $> $ TyElOpr (unLoc $2)) - [mj AnnSimpleQuote $1] } + [mj AnnSimpleQuote $1,mj AnnVal $2] } atype_docs :: { LHsType GhcPs } : atype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 } diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 2da5fc0..98b4574 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -141,3 +141,7 @@ T12417: .PHONY: T13163 T13163: $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test13163.hs + +.PHONY: T15303 +T15303: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test15303.hs diff --git a/testsuite/tests/ghc-api/annotations/T15303.stdout b/testsuite/tests/ghc-api/annotations/T15303.stdout new file mode 100644 index 0000000..003dab5 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T15303.stdout @@ -0,0 +1,35 @@ +---Problems (should be empty list)--- +[] +---Annotations----------------------- +-- SrcSpan the annotation is attached to, AnnKeywordId, +-- list of locations the keyword item appears in +[ +((Test15303.hs:4:1-4,AnnCloseP), [Test15303.hs:4:4]), +((Test15303.hs:4:1-4,AnnOpenP), [Test15303.hs:4:1]), +((Test15303.hs:4:1-4,AnnVal), [Test15303.hs:4:2-3]), +((Test15303.hs:4:1-66,AnnDcolon), [Test15303.hs:4:6-7]), +((Test15303.hs:4:1-66,AnnSemi), [Test15303.hs:5:1]), +((Test15303.hs:4:9-17,AnnDarrow), [Test15303.hs:4:19-20]), +((Test15303.hs:4:22-41,AnnRarrow), [Test15303.hs:4:43-44]), +((Test15303.hs:4:22-66,AnnRarrow), [Test15303.hs:4:43-44]), +((Test15303.hs:4:33-41,AnnCloseP), [Test15303.hs:4:41]), +((Test15303.hs:4:33-41,AnnOpenP), [Test15303.hs:4:33]), +((Test15303.hs:4:36-37,AnnSimpleQuote), [Test15303.hs:4:36]), +((Test15303.hs:4:36-37,AnnVal), [Test15303.hs:4:37]), +((Test15303.hs:4:46-48,AnnRarrow), [Test15303.hs:4:50-51]), +((Test15303.hs:4:46-66,AnnRarrow), [Test15303.hs:4:50-51]), +((Test15303.hs:4:58-66,AnnCloseP), [Test15303.hs:4:66]), +((Test15303.hs:4:58-66,AnnOpenP), [Test15303.hs:4:58]), +((Test15303.hs:4:61-62,AnnSimpleQuote), [Test15303.hs:4:61]), +((Test15303.hs:4:61-62,AnnVal), [Test15303.hs:4:62]), +((Test15303.hs:5:1-4,AnnCloseP), [Test15303.hs:5:4]), +((Test15303.hs:5:1-4,AnnOpenP), [Test15303.hs:5:1]), +((Test15303.hs:5:1-4,AnnVal), [Test15303.hs:5:2-3]), +((Test15303.hs:5:1-15,AnnEqual), [Test15303.hs:5:6]), +((Test15303.hs:5:1-15,AnnFunId), [Test15303.hs:5:1-4]), +((Test15303.hs:5:1-15,AnnSemi), [Test15303.hs:6:1]), +((Test15303.hs:6:1-11,AnnInfix), [Test15303.hs:6:1-6]), +((Test15303.hs:6:1-11,AnnSemi), [Test15303.hs:7:1]), +((Test15303.hs:6:1-11,AnnVal), [Test15303.hs:6:8]), +((,AnnEofPos), [Test15303.hs:7:1]) +] diff --git a/testsuite/tests/ghc-api/annotations/Test15303.hs b/testsuite/tests/ghc-api/annotations/Test15303.hs new file mode 100644 index 0000000..212e9da --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test15303.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +(~#) :: Comonad w => CascadeW w (t ': ts) -> w t -> Last (t ': ts) +(~#) = cascadeW +infixr 0 ~# diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index adc0d14..666cb3f 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -57,3 +57,5 @@ test('T12417', [extra_files(['Test12417.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T12417']) test('T13163', [extra_files(['Test13163.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T13163']) +test('T15303', [extra_files(['Test15303.hs']), + ignore_stderr], run_command, ['$MAKE -s --no-print-directory T15303']) From git at git.haskell.org Wed Jun 27 21:09:45 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 27 Jun 2018 21:09:45 +0000 (UTC) Subject: [commit: ghc] ghc-8.6: Fix error recovery for pattern synonyms (149d791) Message-ID: <20180627210945.6C8D43ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-8.6 Link : http://ghc.haskell.org/trac/ghc/changeset/149d7912eb84a24861b021c13d2ee61b44de5856/ghc >--------------------------------------------------------------- commit 149d7912eb84a24861b021c13d2ee61b44de5856 Author: Simon Peyton Jones Date: Mon Jun 25 11:42:46 2018 +0100 Fix error recovery for pattern synonyms As Trac #15289 showed, we were carrying on after a type error in a pattern synonym, and then crashing. This patch improves error handling for pattern synonyms. I also moved a bit of code from TcBinds into TcPatSyn, which helpfully narrows the API. (cherry picked from commit 2896082ec79f02b6388e038a8dae6cb22fe72dfc) >--------------------------------------------------------------- 149d7912eb84a24861b021c13d2ee61b44de5856 compiler/typecheck/TcBinds.hs | 11 +-- compiler/typecheck/TcPatSyn.hs | 86 ++++++++++++++++++++---- compiler/typecheck/TcPatSyn.hs-boot | 12 ++-- testsuite/tests/patsyn/should_fail/T15289.stderr | 21 +++--- testsuite/tests/patsyn/should_fail/all.T | 2 +- 5 files changed, 95 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 149d7912eb84a24861b021c13d2ee61b44de5856 From git at git.haskell.org Thu Jun 28 04:09:31 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Jun 2018 04:09:31 +0000 (UTC) Subject: [commit: ghc] master: Clarify role of coercion in flattening function (45de833) Message-ID: <20180628040931.738EF3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/45de833e3105245763b6c1652146b925ed42be46/ghc >--------------------------------------------------------------- commit 45de833e3105245763b6c1652146b925ed42be46 Author: Richard Eisenberg Date: Thu Jun 28 00:08:58 2018 -0400 Clarify role of coercion in flattening function Comments only: [ci skip] >--------------------------------------------------------------- 45de833e3105245763b6c1652146b925ed42be46 compiler/typecheck/TcFlatten.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index f4176f5..f6a1adf 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1432,7 +1432,8 @@ flatten_app_tys fun_ty arg_tys ; flatten_app_ty_args fun_xi fun_co arg_tys } -- Given a flattened function (with the coercion produced by flattening) and --- a bunch of unflattened arguments, flatten the arguments and apply +-- a bunch of unflattened arguments, flatten the arguments and apply. +-- The coercion argument's role matches the role stored in the FlatM monad. -- -- The bang patterns used here were observed to improve performance. If you -- wish to remove them, be sure to check for regeressions in allocations. From git at git.haskell.org Thu Jun 28 05:44:43 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 28 Jun 2018 05:44:43 +0000 (UTC) Subject: [commit: ghc] master: Document SRT scavenging behavior of scavenge_block() and scavenge_one() (904abd4) Message-ID: <20180628054443.697EB3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/904abd4e6922451a2d3c32e748207c94fc6ddc59/ghc >--------------------------------------------------------------- commit 904abd4e6922451a2d3c32e748207c94fc6ddc59 Author: Ömer Sinan Ağacan Date: Thu Jun 28 08:44:15 2018 +0300 Document SRT scavenging behavior of scavenge_block() and scavenge_one() Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4893 >--------------------------------------------------------------- 904abd4e6922451a2d3c32e748207c94fc6ddc59 rts/sm/Scav.c | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 39374c0..2f61914 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -11,6 +11,37 @@ * * ---------------------------------------------------------------------------*/ +/* ---------------------------------------------------------------------------- + We have two main scavenge functions: + + - scavenge_block(bdescr *bd) + - scavenge_one(StgPtr p) + + As the names and parameters suggest, first one scavenges a whole block while + the second one only scavenges one object. This however is not the only + difference. scavenge_block scavenges all SRTs while scavenge_one only + scavenges SRTs of stacks. The reason is because scavenge_one is called in two + cases: + + - When scavenging a mut_list + - When scavenging a large object + + We don't have to scavenge SRTs when scavenging a mut_list, because we only + scavenge mut_lists in minor GCs, and static objects are only collected in + major GCs. + + However, because scavenge_one is also used to scavenge large objects (which + are scavenged even in major GCs), we need to deal with SRTs of large + objects. We never allocate large FUNs and THUNKs, but we allocate large + STACKs (e.g. in threadStackOverflow), and stack frames can have SRTs. So + scavenge_one skips FUN and THUNK SRTs but scavenges stack frame SRTs. + + In summary, in a major GC: + + - scavenge_block() scavenges all SRTs + - scavenge_one() scavenges only stack frame SRTs + ------------------------------------------------------------------------- */ + #include "PosixSource.h" #include "Rts.h" From git at git.haskell.org Fri Jun 29 06:46:57 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Jun 2018 06:46:57 +0000 (UTC) Subject: [commit: ghc] master: Add -ddump-rtti to user's guide and man page (4760a8c) Message-ID: <20180629064657.1514A3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4760a8c1d5f5e0daea7a5a3cae7721f4a214d2ff/ghc >--------------------------------------------------------------- commit 4760a8c1d5f5e0daea7a5a3cae7721f4a214d2ff Author: Ömer Sinan Ağacan Date: Fri Jun 29 09:46:24 2018 +0300 Add -ddump-rtti to user's guide and man page Reviewers: bgamari Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4903 >--------------------------------------------------------------- 4760a8c1d5f5e0daea7a5a3cae7721f4a214d2ff docs/users_guide/debugging.rst | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index 1a37eae..ab5942f 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -554,6 +554,12 @@ These flags dump various bits of information from other backends. Dump byte-code objects (BCOs) produced for the GHC's byte-code interpreter. +.. ghc-flag:: -ddump-rtti + :shortdesc: Trace runtime type inference + :type: dynamic + + Trace runtime type inference done by various interpreter commands. + .. ghc-flag:: -ddump-foreign :shortdesc: Dump ``foreign export`` stubs :type: dynamic From git at git.haskell.org Fri Jun 29 12:52:21 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Jun 2018 12:52:21 +0000 (UTC) Subject: [commit: ghc] master: A few typofixes in comments (9a371d6) Message-ID: <20180629125221.B122B3ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9a371d6534549496bb3083853645d6e649743fd2/ghc >--------------------------------------------------------------- commit 9a371d6534549496bb3083853645d6e649743fd2 Author: Gabor Greif Date: Fri Jun 29 14:50:12 2018 +0200 A few typofixes in comments >--------------------------------------------------------------- 9a371d6534549496bb3083853645d6e649743fd2 compiler/basicTypes/Id.hs | 2 +- compiler/basicTypes/IdInfo.hs | 2 +- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/typecheck/TcUnify.hs | 2 +- compiler/types/Coercion.hs | 2 +- testsuite/tests/simplCore/should_compile/T7287.hs | 2 +- testsuite/tests/simplCore/should_compile/all.T | 2 +- utils/llvm-targets/gen-data-layout.sh | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index e38769a..c1d281e 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -219,7 +219,7 @@ lazySetIdInfo = Var.lazySetIdInfo setIdInfo :: Id -> IdInfo -> Id setIdInfo id info = info `seq` (lazySetIdInfo id info) - -- Try to avoid spack leaks by seq'ing + -- Try to avoid space leaks by seq'ing modifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id modifyIdInfo fn id = setIdInfo id (fn (idInfo id)) diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index f6febaf..12ea490 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -263,7 +263,7 @@ setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } setOccInfo :: IdInfo -> OccInfo -> IdInfo setOccInfo info oc = oc `seq` info { occInfo = oc } - -- Try to avoid spack leaks by seq'ing + -- Try to avoid space leaks by seq'ing setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo setUnfoldingInfo info uf diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 8f4f84b..3c65072 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -532,7 +532,7 @@ isDefaultAlt _ = False -- | Find the case alternative corresponding to a particular -- constructor: panics if no such constructor exists findAlt :: AltCon -> [(AltCon, a, b)] -> Maybe (AltCon, a, b) - -- A "Nothing" result *is* legitmiate + -- A "Nothing" result *is* legitimate -- See Note [Unreachable code] findAlt con alts = case alts of diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 9b32c3c..eb44bc3 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -1778,7 +1778,7 @@ Note [Eliminate younger unification variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a choice of unifying alpha := beta or beta := alpha -we try, if possible, to elimiate the "younger" one, as determined +we try, if possible, to eliminate the "younger" one, as determined by `ltUnique`. Reason: the younger one is less likely to appear free in an existing inert constraint, and hence we are less likely to be forced into kicking out and rewriting inert constraints. diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index d0d0e97..346190c 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1161,7 +1161,7 @@ applyRoles tc cos = zipWith (\r -> downgradeRole r Nominal) (tyConRolesRepresentational tc) cos -- the Role parameter is the Role of the TyConAppCo --- defined here because this is intimiately concerned with the implementation +-- defined here because this is intimately concerned with the implementation -- of TyConAppCo tyConRolesX :: Role -> TyCon -> [Role] tyConRolesX Representational tc = tyConRolesRepresentational tc diff --git a/testsuite/tests/simplCore/should_compile/T7287.hs b/testsuite/tests/simplCore/should_compile/T7287.hs index e4a07b1..bb9035a 100644 --- a/testsuite/tests/simplCore/should_compile/T7287.hs +++ b/testsuite/tests/simplCore/should_compile/T7287.hs @@ -7,7 +7,7 @@ import GHC.Prim "int2Word#/word2Int#" forall x. int2Word# (word2Int# x) = x #-} -{- We get a legitmiate +{- We get a legitimate T7287.hs:7:3: warning: Rule int2Word#/word2Int# may never fire because diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 5ad7dba..58e9893 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -113,7 +113,7 @@ test('T5168', ['$MAKE -s --no-print-directory T5168']) test('T5329', normal, compile, ['']) -test('T5303', normal, compile, ['']) # Coercion-optimiation test +test('T5303', normal, compile, ['']) # Coercion-optimisation test test('T5342', normal, compile, ['']) # Lint error with -prof test('T5359a', normal, compile, ['']) # Lint error with -O (OccurAnal) test('T5359b', normal, compile, ['']) # Lint error with -O (OccurAnal) diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh index ab036a9..3d222d0 100755 --- a/utils/llvm-targets/gen-data-layout.sh +++ b/utils/llvm-targets/gen-data-layout.sh @@ -71,7 +71,7 @@ function get_cpu_and_attr() { done } -# first marker to discrimiate the first line being outputted. +# first marker to discriminate the first line being outputted. FST=1 # a dummy file to use for the clang invocation. FILE=_____dummy.c From git at git.haskell.org Fri Jun 29 18:33:22 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Jun 2018 18:33:22 +0000 (UTC) Subject: [commit: ghc] master: Don't lock the MVar closure on tryReadMVar (6bb0c5d) Message-ID: <20180629183322.45E783ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6bb0c5db818c1ba9cd5fe1785a3020cfddf0c223/ghc >--------------------------------------------------------------- commit 6bb0c5db818c1ba9cd5fe1785a3020cfddf0c223 Author: David Feuer Date: Fri Jun 29 14:31:33 2018 -0400 Don't lock the MVar closure on tryReadMVar It shouldn't be necessary to lock the `MVar` closure on `tryReadMVar`, since it just reads one field of the structure and doesn't make any modifications. So let's not. Reviewers: bgamari, erikd, simonmar, fryguybob, osa1 Reviewed By: osa1 Subscribers: osa1, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4905 >--------------------------------------------------------------- 6bb0c5db818c1ba9cd5fe1785a3020cfddf0c223 rts/PrimOps.cmm | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 6081fab..058fe1e 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -1825,18 +1825,14 @@ stg_readMVarzh ( P_ mvar, /* :: MVar a */ ) stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ ) { - W_ val, info, tso, q; + W_ val; - LOCK_CLOSURE(mvar, info); + val = StgMVar_value(mvar); - if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) { - unlockClosure(mvar, info); + if (val == stg_END_TSO_QUEUE_closure) { return (0, stg_NO_FINALIZER_closure); } - val = StgMVar_value(mvar); - - unlockClosure(mvar, info); return (1, val); } From git at git.haskell.org Fri Jun 29 19:01:53 2018 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 29 Jun 2018 19:01:53 +0000 (UTC) Subject: [commit: ghc] master: Fix mkGadtDecl does not set con_forall correctly (6e4e6d1) Message-ID: <20180629190153.98A833ABA3@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6e4e6d1c674a9d0257ca5c6caa26da18edf8ad8c/ghc >--------------------------------------------------------------- commit 6e4e6d1c674a9d0257ca5c6caa26da18edf8ad8c 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 >--------------------------------------------------------------- 6e4e6d1c674a9d0257ca5c6caa26da18edf8ad8c 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 44159dc..7dc3aaf 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'])