From git at git.haskell.org Sat Aug 1 08:03:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Aug 2015 08:03:29 +0000 (UTC) Subject: [commit: ghc] wip/branchedness: a few changes along the lines of Richard's review in https://phabricator.haskell.org/rGHCb5be9b7fb82b (e19bc09) Message-ID: <20150801080329.04C723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/branchedness Link : http://ghc.haskell.org/trac/ghc/changeset/e19bc0941cce8b0d50c33a6c6337478148585ad3/ghc >--------------------------------------------------------------- commit e19bc0941cce8b0d50c33a6c6337478148585ad3 Author: Gabor Greif Date: Sat Aug 1 10:04:11 2015 +0200 a few changes along the lines of Richard's review in https://phabricator.haskell.org/rGHCb5be9b7fb82b >--------------------------------------------------------------- e19bc0941cce8b0d50c33a6c6337478148585ad3 compiler/types/CoAxiom.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index 4c6f478..5f36048 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -6,7 +6,7 @@ -- and newtypes module CoAxiom ( - Branchedness(..), BranchIndex, BranchList(..), + Branched, Unbranched, BranchIndex, BranchList(..), toBranchList, fromBranchList, toBranchedList, toUnbranchedList, brListLength, brListNth, brListMap, brListFoldr, brListMapM, @@ -119,11 +119,15 @@ type BranchIndex = Int -- The index of the branch in the list of branches -- Counting from zero -- promoted data type -data Branchedness = Unbranched | Branched -deriving instance Typeable 'Unbranched +data BranchFlag = Branched | Unbranched +type Branched = 'Branched deriving instance Typeable 'Branched +type Unbranched = 'Unbranched +--data Branchedness = Unbranched | Branched +deriving instance Typeable 'Unbranched +--deriving instance Typeable 'Branched -data BranchList a (br :: Branchedness) where +data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br NextBranch :: a -> BranchList a br -> BranchList a Branched From git at git.haskell.org Sat Aug 1 08:22:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Aug 2015 08:22:42 +0000 (UTC) Subject: [commit: ghc] wip/branchedness: cleanups (edb627d) Message-ID: <20150801082242.8A61D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/branchedness Link : http://ghc.haskell.org/trac/ghc/changeset/edb627d8fbba9b616f96c00af85946b0aa97ad49/ghc >--------------------------------------------------------------- commit edb627d8fbba9b616f96c00af85946b0aa97ad49 Author: Gabor Greif Date: Sat Aug 1 10:21:10 2015 +0200 cleanups >--------------------------------------------------------------- edb627d8fbba9b616f96c00af85946b0aa97ad49 compiler/basicTypes/MkId.hs | 2 +- compiler/iface/TcIface.hs | 2 +- compiler/main/HscTypes.hs | 2 +- compiler/typecheck/FamInst.hs | 2 +- compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcEvidence.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/types/CoAxiom.hs | 2 -- compiler/types/Coercion.hs | 2 +- compiler/types/FamInstEnv.hs | 2 +- compiler/types/OptCoercion.hs | 2 +- compiler/types/TyCon.hs | 2 +- compiler/types/TypeRep.hs | 2 +- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- 14 files changed, 13 insertions(+), 15 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 784ba1d..bdcaf72 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -12,7 +12,7 @@ have a standard form, namely: - primitive operations -} -{-# LANGUAGE CPP, DataKinds #-} +{-# LANGUAGE CPP #-} module MkId ( mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs, diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index dc1bf0f..30ce0cd 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -6,7 +6,7 @@ Type checking of type signatures in interface files -} -{-# LANGUAGE CPP, DataKinds #-} +{-# LANGUAGE CPP #-} module TcIface ( tcLookupImported_maybe, diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 6b8d40d..7bceda5 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -4,7 +4,7 @@ \section[HscTypes]{Types for the per-module compiler} -} -{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, ScopedTypeVariables #-} +{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-} -- | Types for the per-module compiler module HscTypes ( diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index 1dfdd21..3af2358 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -1,6 +1,6 @@ -- The @FamInst@ type: family instance heads -{-# LANGUAGE CPP, DataKinds, GADTs #-} +{-# LANGUAGE CPP, GADTs #-} module FamInst ( FamInstEnvs, tcGetFamInstEnvs, diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 7f0fd86..8db9f26 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE CPP, DataKinds, FlexibleInstances #-} +{-# LANGUAGE CPP, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan module TcEnv( diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index ab3c9c5..e08d0d5 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module TcEvidence ( diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index da68cfa..b7a959e 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -6,7 +6,7 @@ TcTyClsDecls: Typecheck type and class declarations -} -{-# LANGUAGE CPP, DataKinds, TupleSections #-} +{-# LANGUAGE CPP, TupleSections #-} module TcTyClsDecls ( tcTyAndClassDecls, tcAddImplicits, diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index 5f36048..36d9a67 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -123,9 +123,7 @@ data BranchFlag = Branched | Unbranched type Branched = 'Branched deriving instance Typeable 'Branched type Unbranched = 'Unbranched ---data Branchedness = Unbranched | Branched deriving instance Typeable 'Unbranched ---deriving instance Typeable 'Branched data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 79d3b1c..80fdcc6 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} -- | Module for (a) type kinds and (b) type coercions, -- as used in System FC. See 'CoreSyn.Expr' for diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 9867551..98071e8 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -2,7 +2,7 @@ -- -- FamInstEnv: Type checked family instance declarations -{-# LANGUAGE CPP, DataKinds, GADTs, ScopedTypeVariables #-} +{-# LANGUAGE CPP, GADTs, ScopedTypeVariables #-} module FamInstEnv ( FamInst(..), FamFlavor(..), famInstAxiom, famInstTyCon, famInstRHS, diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index e50967b..35d1781 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2006 -{-# LANGUAGE CPP, DataKinds #-} +{-# LANGUAGE CPP #-} module OptCoercion ( optCoercion, checkAxInstCo ) where diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 76e1d28..683c939 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -6,7 +6,7 @@ The @TyCon@ datatype -} -{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} module TyCon( -- * Main TyCon data types diff --git a/compiler/types/TypeRep.hs b/compiler/types/TypeRep.hs index b928d6a..b37ca62 100644 --- a/compiler/types/TypeRep.hs +++ b/compiler/types/TypeRep.hs @@ -15,7 +15,7 @@ Note [The Type-related module hierarchy] Coercion imports Type -} -{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# OPTIONS_HADDOCK hide #-} -- We expose the relevant stuff from this module via the Type module diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index 4e1e900..47b1caa 100644 --- a/compiler/vectorise/Vectorise/Type/Env.hs +++ b/compiler/vectorise/Vectorise/Type/Env.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DataKinds #-} +{-# LANGUAGE CPP #-} -- Vectorise a modules type and class declarations. -- From git at git.haskell.org Sat Aug 1 08:54:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Aug 2015 08:54:28 +0000 (UTC) Subject: [commit: ghc] wip/branchedness: Make BranchFlag a new kind, resolving an old TODO comment (a8754a4) Message-ID: <20150801085428.656393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/branchedness Link : http://ghc.haskell.org/trac/ghc/changeset/a8754a40132f7e59d4e0e166fc8ad4ef96b95aab/ghc >--------------------------------------------------------------- commit a8754a40132f7e59d4e0e166fc8ad4ef96b95aab Author: Gabor Greif Date: Sat Aug 1 10:52:39 2015 +0200 Make BranchFlag a new kind, resolving an old TODO comment >--------------------------------------------------------------- a8754a40132f7e59d4e0e166fc8ad4ef96b95aab compiler/types/CoAxiom.hs | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index cd8607a..36d9a67 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2012 -{-# LANGUAGE CPP, DeriveDataTypeable, GADTs, ScopedTypeVariables #-} +{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, GADTs, KindSignatures, ScopedTypeVariables, StandaloneDeriving #-} -- | Module for coercion axioms, used to represent type family instances -- and newtypes @@ -108,13 +108,6 @@ declaring whether it is known to be a singleton or not. The list of branches is stored using a special form of list, declared below, that ensures that the type variable is accurate. -As of this writing (Dec 2012), it would not be appropriate to use a promoted -type as the phantom type, so we use empty datatypes. We wish to have GHC -remain compilable with GHC 7.2.1. If you are revising this code and GHC no -longer needs to remain compatible with GHC 7.2.x, then please update this -code to use promoted types. - - ************************************************************************ * * Branch lists @@ -125,11 +118,14 @@ code to use promoted types. type BranchIndex = Int -- The index of the branch in the list of branches -- Counting from zero --- the phantom type labels -data Unbranched deriving Typeable -data Branched deriving Typeable +-- promoted data type +data BranchFlag = Branched | Unbranched +type Branched = 'Branched +deriving instance Typeable 'Branched +type Unbranched = 'Unbranched +deriving instance Typeable 'Unbranched -data BranchList a br where +data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br NextBranch :: a -> BranchList a br -> BranchList a Branched From git at git.haskell.org Sat Aug 1 15:33:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 1 Aug 2015 15:33:29 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (75504f3) Message-ID: <20150801153329.A990A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/75504f300d4db33ff66cc1a572d473bdb23b6a42/ghc >--------------------------------------------------------------- commit 75504f300d4db33ff66cc1a572d473bdb23b6a42 Author: Gabor Greif Date: Sat Aug 1 17:31:42 2015 +0200 Typos in comments >--------------------------------------------------------------- 75504f300d4db33ff66cc1a572d473bdb23b6a42 compiler/basicTypes/MkId.hs | 2 +- compiler/hsSyn/HsDecls.hs | 2 +- compiler/typecheck/TcValidity.hs | 2 +- compiler/types/FamInstEnv.hs | 2 +- rts/win32/GetTime.c | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index bdcaf72..11f8f78 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -833,7 +833,7 @@ wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr -- newtype T a = MkT (a,Int) -- MkT :: forall a. (a,Int) -> T a -- MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a) --- where CoT is the coercion TyCon assoicated with the newtype +-- where CoT is the coercion TyCon associated with the newtype -- -- The call (wrapNewTypeBody T [a] e) returns the -- body of the wrapper, namely diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 79b0dee..7b263ab 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -494,7 +494,7 @@ data TyClDecl name -- For details on above see note [Api annotations] in ApiAnnotation DataDecl { tcdLName :: Located name -- ^ Type constructor - , tcdTyVars :: LHsTyVarBndrs name -- ^ Type variables; for an assoicated type + , tcdTyVars :: LHsTyVarBndrs name -- ^ Type variables; for an associated type -- these include outer binders -- Eg class T a where -- type F a :: * diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 4dd9a5e..67d7517 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1107,7 +1107,7 @@ So we consistent with the instance types [p] y Int We do *not* assume (at this point) the the bound variables of -the assoicated type instance decl are the same as for the parent +the associated type instance decl are the same as for the parent instance decl. So, for example, instance C [p] Int diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 98071e8..a4b1a21 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -891,7 +891,7 @@ topNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe (Coercion, Type) -- * type function redex -- * data family redex -- * newtypes --- returning an appropriate Representaitonal coercion. Specifically, if +-- returning an appropriate Representational coercion. Specifically, if -- topNormaliseType_maybe env ty = Maybe (co, ty') -- then -- (a) co :: ty ~R ty' diff --git a/rts/win32/GetTime.c b/rts/win32/GetTime.c index 514def6..3600839 100644 --- a/rts/win32/GetTime.c +++ b/rts/win32/GetTime.c @@ -48,7 +48,7 @@ getProcessCPUTime(void) } // Number of ticks per second used by the QueryPerformanceFrequency -// implementaiton, represented by a 64-bit union type. +// implementation, represented by a 64-bit union type. static LARGE_INTEGER qpc_frequency = {.QuadPart = 0}; // Initialize qpc_frequency. This function should be called before any call to From git at git.haskell.org Sun Aug 2 08:25:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 08:25:49 +0000 (UTC) Subject: [commit: ghc] master: Replace (SourceText, FastString) with StringLiteral data type (15dd700) Message-ID: <20150802082549.C7CA83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15dd7007275a5dcdae2c9f104773eceaa56590dc/ghc >--------------------------------------------------------------- commit 15dd7007275a5dcdae2c9f104773eceaa56590dc Author: Alan Zimmerman Date: Sun Aug 2 10:26:59 2015 +0200 Replace (SourceText,FastString) with StringLiteral data type Summary: Phab:D907 introduced SourceText for a number of data types, by replacing FastString with (SourceText,FastString). Since this has an Outputable instance, no warnings are generated when ppr is called on it, but unexpected output is generated. See Phab:D1096 for an example of this. Replace the (SourceText,FastString) tuples with a new data type, ```lang=hs data StringLiteral = StringLiteral SourceText FastString ``` Update haddock submodule accordingly Test Plan: ./validate Reviewers: hvr, austin, rwbarton, trofi, bgamari Reviewed By: trofi, bgamari Subscribers: thomie, trofi, rwbarton, mpickering Differential Revision: https://phabricator.haskell.org/D1101 GHC Trac Issues: #10692 >--------------------------------------------------------------- 15dd7007275a5dcdae2c9f104773eceaa56590dc compiler/basicTypes/BasicTypes.hs | 24 +++++++++++----- compiler/deSugar/DsExpr.hs | 2 +- compiler/hsSyn/HsExpr.hs | 18 +++++++----- compiler/hsSyn/HsImpExp.hs | 20 ++++++------- compiler/iface/MkIface.hs | 2 +- compiler/main/DriverMkDepend.hs | 3 +- compiler/main/GhcMake.hs | 2 +- compiler/parser/Parser.y | 33 +++++++++++----------- compiler/parser/RdrHsSyn.hs | 8 +++--- compiler/rename/RnNames.hs | 13 +++++---- compiler/utils/Binary.hs | 9 ++++++ ghc/InteractiveUI.hs | 6 ++-- .../tests/ghc-api/annotations/stringSource.hs | 15 ++++++---- utils/haddock | 2 +- 14 files changed, 93 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 15dd7007275a5dcdae2c9f104773eceaa56590dc From git at git.haskell.org Sun Aug 2 17:44:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 17:44:44 +0000 (UTC) Subject: [commit: ghc] wip/branchedness: Make BranchFlag a new kind, resolving an old TODO comment (1634c3c) Message-ID: <20150802174444.DC31A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/branchedness Link : http://ghc.haskell.org/trac/ghc/changeset/1634c3c6cf7b1410bd1a939d795c7afa66e94254/ghc >--------------------------------------------------------------- commit 1634c3c6cf7b1410bd1a939d795c7afa66e94254 Author: Gabor Greif Date: Sat Aug 1 10:52:39 2015 +0200 Make BranchFlag a new kind, resolving an old TODO comment >--------------------------------------------------------------- 1634c3c6cf7b1410bd1a939d795c7afa66e94254 compiler/types/CoAxiom.hs | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index cd8607a..36d9a67 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -1,6 +1,6 @@ -- (c) The University of Glasgow 2012 -{-# LANGUAGE CPP, DeriveDataTypeable, GADTs, ScopedTypeVariables #-} +{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, GADTs, KindSignatures, ScopedTypeVariables, StandaloneDeriving #-} -- | Module for coercion axioms, used to represent type family instances -- and newtypes @@ -108,13 +108,6 @@ declaring whether it is known to be a singleton or not. The list of branches is stored using a special form of list, declared below, that ensures that the type variable is accurate. -As of this writing (Dec 2012), it would not be appropriate to use a promoted -type as the phantom type, so we use empty datatypes. We wish to have GHC -remain compilable with GHC 7.2.1. If you are revising this code and GHC no -longer needs to remain compatible with GHC 7.2.x, then please update this -code to use promoted types. - - ************************************************************************ * * Branch lists @@ -125,11 +118,14 @@ code to use promoted types. type BranchIndex = Int -- The index of the branch in the list of branches -- Counting from zero --- the phantom type labels -data Unbranched deriving Typeable -data Branched deriving Typeable +-- promoted data type +data BranchFlag = Branched | Unbranched +type Branched = 'Branched +deriving instance Typeable 'Branched +type Unbranched = 'Unbranched +deriving instance Typeable 'Unbranched -data BranchList a br where +data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br NextBranch :: a -> BranchList a br -> BranchList a Branched From git at git.haskell.org Sun Aug 2 17:44:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 17:44:47 +0000 (UTC) Subject: [commit: ghc] wip/branchedness: Typo (9364d27) Message-ID: <20150802174447.988193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/branchedness Link : http://ghc.haskell.org/trac/ghc/changeset/9364d27976853cad7e4aff37384fe208489e4406/ghc >--------------------------------------------------------------- commit 9364d27976853cad7e4aff37384fe208489e4406 Author: Gabor Greif Date: Sun Aug 2 19:26:04 2015 +0200 Typo >--------------------------------------------------------------- 9364d27976853cad7e4aff37384fe208489e4406 compiler/types/FamInstEnv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index a4b1a21..bea00fc 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -274,7 +274,7 @@ Type families are reduced during type inference, but not data families; the user explains when to use a data family instance by using contructors and pattern matching. -Neverthless it is still useful to have data families in the FamInstEnv: +Nevertheless it is still useful to have data families in the FamInstEnv: - For finding overlaps and conflicts From git at git.haskell.org Sun Aug 2 17:44:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 17:44:50 +0000 (UTC) Subject: [commit: ghc] wip/branchedness: Add explaining comment (d7c6a64) Message-ID: <20150802174450.5D3963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/branchedness Link : http://ghc.haskell.org/trac/ghc/changeset/d7c6a64d9f34d1fa6be08857c8c6c85d6a0b61f2/ghc >--------------------------------------------------------------- commit d7c6a64d9f34d1fa6be08857c8c6c85d6a0b61f2 Author: Gabor Greif Date: Sun Aug 2 19:29:46 2015 +0200 Add explaining comment >--------------------------------------------------------------- d7c6a64d9f34d1fa6be08857c8c6c85d6a0b61f2 compiler/types/CoAxiom.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index 36d9a67..9a85185 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -6,7 +6,7 @@ -- and newtypes module CoAxiom ( - Branched, Unbranched, BranchIndex, BranchList(..), + BranchFlag, Branched, Unbranched, BranchIndex, BranchList(..), toBranchList, fromBranchList, toBranchedList, toUnbranchedList, brListLength, brListNth, brListMap, brListFoldr, brListMapM, @@ -124,6 +124,9 @@ type Branched = 'Branched deriving instance Typeable 'Branched type Unbranched = 'Unbranched deriving instance Typeable 'Unbranched +-- By using type synonyms for the promoted constructors, we avoid needing +-- DataKinds and the promotion quote in client modules. This also means that +-- we don't need to export the term-level constructors, which should never be used. data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br From git at git.haskell.org Sun Aug 2 17:44:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 17:44:52 +0000 (UTC) Subject: [commit: ghc] wip/branchedness's head updated: Add explaining comment (d7c6a64) Message-ID: <20150802174452.A4EDC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/branchedness' now includes: a66e1ba User's guide: delete ancient "Core syntax" example 7cf87df Fix #7919 (again) 353db30 Remove checked-in PDFs. 8f81af9 Typos in comments ad089f5 Give raise# a return type of open kind (#10481) 75504f3 Typos in comments 15dd700 Replace (SourceText,FastString) with StringLiteral data type 1634c3c Make BranchFlag a new kind, resolving an old TODO comment 9364d27 Typo d7c6a64 Add explaining comment From git at git.haskell.org Sun Aug 2 18:12:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 18:12:12 +0000 (UTC) Subject: [commit: ghc] master: Typo in comment (d9b618f) Message-ID: <20150802181212.E1AB03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d9b618ff78e13f5fe7ae53e4363c658eb805785f/ghc >--------------------------------------------------------------- commit d9b618ff78e13f5fe7ae53e4363c658eb805785f Author: Gabor Greif Date: Sun Aug 2 19:26:04 2015 +0200 Typo in comment >--------------------------------------------------------------- d9b618ff78e13f5fe7ae53e4363c658eb805785f compiler/types/FamInstEnv.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index a4b1a21..bea00fc 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -274,7 +274,7 @@ Type families are reduced during type inference, but not data families; the user explains when to use a data family instance by using contructors and pattern matching. -Neverthless it is still useful to have data families in the FamInstEnv: +Nevertheless it is still useful to have data families in the FamInstEnv: - For finding overlaps and conflicts From git at git.haskell.org Sun Aug 2 18:12:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 18:12:15 +0000 (UTC) Subject: [commit: ghc] master: Make BranchFlag a new kind (37227d3) Message-ID: <20150802181215.A18D83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37227d3400549c2a6844dfb8c34c0738edc69ecc/ghc >--------------------------------------------------------------- commit 37227d3400549c2a6844dfb8c34c0738edc69ecc Author: Gabor Greif Date: Sat Aug 1 10:52:39 2015 +0200 Make BranchFlag a new kind this is resolving an old TODO comment >--------------------------------------------------------------- 37227d3400549c2a6844dfb8c34c0738edc69ecc compiler/types/CoAxiom.hs | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index cd8607a..9a85185 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -1,12 +1,12 @@ -- (c) The University of Glasgow 2012 -{-# LANGUAGE CPP, DeriveDataTypeable, GADTs, ScopedTypeVariables #-} +{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, GADTs, KindSignatures, ScopedTypeVariables, StandaloneDeriving #-} -- | Module for coercion axioms, used to represent type family instances -- and newtypes module CoAxiom ( - Branched, Unbranched, BranchIndex, BranchList(..), + BranchFlag, Branched, Unbranched, BranchIndex, BranchList(..), toBranchList, fromBranchList, toBranchedList, toUnbranchedList, brListLength, brListNth, brListMap, brListFoldr, brListMapM, @@ -108,13 +108,6 @@ declaring whether it is known to be a singleton or not. The list of branches is stored using a special form of list, declared below, that ensures that the type variable is accurate. -As of this writing (Dec 2012), it would not be appropriate to use a promoted -type as the phantom type, so we use empty datatypes. We wish to have GHC -remain compilable with GHC 7.2.1. If you are revising this code and GHC no -longer needs to remain compatible with GHC 7.2.x, then please update this -code to use promoted types. - - ************************************************************************ * * Branch lists @@ -125,11 +118,17 @@ code to use promoted types. type BranchIndex = Int -- The index of the branch in the list of branches -- Counting from zero --- the phantom type labels -data Unbranched deriving Typeable -data Branched deriving Typeable - -data BranchList a br where +-- promoted data type +data BranchFlag = Branched | Unbranched +type Branched = 'Branched +deriving instance Typeable 'Branched +type Unbranched = 'Unbranched +deriving instance Typeable 'Unbranched +-- By using type synonyms for the promoted constructors, we avoid needing +-- DataKinds and the promotion quote in client modules. This also means that +-- we don't need to export the term-level constructors, which should never be used. + +data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br NextBranch :: a -> BranchList a br -> BranchList a Branched From git at git.haskell.org Sun Aug 2 18:21:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 18:21:27 +0000 (UTC) Subject: [commit: ghc] branch 'wip/branchedness' deleted Message-ID: <20150802182127.064B83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/branchedness From git at git.haskell.org Sun Aug 2 21:39:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 21:39:59 +0000 (UTC) Subject: [commit: ghc] branch 'wip/ggreif' created Message-ID: <20150802213959.6C5183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/ggreif Referencing: 0c6e8116c1b525304beed4a9d89ec780485c5e18 From git at git.haskell.org Sun Aug 2 21:40:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 2 Aug 2015 21:40:02 +0000 (UTC) Subject: [commit: ghc] wip/ggreif: BranchList refactoring, wip (0c6e811) Message-ID: <20150802214002.4C15B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ggreif Link : http://ghc.haskell.org/trac/ghc/changeset/0c6e8116c1b525304beed4a9d89ec780485c5e18/ghc >--------------------------------------------------------------- commit 0c6e8116c1b525304beed4a9d89ec780485c5e18 Author: Gabor Greif Date: Sun Aug 2 23:34:49 2015 +0200 BranchList refactoring, wip >--------------------------------------------------------------- 0c6e8116c1b525304beed4a9d89ec780485c5e18 compiler/types/CoAxiom.hs | 34 +++++++++++++++++++--------------- compiler/types/FamInstEnv.hs | 2 +- 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index 9a85185..4380ca8 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -130,17 +130,17 @@ deriving instance Typeable 'Unbranched data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br - NextBranch :: a -> BranchList a br -> BranchList a Branched + NextBranch :: a -> [a] -> BranchList a Branched -- convert to/from lists toBranchList :: [a] -> BranchList a Branched toBranchList [] = pprPanic "toBranchList" empty toBranchList [b] = FirstBranch b -toBranchList (h:t) = NextBranch h (toBranchList t) +toBranchList (h:t) = NextBranch h t fromBranchList :: BranchList a br -> [a] fromBranchList (FirstBranch b) = [b] -fromBranchList (NextBranch h t) = h : (fromBranchList t) +fromBranchList (NextBranch h t) = h : t -- convert from any BranchList to a Branched BranchList toBranchedList :: BranchList a br -> BranchList a Branched @@ -155,45 +155,49 @@ toUnbranchedList _ = pprPanic "toUnbranchedList" empty -- length brListLength :: BranchList a br -> Int brListLength (FirstBranch _) = 1 -brListLength (NextBranch _ t) = 1 + brListLength t +brListLength (NextBranch _ t) = 1 + length t -- lookup brListNth :: BranchList a br -> BranchIndex -> a brListNth (FirstBranch b) 0 = b brListNth (NextBranch h _) 0 = h -brListNth (NextBranch _ t) n = brListNth t (n-1) +brListNth (NextBranch _ t) n = t !! (n-1) brListNth _ _ = pprPanic "brListNth" empty -- map, fold brListMap :: (a -> b) -> BranchList a br -> [b] brListMap f (FirstBranch b) = [f b] -brListMap f (NextBranch h t) = f h : (brListMap f t) +brListMap f (NextBranch h t) = f h : map f t brListFoldr :: (a -> b -> b) -> b -> BranchList a br -> b brListFoldr f x (FirstBranch b) = f b x -brListFoldr f x (NextBranch h t) = f h (brListFoldr f x t) +brListFoldr f x (NextBranch h t) = f h (foldr f x t) brListMapM :: Monad m => (a -> m b) -> BranchList a br -> m [b] brListMapM f (FirstBranch b) = f b >>= \fb -> return [fb] brListMapM f (NextBranch h t) = do { fh <- f h - ; ft <- brListMapM f t + ; ft <- mapM f t ; return (fh : ft) } brListFoldlM_ :: forall a b m br. Monad m => (a -> b -> m a) -> a -> BranchList b br -> m () -brListFoldlM_ f z brs = do { _ <- go z brs - ; return () } - where go :: forall br'. a -> BranchList b br' -> m a - go acc (FirstBranch b) = f acc b - go acc (NextBranch h t) = do { fh <- f acc h - ; go fh t } +brListFoldlM_ f z (FirstBranch b) = do { _ <- f z b + ; return () } +brListFoldlM_ f z (NextBranch h t) = do { z' <- f z h + ; _ <- go z' t + ; return () } + where go :: a -> [b] -> m a + go acc [b] = f acc b + go acc (h : t) = do { fh <- f acc h + ; go fh t } + go _ _ = pprPanic "brListFoldlM_" empty -- zipWith brListZipWith :: (a -> b -> c) -> BranchList a br1 -> BranchList b br2 -> [c] brListZipWith f (FirstBranch a) (FirstBranch b) = [f a b] brListZipWith f (FirstBranch a) (NextBranch b _) = [f a b] brListZipWith f (NextBranch a _) (FirstBranch b) = [f a b] -brListZipWith f (NextBranch a ta) (NextBranch b tb) = f a b : brListZipWith f ta tb +brListZipWith f (NextBranch a ta) (NextBranch b tb) = f a b : zipWith f ta tb -- pretty-printing diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index bea00fc..b22b10f 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -492,7 +492,7 @@ computeAxiomIncomps ax@(CoAxiom { co_ax_branches = branches }) = FirstBranch (br { cab_incomps = mk_incomps br prev_branches }) go prev_branches (NextBranch br tail) = let br' = br { cab_incomps = mk_incomps br prev_branches } in - NextBranch br' (go (br' : prev_branches) tail) + NextBranch br' (fromBranchList (go (br' : prev_branches) tail)) mk_incomps :: CoAxBranch -> [CoAxBranch] -> [CoAxBranch] mk_incomps br = filter (not . compatibleBranches br) From git at git.haskell.org Mon Aug 3 09:15:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 09:15:08 +0000 (UTC) Subject: [commit: ghc] master: Support MO_U_QuotRem2 in LLVM backend (92f5385) Message-ID: <20150803091508.B29033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92f5385d8b2be50848a2496199a481f299f4b53a/ghc >--------------------------------------------------------------- commit 92f5385d8b2be50848a2496199a481f299f4b53a Author: Michal Terepeta Date: Mon Aug 3 08:41:13 2015 +0200 Support MO_U_QuotRem2 in LLVM backend This adds support for MO_U_QuotRem2 in LLVM backend. Similarly to MO_U_Mul2 we use the standard LLVM instructions (in this case 'udiv' and 'urem') but do the computation on double the word width (e.g., for 64-bit we will do them on 128 registers). Test Plan: validate Reviewers: rwbarton, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1100 GHC Trac Issues: #9430 >--------------------------------------------------------------- 92f5385d8b2be50848a2496199a481f299f4b53a compiler/codeGen/StgCmmPrim.hs | 3 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 72 +++++++++++++++++++++++++++++ testsuite/tests/primops/should_run/T9430.hs | 35 ++++++++++++++ 3 files changed, 109 insertions(+), 1 deletion(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 243e2a3..d201eaf 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -808,7 +808,8 @@ callishPrimOpSupported dflags op WordQuotRemOp | ncg && x86ish -> Left (MO_U_QuotRem (wordWidth dflags)) | otherwise -> Right (genericWordQuotRemOp dflags) - WordQuotRem2Op | ncg && x86ish -> Left (MO_U_QuotRem2 (wordWidth dflags)) + WordQuotRem2Op | (ncg && x86ish) + || llvm -> Left (MO_U_QuotRem2 (wordWidth dflags)) | otherwise -> Right (genericWordQuotRem2Op dflags) WordAdd2Op | (ncg && x86ish) diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index fb02120..517da53 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -32,6 +32,13 @@ import UniqSupply import Unique import Util +import Control.Monad.Trans.Class +import Control.Monad.Trans.Writer + +#if MIN_VERSION_base(4,8,0) +#else +import Data.Monoid ( Monoid, mappend, mempty ) +#endif import Data.List ( nub ) import Data.Maybe ( catMaybes ) @@ -288,6 +295,53 @@ genCall (PrimTarget (MO_U_Mul2 w)) [dstH, dstL] [lhs, rhs] = do toOL [ stmt3 , stmt4, stmt5, stmt6, stmt7, stmt8, storeL, storeH ] return (stmts, decls1 ++ decls2) +-- MO_U_QuotRem2 is another case we handle by widening the registers to double +-- the width and use normal LLVM instructions (similarly to the MO_U_Mul2). The +-- main difference here is that we need to conmbine two words into one register +-- and then use both 'udiv' and 'urem' instructions to compute the result. +genCall (PrimTarget (MO_U_QuotRem2 w)) [dstQ, dstR] [lhsH, lhsL, rhs] = run $ do + let width = widthToLlvmInt w + bitWidth = widthInBits w + width2x = LMInt (bitWidth * 2) + -- First zero-extend all parameters to double width. + let zeroExtend expr = do + var <- liftExprData $ exprToVar expr + doExprW width2x $ Cast LM_Zext var width2x + lhsExtH <- zeroExtend lhsH + lhsExtL <- zeroExtend lhsL + rhsExt <- zeroExtend rhs + -- Now we combine the first two parameters (that represent the high and low + -- bits of the value). So first left-shift the high bits to their position + -- and then bit-or them with the low bits. + let widthLlvmLit = LMLitVar $ LMIntLit (fromIntegral bitWidth) width + lhsExtHShifted <- doExprW width2x $ LlvmOp LM_MO_Shl lhsExtH widthLlvmLit + lhsExt <- doExprW width2x $ LlvmOp LM_MO_Or lhsExtHShifted lhsExtL + -- Finally, we can call 'udiv' and 'urem' to compute the results. + retExtDiv <- doExprW width2x $ LlvmOp LM_MO_UDiv lhsExt rhsExt + retExtRem <- doExprW width2x $ LlvmOp LM_MO_URem lhsExt rhsExt + -- And since everything is in 2x width, we need to truncate the results and + -- then return them. + let narrow var = doExprW width $ Cast LM_Trunc var width + retDiv <- narrow retExtDiv + retRem <- narrow retExtRem + dstRegQ <- lift $ getCmmReg (CmmLocal dstQ) + dstRegR <- lift $ getCmmReg (CmmLocal dstR) + statement $ Store retDiv dstRegQ + statement $ Store retRem dstRegR + where + -- TODO(michalt): Consider extracting this and using in more places. + -- Hopefully this should cut down on the noise of accumulating the + -- statements and declarations. + doExprW :: LlvmType -> LlvmExpression -> WriterT LlvmAccum LlvmM LlvmVar + doExprW a b = do + (var, stmt) <- lift $ doExpr a b + statement stmt + return var + run :: WriterT LlvmAccum LlvmM () -> LlvmM (LlvmStatements, [LlvmCmmDecl]) + run action = do + LlvmAccum stmts decls <- execWriterT action + return (stmts, decls) + -- Handle the MO_{Add,Sub}IntC separately. LLVM versions return a record from -- which we need to extract the actual values. genCall t@(PrimTarget (MO_AddIntC w)) [dstV, dstO] [lhs, rhs] = @@ -1767,3 +1821,21 @@ getTBAAMeta u = do -- | Returns TBAA meta data for given register getTBAARegMeta :: GlobalReg -> LlvmM [MetaAnnot] getTBAARegMeta = getTBAAMeta . getTBAA + + +-- | A more convenient way of accumulating LLVM statements and declarations. +data LlvmAccum = LlvmAccum LlvmStatements [LlvmCmmDecl] + +instance Monoid LlvmAccum where + mempty = LlvmAccum nilOL [] + LlvmAccum stmtsA declsA `mappend` LlvmAccum stmtsB declsB = + LlvmAccum (stmtsA `mappend` stmtsB) (declsA `mappend` declsB) + +liftExprData :: LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar +liftExprData action = do + (var, stmts, decls) <- lift action + tell $ LlvmAccum stmts decls + return var + +statement :: LlvmStatement -> WriterT LlvmAccum LlvmM () +statement stmt = tell $ LlvmAccum (unitOL stmt) [] diff --git a/testsuite/tests/primops/should_run/T9430.hs b/testsuite/tests/primops/should_run/T9430.hs index aec2d26..eedc0a7 100644 --- a/testsuite/tests/primops/should_run/T9430.hs +++ b/testsuite/tests/primops/should_run/T9430.hs @@ -34,6 +34,23 @@ checkW (expX, expY) op (W# a) (W# b) = "Expected " ++ show expX ++ " and " ++ show expY ++ " but got " ++ show (W# x) ++ " and " ++ show (W# y) +checkW2 + :: (Word, Word) -- ^ expected results + -> (Word# -> Word# -> Word# -> (# Word#, Word# #)) + -- ^ primop + -> Word -- ^ first argument + -> Word -- ^ second argument + -> Word -- ^ third argument + -> Maybe String -- ^ maybe error +checkW2 (expX, expY) op (W# a) (W# b) (W# c) = + case op a b c of + (# x, y #) + | W# x == expX && W# y == expY -> Nothing + | otherwise -> + Just $ + "Expected " ++ show expX ++ " and " ++ show expY + ++ " but got " ++ show (W# x) ++ " and " ++ show (W# y) + check :: String -> Maybe String -> IO () check s (Just err) = error $ "Error for " ++ s ++ ": " ++ err check _ Nothing = return () @@ -91,3 +108,21 @@ main = do checkW (2, maxBound - 2) timesWord2# maxBound 3 check "timesWord2# 3 maxBound" $ checkW (2, maxBound - 2) timesWord2# 3 maxBound + + check "quotRemWord2# 0 0 1" $ checkW2 (0, 0) quotRemWord2# 0 0 1 + check "quotRemWord2# 0 4 2" $ checkW2 (2, 0) quotRemWord2# 0 4 2 + check "quotRemWord2# 0 7 3" $ checkW2 (2, 1) quotRemWord2# 0 7 3 + check "quotRemWord2# 1 0 (2 ^ 63)" $ + checkW2 (2, 0) quotRemWord2# 1 0 (2 ^ 63) + check "quotRemWord2# 1 1 (2 ^ 63)" $ + checkW2 (2, 1) quotRemWord2# 1 1 (2 ^ 63) + check "quotRemWord2# 1 0 maxBound" $ + checkW2 (1, 1) quotRemWord2# 1 0 maxBound + check "quotRemWord2# 2 0 maxBound" $ + checkW2 (2, 2) quotRemWord2# 2 0 maxBound + check "quotRemWord2# 1 maxBound maxBound" $ + checkW2 (2, 1) quotRemWord2# 1 maxBound maxBound + check "quotRemWord2# (2 ^ 63) 0 maxBound" $ + checkW2 (2 ^ 63, 2 ^ 63) quotRemWord2# (2 ^ 63) 0 maxBound + check "quotRemWord2# (2 ^ 63) maxBound maxBound" $ + checkW2 (2 ^ 63 + 1, 2 ^ 63) quotRemWord2# (2 ^ 63) maxBound maxBound From git at git.haskell.org Mon Aug 3 09:15:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 09:15:11 +0000 (UTC) Subject: [commit: ghc] master: Update parallel submodule, and re-enable warnings (948e03e) Message-ID: <20150803091511.6F3D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/948e03e55a47a7c5a3566a7f8ba347f590fd8d1f/ghc >--------------------------------------------------------------- commit 948e03e55a47a7c5a3566a7f8ba347f590fd8d1f Author: Simon Marlow Date: Mon Aug 3 08:41:45 2015 +0200 Update parallel submodule, and re-enable warnings Test Plan: using remote validate Reviewers: austin, hvr, simonpj, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1117 >--------------------------------------------------------------- 948e03e55a47a7c5a3566a7f8ba347f590fd8d1f libraries/parallel | 2 +- mk/warnings.mk | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/parallel b/libraries/parallel index e4e4228..f606922 160000 --- a/libraries/parallel +++ b/libraries/parallel @@ -1 +1 @@ -Subproject commit e4e4228ba94178cf31b97fe81b94bff3de6fce03 +Subproject commit f6069229df73045770fe4521991b9d22fd58e680 diff --git a/mk/warnings.mk b/mk/warnings.mk index a960e0e..2e82428 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -39,7 +39,6 @@ utils/hpc_dist-install_EXTRA_HC_OPTS += -fwarn-tabs # Libraries that have dubious RULES libraries/bytestring_dist-install_EXTRA_HC_OPTS += -fno-warn-inline-rule-shadowing -libraries/parallel_dist-install_EXTRA_HC_OPTS += -fno-warn-inline-rule-shadowing # Cabal doesn't promise to be warning-free utils/ghc-cabal_dist_EXTRA_HC_OPTS += -w From git at git.haskell.org Mon Aug 3 09:15:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 09:15:14 +0000 (UTC) Subject: [commit: ghc] master: Fix incorrect stack pointer usage in StgRun() on x86_64 (b38ee89) Message-ID: <20150803091514.35DCA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b38ee89c8c8724ba2feb98d4082795a5d4ae96f6/ghc >--------------------------------------------------------------- commit b38ee89c8c8724ba2feb98d4082795a5d4ae96f6 Author: Ben Gamari Date: Mon Aug 3 08:42:00 2015 +0200 Fix incorrect stack pointer usage in StgRun() on x86_64 The STG_RETURN code from StgCRun.c is incorrect for x86_64 variants where the ABI doesn't impose a mandatory red zone for the stack, like on Windows or Xen/HaLVM. The current implementation restores the stack pointer first, which effectively marks the area with the saved registers as reusable. Later, the CPU registers are restored from this "free" area. This ordering happens to work by accident on operating systems that strictly adhere to the System V ABI, because any interrupt/signal delivery is guaranteed to leave the first 128 bytes past the stack pointer untouched (red zone). On other systems this might result in corrupted CPU registers if an interruption happens just after restoring the stack pointer. The red zone is usually only used by small leaf functions to avoid updates to the stack pointer and exploiting it doesn't give us any advantage in this case. Reviewers: austin, rwbarton Reviewed By: rwbarton Subscribers: thomie, simonmar Differential Revision: https://phabricator.haskell.org/D1120 GHC Trac Issues: #10155 >--------------------------------------------------------------- b38ee89c8c8724ba2feb98d4082795a5d4ae96f6 rts/StgCRun.c | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/rts/StgCRun.c b/rts/StgCRun.c index 2903911..6448509 100644 --- a/rts/StgCRun.c +++ b/rts/StgCRun.c @@ -302,19 +302,18 @@ StgRunIsImplementedInAssembler(void) * restore callee-saves registers. (Don't stomp on %%rax!) */ "addq %0, %%rsp\n\t" - "movq %%rsp, %%rdx\n\t" - "addq %1, %%rsp\n\t" - "movq 0(%%rdx),%%rbx\n\t" /* restore the registers saved above */ - "movq 8(%%rdx),%%rbp\n\t" - "movq 16(%%rdx),%%r12\n\t" - "movq 24(%%rdx),%%r13\n\t" - "movq 32(%%rdx),%%r14\n\t" - "movq 40(%%rdx),%%r15\n\t" + "movq 0(%%rsp),%%rbx\n\t" /* restore the registers saved above */ + "movq 8(%%rsp),%%rbp\n\t" + "movq 16(%%rsp),%%r12\n\t" + "movq 24(%%rsp),%%r13\n\t" + "movq 32(%%rsp),%%r14\n\t" + "movq 40(%%rsp),%%r15\n\t" #if defined(mingw32_HOST_OS) - "movq 48(%%rdx),%%rdi\n\t" - "movq 56(%%rdx),%%rsi\n\t" - "movq 64(%%rdx),%%xmm6\n\t" + "movq 48(%%rsp),%%rdi\n\t" + "movq 56(%%rsp),%%rsi\n\t" + "movq 64(%%rsp),%%xmm6\n\t" #endif + "addq %1, %%rsp\n\t" "retq" : From git at git.haskell.org Mon Aug 3 12:26:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 12:26:27 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments (4d8859c) Message-ID: <20150803122627.071243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4d8859cc6302b89c81de9b6e4af241527c8fe716/ghc >--------------------------------------------------------------- commit 4d8859cc6302b89c81de9b6e4af241527c8fe716 Author: Simon Peyton Jones Date: Mon Aug 3 11:04:22 2015 +0100 Typos in comments >--------------------------------------------------------------- 4d8859cc6302b89c81de9b6e4af241527c8fe716 compiler/basicTypes/Demand.hs | 2 +- compiler/stranal/DmdAnal.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index bd2924a..8ee0f13 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -1214,7 +1214,7 @@ splitDmdTy ty@(DmdType _ [] res_ty) = (resTypeArgDmd res_ty, ty) -- what of this demand should we consider, given that the IO action can cleanly -- exit? -- * We have to kill all strictness demands (i.e. lub with a lazy demand) --- * We can keep demand information (i.e. lub with an absent deman) +-- * We can keep demand information (i.e. lub with an absent demand) -- * We have to kill definite divergence -- * We can keep CPR information. -- See Note [IO hack in the demand analyser] diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 8b97b6b..5836bfd 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -342,7 +342,7 @@ dmdAnalAlt env dmd case_bndr (con,bndrs,rhs) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There's a hack here for I/O operations. Consider case foo x s of { (# s, r #) -> y } -Is this strict in 'y'. Normally yes, but what if 'foo' is an I/O +Is this strict in 'y'? Normally yes, but what if 'foo' is an I/O operation that simply terminates the program (not in an erroneous way)? In that case we should not evaluate 'y' before the call to 'foo'. Hackish solution: spot the IO-like situation and add a virtual branch, @@ -365,14 +365,14 @@ However, consider Here it is terribly sad to make 'f' lazy in 's'. After all, getMaskingState# is not going to diverge or throw an exception! This situation actually arises in GHC.IO.Handle.Internals.wantReadableHandle -(on an MVar not an Int), and make a material difference. +(on an MVar not an Int), and made a material difference. So if the scrutinee is a primop call, we *don't* apply the state hack: - If is a simple, terminating one like getMaskingState, applying the hack is over-conservative. - If the primop is raise# then it returns bottom, so - the case alternatives are alraedy discarded. + the case alternatives are already discarded. - If the primop can raise a non-IO exception, like divide by zero or seg-fault (eg writing an array out of bounds) then we don't mind evaluating 'x' first. From git at git.haskell.org Mon Aug 3 12:26:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 12:26:29 +0000 (UTC) Subject: [commit: ghc] master: Minor improvement to user guide (d7ced09) Message-ID: <20150803122629.CDF0B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7ced09a0a8d9e0f3c6631e2814078145036c90a/ghc >--------------------------------------------------------------- commit d7ced09a0a8d9e0f3c6631e2814078145036c90a Author: Simon Peyton Jones Date: Mon Aug 3 11:07:08 2015 +0100 Minor improvement to user guide Specify that the type variables for a class/instance decl scope over the body even without a 'forall'. Provoked by Trac #10722. >--------------------------------------------------------------- d7ced09a0a8d9e0f3c6631e2814078145036c90a docs/users_guide/glasgow_exts.xml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index e3368f2..b6c01d6 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -8820,9 +8820,8 @@ consider how one would parse this: The type variables in the head of a class or instance declaration -scope over the methods defined in the where part. For example: - - +scope over the methods defined in the where part. You do not even need +an explicit forall. For example: class C a where op :: [a] -> a @@ -8831,6 +8830,9 @@ scope over the methods defined in the where part. For exampl ys = reverse xs in head ys + + instance C b => C [b] where + op xs = reverse (head (xs :: [[b]])) From git at git.haskell.org Mon Aug 3 12:41:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 12:41:03 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10134 (30b32f4) Message-ID: <20150803124103.EA8183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30b32f4ca83147544c4dafeb96fed70b791e40cd/ghc >--------------------------------------------------------------- commit 30b32f4ca83147544c4dafeb96fed70b791e40cd Author: Simon Peyton Jones Date: Mon Aug 3 13:39:56 2015 +0100 Test Trac #10134 >--------------------------------------------------------------- 30b32f4ca83147544c4dafeb96fed70b791e40cd testsuite/tests/polykinds/T10134.hs | 19 +++++++++++++++++++ .../{ghci/scripts/T10321.hs => polykinds/T10134a.hs} | 11 ++++------- testsuite/tests/polykinds/all.T | 1 + 3 files changed, 24 insertions(+), 7 deletions(-) diff --git a/testsuite/tests/polykinds/T10134.hs b/testsuite/tests/polykinds/T10134.hs new file mode 100644 index 0000000..0b64625 --- /dev/null +++ b/testsuite/tests/polykinds/T10134.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DataKinds, TypeOperators, ConstraintKinds, TypeFamilies, NoMonoLocalBinds, NoMonomorphismRestriction #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} + +module T10134 where + +import GHC.TypeLits +import T10134a +import Prelude + +type Positive n = ((n-1)+1)~n + +data Dummy n d = Dummy { vec :: Vec n (Vec d Bool) } + +nextDummy :: Positive (2*(n+d)) => Dummy n d -> Dummy n d +nextDummy d = Dummy { vec = vec dFst } + where (dFst,dSnd) = nextDummy' d + +nextDummy' :: Positive (2*(n+d)) => Dummy n d -> ( Dummy n d, Bool ) +nextDummy' _ = undefined diff --git a/testsuite/tests/ghci/scripts/T10321.hs b/testsuite/tests/polykinds/T10134a.hs similarity index 52% copy from testsuite/tests/ghci/scripts/T10321.hs copy to testsuite/tests/polykinds/T10134a.hs index 44d264a..0d84d56 100644 --- a/testsuite/tests/ghci/scripts/T10321.hs +++ b/testsuite/tests/polykinds/T10134a.hs @@ -1,14 +1,11 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeOperators #-} - -module T10321 where +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module T10134a where import GHC.TypeLits data Vec :: Nat -> * -> * where Nil :: Vec 0 a (:>) :: a -> Vec n a -> Vec (n + 1) a - -infixr 5 :> diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 3c8096c..55041dc 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -119,3 +119,4 @@ test('T10503', normal, compile_fail, ['']) test('T10570', normal, compile_fail, ['']) test('T10670', normal, compile, ['']) test('T10670a', normal, compile, ['']) +test('T10134', normal, multimod_compile, ['T10134.hs','-v0']) From git at git.haskell.org Mon Aug 3 13:36:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 13:36:40 +0000 (UTC) Subject: [commit: ghc] master: 4 reduce/reduce parser conflicts resolved (697079f) Message-ID: <20150803133640.907273A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/697079f118197931e7a8c0768e99bf60be4150fd/ghc >--------------------------------------------------------------- commit 697079f118197931e7a8c0768e99bf60be4150fd Author: Ulya Trofimovich Date: Mon Aug 3 14:56:16 2015 +0200 4 reduce/reduce parser conflicts resolved As GHC documentation (section 7.4.4, Type operators) says: > "There is now some potential ambiguity in import and export lists; for example if you write import M( (+) ) do you mean the function (+) or the type constructor (+)? The default is the former, but with -XExplicitNamespaces (which is implied by -XExplicitTypeOperators) GHC allows you to specify the latter by preceding it with the keyword type" Turns out this ambiguity causes 4 of 6 reduce/reduce conflicts in GHC parser. All 4 conflicts arise from a single production: qcname : qvar | oqtycon Recursive inlining of 'qvar' and 'oqtycon' helps reveal the faulty productions: qcname : ... | '(' QVARSYM ')' | '(' VARSYM ')' | '(' '*' ')' | '(' '-' ')' These productions can either be parsed as variable or type constructor, but variable constuctor is always preferred. My patch removes ambiguity while preserving the existing behaviour: - all unambigous productions are left as-is - ambigous productions for variable constuctors are left - ambigous productions for type constructors are removed (there's no way they could be triggered) Updated comment. Test Plan: Tested with 'make fasttest' Reviewers: austin, simonpj, trofi, bgamari, simonmar Reviewed By: trofi, bgamari, simonmar Subscribers: thomie, mpickering Projects: #ghc Differential Revision: https://phabricator.haskell.org/D1111 >--------------------------------------------------------------- 697079f118197931e7a8c0768e99bf60be4150fd compiler/parser/Parser.y | 253 +++++++++++++++++++---------------------------- 1 file changed, 99 insertions(+), 154 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 697079f118197931e7a8c0768e99bf60be4150fd From git at git.haskell.org Mon Aug 3 13:36:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 13:36:44 +0000 (UTC) Subject: [commit: ghc] master: Support wild cards in data/type family instances (d9d2102) Message-ID: <20150803133644.66E723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d9d2102ea7f6da1bc3a69fa469b89ea843cb8b02/ghc >--------------------------------------------------------------- commit d9d2102ea7f6da1bc3a69fa469b89ea843cb8b02 Author: Thomas Winant Date: Mon Aug 3 14:57:40 2015 +0200 Support wild cards in data/type family instances Handle anonymous wild cards in type or data family instance declarations like unnamed type variables. For instance (pun intented): type family F (a :: *) (b :: *) :: * type instance F Int _ = Int Is now the same as: type family F (a :: *) (b :: *) :: * type instance F Int x = Int Note that unlike wild cards in partial type signatures, no errors (or warnings with -XPartialTypeSignatures) are generated for these wild cards, as there is nothing interesting to report to the user, i.e. the inferred kind. Only anonymous wild cards are supported here, named and extra-constraints wild card are not. Test Plan: pass new tests Reviewers: goldfire, austin, simonpj, bgamari Reviewed By: simonpj, bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D1092 GHC Trac Issues: #3699, #10586 >--------------------------------------------------------------- d9d2102ea7f6da1bc3a69fa469b89ea843cb8b02 compiler/rename/RnSource.hs | 9 +++++- compiler/typecheck/TcTyClsDecls.hs | 35 ++++++++++++++++++++-- docs/users_guide/7.12.1-notes.xml | 9 ++++++ docs/users_guide/glasgow_exts.xml | 31 +++++++++++++++++++ .../should_compile/DataFamilyInstanceLHS.hs | 13 ++++++++ .../should_compile/DataFamilyInstanceLHS.stderr | 16 ++++++++++ .../should_compile/TypeFamilyInstanceLHS.hs | 9 ++++++ .../should_compile/TypeFamilyInstanceLHS.stderr | 13 ++++++++ testsuite/tests/partial-sigs/should_compile/all.T | 2 ++ .../NamedWildcardInDataFamilyInstanceLHS.hs | 10 +++++++ .../NamedWildcardInDataFamilyInstanceLHS.stderr | 4 +++ .../NamedWildcardInTypeFamilyInstanceLHS.hs | 5 ++++ .../NamedWildcardInTypeFamilyInstanceLHS.stderr | 4 +++ .../should_fail/WildcardInTypeFamilyInstanceLHS.hs | 8 ----- .../WildcardInTypeFamilyInstanceLHS.stderr | 6 ---- testsuite/tests/partial-sigs/should_fail/all.T | 3 +- 16 files changed, 159 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 d9d2102ea7f6da1bc3a69fa469b89ea843cb8b02 From git at git.haskell.org Mon Aug 3 15:13:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 15:13:36 +0000 (UTC) Subject: [commit: ghc] master: Typos in comments [skip ci] (7ec6ffc) Message-ID: <20150803151336.E4DC23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7ec6ffc4e8ccf5c24149d9ab34c3619516dc3081/ghc >--------------------------------------------------------------- commit 7ec6ffc4e8ccf5c24149d9ab34c3619516dc3081 Author: Gabor Greif Date: Mon Aug 3 13:38:48 2015 +0200 Typos in comments [skip ci] >--------------------------------------------------------------- 7ec6ffc4e8ccf5c24149d9ab34c3619516dc3081 compiler/coreSyn/CoreLint.hs | 2 +- compiler/coreSyn/CoreUnfold.hs | 4 ++-- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 2 +- compiler/main/DynFlags.hs | 2 +- compiler/parser/Parser.y | 2 +- compiler/specialise/Specialise.hs | 2 +- compiler/typecheck/TcSplice.hs | 2 +- compiler/utils/Outputable.hs | 2 +- libraries/base/GHC/Event/EPoll.hsc | 2 +- libraries/base/cbits/primFloat.c | 2 +- libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 2 +- testsuite/tests/programs/galois_raytrace/Data.hs | 2 +- testsuite/tests/programs/galois_raytrace/Eval.hs | 2 +- testsuite/tests/rename/should_fail/T9177.hs | 2 +- testsuite/tests/simplCore/should_compile/spec001.hs | 2 +- 15 files changed, 16 insertions(+), 16 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 7ec6ffc4e8ccf5c24149d9ab34c3619516dc3081 From git at git.haskell.org Mon Aug 3 15:21:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 15:21:05 +0000 (UTC) Subject: [commit: ghc] master: CmmParse: Don't force alignment in memcpy-ish operations (64b6733) Message-ID: <20150803152105.3A5883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64b6733e217f32feb8c4872096749c6f417d0c39/ghc >--------------------------------------------------------------- commit 64b6733e217f32feb8c4872096749c6f417d0c39 Author: Ben Gamari Date: Mon Aug 3 15:31:03 2015 +0200 CmmParse: Don't force alignment in memcpy-ish operations This was initially made in 681973c31c614185229bdae4f6b7ab4f6e64753d. Here I wanted to enforce that the alignment passed to %memcpy was a constant expression, as this is required by LLVM. However, this breaks the knot-tying done in `loopDecls`, causing T8131 to hang. Here I remove the `seq` and mark T8131 as `expect_broken` in the case of the NCG, which doesn't force the alignment in this case. Fixes #10664. >--------------------------------------------------------------- 64b6733e217f32feb8c4872096749c6f417d0c39 compiler/cmm/CmmParse.y | 3 +-- testsuite/tests/codeGen/should_fail/all.T | 4 +++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 9638c14..ea0f4a5 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -988,8 +988,7 @@ callishMachOps = listToUFM $ memcpyLikeTweakArgs :: (Int -> CallishMachOp) -> [CmmExpr] -> (CallishMachOp, [CmmExpr]) memcpyLikeTweakArgs op [] = pgmError "memcpy-like function requires at least one argument" memcpyLikeTweakArgs op args@(_:_) = - -- Force alignment with result to ensure pprPgmError fires - align `seq` (op align, args') + (op align, args') where args' = init args align = case last args of diff --git a/testsuite/tests/codeGen/should_fail/all.T b/testsuite/tests/codeGen/should_fail/all.T index 39faebb..7e25b5f 100644 --- a/testsuite/tests/codeGen/should_fail/all.T +++ b/testsuite/tests/codeGen/should_fail/all.T @@ -1,3 +1,5 @@ # Tests for code generator and CMM parser -test('T8131', cmm_src, compile_fail, ['']) +# Only the LLVM code generator consistently forces the alignment of +# memcpy operations +test('T8131', [cmm_src, only_ways(llvm_ways)], compile_fail, ['']) From git at git.haskell.org Mon Aug 3 16:20:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 16:20:26 +0000 (UTC) Subject: [commit: ghc] master: Removed deprecated syntax for GADT constuctors. (30c981e) Message-ID: <20150803162026.447C93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/30c981e135033840fe1b4bcab697b412369739d7/ghc >--------------------------------------------------------------- commit 30c981e135033840fe1b4bcab697b412369739d7 Author: Ulya Trofimovich Date: Mon Aug 3 17:45:56 2015 +0200 Removed deprecated syntax for GADT constuctors. Old syntax was deprecated 6 years ago in this commit 432b9c9322181a3644083e3c19b7e240d90659e7 by simonpj:"New syntax for GADT-style record declarations, and associated refactoring" discussed in Trac #3306. This patch removes 2 reduce/reduce conflicts in parser. Conflicting productions were: ``` gadt_constr -> con_list '::' sigtype gadt_constr -> oqtycon '{' fielddecls '}' '::' sigtype ``` Recursive inlining of `con_list` and `oqtycon` helped reveal the conflict: ``` gadt_constr -> '(' CONSYM ')' '::' sigtype gadt_constr -> '(' CONSYM ')' '{' fielddecls '}' '::' sigtype ``` between two types of GADT constructors (second form stands for deprecated syntax). Test Plan: `make fasttest`, one breakage TEST="records-fail" (parse error instead of typecheck error due to removal of deprecated syntax). Updated test. Reviewers: simonmar, bgamari, austin, simonpj Reviewed By: simonpj Subscribers: thomie, mpickering, trofi Differential Revision: https://phabricator.haskell.org/D1118 GHC Trac Issues: #3306 >--------------------------------------------------------------- 30c981e135033840fe1b4bcab697b412369739d7 compiler/parser/Parser.y | 65 +++++++++++++------------------ compiler/parser/RdrHsSyn.hs | 20 ---------- testsuite/tests/gadt/records-fail1.hs | 12 +++++- testsuite/tests/gadt/records-fail1.stderr | 5 +-- 4 files changed, 37 insertions(+), 65 deletions(-) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 1cfe491..4b8eca6 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -82,10 +82,9 @@ import Util ( looksLikePackageName ) } -{- Last updated: 29 Jul 2015 +{- Last updated: 31 Jul 2015 Conflicts: 47 shift/reduce - 2 reduce/reduce If you modify this parser and add a conflict, please update this comment. You can learn more about the conflicts by passing 'happy' the -i flag: @@ -293,29 +292,6 @@ state 950 contains 1 shift/reduce conflicts. Conflict: 'by' -------------------------------------------------------------------------------- - -state 1230 contains 1 reduce/reduce conflicts. - - *** tyconsym -> ':' . (rule 653) - consym -> ':' . (rule 721) - - Conflict: ')' - -------------------------------------------------------------------------------- - -state 1231 contains 1 reduce/reduce conflicts. - - *** tyconsym -> CONSYM . (rule 651) - consym -> CONSYM . (rule 720) - - Conflict: ')' - -TODO: Why? (NB: This one has been around for a while; it's quite puzzling - because we really shouldn't get confused between tyconsym and consym. - Trace the state machine, maybe?) - -TODO: Same as State 1230 ------------------------------------------------------------------------------- -- API Annotations @@ -1820,18 +1796,24 @@ gadt_constr_with_doc {% return $1 } gadt_constr :: { LConDecl RdrName } - -- Returns a list because of: C,D :: ty + -- see Note [Difference in parsing GADT and data constructors] + -- Returns a list because of: C,D :: ty : con_list '::' sigtype {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3 ; ams (sLL $1 $> gadtDecl) (mj AnnDcolon $2:anns) } } - -- Deprecated syntax for GADT record declarations - | oqtycon '{' fielddecls '}' '::' sigtype - {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 (noLoc $3) $6 - ; cd' <- checkRecordSyntax cd - ; ams (L (comb2 $1 $6) (unLoc cd')) - [moc $2,mcc $4,mj AnnDcolon $5] } } +{- Note [Difference in parsing GADT and data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GADT constructors have simpler syntax than usual data constructors: +in GADTs, types cannot occur to the left of '::', so they cannot be mixed +with constructor names (see Note [Parsing data constructors is hard]). + +Due to simplified syntax, GADT constructor names (left-hand side of '::') +use simpler grammar production than usual data constructor names. As a +consequence, GADT constructor names are resticted (names like '(*)' are +allowed in usual data constructors, but not in GADTs). +-} constrs :: { Located ([AddAnn],[LConDecl RdrName]) } : maybe_docnext '=' constrs1 { L (comb2 $2 $3) ([mj AnnEqual $2] @@ -1862,16 +1844,21 @@ forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) } | {- empty -} { noLoc ([],[]) } constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) } --- We parse the constructor declaration --- C t1 t2 --- as a btype (treating C as a type constructor) and then convert C to be --- a data constructor. Reason: it might continue like this: --- C t1 t2 %: D Int --- in which case C really would be a type constructor. We can't resolve this --- ambiguity till we come across the constructor oprerator :% (or not, more usually) + -- see Note [Parsing data constructors is hard] : btype {% splitCon $1 >>= return.sLL $1 $> } | btype conop btype { sLL $1 $> ($2, InfixCon $1 $3) } +{- Note [Parsing data constructors is hard] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We parse the constructor declaration + C t1 t2 +as a btype (treating C as a type constructor) and then convert C to be +a data constructor. Reason: it might continue like this: + C t1 t2 %: D Int +in which case C really would be a type constructor. We can't resolve this +ambiguity till we come across the constructor oprerator :% (or not, more usually) +-} + fielddecls :: { [LConDeclField RdrName] } : {- empty -} { [] } | fielddecls1 { $1 } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index ab3f17d..18890b5 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -35,7 +35,6 @@ module RdrHsSyn ( mkExtName, -- RdrName -> CLabelString mkGadtDecl, -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName mkSimpleConDecl, - mkDeprecatedGadtRecordDecl, mkATDefault, -- Bunch of functions in the parser monad for @@ -469,25 +468,6 @@ mkPatSynMatchGroup (L _ patsyn_name) (L _ decls) = text "pattern synonym 'where' clause must bind the pattern synonym's name" <+> quotes (ppr patsyn_name) $$ ppr decl -mkDeprecatedGadtRecordDecl :: SrcSpan - -> Located RdrName - -> Located [LConDeclField RdrName] - -> LHsType RdrName - -> P (LConDecl RdrName) --- This one uses the deprecated syntax --- C { x,y ::Int } :: T a b --- We give it a RecCon details right away -mkDeprecatedGadtRecordDecl loc (L con_loc con) flds res_ty - = do { data_con <- tyConToDataCon con_loc con - ; return (L loc (ConDecl { con_old_rec = True - , con_names = [data_con] - , con_explicit = Implicit - , con_qvars = mkHsQTvs [] - , con_cxt = noLoc [] - , con_details = RecCon flds - , con_res = ResTyGADT loc res_ty - , con_doc = Nothing })) } - mkSimpleConDecl :: Located RdrName -> [LHsTyVarBndr RdrName] -> LHsContext RdrName -> HsConDeclDetails RdrName -> ConDecl RdrName diff --git a/testsuite/tests/gadt/records-fail1.hs b/testsuite/tests/gadt/records-fail1.hs index 8eefee5..b26404a 100644 --- a/testsuite/tests/gadt/records-fail1.hs +++ b/testsuite/tests/gadt/records-fail1.hs @@ -2,10 +2,18 @@ -- Tests record syntax for GADTs +-- Record syntax in GADTs has been deprecated since July 2009 +-- see commit 432b9c9322181a3644083e3c19b7e240d90659e7 by simonpj: +-- "New syntax for GADT-style record declarations, and associated refactoring" +-- and Trac #3306 + +-- It's been removed in August 2015 +-- see Phab D1118 + +-- test should result into parse error + module ShouldFail where data T a where T1 { x :: a, y :: b } :: T (a,b) T4 { x :: Int } :: T [a] - - \ No newline at end of file diff --git a/testsuite/tests/gadt/records-fail1.stderr b/testsuite/tests/gadt/records-fail1.stderr index 6fd871c..9e8c80b 100644 --- a/testsuite/tests/gadt/records-fail1.stderr +++ b/testsuite/tests/gadt/records-fail1.stderr @@ -1,5 +1,2 @@ -records-fail1.hs:7:1: error: - Constructors T1 and T4 have a common field ?x?, - but have different result types - In the data type declaration for ?T? +records-fail1.hs:18:6: error: parse error on input ?{? From git at git.haskell.org Mon Aug 3 18:19:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 18:19:41 +0000 (UTC) Subject: [commit: ghc] wip/ggreif: Richard's rewrite of compatibleBranches (1d2fe18) Message-ID: <20150803181941.602983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ggreif Link : http://ghc.haskell.org/trac/ghc/changeset/1d2fe1895f3ccfcfd731ef4c7ee9fb595dfbf7a2/ghc >--------------------------------------------------------------- commit 1d2fe1895f3ccfcfd731ef4c7ee9fb595dfbf7a2 Author: Gabor Greif Date: Mon Aug 3 20:19:36 2015 +0200 Richard's rewrite of compatibleBranches >--------------------------------------------------------------- 1d2fe1895f3ccfcfd731ef4c7ee9fb595dfbf7a2 compiler/types/FamInstEnv.hs | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index b22b10f..d012cf3 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -55,6 +55,7 @@ import Pair import SrcLoc import NameSet import FastString +import Data.List (mapAccumL) {- ************************************************************************ @@ -485,14 +486,22 @@ compatibleBranches (CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 }) -- See Note [Storing compatibility] in CoAxiom computeAxiomIncomps :: CoAxiom br -> CoAxiom br computeAxiomIncomps ax@(CoAxiom { co_ax_branches = branches }) - = ax { co_ax_branches = go [] branches } + = ax { co_ax_branches = go branches } where - go :: [CoAxBranch] -> BranchList CoAxBranch br -> BranchList CoAxBranch br - go prev_branches (FirstBranch br) - = FirstBranch (br { cab_incomps = mk_incomps br prev_branches }) - go prev_branches (NextBranch br tail) - = let br' = br { cab_incomps = mk_incomps br prev_branches } in - NextBranch br' (fromBranchList (go (br' : prev_branches) tail)) + go :: BranchList CoAxBranch br -> BranchList CoAxBranch br + go (FirstBranch br) + = FirstBranch (go1 [] br) + go (NextBranch br tail) + = let br' = go1 [] br in + NextBranch br' (snd $ mapAccumL go_list [br'] tail) + + go_list :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch) + go_list prev_branches br + = let br' = go1 prev_branches br in + (br' : prev_branches, br') + + go1 :: [CoAxBranch] -> CoAxBranch -> CoAxBranch + go1 prev_branches br = br { cab_incomps = mk_incomps br prev_branches } mk_incomps :: CoAxBranch -> [CoAxBranch] -> [CoAxBranch] mk_incomps br = filter (not . compatibleBranches br) From git at git.haskell.org Mon Aug 3 21:50:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 3 Aug 2015 21:50:03 +0000 (UTC) Subject: [commit: ghc] wip/ggreif: Tweaks to brListMapM and brListFoldlM_ (3fca648) Message-ID: <20150803215003.5FF333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ggreif Link : http://ghc.haskell.org/trac/ghc/changeset/3fca648585349e0d42a330090536474475ef0a3f/ghc >--------------------------------------------------------------- commit 3fca648585349e0d42a330090536474475ef0a3f Author: Gabor Greif Date: Mon Aug 3 23:50:42 2015 +0200 Tweaks to brListMapM and brListFoldlM_ >--------------------------------------------------------------- 3fca648585349e0d42a330090536474475ef0a3f compiler/types/CoAxiom.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index 4380ca8..31f93d8 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -174,7 +174,7 @@ brListFoldr f x (FirstBranch b) = f b x brListFoldr f x (NextBranch h t) = f h (foldr f x t) brListMapM :: Monad m => (a -> m b) -> BranchList a br -> m [b] -brListMapM f (FirstBranch b) = f b >>= \fb -> return [fb] +brListMapM f (FirstBranch b) = f b >>= return . return brListMapM f (NextBranch h t) = do { fh <- f h ; ft <- mapM f t ; return (fh : ft) } @@ -183,14 +183,13 @@ brListFoldlM_ :: forall a b m br. Monad m => (a -> b -> m a) -> a -> BranchList b br -> m () brListFoldlM_ f z (FirstBranch b) = do { _ <- f z b ; return () } -brListFoldlM_ f z (NextBranch h t) = do { z' <- f z h - ; _ <- go z' t +brListFoldlM_ f z (NextBranch h t) = do { _ <- go z (h : t) ; return () } where go :: a -> [b] -> m a go acc [b] = f acc b go acc (h : t) = do { fh <- f acc h ; go fh t } - go _ _ = pprPanic "brListFoldlM_" empty + go _ _ = pprPanic "brListFoldlM_" empty -- dead code -- zipWith brListZipWith :: (a -> b -> c) -> BranchList a br1 -> BranchList b br2 -> [c] From git at git.haskell.org Tue Aug 4 07:36:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 07:36:34 +0000 (UTC) Subject: [commit: ghc] wip/impredicativity: Never generate a `tyvar <~ sigma` constraint (b3154e7) Message-ID: <20150804073634.27EDE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/impredicativity Link : http://ghc.haskell.org/trac/ghc/changeset/b3154e7d34986fbba403ed00c4ea6b694c220107/ghc >--------------------------------------------------------------- commit b3154e7d34986fbba403ed00c4ea6b694c220107 Author: Alejandro Serrano Date: Sat Aug 1 08:32:04 2015 +0200 Never generate a `tyvar <~ sigma` constraint This patch changes the generation and canonicalization of <~ constraints, as shown in the document in docs/types. Now, `tyvar <~ sigma` or `tyfam <~ sigma` constraint are not regarded as canonical, and are converted to equalities at canonicalisation time. However, care is taken to not generate those equalities, neither in other canonicalisation steps or in the constraint generation process. This changes allows us to get rid of the `tct_flavor` flag in `TyThing`, which remembered whether certain type was coming from an un-annotated lamda or let. Now, since these constructs get a new fresh variable, the desired constraint with equality is to be generated. >--------------------------------------------------------------- b3154e7d34986fbba403ed00c4ea6b694c220107 compiler/coreSyn/CoreSubst.hs | 25 ++-- compiler/deSugar/DsBinds.hs | 15 +-- compiler/typecheck/TcArrows.hs | 3 +- compiler/typecheck/TcBinds.hs | 17 +-- compiler/typecheck/TcCanonical.hs | 66 +++++------ compiler/typecheck/TcEnv.hs | 32 +++--- compiler/typecheck/TcEvidence.hs | 43 ++++--- compiler/typecheck/TcExpr.hs | 70 ++++++------ compiler/typecheck/TcHsSyn.hs | 10 +- compiler/typecheck/TcInstDcls.hs | 3 +- compiler/typecheck/TcMatches.hs | 9 +- compiler/typecheck/TcPat.hs | 13 +-- compiler/typecheck/TcRnDriver.hs | 3 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcRules.hs | 11 +- compiler/typecheck/TcType.hs | 9 +- docs/types/impredicativity.ltx | 234 ++++++++++++++++++++++---------------- 17 files changed, 284 insertions(+), 286 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 b3154e7d34986fbba403ed00c4ea6b694c220107 From git at git.haskell.org Tue Aug 4 07:36:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 07:36:36 +0000 (UTC) Subject: [commit: ghc] wip/impredicativity: Revamp part of the impredicativity document (6f59156) Message-ID: <20150804073636.ED00B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/impredicativity Link : http://ghc.haskell.org/trac/ghc/changeset/6f59156da0d397c48b3444334731bcd2dde4a799/ghc >--------------------------------------------------------------- commit 6f59156da0d397c48b3444334731bcd2dde4a799 Author: Alejandro Serrano Date: Mon Aug 3 11:45:22 2015 +0200 Revamp part of the impredicativity document >--------------------------------------------------------------- 6f59156da0d397c48b3444334731bcd2dde4a799 docs/types/impredicativity.ltx | 233 ++++++++++++++++++++++++++++------------- 1 file changed, 158 insertions(+), 75 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 6f59156da0d397c48b3444334731bcd2dde4a799 From git at git.haskell.org Tue Aug 4 07:36:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 07:36:39 +0000 (UTC) Subject: [commit: ghc] wip/impredicativity: Fix bugs on implementation of \upsilon types (864c14a) Message-ID: <20150804073639.E4F563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/impredicativity Link : http://ghc.haskell.org/trac/ghc/changeset/864c14a8c605b838c16127c5195f41860db2919f/ghc >--------------------------------------------------------------- commit 864c14a8c605b838c16127c5195f41860db2919f Author: Alejandro Serrano Date: Tue Aug 4 09:37:44 2015 +0200 Fix bugs on implementation of \upsilon types >--------------------------------------------------------------- 864c14a8c605b838c16127c5195f41860db2919f compiler/typecheck/TcCanonical.hs | 18 +++++++++--------- compiler/typecheck/TcExpr.hs | 15 ++++++++------- compiler/typecheck/TcRules.hs | 4 +++- compiler/typecheck/TcSimplify.hs | 12 ++++++++---- compiler/typecheck/TcType.hs | 2 +- 5 files changed, 29 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 50f6cf0..59d67f8 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -1744,19 +1744,19 @@ can_instance_inst ev lhs rhs ; let qvars' = map mkTyVarTy qvars evars' = map ctev_evar new_ev_qs ; if isUpsilonTy ty - then do { let inst = mkInstanceOfPred ty rhs - ; new_ev_inst <- newWantedEvVarNC loc inst - ; setWantedEvBind evar - (mkInstanceOfInst lhs qvars' (ctEvId new_ev_inst) evars') - ; emitWorkNC new_ev_qs - ; traceTcS "can_instance_of/INST" (vcat [ ppr new_ev_inst, ppr new_ev_qs ]) - ; canInstanceOfNC new_ev_inst } -- if the inner type is upsilon, generate equality - else do { let eq = mkTcEqPredRole Nominal ty rhs + then do { let eq = mkTcEqPredRole Nominal ty rhs ; new_ev_eq <- newWantedEvVarNC loc eq ; setWantedEvBind evar (mkInstanceOfInstEq lhs qvars' (ctEvCoercion new_ev_eq) evars') ; emitWorkNC new_ev_qs ; traceTcS "can_instance_of/INSTEQ" (vcat [ ppr new_ev_eq, ppr new_ev_qs ]) - ; canEqNC new_ev_eq NomEq ty rhs } } + ; canEqNC new_ev_eq NomEq ty rhs } + else do { let inst = mkInstanceOfPred ty rhs + ; new_ev_inst <- newWantedEvVarNC loc inst + ; setWantedEvBind evar + (mkInstanceOfInst lhs qvars' (ctEvId new_ev_inst) evars') + ; emitWorkNC new_ev_qs + ; traceTcS "can_instance_of/INST" (vcat [ ppr new_ev_inst, ppr new_ev_qs ]) + ; canInstanceOfNC new_ev_inst } } _ -> stopWith ev "Given/Derived instanceOf instantiation" diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 9b73562..7f7a476 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1009,19 +1009,20 @@ tc_app fun_expr args fun_ty res_ty -- Without it, the `a` coming from `f` cannot be unified with -- the second type variable of `error` ; if isUpsilonTy actual_res_ty - then do { ev_res <- addErrCtxtM (funResCtxt True (unLoc fun_expr) actual_res_ty res_ty) $ - emitWanted AppOrigin (mkInstanceOfPred actual_res_ty res_ty) + then do { co_res <- addErrCtxtM (funResCtxt True (unLoc fun_expr) actual_res_ty res_ty) $ + unifyType actual_res_ty res_ty ; return $ TcAppResult (mkLHsWrapCo co_fun fun_expr) -- Instantiated function args1 -- Arguments - -- Coercion to expected result type - (mkWpInstanceOf ev_res) } - else do { co_res <- addErrCtxtM (funResCtxt True (unLoc fun_expr) actual_res_ty res_ty) $ - unifyType actual_res_ty res_ty + (coToHsWrapper co_res) } -- Coercion to expected result type + else do { ev_res <- addErrCtxtM (funResCtxt True (unLoc fun_expr) actual_res_ty res_ty) $ + emitWanted AppOrigin (mkInstanceOfPred actual_res_ty res_ty) ; return $ TcAppResult (mkLHsWrapCo co_fun fun_expr) -- Instantiated function args1 -- Arguments - (coToHsWrapper co_res) } } -- Coercion to expected result type + -- Coercion to expected result type + (mkWpInstanceOf ev_res) } } + mk_app_msg :: Outputable a => a -> SDoc mk_app_msg fun = sep [ ptext (sLit "The function") <+> quotes (ppr fun) diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs index f439675..aafb520 100644 --- a/compiler/typecheck/TcRules.hs +++ b/compiler/typecheck/TcRules.hs @@ -73,8 +73,10 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs) tcExtendIdEnv id_bndrs $ do { -- See Note [Solve order for RULES] ((lhs', rule_ty), lhs_wanted) <- captureConstraints (tcInferRho lhs) + ; (lhs_inst_simple, _) <- runTcS (instantiateCts (wc_simple lhs_wanted)) + ; let lhs_inst = lhs_wanted { wc_simple = lhs_inst_simple } ; (rhs', rhs_wanted) <- captureConstraints (tcPolyMonoExpr rhs rule_ty) - ; return (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty) } + ; return (lhs', lhs_inst, rhs', rhs_wanted, rule_ty) } ; (lhs_evs, other_lhs_wanted) <- simplifyRule (snd $ unLoc name) (bndr_wanted `andWC` lhs_wanted) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index f080c09..e95c9f7 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -9,7 +9,8 @@ module TcSimplify( solveWantedsTcM, -- For Rules we need these three - solveWanteds, runTcS, instantiateWC + solveWanteds, runTcS, approximateWC, + instantiateCts ) where #include "HsVersions.h" @@ -1327,7 +1328,7 @@ defaultTyVar the_tv | otherwise = return the_tv -- The common case approximateWC :: WantedConstraints -> TcS Cts -approximateWC = fmap andManyCts . mapM instantiateWC . bagToList . approximateWC_ +approximateWC = instantiateCts . approximateWC_ approximateWC_ :: WantedConstraints -> Cts -- Postcondition: Wanted or Derived Cts @@ -1362,8 +1363,11 @@ approximateWC_ wc do_bag :: (a -> Bag c) -> Bag a -> Bag c do_bag f = foldrBag (unionBags.f) emptyBag -instantiateWC :: Ct -> TcS Cts -instantiateWC ct +instantiateCts :: Cts -> TcS Cts +instantiateCts = fmap andManyCts . mapM instantiateCt . bagToList + +instantiateCt :: Ct -> TcS Cts +instantiateCt ct | isWantedCt ct, InstanceOfPred lhs rhs <- classifyPredType (ctPred ct) = do { let loc = ctLoc ct ; (_qvars, q, ty) <- deeplySplitInst lhs diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index b27e4f6..425d0f5 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1429,7 +1429,7 @@ isUpsilonTy ty | isSigmaTy ty = False | Just v <- tcGetTyVar_maybe ty = not (isImmutableTyVar v) | Just (tc, _) <- tcSplitTyConApp_maybe ty = isFamilyTyCon tc - | otherwise = True + | otherwise = False isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy, isUnitTy, isCharTy, isAnyTy :: Type -> Bool From git at git.haskell.org Tue Aug 4 08:56:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 08:56:10 +0000 (UTC) Subject: [commit: ghc] wip/impredicativity: Add instantiation in rule checking (d737c81) Message-ID: <20150804085610.018993A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/impredicativity Link : http://ghc.haskell.org/trac/ghc/changeset/d737c812c922042020ec71c22b09c5c8248a6df0/ghc >--------------------------------------------------------------- commit d737c812c922042020ec71c22b09c5c8248a6df0 Author: Alejandro Serrano Date: Tue Aug 4 10:57:21 2015 +0200 Add instantiation in rule checking >--------------------------------------------------------------- d737c812c922042020ec71c22b09c5c8248a6df0 compiler/typecheck/TcRules.hs | 5 +++-- compiler/typecheck/TcSimplify.hs | 6 +++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs index aafb520..193695a 100644 --- a/compiler/typecheck/TcRules.hs +++ b/compiler/typecheck/TcRules.hs @@ -73,8 +73,9 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs) tcExtendIdEnv id_bndrs $ do { -- See Note [Solve order for RULES] ((lhs', rule_ty), lhs_wanted) <- captureConstraints (tcInferRho lhs) - ; (lhs_inst_simple, _) <- runTcS (instantiateCts (wc_simple lhs_wanted)) - ; let lhs_inst = lhs_wanted { wc_simple = lhs_inst_simple } + ; let lhs_wanted_simple = wc_simple lhs_wanted + ; (lhs_inst_simple, _) <- runTcS (instantiateCts lhs_wanted_simple) + ; let lhs_inst = lhs_wanted { wc_simple = lhs_inst_simple `unionBags` lhs_wanted_simple } ; (rhs', rhs_wanted) <- captureConstraints (tcPolyMonoExpr rhs rule_ty) ; return (lhs', lhs_inst, rhs', rhs_wanted, rule_ty) } diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index e95c9f7..2fd74b8 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -8,9 +8,9 @@ module TcSimplify( simplifyTop, simplifyInteractive, solveWantedsTcM, - -- For Rules we need these three - solveWanteds, runTcS, approximateWC, - instantiateCts + -- For Rules we need these + solveWanteds, runTcS, runTcSWithEvBinds, + approximateWC, instantiateCts ) where #include "HsVersions.h" From git at git.haskell.org Tue Aug 4 14:50:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 14:50:04 +0000 (UTC) Subject: [commit: ghc] master: Fix #10713. (f063bd5) Message-ID: <20150804145004.9E22B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f063bd5413edf40f1b48e0f958410dcb6bf20b68/ghc >--------------------------------------------------------------- commit f063bd5413edf40f1b48e0f958410dcb6bf20b68 Author: Richard Eisenberg Date: Mon Aug 3 08:53:03 2015 -0400 Fix #10713. When doing the apartness/flattening thing, we really only need to eliminate non-generative tycons, not *all* families. (Data families are indeed generative!) >--------------------------------------------------------------- f063bd5413edf40f1b48e0f958410dcb6bf20b68 compiler/types/FamInstEnv.hs | 4 +++- testsuite/tests/indexed-types/should_compile/T10713.hs | 13 +++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 1 + 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index bea00fc..11e93df 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -1045,7 +1045,9 @@ coreFlattenTy in_scope = go (m2, ty2') = go m1 ty2 in (m2, AppTy ty1' ty2') go m (TyConApp tc tys) - | isFamilyTyCon tc + -- NB: Don't just check if isFamilyTyCon: this catches *data* families, + -- which are generative and thus can be preserved during flattening + | not (isGenerativeTyCon tc Nominal) = let (m', tv) = coreFlattenTyFamApp in_scope m tc tys in (m', mkTyVarTy tv) diff --git a/testsuite/tests/indexed-types/should_compile/T10713.hs b/testsuite/tests/indexed-types/should_compile/T10713.hs new file mode 100644 index 0000000..cf4af28 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10713.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-} + +module T10713 where + +import Data.Proxy + +type family TEq t s where + TEq t t = 'True + TEq t s = 'False +data family T a + +foo :: Proxy (TEq (T Int) (T Bool)) -> Proxy 'False +foo = id diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 773ad30..ff5070b 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -260,3 +260,4 @@ test('T10340', normal, compile, ['']) test('T10226', normal, compile, ['']) test('T10507', normal, compile, ['']) test('T10634', normal, compile, ['']) +test('T10713', normal, compile, ['']) From git at git.haskell.org Tue Aug 4 16:55:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 16:55:10 +0000 (UTC) Subject: [commit: ghc] master: Test #9233 in perf/compiler/T9233 (b5f1c85) Message-ID: <20150804165510.61F203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b5f1c851c34d34cadf536de6494e0ca79b806b67/ghc >--------------------------------------------------------------- commit b5f1c851c34d34cadf536de6494e0ca79b806b67 Author: Richard Eisenberg Date: Mon Aug 3 11:11:04 2015 -0400 Test #9233 in perf/compiler/T9233 Summary: Ideally, we could use Phab's numbers to set the perf test correctly. But even if that's not possible, then I need help writing my `all.T`. With the version you see here, I get the following ``` Traceback (most recent call last): File "/Users/rae/Documents/ghc-valid/testsuite/driver/testlib.py", line 801, in do_test result = func(*[name,way] + args) TypeError: multimod_compile() takes exactly 4 arguments (6 given) ``` I don't know how to fix this. Test Plan: validate Reviewers: austin, bgamari, thomie Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1129 GHC Trac Issues: #9233 >--------------------------------------------------------------- b5f1c851c34d34cadf536de6494e0ca79b806b67 testsuite/tests/perf/compiler/T9233.hs | 12 +++ testsuite/tests/perf/compiler/T9233a.hs | 128 ++++++++++++++++++++++++++++++++ testsuite/tests/perf/compiler/all.T | 12 +++ 3 files changed, 152 insertions(+) diff --git a/testsuite/tests/perf/compiler/T9233.hs b/testsuite/tests/perf/compiler/T9233.hs new file mode 100644 index 0000000..1636be6 --- /dev/null +++ b/testsuite/tests/perf/compiler/T9233.hs @@ -0,0 +1,12 @@ +module T9233 where + +import T9233a +import Data.Functor.Identity + +upds :: (Monad m) => [String -> Options -> m Options] +upds = [ + \a o -> return o { flags = (flags o) { f1 = splitComma a ++ " " ++ f1 (flags o) } } + ] + +setAll :: Options -> Options +setAll _ = (getOpt upds :: Identity ()) `seq` undefined diff --git a/testsuite/tests/perf/compiler/T9233a.hs b/testsuite/tests/perf/compiler/T9233a.hs new file mode 100644 index 0000000..8f7283a --- /dev/null +++ b/testsuite/tests/perf/compiler/T9233a.hs @@ -0,0 +1,128 @@ +module T9233a where + + +data X = X { + f1 :: String, + f2 :: !Bool, + f3 :: !Bool, + f4 :: !Bool, + f5 :: !Bool, + f6 :: !Bool, + f7 :: !Bool, + f8 :: !Bool, + f9 :: !Bool, + f10 :: !Bool, + f11 :: !Bool, + f12 :: !Bool, + f13 :: !Bool, + f14 :: !Bool, + f15 :: !Bool, + f16 :: !Bool, + f17 :: !Bool, + f18 :: !Bool, + f19 :: !Bool, + f20 :: !Bool, + f21 :: !Bool, + f22 :: !Bool, + f23 :: !Bool, + f24 :: !Bool, + f25 :: !Bool, + f26 :: !Bool, + f27 :: !Bool, + f28 :: !Bool, + f29 :: !Bool, + f30 :: !Bool, + f31 :: !Bool, + f32 :: !Bool, + f33 :: !Bool, + f34 :: !Bool, + f35 :: !Bool, + f36 :: !Bool, + f37 :: !Bool, + f38 :: !Bool, + f39 :: !Bool, + f40 :: !Bool, + f41 :: !Bool, + f42 :: !Bool, + f43 :: !Bool, + f44 :: !Bool, + f45 :: !Bool, + f46 :: !Bool, + f47 :: !Bool, + f48 :: !Bool, + f49 :: !Bool, + f50 :: !Bool, + f51 :: !Bool, + f52 :: !Bool, + f53 :: !Bool, + f54 :: !Bool, + f55 :: !Bool, + f56 :: !Bool, + f57 :: !Bool, + f58 :: !Bool, + f59 :: !Bool, + f60 :: !Bool, + f61 :: !Bool, + f62 :: !Bool, + f63 :: !Bool, + f64 :: !Bool, + f65 :: !Bool, + f66 :: !Bool, + f67 :: !Bool, + f68 :: !Bool, + f69 :: !Bool, + f70 :: !Bool, + f71 :: !Bool, + f72 :: !Bool, + f73 :: !Bool, + f74 :: !Bool, + f75 :: !Bool, + f76 :: !Bool, + f77 :: !Bool, + f78 :: !Bool, + f79 :: !Bool, + f80 :: !Bool, + f81 :: !Bool, + f82 :: !Bool, + f83 :: !Bool, + f84 :: !Bool, + f85 :: !Bool, + f86 :: !Bool, + f87 :: !Bool, + f88 :: !Bool, + f89 :: !Bool, + f90 :: !Bool, + f91 :: !Bool, + f92 :: !Bool, + f93 :: !Bool, + f94 :: !Bool, + f95 :: !Bool, + f96 :: !Bool, + f97 :: !Bool, + f98 :: !Bool, + f99 :: !Bool, + f100 :: !Bool + } + +data Options = Options { + flags :: !X, + o2 :: !Bool, + o3 :: !Bool, + o4 :: !Bool, + o5 :: !Bool, + o6 :: !Bool, + o7 :: !Bool, + o8 :: !Bool, + o9 :: !Bool, + o10 :: !Bool, + o11 :: !Bool, + o12 :: !Bool + } + +splitComma :: String -> String +splitComma _ = "a" +{-# NOINLINE splitComma #-} + +getOpt :: Monad m => [String -> Options -> m Options] -> m () +getOpt _ = return () +{-# NOINLINE getOpt #-} diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 4cb811d..66b13bd 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -679,3 +679,15 @@ test('T9961', ], compile, ['-O']) + +test('T9233', + [ only_ways(['normal']), + compiler_stats_num_field('bytes allocated', + [(wordsize(64), 999826288, 5), + # 999826288 4 Aug 2015 initial value + (wordsize(32), 1, 5) # Put in your value here if you hit this + ]), + extra_clean(['T9233a.hi', 'T9233a.o']) + ], + multimod_compile, + ['T9233', '-v0 -O2 -fno-spec-constr']) From git at git.haskell.org Tue Aug 4 18:03:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 18:03:26 +0000 (UTC) Subject: [commit: ghc] wip/ggreif: BranchList refactoring (ae636d0) Message-ID: <20150804180326.33E323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/ggreif Link : http://ghc.haskell.org/trac/ghc/changeset/ae636d0533dbbcdc93cf50a7be646b368c893faa/ghc >--------------------------------------------------------------- commit ae636d0533dbbcdc93cf50a7be646b368c893faa Author: Gabor Greif Date: Sun Aug 2 23:34:49 2015 +0200 BranchList refactoring contains Richard's rewrite of compatibleBranches >--------------------------------------------------------------- ae636d0533dbbcdc93cf50a7be646b368c893faa compiler/types/CoAxiom.hs | 35 +++++++++++++++++++---------------- compiler/types/FamInstEnv.hs | 23 ++++++++++++++++------- 2 files changed, 35 insertions(+), 23 deletions(-) diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs index 9a85185..31f93d8 100644 --- a/compiler/types/CoAxiom.hs +++ b/compiler/types/CoAxiom.hs @@ -130,17 +130,17 @@ deriving instance Typeable 'Unbranched data BranchList a (br :: BranchFlag) where FirstBranch :: a -> BranchList a br - NextBranch :: a -> BranchList a br -> BranchList a Branched + NextBranch :: a -> [a] -> BranchList a Branched -- convert to/from lists toBranchList :: [a] -> BranchList a Branched toBranchList [] = pprPanic "toBranchList" empty toBranchList [b] = FirstBranch b -toBranchList (h:t) = NextBranch h (toBranchList t) +toBranchList (h:t) = NextBranch h t fromBranchList :: BranchList a br -> [a] fromBranchList (FirstBranch b) = [b] -fromBranchList (NextBranch h t) = h : (fromBranchList t) +fromBranchList (NextBranch h t) = h : t -- convert from any BranchList to a Branched BranchList toBranchedList :: BranchList a br -> BranchList a Branched @@ -155,45 +155,48 @@ toUnbranchedList _ = pprPanic "toUnbranchedList" empty -- length brListLength :: BranchList a br -> Int brListLength (FirstBranch _) = 1 -brListLength (NextBranch _ t) = 1 + brListLength t +brListLength (NextBranch _ t) = 1 + length t -- lookup brListNth :: BranchList a br -> BranchIndex -> a brListNth (FirstBranch b) 0 = b brListNth (NextBranch h _) 0 = h -brListNth (NextBranch _ t) n = brListNth t (n-1) +brListNth (NextBranch _ t) n = t !! (n-1) brListNth _ _ = pprPanic "brListNth" empty -- map, fold brListMap :: (a -> b) -> BranchList a br -> [b] brListMap f (FirstBranch b) = [f b] -brListMap f (NextBranch h t) = f h : (brListMap f t) +brListMap f (NextBranch h t) = f h : map f t brListFoldr :: (a -> b -> b) -> b -> BranchList a br -> b brListFoldr f x (FirstBranch b) = f b x -brListFoldr f x (NextBranch h t) = f h (brListFoldr f x t) +brListFoldr f x (NextBranch h t) = f h (foldr f x t) brListMapM :: Monad m => (a -> m b) -> BranchList a br -> m [b] -brListMapM f (FirstBranch b) = f b >>= \fb -> return [fb] +brListMapM f (FirstBranch b) = f b >>= return . return brListMapM f (NextBranch h t) = do { fh <- f h - ; ft <- brListMapM f t + ; ft <- mapM f t ; return (fh : ft) } brListFoldlM_ :: forall a b m br. Monad m => (a -> b -> m a) -> a -> BranchList b br -> m () -brListFoldlM_ f z brs = do { _ <- go z brs - ; return () } - where go :: forall br'. a -> BranchList b br' -> m a - go acc (FirstBranch b) = f acc b - go acc (NextBranch h t) = do { fh <- f acc h - ; go fh t } +brListFoldlM_ f z (FirstBranch b) = do { _ <- f z b + ; return () } +brListFoldlM_ f z (NextBranch h t) = do { _ <- go z (h : t) + ; return () } + where go :: a -> [b] -> m a + go acc [b] = f acc b + go acc (h : t) = do { fh <- f acc h + ; go fh t } + go _ _ = pprPanic "brListFoldlM_" empty -- dead code -- zipWith brListZipWith :: (a -> b -> c) -> BranchList a br1 -> BranchList b br2 -> [c] brListZipWith f (FirstBranch a) (FirstBranch b) = [f a b] brListZipWith f (FirstBranch a) (NextBranch b _) = [f a b] brListZipWith f (NextBranch a _) (FirstBranch b) = [f a b] -brListZipWith f (NextBranch a ta) (NextBranch b tb) = f a b : brListZipWith f ta tb +brListZipWith f (NextBranch a ta) (NextBranch b tb) = f a b : zipWith f ta tb -- pretty-printing diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 11e93df..bfb0141 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -55,6 +55,7 @@ import Pair import SrcLoc import NameSet import FastString +import Data.List (mapAccumL) {- ************************************************************************ @@ -485,14 +486,22 @@ compatibleBranches (CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 }) -- See Note [Storing compatibility] in CoAxiom computeAxiomIncomps :: CoAxiom br -> CoAxiom br computeAxiomIncomps ax@(CoAxiom { co_ax_branches = branches }) - = ax { co_ax_branches = go [] branches } + = ax { co_ax_branches = go branches } where - go :: [CoAxBranch] -> BranchList CoAxBranch br -> BranchList CoAxBranch br - go prev_branches (FirstBranch br) - = FirstBranch (br { cab_incomps = mk_incomps br prev_branches }) - go prev_branches (NextBranch br tail) - = let br' = br { cab_incomps = mk_incomps br prev_branches } in - NextBranch br' (go (br' : prev_branches) tail) + go :: BranchList CoAxBranch br -> BranchList CoAxBranch br + go (FirstBranch br) + = FirstBranch (go1 [] br) + go (NextBranch br tail) + = let br' = go1 [] br in + NextBranch br' (snd $ mapAccumL go_list [br'] tail) + + go_list :: [CoAxBranch] -> CoAxBranch -> ([CoAxBranch], CoAxBranch) + go_list prev_branches br + = let br' = go1 prev_branches br in + (br' : prev_branches, br') + + go1 :: [CoAxBranch] -> CoAxBranch -> CoAxBranch + go1 prev_branches br = br { cab_incomps = mk_incomps br prev_branches } mk_incomps :: CoAxBranch -> [CoAxBranch] -> [CoAxBranch] mk_incomps br = filter (not . compatibleBranches br) From git at git.haskell.org Tue Aug 4 18:03:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 4 Aug 2015 18:03:28 +0000 (UTC) Subject: [commit: ghc] wip/ggreif's head updated: BranchList refactoring (ae636d0) Message-ID: <20150804180328.625A33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/ggreif' now includes: 92f5385 Support MO_U_QuotRem2 in LLVM backend 948e03e Update parallel submodule, and re-enable warnings b38ee89 Fix incorrect stack pointer usage in StgRun() on x86_64 4d8859c Typos in comments d7ced09 Minor improvement to user guide 30b32f4 Test Trac #10134 697079f 4 reduce/reduce parser conflicts resolved d9d2102 Support wild cards in data/type family instances 7ec6ffc Typos in comments [skip ci] 64b6733 CmmParse: Don't force alignment in memcpy-ish operations 30c981e Removed deprecated syntax for GADT constuctors. f063bd5 Fix #10713. b5f1c85 Test #9233 in perf/compiler/T9233 ae636d0 BranchList refactoring From git at git.haskell.org Wed Aug 5 08:10:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:10:51 +0000 (UTC) Subject: [commit: ghc] master: Pretty: reformat using style from libraries/pretty (#10735) (d7b053a) Message-ID: <20150805081051.B423C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d7b053a25f17a02753780293bc1d417c5794e91f/ghc >--------------------------------------------------------------- commit d7b053a25f17a02753780293bc1d417c5794e91f Author: Thomas Miedema Date: Mon Aug 3 16:36:42 2015 +0200 Pretty: reformat using style from libraries/pretty (#10735) This commit copies the code structure (what goes where), whitespace layout and comments from libraries/pretty/src/Text/PrettyPrint/HughesPJ.hs, with the intention to be able to later more easily compare the two files, and port bug fixes. I'm sorry this messes up git blame history, but there's no other way. >--------------------------------------------------------------- d7b053a25f17a02753780293bc1d417c5794e91f compiler/utils/Pretty.hs | 816 +++++++++++++++++++++++++---------------------- 1 file changed, 442 insertions(+), 374 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 d7b053a25f17a02753780293bc1d417c5794e91f From git at git.haskell.org Wed Aug 5 08:10:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:10:54 +0000 (UTC) Subject: [commit: ghc] master: Pretty: remove superfluous parenthesis (#10735) (53484d3) Message-ID: <20150805081054.9CF3A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/53484d3deff9fa9f8b3da01a4b375b4ea8a7ba05/ghc >--------------------------------------------------------------- commit 53484d3deff9fa9f8b3da01a4b375b4ea8a7ba05 Author: Thomas Miedema Date: Mon Aug 3 18:57:06 2015 +0200 Pretty: remove superfluous parenthesis (#10735) >--------------------------------------------------------------- 53484d3deff9fa9f8b3da01a4b375b4ea8a7ba05 compiler/utils/Pretty.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 5ae6f2b..62a1a1c 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -678,7 +678,7 @@ nilAboveNest :: Bool -> FastInt -> RDoc -> RDoc nilAboveNest _ _ Empty = Empty -- Here's why the "text s <>" is in the spec! nilAboveNest g k (Nest k1 q) = nilAboveNest g (k +# k1) q -nilAboveNest g k q | (not g) && (k ># _ILIT(0)) -- No newline if no overlap +nilAboveNest g k q | not g && k ># _ILIT(0) -- No newline if no overlap = textBeside_ (Str (spaces k)) k q | otherwise -- Put them really above = nilAbove_ (mkNest k q) @@ -704,7 +704,7 @@ p <+> q = Beside p True q -- Specification: beside g p q = p q beside :: Doc -> Bool -> RDoc -> RDoc beside NoDoc _ _ = NoDoc -beside (p1 `Union` p2) g q = (beside p1 g q) `union_` (beside p2 g q) +beside (p1 `Union` p2) g q = beside p1 g q `union_` beside p2 g q beside Empty _ q = q beside (Nest k p) g q = nest_ k $! beside p g q beside p@(Beside p1 g1 q1) g2 q2 @@ -753,7 +753,7 @@ sepX x (p:ps) = sep1 x (reduceDoc p) (_ILIT(0)) ps sep1 :: Bool -> RDoc -> FastInt -> [Doc] -> RDoc sep1 _ NoDoc _ _ = NoDoc sep1 g (p `Union` q) k ys = sep1 g p k ys `union_` - (aboveNest q False k (reduceDoc (vcat ys))) + aboveNest q False k (reduceDoc (vcat ys)) sep1 g Empty k ys = mkNest k (sepX g ys) sep1 g (Nest n p) k ys = nest_ n (sep1 g p (k -# n) ys) @@ -815,7 +815,7 @@ fill g (p:ps) = fill1 g (reduceDoc p) (_ILIT(0)) ps fill1 :: Bool -> RDoc -> FastInt -> [Doc] -> Doc fill1 _ NoDoc _ _ = NoDoc fill1 g (p `Union` q) k ys = fill1 g p k ys `union_` - (aboveNest q False k (fill g ys)) + aboveNest q False k (fill g ys) fill1 g Empty k ys = mkNest k (fill g ys) fill1 g (Nest n p) k ys = nest_ n (fill1 g p (k -# n) ys) fill1 g (NilAbove p) k ys = nilAbove_ (aboveNest p False k (fill g ys)) @@ -994,14 +994,14 @@ display m page_width ribbon_width txt end doc ZigZagMode | k >=# gap_width -> nlText `txt` ( Str (multi_ch shift '/') `txt` ( - nlText `txt` ( - lay1 (k -# shift) s sl p ))) + nlText `txt` + lay1 (k -# shift) s sl p )) | k <# _ILIT(0) -> nlText `txt` ( Str (multi_ch shift '\\') `txt` ( - nlText `txt` ( - lay1 (k +# shift) s sl p ))) + nlText `txt` + lay1 (k +# shift) s sl p )) _ -> lay1 k s sl p lay _ (Above {}) = error "display lay Above" @@ -1012,7 +1012,7 @@ display m page_width ribbon_width txt end doc lay1 k s sl p = indent k (s `txt` lay2 (k +# sl) p) lay2 k (NilAbove p) = nlText `txt` lay k p - lay2 k (TextBeside s sl p) = s `txt` (lay2 (k +# sl) p) + lay2 k (TextBeside s sl p) = s `txt` lay2 (k +# sl) p lay2 k (Nest _ p) = lay2 k p lay2 _ Empty = end lay2 _ (Above {}) = error "display lay2 Above" From git at git.haskell.org Wed Aug 5 08:10:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:10:57 +0000 (UTC) Subject: [commit: ghc] master: Pretty: rename variables to the ones used by libraries/pretty (#10735) (9d24b06) Message-ID: <20150805081057.7AF5B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9d24b060af190c89173f9d13260e6eb1ab7debc3/ghc >--------------------------------------------------------------- commit 9d24b060af190c89173f9d13260e6eb1ab7debc3 Author: Thomas Miedema Date: Mon Aug 3 18:05:28 2015 +0200 Pretty: rename variables to the ones used by libraries/pretty (#10735) >--------------------------------------------------------------- 9d24b060af190c89173f9d13260e6eb1ab7debc3 compiler/utils/Outputable.hs | 3 +- compiler/utils/Pretty.hs | 78 ++++++++++++++++++++++---------------------- 2 files changed, 40 insertions(+), 41 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 9d24b060af190c89173f9d13260e6eb1ab7debc3 From git at git.haskell.org Wed Aug 5 08:11:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:11:00 +0000 (UTC) Subject: [commit: ghc] master: Pretty: improve error messages (#10735) (25bc406) Message-ID: <20150805081100.5F0653A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/25bc406209eaff04d1ba1f2ec65cbac098c27829/ghc >--------------------------------------------------------------- commit 25bc406209eaff04d1ba1f2ec65cbac098c27829 Author: Thomas Miedema Date: Mon Aug 3 18:27:07 2015 +0200 Pretty: improve error messages (#10735) Again, following libraries/pretty. >--------------------------------------------------------------- 25bc406209eaff04d1ba1f2ec65cbac098c27829 compiler/utils/Pretty.hs | 51 +++++++++++++++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 14 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 25bc406209eaff04d1ba1f2ec65cbac098c27829 From git at git.haskell.org Wed Aug 5 08:11:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:11:03 +0000 (UTC) Subject: [commit: ghc] master: Pretty: mimic pretty API more closely (#10735) (f951ffc) Message-ID: <20150805081103.5B7713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f951ffc6e4aa8fad1f5dcb6fd013340bf792f92d/ghc >--------------------------------------------------------------- commit f951ffc6e4aa8fad1f5dcb6fd013340bf792f92d Author: Thomas Miedema Date: Tue Aug 4 16:20:08 2015 +0200 Pretty: mimic pretty API more closely (#10735) Refactoring only. Nothing much to see here. >--------------------------------------------------------------- f951ffc6e4aa8fad1f5dcb6fd013340bf792f92d compiler/utils/Outputable.hs | 15 ++++--- compiler/utils/Pretty.hs | 100 +++++++++++++++++++++++++------------------ 2 files changed, 68 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 f951ffc6e4aa8fad1f5dcb6fd013340bf792f92d From git at git.haskell.org Wed Aug 5 08:11:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:11:06 +0000 (UTC) Subject: [commit: ghc] master: Pretty: kill code that has been dead since 1997 (#10735) (2d1eae2) Message-ID: <20150805081106.5AFE83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2d1eae26f83bdff3bc5f5eb98101e4fd718afd62/ghc >--------------------------------------------------------------- commit 2d1eae26f83bdff3bc5f5eb98101e4fd718afd62 Author: Thomas Miedema Date: Mon Aug 3 19:23:21 2015 +0200 Pretty: kill code that has been dead since 1997 (#10735) >--------------------------------------------------------------- 2d1eae26f83bdff3bc5f5eb98101e4fd718afd62 compiler/utils/Pretty.hs | 25 ++++--------------------- 1 file changed, 4 insertions(+), 21 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 62a1a1c..87881ce 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -296,9 +296,6 @@ infixl 6 <> infixl 6 <+> infixl 5 $$, $+$ --- Disable ASSERT checks; they are expensive! -#define LOCAL_ASSERT(x) - -- --------------------------------------------------------------------------- -- The Doc data type @@ -588,33 +585,19 @@ mkUnion p q = p `union_` q -- Arg of a NilAbove is always an RDoc nilAbove_ :: Doc -> Doc -nilAbove_ p = LOCAL_ASSERT( _ok p ) NilAbove p - where - _ok Empty = False - _ok _ = True +nilAbove_ = NilAbove -- Arg of a TextBeside is always an RDoc textBeside_ :: TextDetails -> FastInt -> Doc -> Doc -textBeside_ s sl p = TextBeside s sl (LOCAL_ASSERT( _ok p ) p) - where - _ok (Nest _ _) = False - _ok _ = True +textBeside_ = TextBeside -- Arg of Nest is always an RDoc nest_ :: FastInt -> Doc -> Doc -nest_ k p = Nest k (LOCAL_ASSERT( _ok p ) p) - where - _ok Empty = False - _ok _ = True +nest_ = Nest -- Args of union are always RDocs union_ :: Doc -> Doc -> Doc -union_ p q = Union (LOCAL_ASSERT( _ok p ) p) (LOCAL_ASSERT( _ok q ) q) - where - _ok (TextBeside _ _ _) = True - _ok (NilAbove _) = True - _ok (Union _ _) = True - _ok _ = False +union_ = Union -- --------------------------------------------------------------------------- From git at git.haskell.org Wed Aug 5 08:11:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:11:09 +0000 (UTC) Subject: [commit: ghc] master: Pretty: Args of NilAbove/TextBeside/Nest/Union are always RDocs (#10735) (6f6d082) Message-ID: <20150805081109.3875D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6f6d082124b24bd8437f95d99a8fd8844a0f6cd8/ghc >--------------------------------------------------------------- commit 6f6d082124b24bd8437f95d99a8fd8844a0f6cd8 Author: Thomas Miedema Date: Mon Aug 3 19:34:36 2015 +0200 Pretty: Args of NilAbove/TextBeside/Nest/Union are always RDocs (#10735) Just following libraries/pretty. >--------------------------------------------------------------- 6f6d082124b24bd8437f95d99a8fd8844a0f6cd8 compiler/utils/Pretty.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 87881ce..12a8a53 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -583,20 +583,17 @@ mkUnion :: Doc -> Doc -> Doc mkUnion Empty _ = Empty mkUnion p q = p `union_` q --- Arg of a NilAbove is always an RDoc -nilAbove_ :: Doc -> Doc +nilAbove_ :: RDoc -> RDoc nilAbove_ = NilAbove -- Arg of a TextBeside is always an RDoc -textBeside_ :: TextDetails -> FastInt -> Doc -> Doc +textBeside_ :: TextDetails -> FastInt -> RDoc -> RDoc textBeside_ = TextBeside --- Arg of Nest is always an RDoc -nest_ :: FastInt -> Doc -> Doc +nest_ :: FastInt -> RDoc -> RDoc nest_ = Nest --- Args of union are always RDocs -union_ :: Doc -> Doc -> Doc +union_ :: RDoc -> RDoc -> RDoc union_ = Union @@ -791,7 +788,7 @@ fsep = fill True -- layout1 $*$ layout2 | hasMoreThanOneLine layout1 = layout1 $$ layout2 -- | otherwise = layout1 $+$ layout2 -fill :: Bool -> [Doc] -> Doc +fill :: Bool -> [Doc] -> RDoc fill _ [] = empty fill g (p:ps) = fill1 g (reduceDoc p) (_ILIT(0)) ps From git at git.haskell.org Wed Aug 5 08:11:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:11:12 +0000 (UTC) Subject: [commit: ghc] master: Pretty: use replicate for spaces and multi_ch (#10735) (85179b5) Message-ID: <20150805081112.10BB33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/85179b5821bb1010eede7cec43280c2cd7e59bd3/ghc >--------------------------------------------------------------- commit 85179b5821bb1010eede7cec43280c2cd7e59bd3 Author: Thomas Miedema Date: Tue Aug 4 18:32:09 2015 +0200 Pretty: use replicate for spaces and multi_ch (#10735) Similar changes were made to pretty in commit 7575ab16430c876eaa1451b02465b6b103b3a519. >--------------------------------------------------------------- 85179b5821bb1010eede7cec43280c2cd7e59bd3 compiler/utils/Pretty.hs | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 741c931..0bde5fa 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -430,8 +430,7 @@ isEmpty _ = False -- -- an old version inserted tabs being 8 columns apart in the output. spaces :: Int -> String -spaces !n | n <= 0 = "" - | otherwise = ' ' : spaces (n - 1) +spaces !n = replicate n ' ' {- Q: What is the reason for negative indentation (i.e. argument to indent @@ -1000,13 +999,13 @@ display m !page_width !ribbon_width txt end doc = case m of ZigZagMode | k >= gap_width -> nlText `txt` ( - Str (multi_ch shift '/') `txt` ( + Str (replicate shift '/') `txt` ( nlText `txt` lay1 (k - shift) s sl p )) | k < 0 -> nlText `txt` ( - Str (multi_ch shift '\\') `txt` ( + Str (replicate shift '\\') `txt` ( nlText `txt` lay1 (k + shift) s sl p )) @@ -1037,10 +1036,6 @@ display m !page_width !ribbon_width txt end doc lay 0 doc }} -multi_ch :: Int -> Char -> String -multi_ch !n ch | n <= 0 = "" - | otherwise = ch : multi_ch (n - 1) ch - printDoc :: Mode -> Int -> Handle -> Doc -> IO () -- printDoc adds a newline to the end printDoc mode cols hdl doc = printDoc_ mode cols hdl (doc $$ text "") From git at git.haskell.org Wed Aug 5 08:11:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 08:11:14 +0000 (UTC) Subject: [commit: ghc] master: Pretty: use BangPatterns instead of manual unboxing Ints (#10735) (926e428) Message-ID: <20150805081114.E9F533A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/926e4288c5aabb75addcdc4cbdc106e74c11162d/ghc >--------------------------------------------------------------- commit 926e4288c5aabb75addcdc4cbdc106e74c11162d Author: Thomas Miedema Date: Mon Aug 3 20:16:58 2015 +0200 Pretty: use BangPatterns instead of manual unboxing Ints (#10735) Follow same style as libraries/pretty, although some of it is pretty archaic, and could be improved with BangPatterns: * `get w _ | w == 0 && False = undefined` * `mkNest k _ | k `seq` False = undefined` >--------------------------------------------------------------- 926e4288c5aabb75addcdc4cbdc106e74c11162d compiler/utils/BufWrite.hs | 8 +-- compiler/utils/Pretty.hs | 168 ++++++++++++++++++++++++--------------------- 2 files changed, 91 insertions(+), 85 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 926e4288c5aabb75addcdc4cbdc106e74c11162d From git at git.haskell.org Wed Aug 5 12:44:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:13 +0000 (UTC) Subject: [commit: ghc] master: Add Fixity info for infix types (575abf4) Message-ID: <20150805124413.AD8D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/575abf42e218925e456bf765abb14f069ac048a0/ghc >--------------------------------------------------------------- commit 575abf42e218925e456bf765abb14f069ac048a0 Author: RyanGlScott Date: Wed Aug 5 14:24:08 2015 +0200 Add Fixity info for infix types Template Haskell allows reification of fixity for infix functions and data constructors, and not for infix types. This adds a `Fixity` field to the relevant `Info` constructors that can have infix types (`ClassI`, `TyConI`, and `FamilyI`). I don't think that `VarI` or `PrimTyConI` can be infix, but I could be wrong. Test Plan: ./validate Reviewers: austin, goldfire, bgamari Reviewed By: goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1109 GHC Trac Issues: #10704 >--------------------------------------------------------------- 575abf42e218925e456bf765abb14f069ac048a0 compiler/typecheck/TcSplice.hs | 14 ++++---- docs/users_guide/7.12.1-notes.xml | 11 ++++++ libraries/template-haskell/Language/Haskell/TH.hs | 2 ++ .../template-haskell/Language/Haskell/TH/Ppr.hs | 14 ++++---- .../template-haskell/Language/Haskell/TH/Syntax.hs | 12 +++++-- testsuite/tests/th/T10704.hs | 24 +++++++++++++ testsuite/tests/th/T10704.stdout | 16 +++++++++ testsuite/tests/th/T10704a.hs | 21 ++++++++++++ testsuite/tests/th/T1849.script | 2 +- testsuite/tests/th/T2222.hs | 10 +++--- testsuite/tests/th/T5358.hs | 2 +- testsuite/tests/th/T5358.stderr | 6 ++-- testsuite/tests/th/TH_reifyDecl1.hs | 40 +++++++++++----------- testsuite/tests/th/TH_reifyDecl1.stderr | 1 - testsuite/tests/th/all.T | 4 +++ 15 files changed, 129 insertions(+), 50 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 575abf42e218925e456bf765abb14f069ac048a0 From git at git.haskell.org Wed Aug 5 12:44:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:16 +0000 (UTC) Subject: [commit: ghc] master: Make Exception datatypes into newtypes (b12dba7) Message-ID: <20150805124416.AA93B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b12dba7829742de98a483645142c7962b9dd9f3f/ghc >--------------------------------------------------------------- commit b12dba7829742de98a483645142c7962b9dd9f3f Author: RyanGlScott Date: Wed Aug 5 14:23:12 2015 +0200 Make Exception datatypes into newtypes Certain instances of `Exception` are simply datatypes with only one argument, which should be `newtype`s. Reviewers: ekmett, hvr, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1131 GHC Trac Issues: #10738 >--------------------------------------------------------------- b12dba7829742de98a483645142c7962b9dd9f3f libraries/base/Control/Exception/Base.hs | 10 +++++----- libraries/base/GHC/IO/Exception.hs | 2 +- libraries/base/changelog.md | 3 +++ 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index 4318773..ece5c69 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -297,7 +297,7 @@ bracketOnError before after thing = -- |A pattern match failed. The @String@ gives information about the -- source location of the pattern. -data PatternMatchFail = PatternMatchFail String +newtype PatternMatchFail = PatternMatchFail String instance Show PatternMatchFail where showsPrec _ (PatternMatchFail err) = showString err @@ -311,7 +311,7 @@ instance Exception PatternMatchFail -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record selector. -data RecSelError = RecSelError String +newtype RecSelError = RecSelError String instance Show RecSelError where showsPrec _ (RecSelError err) = showString err @@ -323,7 +323,7 @@ instance Exception RecSelError -- |An uninitialised record field was used. The @String@ gives -- information about the source location where the record was -- constructed. -data RecConError = RecConError String +newtype RecConError = RecConError String instance Show RecConError where showsPrec _ (RecConError err) = showString err @@ -337,7 +337,7 @@ instance Exception RecConError -- multiple constructors, where some fields are in one constructor -- but not another. The @String@ gives information about the source -- location of the record update. -data RecUpdError = RecUpdError String +newtype RecUpdError = RecUpdError String instance Show RecUpdError where showsPrec _ (RecUpdError err) = showString err @@ -349,7 +349,7 @@ instance Exception RecUpdError -- |A class method without a definition (neither a default definition, -- nor a definition in the appropriate instance) was called. The -- @String@ gives information about which method it was. -data NoMethodError = NoMethodError String +newtype NoMethodError = NoMethodError String instance Show NoMethodError where showsPrec _ (NoMethodError err) = showString err diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs index 9cf78b3..482027b 100644 --- a/libraries/base/GHC/IO/Exception.hs +++ b/libraries/base/GHC/IO/Exception.hs @@ -118,7 +118,7 @@ allocationLimitExceeded = toException AllocationLimitExceeded ----- -- |'assert' was applied to 'False'. -data AssertionFailed = AssertionFailed String +newtype AssertionFailed = AssertionFailed String instance Exception AssertionFailed diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 7a4bb71..bad0e8a 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -48,6 +48,9 @@ * New function `GHC.IO.interruptible` used to correctly implement `Control.Exception.allowInterrupt` (#9516) + * Made `PatternMatchFail`, `RecSelError`, `RecConError`, `RecUpdError`, + `NoMethodError`, and `AssertionFailed` newtypes (#10738) + ## 4.8.1.0 *TBA* * Bundled with GHC 7.10.2 From git at git.haskell.org Wed Aug 5 12:44:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:19 +0000 (UTC) Subject: [commit: ghc] master: Additions to users' guide and release notes (fd6b24f) Message-ID: <20150805124419.A28AA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fd6b24f1ef8ff26c97cb7e48bad8645cc63d2001/ghc >--------------------------------------------------------------- commit fd6b24f1ef8ff26c97cb7e48bad8645cc63d2001 Author: RyanGlScott Date: Wed Aug 5 14:23:32 2015 +0200 Additions to users' guide and release notes This makes two changes to the documentation: * Adds a comment in the release notes about the ability to quote primitive chars and strings in TH (see D1054) * Removes an outdated comment in the users' guide about TH not being able to handle `PartialTypeSignatures` (which was fixed in D1048) Reviewers: goldfire, austin, simonpj, bgamari Reviewed By: simonpj, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1125 >--------------------------------------------------------------- fd6b24f1ef8ff26c97cb7e48bad8645cc63d2001 docs/users_guide/7.12.1-notes.xml | 10 ++++++++++ docs/users_guide/glasgow_exts.xml | 7 ------- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index 3efdd19..d8519d3 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -178,6 +178,16 @@ counterparts. + + + Primitive chars (e.g., [| 'a'# |]) and + primitive strings (e.g., [| "abc"# |]) + can now be quoted with Template Haskell. The + Lit data type also has a new + constructor, CharPrimL, for primitive + char literals. + + diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index f6a4403..d1a908e 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -9926,13 +9926,6 @@ module M where Trac #10267) - - - Partial type signatures (see - - Trac #10548) - - From git at git.haskell.org Wed Aug 5 12:44:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:23 +0000 (UTC) Subject: [commit: ghc] master: Make sure that `all`, `any`, `and`, and `or` fuse (#9848) (22bbc1c) Message-ID: <20150805124423.117A23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22bbc1cf209d44b8bb8897ae7a35f9ebaf411b10/ghc >--------------------------------------------------------------- commit 22bbc1cf209d44b8bb8897ae7a35f9ebaf411b10 Author: Takano Akio Date: Wed Aug 5 14:23:22 2015 +0200 Make sure that `all`, `any`, `and`, and `or` fuse (#9848) Test Plan: validate Reviewers: hvr, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1126 GHC Trac Issues: #9848 >--------------------------------------------------------------- 22bbc1cf209d44b8bb8897ae7a35f9ebaf411b10 libraries/base/Data/Foldable.hs | 2 ++ libraries/base/tests/T9848.hs | 14 ++++++++++++++ libraries/base/tests/{T2528.stdout => T9848.stdout} | 2 -- libraries/base/tests/all.T | 7 +++++++ 4 files changed, 23 insertions(+), 2 deletions(-) diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 1f20261..24b6dd1 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -119,6 +119,8 @@ class Foldable t where -- | Map each element of the structure to a monoid, -- and combine the results. foldMap :: Monoid m => (a -> m) -> t a -> m + {-# INLINE foldMap #-} + -- This INLINE allows more list functions to fuse. See Trac #9848. foldMap f = foldr (mappend . f) mempty -- | Right-associative fold of a structure. diff --git a/libraries/base/tests/T9848.hs b/libraries/base/tests/T9848.hs new file mode 100644 index 0000000..d473f93 --- /dev/null +++ b/libraries/base/tests/T9848.hs @@ -0,0 +1,14 @@ +import Data.IORef + +foo :: Int -> Bool +foo n = all (<10000000) [1..n] + +bar :: Int -> Bool +bar n = and $ map (<10000000) [1..n] + +main :: IO () +main = do + ref <- newIORef 1000000 + val <- readIORef ref + print $ foo val + print $ bar val diff --git a/libraries/base/tests/T2528.stdout b/libraries/base/tests/T9848.stdout similarity index 55% copy from libraries/base/tests/T2528.stdout copy to libraries/base/tests/T9848.stdout index 4f90091..dbde422 100644 --- a/libraries/base/tests/T2528.stdout +++ b/libraries/base/tests/T9848.stdout @@ -1,4 +1,2 @@ -[A] -[1] True True diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 34176d0..1b065a3 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -191,3 +191,10 @@ test('T9681', normal, compile_fail, ['']) test('T8089', [exit_code(99), run_timeout_multiplier(0.01)], compile_and_run, ['']) test('T9826',normal, compile_and_run,['']) +test('T9848', + [ stats_num_field('bytes allocated', + [ (wordsize(64), 51840, 20) + , (wordsize(32), 47348, 20) ]) + , only_ways(['normal'])], + compile_and_run, + ['-O']) From git at git.haskell.org Wed Aug 5 12:44:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:25 +0000 (UTC) Subject: [commit: ghc] master: Drop custom mapM impl for [] (6029748) Message-ID: <20150805124425.ED8363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60297486fddd5c9695e2263c2ae46fa90f0feb9e/ghc >--------------------------------------------------------------- commit 60297486fddd5c9695e2263c2ae46fa90f0feb9e Author: Ben Gamari Date: Wed Aug 5 14:21:47 2015 +0200 Drop custom mapM impl for [] See https://mail.haskell.org/pipermail/libraries/2015-May/025708.html for motivation. This fixes #10457 Test Plan: Validate Reviewers: hvr, austin Subscribers: simonmar, thomie, dolio Differential Revision: https://phabricator.haskell.org/D1124 GHC Trac Issues: #10457 >--------------------------------------------------------------- 60297486fddd5c9695e2263c2ae46fa90f0feb9e libraries/base/Data/Traversable.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 1d3ef93..535db00 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -56,7 +56,6 @@ import Data.Proxy ( Proxy(..) ) import GHC.Arr import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..), ($), (.), id, flip ) -import qualified GHC.Base as Monad ( mapM ) import qualified GHC.List as List ( foldr ) -- | Functors representing data structures that can be traversed from @@ -180,8 +179,6 @@ instance Traversable [] where traverse f = List.foldr cons_f (pure []) where cons_f x ys = (:) <$> f x <*> ys - mapM = Monad.mapM - instance Traversable (Either a) where traverse _ (Left x) = pure (Left x) traverse f (Right y) = Right <$> f y From git at git.haskell.org Wed Aug 5 12:44:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:28 +0000 (UTC) Subject: [commit: ghc] master: Add framework flags when linking a dynamic library (dd7e188) Message-ID: <20150805124428.E5F313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/dd7e1880ae078a2d9f254dc5d8f330121e0ec291/ghc >--------------------------------------------------------------- commit dd7e1880ae078a2d9f254dc5d8f330121e0ec291 Author: Christiaan Baaij Date: Wed Aug 5 14:20:56 2015 +0200 Add framework flags when linking a dynamic library This fixes the GHC side of trac #10568. So `cabal install --ghc-options="-framework GLUT" GLUT` creates a correctly linked GLUT.dylib. We still need to explictly pass `--ghc-options="-framework GLUT"` because the Cabal side #10568 is not fixed. Update: the Cabal side of #10568 is fixed by [Cabal#2747](https://github.com/haskell/cabal/pull/2747) Test Plan: validate Reviewers: austin, rwbarton, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D1115 GHC Trac Issues: #10568 >--------------------------------------------------------------- dd7e1880ae078a2d9f254dc5d8f330121e0ec291 compiler/main/DriverPipeline.hs | 31 +++--------------------------- compiler/main/SysTools.hs | 42 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 44 insertions(+), 29 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 97e64c4..f8b7c30 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1818,32 +1818,9 @@ linkBinary' staticLink dflags o_files dep_packages = do -- This option must be placed before the library -- that defines the symbol." - pkg_framework_path_opts <- - if platformUsesFrameworks platform - then do pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages - return $ map ("-F" ++) pkg_framework_paths - else return [] - - framework_path_opts <- - if platformUsesFrameworks platform - then do let framework_paths = frameworkPaths dflags - return $ map ("-F" ++) framework_paths - else return [] - - pkg_framework_opts <- - if platformUsesFrameworks platform - then do pkg_frameworks <- getPackageFrameworks dflags dep_packages - return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ] - else return [] - - framework_opts <- - if platformUsesFrameworks platform - then do let frameworks = cmdlineFrameworks dflags - -- reverse because they're added in reverse order from - -- the cmd line: - return $ concat [ ["-framework", fw] - | fw <- reverse frameworks ] - else return [] + -- frameworks + pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages + let framework_opts = getFrameworkOpts dflags platform -- probably _stub.o files let extra_ld_inputs = ldInputs dflags @@ -1932,12 +1909,10 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ extra_ld_inputs ++ map SysTools.Option ( rc_objs - ++ framework_path_opts ++ framework_opts ++ pkg_lib_path_opts ++ extraLinkObj:noteLinkObjs ++ pkg_link_opts - ++ pkg_framework_path_opts ++ pkg_framework_opts ++ debug_opts ++ thread_opts diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 0b9537f..8ff0d9b 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -44,7 +44,12 @@ module SysTools ( cleanTempDirs, cleanTempFiles, cleanTempFilesExcept, addFilesToClean, - Option(..) + Option(..), + + -- frameworks + getPkgFrameworkOpts, + getFrameworkOpts + ) where @@ -1518,6 +1523,11 @@ linkDynLib dflags0 o_files dep_packages -- and last temporary shared object file let extra_ld_inputs = ldInputs dflags + -- frameworks + pkg_framework_opts <- getPkgFrameworkOpts dflags platform + (map packageKey pkgs) + let framework_opts = getFrameworkOpts dflags platform + case os of OSMinGW32 -> do ------------------------------------------------------------- @@ -1603,8 +1613,10 @@ linkDynLib dflags0 o_files dep_packages ++ [ Option "-install_name", Option instName ] ++ map Option lib_path_opts ++ extra_ld_inputs + ++ map Option framework_opts ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts + ++ map Option pkg_framework_opts ) OSiOS -> throwGhcExceptionIO (ProgramError "dynamic libraries are not supported on iOS target") _ -> do @@ -1633,3 +1645,31 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ) + +getPkgFrameworkOpts :: DynFlags -> Platform -> [PackageKey] -> IO [String] +getPkgFrameworkOpts dflags platform dep_packages + | platformUsesFrameworks platform = do + pkg_framework_path_opts <- do + pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages + return $ map ("-F" ++) pkg_framework_paths + + pkg_framework_opts <- do + pkg_frameworks <- getPackageFrameworks dflags dep_packages + return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ] + + return (pkg_framework_path_opts ++ pkg_framework_opts) + + | otherwise = return [] + +getFrameworkOpts :: DynFlags -> Platform -> [String] +getFrameworkOpts dflags platform + | platformUsesFrameworks platform = framework_path_opts ++ framework_opts + | otherwise = [] + where + framework_paths = frameworkPaths dflags + framework_path_opts = map ("-F" ++) framework_paths + + frameworks = cmdlineFrameworks dflags + -- reverse because they're added in reverse order from the cmd line: + framework_opts = concat [ ["-framework", fw] + | fw <- reverse frameworks ] From git at git.haskell.org Wed Aug 5 12:44:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:31 +0000 (UTC) Subject: [commit: ghc] master: Make -fcpr-off a dynamic flag (ecb1752) Message-ID: <20150805124431.CECA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ecb1752ffa12dfa71053f640e6cce64d15e47e8f/ghc >--------------------------------------------------------------- commit ecb1752ffa12dfa71053f640e6cce64d15e47e8f Author: Christiaan Baaij Date: Wed Aug 5 14:22:14 2015 +0200 Make -fcpr-off a dynamic flag Test Plan: validate Reviewers: austin, goldfire, simonpj, bgamari Reviewed By: bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D1110 GHC Trac Issues: #10706 >--------------------------------------------------------------- ecb1752ffa12dfa71053f640e6cce64d15e47e8f compiler/basicTypes/Demand.hs | 12 +++--------- compiler/main/DynFlags.hs | 3 +++ compiler/main/StaticFlags.hs | 9 +-------- compiler/stranal/WwLib.hs | 12 +++++++++--- docs/users_guide/7.12.1-notes.xml | 11 +++++++++++ docs/users_guide/flags.xml | 9 +++++---- 6 files changed, 32 insertions(+), 24 deletions(-) diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 8ee0f13..41860eb 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -57,7 +57,6 @@ module Demand ( #include "HsVersions.h" -import StaticFlags import DynFlags import Outputable import Var ( Var ) @@ -871,18 +870,13 @@ topRes = Dunno NoCPR botRes = Diverges cprSumRes :: ConTag -> DmdResult -cprSumRes tag | opt_CprOff = topRes - | otherwise = Dunno $ RetSum tag +cprSumRes tag = Dunno $ RetSum tag cprProdRes :: [DmdType] -> DmdResult -cprProdRes _arg_tys - | opt_CprOff = topRes - | otherwise = Dunno $ RetProd +cprProdRes _arg_tys = Dunno $ RetProd vanillaCprProdRes :: Arity -> DmdResult -vanillaCprProdRes _arity - | opt_CprOff = topRes - | otherwise = Dunno $ RetProd +vanillaCprProdRes _arity = Dunno $ RetProd isTopRes :: DmdResult -> Bool isTopRes (Dunno NoCPR) = True diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c94c6d9..effe803 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -378,6 +378,7 @@ data GeneralFlag | Opt_DictsStrict -- be strict in argument dictionaries | Opt_DmdTxDictSel -- use a special demand transformer for dictionary selectors | Opt_Loopification -- See Note [Self-recursive tail calls] + | Opt_CprAnal -- Interface files | Opt_IgnoreInterfacePragmas @@ -2965,6 +2966,7 @@ fFlags = [ flagSpec "cmm-elim-common-blocks" Opt_CmmElimCommonBlocks, flagSpec "cmm-sink" Opt_CmmSink, flagSpec "cse" Opt_CSE, + flagSpec "cpr-anal" Opt_CprAnal, flagSpec "defer-type-errors" Opt_DeferTypeErrors, flagSpec "defer-typed-holes" Opt_DeferTypedHoles, flagSpec "dicts-cheap" Opt_DictsCheap, @@ -3357,6 +3359,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] , ([1,2], Opt_CrossModuleSpecialise) , ([1,2], Opt_Strictness) , ([1,2], Opt_UnboxSmallStrictFields) + , ([1,2], Opt_CprAnal) , ([2], Opt_LiberateCase) , ([2], Opt_SpecConstr) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index e2876a4..a89f3c5 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -27,7 +27,6 @@ module StaticFlags ( -- optimisation opts opt_NoStateHack, - opt_CprOff, opt_NoOptCoercion, -- For the parser @@ -144,8 +143,7 @@ isStaticFlag f = f `elem` flagsStaticNames flagsStaticNames :: [String] flagsStaticNames = [ "fno-state-hack", - "fno-opt-coercion", - "fcpr-off" + "fno-opt-coercion" ] -- We specifically need to discard static flags for clients of the @@ -158,7 +156,6 @@ discardStaticFlags :: [String] -> [String] discardStaticFlags = filter (\x -> x `notElem` flags) where flags = [ "-fno-state-hack" , "-fno-opt-coercion" - , "-fcpr-off" , "-dppr-debug" , "-dno-debug-output" ] @@ -202,10 +199,6 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output") opt_NoStateHack :: Bool opt_NoStateHack = lookUp (fsLit "-fno-state-hack") --- Switch off CPR analysis in the new demand analyser -opt_CprOff :: Bool -opt_CprOff = lookUp (fsLit "-fcpr-off") - opt_NoOptCoercion :: Bool opt_NoOptCoercion = lookUp (fsLit "-fno-opt-coercion") diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index b442f3d..02ef6ca 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -136,7 +136,8 @@ mkWwBodies dflags fam_envs fun_ty demands res_info one_shots ; (useful1, work_args, wrap_fn_str, work_fn_str) <- mkWWstr dflags fam_envs wrap_args -- Do CPR w/w. See Note [Always do CPR w/w] - ; (useful2, wrap_fn_cpr, work_fn_cpr, cpr_res_ty) <- mkWWcpr fam_envs res_ty res_info + ; (useful2, wrap_fn_cpr, work_fn_cpr, cpr_res_ty) + <- mkWWcpr (gopt Opt_CprAnal dflags) fam_envs res_ty res_info ; let (work_lam_args, work_call_args) = mkWorkerArgs dflags work_args all_one_shots cpr_res_ty worker_args_dmds = [idDemandInfo v | v <- work_call_args, isId v] @@ -601,7 +602,8 @@ The non-CPR results appear ordered in the unboxed tuple as if by a left-to-right traversal of the result structure. -} -mkWWcpr :: FamInstEnvs +mkWWcpr :: Bool + -> FamInstEnvs -> Type -- function body type -> DmdResult -- CPR analysis results -> UniqSM (Bool, -- Is w/w'ing useful? @@ -609,7 +611,11 @@ mkWWcpr :: FamInstEnvs CoreExpr -> CoreExpr, -- New worker Type) -- Type of worker's body -mkWWcpr fam_envs body_ty res +mkWWcpr opt_CprAnal fam_envs body_ty res + -- CPR explicitly turned off (or in -O0) + | not opt_CprAnal = return (False, id, id, body_ty) + -- CPR is turned on by default for -O and O2 + | otherwise = case returnsCPR_maybe res of Nothing -> return (False, id, id, body_ty) -- No CPR info Just con_tag | Just stuff <- deepSplitCprType_maybe fam_envs con_tag body_ty diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index b2cb369..3efdd19 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -112,6 +112,17 @@ type errors. + + + Added the option . + + When enabled, the demand analyser performs CPR analysis. + It is implied by . Consequently, + is now removed, run with + to get the old + behaviour. + + diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 39b4872..0683752 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -1967,10 +1967,11 @@ - - Switch off CPR analysis in the demand analyser. - static - - + + Turn on CPR analysis in the demand analyser. Implied by + . + dynamic + From git at git.haskell.org Wed Aug 5 12:44:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 12:44:34 +0000 (UTC) Subject: [commit: ghc] master: users_guide: Add note about #367 to Bugs section (4c55f14) Message-ID: <20150805124434.A5CD93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/4c55f14d0ab0f2b099c475a9810012f645bb059e/ghc >--------------------------------------------------------------- commit 4c55f14d0ab0f2b099c475a9810012f645bb059e Author: Ben Gamari Date: Wed Aug 5 14:21:28 2015 +0200 users_guide: Add note about #367 to Bugs section This is a long-standing bug and should be mentioned in the users guide, as noted in #10639. Test Plan: Carefully check language. Reviewers: simonpj, rwbarton, austin Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D1127 GHC Trac Issues: #10639, #367 >--------------------------------------------------------------- 4c55f14d0ab0f2b099c475a9810012f645bb059e docs/users_guide/bugs.xml | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 8673d71..1b4d5c9 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -476,6 +476,21 @@ checking for duplicates. The reason for this is efficiency, pure and simple. + GHC's runtime system implements cooperative multitasking, with + context switching potentially occurring only when a program allocates. + This means that programs that do not allocate may never context switch. + See + Trac #367 + for further discussion. + + If you are hit by this, you may want to compile the affected module + with -fno-omit-yields. This flag ensures that yield points + are inserted at every function entrypoint (at the expense of a bit of + performance). + + + + GHC can warn about non-exhaustive or overlapping patterns (see ), and usually does so correctly. But not always. It gets confused by From git at git.haskell.org Wed Aug 5 13:25:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 13:25:06 +0000 (UTC) Subject: [commit: ghc] master: Do not complain about SPECIALISE for INLINE (617f696) Message-ID: <20150805132506.B44233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/617f6966b5aaedd3ecd3f4c0f3735253187b7ff5/ghc >--------------------------------------------------------------- commit 617f6966b5aaedd3ecd3f4c0f3735253187b7ff5 Author: Simon Peyton Jones Date: Wed Aug 5 13:38:20 2015 +0100 Do not complain about SPECIALISE for INLINE Fixes Trac #10721. See Note [SPECIALISE on INLINE functions] >--------------------------------------------------------------- 617f6966b5aaedd3ecd3f4c0f3735253187b7ff5 compiler/deSugar/DsBinds.hs | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index b6edf7c..55c82dd 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -67,9 +67,7 @@ import Bag import BasicTypes hiding ( TopLevel ) import DynFlags import FastString -import ErrUtils( MsgDoc ) import Util -import Control.Monad( when ) import MonadUtils import Control.Monad(liftM) import Fingerprint(Fingerprint(..), fingerprintString) @@ -460,8 +458,10 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) ; spec_rhs <- dsHsWrapper spec_co poly_rhs - ; when (isInlinePragma id_inl && wopt Opt_WarnPointlessPragmas dflags) - (warnDs (specOnInline poly_name)) +-- Commented out: see Note [SPECIALISE on INLINE functions] +-- ; when (isInlinePragma id_inl) +-- (warnDs $ ptext (sLit "SPECIALISE pragma on INLINE function probably won't fire:") +-- <+> quotes (ppr poly_name)) ; return (Just (unitOL (spec_id, spec_rhs), rule)) -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because @@ -503,11 +503,20 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) | otherwise = spec_prag_act -- Specified by user -specOnInline :: Name -> MsgDoc -specOnInline f = ptext (sLit "SPECIALISE pragma on INLINE function probably won't fire:") - <+> quotes (ppr f) -{- +{- Note [SPECIALISE on INLINE functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We used to warn that using SPECIALISE for a function marked INLINE +would be a no-op; but it isn't! Especially with worker/wrapper split +we might have + {-# INLINE f #-} + f :: Ord a => Int -> a -> ... + f d x y = case x of I# x' -> $wf d x' y + +We might want to specialise 'f' so that we in turn specialise '$wf'. +We can't even /name/ '$wf' in the source code, so we can't specialise +it even if we wanted to. Trac #10721 is a case in point. + Note [Activation pragmas for SPECIALISE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From a user SPECIALISE pragma for f, we generate From git at git.haskell.org Wed Aug 5 13:25:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 13:25:09 +0000 (UTC) Subject: [commit: ghc] master: Allow proper errors/warnings in core2core passes (e2b5738) Message-ID: <20150805132509.8C5C53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e2b5738141d1f60858e53ed1edd7167b1a93800c/ghc >--------------------------------------------------------------- commit e2b5738141d1f60858e53ed1edd7167b1a93800c Author: Simon Peyton Jones Date: Wed Aug 5 13:31:48 2015 +0100 Allow proper errors/warnings in core2core passes This patch makes it possible for core-to-core passes to emit proper error messages and warnings. * New function CoreMonad.warnMsg * CoreMonad.warnMsg and errorMsg now print a proper warning/error message heading. * CoreMonad carries a SrcSpan, which is used in warning/error messages. It is initialised to be the source file name, but a core-to-core pass could set it more specifically if it had better location information. There was a bit of plumbing needed to get the filename to the right place. >--------------------------------------------------------------- e2b5738141d1f60858e53ed1edd7167b1a93800c compiler/basicTypes/SrcLoc.hs | 10 ++++--- compiler/coreSyn/CoreLint.hs | 3 +- compiler/deSugar/Desugar.hs | 7 +++++ compiler/main/ErrUtils.hs | 17 +++++++++-- compiler/main/ErrUtils.hs-boot | 5 ++-- compiler/main/HscMain.hs | 2 ++ compiler/main/HscTypes.hs | 1 + compiler/simplCore/CoreMonad.hs | 66 ++++++++++++++++++++++++++++------------- compiler/simplCore/SimplCore.hs | 14 +++++---- 9 files changed, 90 insertions(+), 35 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e2b5738141d1f60858e53ed1edd7167b1a93800c From git at git.haskell.org Wed Aug 5 13:25:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 13:25:12 +0000 (UTC) Subject: [commit: ghc] master: Comments only (49615d9) Message-ID: <20150805132512.8CCA43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/49615d9d3a5a25568dc12e4824259439223b44a5/ghc >--------------------------------------------------------------- commit 49615d9d3a5a25568dc12e4824259439223b44a5 Author: Simon Peyton Jones Date: Wed Aug 5 13:56:48 2015 +0100 Comments only >--------------------------------------------------------------- 49615d9d3a5a25568dc12e4824259439223b44a5 compiler/rename/RnBinds.hs | 208 ++++++++++++++++++++++++++------------------- 1 file changed, 120 insertions(+), 88 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 49615d9d3a5a25568dc12e4824259439223b44a5 From git at git.haskell.org Wed Aug 5 13:25:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 13:25:15 +0000 (UTC) Subject: [commit: ghc] master: Warn about missed specialisations for imports (a426154) Message-ID: <20150805132515.75B243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a4261549afaee56b00fbea1b4bc1a07c95e60929/ghc >--------------------------------------------------------------- commit a4261549afaee56b00fbea1b4bc1a07c95e60929 Author: Simon Peyton Jones Date: Wed Aug 5 13:37:18 2015 +0100 Warn about missed specialisations for imports This change was provoked by Trac #10720, where a missing INLINEABLE pragma gave very poor performance. The change is to warn when an imported function is not specialised in a situation where the user expects it to be. New flags -fwarn-missed-specialisations -fwarn-all-missed-specialisations Documented in user manual. See Note [Warning about missed specialisations] >--------------------------------------------------------------- a4261549afaee56b00fbea1b4bc1a07c95e60929 compiler/main/DynFlags.hs | 13 +++-- compiler/specialise/Specialise.hs | 65 ++++++++++++++++------ docs/users_guide/using.xml | 24 +++++--- .../tests/simplCore/should_compile/T5359b.stderr | 3 - 4 files changed, 73 insertions(+), 32 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a4261549afaee56b00fbea1b4bc1a07c95e60929 From git at git.haskell.org Wed Aug 5 15:50:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 15:50:07 +0000 (UTC) Subject: [commit: ghc] master: Minor refactor to use filterInScope (ab98860) Message-ID: <20150805155007.1AB153A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab98860871cfac17417d5b55e590445064d21111/ghc >--------------------------------------------------------------- commit ab98860871cfac17417d5b55e590445064d21111 Author: Simon Peyton Jones Date: Wed Aug 5 14:03:34 2015 +0100 Minor refactor to use filterInScope >--------------------------------------------------------------- ab98860871cfac17417d5b55e590445064d21111 compiler/rename/RnTypes.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 346d764..5dfd3fa 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -489,17 +489,18 @@ rnHsBndrSig :: HsDocContext rnHsBndrSig doc (HsWB { hswb_cts = ty@(L loc _) }) thing_inside = do { sig_ok <- xoptM Opt_ScopedTypeVariables ; unless sig_ok (badSigErr True doc ty) - ; let (kv_bndrs, tv_bndrs) = extractHsTyRdrTyVars ty - ; name_env <- getLocalRdrEnv - ; tv_names <- newLocalBndrsRn [L loc tv | tv <- tv_bndrs - , not (tv `elemLocalRdrEnv` name_env) ] - ; kv_names <- newLocalBndrsRn [L loc kv | kv <- kv_bndrs - , not (kv `elemLocalRdrEnv` name_env) ] + ; rdr_env <- getLocalRdrEnv + ; let (kv_bndrs, tv_bndrs) = filterInScope rdr_env $ + extractHsTyRdrTyVars ty + ; kv_names <- newLocalBndrsRn (map (L loc) kv_bndrs) + ; tv_names <- newLocalBndrsRn (map (L loc) tv_bndrs) ; bindLocalNamesFV kv_names $ bindLocalNamesFV tv_names $ do { (ty', fvs1, wcs) <- rnLHsTypeWithWildCards doc ty - ; (res, fvs2) <- thing_inside (HsWB { hswb_cts = ty', hswb_kvs = kv_names, - hswb_tvs = tv_names, hswb_wcs = wcs }) + ; (res, fvs2) <- thing_inside (HsWB { hswb_cts = ty' + , hswb_kvs = kv_names + , hswb_tvs = tv_names + , hswb_wcs = wcs }) ; return (res, fvs1 `plusFV` fvs2) } } overlappingKindVars :: HsDocContext -> [RdrName] -> SDoc From git at git.haskell.org Wed Aug 5 15:50:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 15:50:10 +0000 (UTC) Subject: [commit: ghc] master: Tidy up and refactor wildcard handling (9536481) Message-ID: <20150805155010.1CA9F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/953648127cea2836ec134b03a966695ac0b36434/ghc >--------------------------------------------------------------- commit 953648127cea2836ec134b03a966695ac0b36434 Author: Simon Peyton Jones Date: Wed Aug 5 14:24:54 2015 +0100 Tidy up and refactor wildcard handling When examining #10615, I found the wildcard handling hard to understand. This patch refactors quite a bit, but with no real change in behaviour. * Split out TcIdSigInfo from TcSigInfo, as a separate type, like TcPatSynInfo. * Make TcIdSigInfo express more invariants by pushing the wildard info into TcIdSigBndr * Remove all special treatment of unification variables that arise from wildcards; so the TauTv of TcType.MetaInfo loses its Bool argument. A ton of konck on changes. The result is significantly simpler, I think. >--------------------------------------------------------------- 953648127cea2836ec134b03a966695ac0b36434 compiler/typecheck/TcBinds.hs | 207 +++++++++++---------- compiler/typecheck/TcClassDcl.hs | 15 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcExpr.hs | 11 +- compiler/typecheck/TcHsType.hs | 25 ++- compiler/typecheck/TcInstDcls.hs | 21 ++- compiler/typecheck/TcMType.hs | 60 +----- compiler/typecheck/TcPat.hs | 128 +++++++------ compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 3 +- compiler/typecheck/TcRnTypes.hs | 4 +- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcType.hs | 36 ++-- compiler/typecheck/TcValidity.hs | 9 +- compiler/types/Type.hs | 2 +- compiler/types/TypeRep.hs | 21 +-- testsuite/tests/ghci/scripts/Defer02.stderr | 84 +++++---- .../should_compile/Defaulting2MROff.stderr | 2 +- .../partial-sigs/should_compile/Either.stderr | 2 +- .../partial-sigs/should_compile/EveryNamed.stderr | 2 +- .../should_compile/ExtraConstraints3.stderr | 8 +- .../partial-sigs/should_compile/ShowNamed.stderr | 2 +- .../partial-sigs/should_compile/SimpleGen.stderr | 2 +- .../partial-sigs/should_compile/SplicesUsed.stderr | 35 ++-- .../partial-sigs/should_compile/T10403.stderr | 9 +- .../partial-sigs/should_compile/T10438.stderr | 15 +- .../partial-sigs/should_compile/T10519.stderr | 3 +- .../partial-sigs/should_compile/Uncurry.stderr | 2 +- .../should_compile/UncurryNamed.stderr | 2 +- .../WarningWildcardInstantiations.stderr | 60 +++--- .../should_fail/Defaulting1MROff.stderr | 6 +- .../ExtraConstraintsWildcardNotEnabled.stderr | 5 +- .../InstantiatedNamedWildcardsInConstraints.stderr | 6 +- .../should_fail/NamedWildcardsEnabled.stderr | 6 +- .../PartialTypeSignaturesDisabled.stderr | 6 +- .../partial-sigs/should_fail/TidyClash.stderr | 20 +- .../partial-sigs/should_fail/Trac10045.stderr | 3 +- .../should_fail/WildcardInPatSynSig.stderr | 5 +- .../should_fail/WildcardInstantiations.stderr | 56 +++--- .../WildcardsInPatternAndExprSig.stderr | 56 +++--- .../tests/typecheck/should_compile/T10072.stderr | 6 +- .../tests/typecheck/should_fail/tcfail198.stderr | 14 +- 42 files changed, 497 insertions(+), 470 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 953648127cea2836ec134b03a966695ac0b36434 From git at git.haskell.org Wed Aug 5 15:50:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 5 Aug 2015 15:50:13 +0000 (UTC) Subject: [commit: ghc] master: Fix quantification for inference with sigs (28096b2) Message-ID: <20150805155013.C60743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28096b274a3803b8a479c5dd94ebda655a15566c/ghc >--------------------------------------------------------------- commit 28096b274a3803b8a479c5dd94ebda655a15566c Author: Simon Peyton Jones Date: Wed Aug 5 16:46:16 2015 +0100 Fix quantification for inference with sigs When we are *inferring* the type of a let-bound function, we might still have a type signature. And we must be sure to quantify over its type variables, else you get the crash in Trac #10615. See Note [Which type variables to quantify] in TcSimplify >--------------------------------------------------------------- 28096b274a3803b8a479c5dd94ebda655a15566c compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 1 + compiler/typecheck/TcSimplify.hs | 60 ++++++++++++++++++---- testsuite/tests/partial-sigs/should_fail/T10615.hs | 10 ++++ .../tests/partial-sigs/should_fail/T10615.stderr | 34 ++++++++++++ testsuite/tests/partial-sigs/should_fail/all.T | 2 + 6 files changed, 100 insertions(+), 11 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 28096b274a3803b8a479c5dd94ebda655a15566c From git at git.haskell.org Thu Aug 6 13:50:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 13:50:16 +0000 (UTC) Subject: [commit: ghc] master: Coments only (75f5f23) Message-ID: <20150806135016.A59843A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/75f5f23b810f74376c71bdf0db51f3ffca6de015/ghc >--------------------------------------------------------------- commit 75f5f23b810f74376c71bdf0db51f3ffca6de015 Author: Simon Peyton Jones Date: Thu Aug 6 13:40:07 2015 +0100 Coments only >--------------------------------------------------------------- 75f5f23b810f74376c71bdf0db51f3ffca6de015 compiler/simplCore/SimplUtils.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index d297be3..db74855 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -702,20 +702,24 @@ updModeForStableUnfoldings inline_rule_act current_mode phaseFromActivation _ = InitialPhase updModeForRuleLHS :: SimplifierMode -> SimplifierMode --- See Note [Simplifying RULE LHSs] +-- See Note [Simplifying rule LHSs] updModeForRuleLHS current_mode = current_mode { sm_phase = InitialPhase , sm_inline = False , sm_rules = False , sm_eta_expand = False } -{- Note [Simplifying RULE LHSs] +{- Note [Simplifying rule LHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When simplifying on the LHS of a rule, refrain from all inlining and all RULES. Doing anything to the LHS is plain confusing, because it means that what the rule matches is not what the user wrote. c.f. Trac #10595, and #10528. +Moreover, inlining (or applying rules) on rule LHSs risks introducing +Ticks into the LHS, which makes matching trickier. Trac #10665, #10745. + + Note [Inlining in gentle mode] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Something is inlined if From git at git.haskell.org Thu Aug 6 13:50:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 13:50:19 +0000 (UTC) Subject: [commit: ghc] master: Comments only (cc07c40) Message-ID: <20150806135019.6CBBD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cc07c40189d4375ca5b22beb3ad74a81fb85d9b4/ghc >--------------------------------------------------------------- commit cc07c40189d4375ca5b22beb3ad74a81fb85d9b4 Author: Simon Peyton Jones Date: Thu Aug 6 14:46:48 2015 +0100 Comments only >--------------------------------------------------------------- cc07c40189d4375ca5b22beb3ad74a81fb85d9b4 compiler/typecheck/TcSimplify.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 825ce21..8babe0f 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -1118,6 +1118,8 @@ warnRedundantGivens (SigSkol ctxt _) FunSigCtxt _ warn_redundant -> warn_redundant ExprSigCtxt -> True _ -> False + -- To think about: do we want to report redundant givens for + -- pattern synonyms, PatSynCtxt? c.f Trac #9953, comment:21. warnRedundantGivens (InstSkol {}) = True warnRedundantGivens _ = False From git at git.haskell.org Thu Aug 6 13:50:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 13:50:22 +0000 (UTC) Subject: [commit: ghc] master: T8968-1 and -3 should pass (294553e) Message-ID: <20150806135022.303D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/294553e960404bf9765eae6891b5800ae5127879/ghc >--------------------------------------------------------------- commit 294553e960404bf9765eae6891b5800ae5127879 Author: Simon Peyton Jones Date: Thu Aug 6 14:50:12 2015 +0100 T8968-1 and -3 should pass See Trac #9953, comment:22. >--------------------------------------------------------------- 294553e960404bf9765eae6891b5800ae5127879 testsuite/tests/patsyn/should_compile/all.T | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index a046e79..b0776ac 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -15,9 +15,9 @@ test('T9732', normal, compile, ['']) test('T8584-1', normal, compile, ['']) test('T8584-2', normal, compile, ['']) test('T8584-3', normal, compile, ['']) -test('T8968-1', expect_broken(9953), compile, ['']) +test('T8968-1', normal, compile, ['']) test('T8968-2', normal, compile, ['']) -test('T8968-3', expect_broken(9953), compile, ['']) +test('T8968-3', normal, compile, ['']) test('ImpExp_Imp', [extra_clean(['ImpExp_Exp.hi', 'ImpExp_Exp.o'])], multimod_compile, ['ImpExp_Imp', '-v0']) test('T9857', normal, compile, ['']) test('T9889', normal, compile, ['']) From git at git.haskell.org Thu Aug 6 13:50:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 13:50:25 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10742 (64dba51) Message-ID: <20150806135025.596963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/64dba5119fdecb4a5b6a2993919a963d02171783/ghc >--------------------------------------------------------------- commit 64dba5119fdecb4a5b6a2993919a963d02171783 Author: Simon Peyton Jones Date: Thu Aug 6 14:50:35 2015 +0100 Test Trac #10742 >--------------------------------------------------------------- 64dba5119fdecb4a5b6a2993919a963d02171783 testsuite/tests/polykinds/T10742.hs | 14 ++++++++++++++ testsuite/tests/polykinds/all.T | 1 + 2 files changed, 15 insertions(+) diff --git a/testsuite/tests/polykinds/T10742.hs b/testsuite/tests/polykinds/T10742.hs new file mode 100644 index 0000000..3b0b1a7 --- /dev/null +++ b/testsuite/tests/polykinds/T10742.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} + +module T10742 where + +import GHC.TypeLits + +data T a where MkT :: T Int + +test :: ((x <=? y) ~ 'True, (y <=? z) ~ 'True) + => proxy x y z -> () +test _ = case MkT of MkT -> () diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 55041dc..c073c1b 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -120,3 +120,4 @@ test('T10570', normal, compile_fail, ['']) test('T10670', normal, compile, ['']) test('T10670a', normal, compile, ['']) test('T10134', normal, multimod_compile, ['T10134.hs','-v0']) +test('T10742', normal, compile, ['']) From git at git.haskell.org Thu Aug 6 16:01:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 16:01:33 +0000 (UTC) Subject: [commit: ghc] master: Ensure DynFlags are consistent (eca9a1a) Message-ID: <20150806160133.256AB3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/eca9a1a17c12d01636417fb88bda5ee5fe34577f/ghc >--------------------------------------------------------------- commit eca9a1a17c12d01636417fb88bda5ee5fe34577f Author: Ben Gamari Date: Thu Aug 6 17:25:46 2015 +0200 Ensure DynFlags are consistent While we have always had makeDynFlagsConsistent to enforce a variety of consistency invariants on DynFlags, it hasn't been widely used. GHC.Main, for instance, ignored it entirely. This leads to issues like Trac #10549, where an OPTIONS_GHC pragma introduced an inconsistency, leading to a perplexing crash later in compilation. Here I add consistency checks in GHC.Main.set{Session,Program}DynFlags, closing this hole. Fixes #10549. Test Plan: Validate with T10549 Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1128 GHC Trac Issues: #10549 >--------------------------------------------------------------- eca9a1a17c12d01636417fb88bda5ee5fe34577f compiler/main/DynFlags.hs | 36 ++++++++++++++++++++-- compiler/main/GHC.hs | 27 +++------------- testsuite/tests/ghc-api/T10052/T10052.stderr | 2 +- .../tests/ghci.debugger/scripts/print007.stderr | 5 +-- .../should_compile => ghci/should_fail}/Makefile | 0 testsuite/tests/ghci/should_fail/T10549.hs | 15 +++++++++ testsuite/tests/ghci/should_fail/T10549.script | 1 + .../should_fail/T10549.stderr} | 2 +- testsuite/tests/ghci/should_fail/all.T | 3 ++ 9 files changed, 61 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 eca9a1a17c12d01636417fb88bda5ee5fe34577f From git at git.haskell.org Thu Aug 6 16:01:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 16:01:38 +0000 (UTC) Subject: [commit: ghc] master: llvmGen: Rework LLVM mangler (600b153) Message-ID: <20150806160138.DE4CC3A301@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/600b153abb78505911db8b0c44e6f172f6ddb18f/ghc >--------------------------------------------------------------- commit 600b153abb78505911db8b0c44e6f172f6ddb18f Author: Ben Gamari Date: Thu Aug 6 17:30:19 2015 +0200 llvmGen: Rework LLVM mangler The LLVM mangler does not currently transform AVX instructions on x86-64 platforms, due to a missing #include. Also, it is significantly more complicated than necessary, due to the file into sections (not needed anymore), and is sensitive to the details of the whitespace in the assembly. Author: dobenour Test Plan: Validation on x86-64, x86-32, and ARM Reviewers: austin Subscribers: thomie, bgamari, rwbarton Differential Revision: https://phabricator.haskell.org/D1034 GHC Trac Issues: #10394 >--------------------------------------------------------------- 600b153abb78505911db8b0c44e6f172f6ddb18f compiler/llvmGen/LlvmMangler.hs | 183 ++++++++++++++++++---------------------- 1 file changed, 81 insertions(+), 102 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 600b153abb78505911db8b0c44e6f172f6ddb18f From git at git.haskell.org Thu Aug 6 16:01:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 16:01:36 +0000 (UTC) Subject: [commit: ghc] master: base: Add instances (97843d0) Message-ID: <20150806160136.0D9893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/97843d0b10cac3912a85329ebcb8ed1a68f71b34/ghc >--------------------------------------------------------------- commit 97843d0b10cac3912a85329ebcb8ed1a68f71b34 Author: fumieval Date: Thu Aug 6 17:28:04 2015 +0200 base: Add instances This patch adds following instances: * Foldable ZipList * Traversable ZipList * Functor Complex * Applicative Complex * Monad Complex * Foldable Complex * Traversable Complex * Generic1 Complex * Monoid a => Monoid (Identity a) * Storable () Reviewers: ekmett, fumieval, hvr, austin Subscribers: thomie, #core_libraries_committee Projects: #core_libraries_committee Differential Revision: https://phabricator.haskell.org/D1049 GHC Trac Issues: #10609 >--------------------------------------------------------------- 97843d0b10cac3912a85329ebcb8ed1a68f71b34 libraries/base/Control/Applicative.hs | 3 ++- libraries/base/Data/Complex.hs | 16 ++++++++++++++-- libraries/base/Data/Functor/Identity.hs | 3 ++- libraries/base/Foreign/Storable.hs | 6 ++++++ libraries/base/changelog.md | 9 ++++++++- 5 files changed, 32 insertions(+), 5 deletions(-) diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs index 521ea9f..39b6466 100644 --- a/libraries/base/Control/Applicative.hs +++ b/libraries/base/Control/Applicative.hs @@ -122,7 +122,8 @@ instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@ -- newtype ZipList a = ZipList { getZipList :: [a] } - deriving (Show, Eq, Ord, Read, Functor, Generic, Generic1) + deriving ( Show, Eq, Ord, Read, Functor, Foldable + , Generic, Generic1) instance Applicative ZipList where pure x = ZipList (repeat x) diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs index c6420cd..09314f1 100644 --- a/libraries/base/Data/Complex.hs +++ b/libraries/base/Data/Complex.hs @@ -2,6 +2,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} ----------------------------------------------------------------------------- -- | @@ -35,7 +36,7 @@ module Data.Complex ) where -import GHC.Generics (Generic) +import GHC.Generics (Generic, Generic1) import Data.Data (Data) import Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf, alignment) @@ -50,10 +51,13 @@ infix 6 :+ -- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@, -- but oriented in the positive real direction, whereas @'signum' z@ -- has the phase of @z@, but unit magnitude. +-- +-- The 'Foldable' and 'Traversable' instances traverse the real part first. data Complex a = !a :+ !a -- ^ forms a complex number from its real and imaginary -- rectangular components. - deriving (Eq, Show, Read, Data, Generic) + deriving (Eq, Show, Read, Data, Generic, Generic1 + , Functor, Foldable, Traversable) -- ----------------------------------------------------------------------------- -- Functions over Complex @@ -203,3 +207,11 @@ instance Storable a => Storable (Complex a) where q <-return $ (castPtr p) poke q r pokeElemOff q 1 i + +instance Applicative Complex where + pure a = a :+ a + f :+ g <*> a :+ b = f a :+ g b + +instance Monad Complex where + return a = a :+ a + a :+ b >>= f = realPart (f a) :+ imagPart (f b) diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs index 59ecc7f..9f7ae24 100644 --- a/libraries/base/Data/Functor/Identity.hs +++ b/libraries/base/Data/Functor/Identity.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- @@ -44,7 +45,7 @@ import GHC.Generics (Generic, Generic1) -- -- @since 4.8.0.0 newtype Identity a = Identity { runIdentity :: a } - deriving (Eq, Ord, Data, Traversable, Generic, Generic1) + deriving (Eq, Ord, Data, Monoid, Traversable, Generic, Generic1) -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed diff --git a/libraries/base/Foreign/Storable.hs b/libraries/base/Foreign/Storable.hs index 52f3eda..5b657a1 100644 --- a/libraries/base/Foreign/Storable.hs +++ b/libraries/base/Foreign/Storable.hs @@ -145,6 +145,12 @@ class Storable a where peek ptr = peekElemOff ptr 0 poke ptr = pokeElemOff ptr 0 +instance Storable () where + sizeOf _ = 0 + alignment _ = 1 + peek _ = return () + poke _ _ = return () + -- System-dependent, but rather obvious instances instance Storable Bool where diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index bad0e8a..2306d36 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -19,6 +19,12 @@ * `(,) a` now has a `Monad` instance + * `ZipList` now has `Foldable` and `Traversable` instances + + * `Identity` now has a `Monoid` instance + + * `()` now has a `Storable` instance + * Redundant typeclass constraints have been removed: - `Data.Ratio.{denominator,numerator}` have no `Integral` constraint anymore - **TODO** @@ -29,7 +35,8 @@ * New `GHC.Stack.CallStack` data type - * `Complex` now has a `Generic` instance + * `Complex` now has `Generic`, `Generic1`, `Functor`, `Foldable`, `Traversable`, + `Applicative`, and `Monad` instances * `System.Exit.ExitCode` now has a `Generic` instance From git at git.haskell.org Thu Aug 6 18:57:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 18:57:11 +0000 (UTC) Subject: [commit: ghc] master: Add test for #10600 (exhaustiveness check with --make and -fno-code) (aa23054) Message-ID: <20150806185711.83B9C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/aa230540f5868263740fd7d2f31505a39e2fcb4e/ghc >--------------------------------------------------------------- commit aa230540f5868263740fd7d2f31505a39e2fcb4e Author: Reid Barton Date: Thu Aug 6 14:12:38 2015 -0400 Add test for #10600 (exhaustiveness check with --make and -fno-code) >--------------------------------------------------------------- aa230540f5868263740fd7d2f31505a39e2fcb4e testsuite/tests/driver/{T8101.hs => T8101b.hs} | 0 testsuite/tests/driver/{T8101.stderr => T8101b.stderr} | 2 +- testsuite/tests/driver/all.T | 2 ++ 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/driver/T8101.hs b/testsuite/tests/driver/T8101b.hs similarity index 100% copy from testsuite/tests/driver/T8101.hs copy to testsuite/tests/driver/T8101b.hs diff --git a/testsuite/tests/driver/T8101.stderr b/testsuite/tests/driver/T8101b.stderr similarity index 84% copy from testsuite/tests/driver/T8101.stderr copy to testsuite/tests/driver/T8101b.stderr index 6fda857..555b036 100644 --- a/testsuite/tests/driver/T8101.stderr +++ b/testsuite/tests/driver/T8101b.stderr @@ -1,5 +1,5 @@ -T8101.hs:7:9: Warning: +T8101b.hs:7:9: Warning: Pattern match(es) are non-exhaustive In a case alternative: Patterns not matched: diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 65c3776..b79f166 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -398,6 +398,8 @@ test('T8959a', test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703']) test('T2182', normal, run_command, ['$MAKE -s --no-print-directory T2182']) test('T8101', normal, compile, ['-Wall -fno-code']) +test('T8101b', expect_broken(10600), multimod_compile, + ['T8101b', '-Wall -fno-code']) def build_T9050(name, way): return simple_build(name + '.cmm', way, '-outputdir=. ', 0, '', 0, 0, 0) From git at git.haskell.org Thu Aug 6 19:58:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 6 Aug 2015 19:58:58 +0000 (UTC) Subject: [commit: ghc] master: Rejigger OSMem.my_mmap to allow building on Mac (bc43d23) Message-ID: <20150806195858.B49033A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bc43d23aa8a63ce64c2eeb5a2c74fb58c8f21356/ghc >--------------------------------------------------------------- commit bc43d23aa8a63ce64c2eeb5a2c74fb58c8f21356 Author: Richard Eisenberg Date: Thu Aug 6 14:37:53 2015 -0400 Rejigger OSMem.my_mmap to allow building on Mac Previously, the prot and flags variables were set but never used on Mac (darwin). This caused a warning, and the build setup stopped compilation. This commit is intended simply to omit these variables when building with darwin_HOST_OS set. No change in behavior on any platform is intended. >--------------------------------------------------------------- bc43d23aa8a63ce64c2eeb5a2c74fb58c8f21356 rts/posix/OSMem.c | 59 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 31 insertions(+), 28 deletions(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 125ae10..976b5f5 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -106,35 +106,8 @@ static void * my_mmap (void *addr, W_ size, int operation) { void *ret; - int prot, flags; - if (operation & MEM_COMMIT) - prot = PROT_READ | PROT_WRITE; - else - prot = PROT_NONE; - if (operation == MEM_RESERVE) - flags = MAP_NORESERVE; - else if (operation == MEM_COMMIT) - flags = MAP_FIXED; - else - flags = 0; - -#if defined(solaris2_HOST_OS) || defined(irix_HOST_OS) - { - if (operation & MEM_RESERVE) - { - int fd = open("/dev/zero",O_RDONLY); - ret = mmap(addr, size, prot, flags | MAP_PRIVATE, fd, 0); - close(fd); - } - else - { - ret = mmap(addr, size, prot, flags | MAP_PRIVATE, -1, 0); - } - } -#elif hpux_HOST_OS - ret = mmap(addr, size, prot, flags | MAP_ANONYMOUS | MAP_PRIVATE, -1, 0); -#elif darwin_HOST_OS +#if darwin_HOST_OS // Without MAP_FIXED, Apple's mmap ignores addr. // With MAP_FIXED, it overwrites already mapped regions, whic // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text @@ -169,6 +142,35 @@ my_mmap (void *addr, W_ size, int operation) VM_PROT_READ|VM_PROT_WRITE); } +#else + + int prot, flags; + if (operation & MEM_COMMIT) + prot = PROT_READ | PROT_WRITE; + else + prot = PROT_NONE; + if (operation == MEM_RESERVE) + flags = MAP_NORESERVE; + else if (operation == MEM_COMMIT) + flags = MAP_FIXED; + else + flags = 0; + +#if defined(solaris2_HOST_OS) || defined(irix_HOST_OS) + { + if (operation & MEM_RESERVE) + { + int fd = open("/dev/zero",O_RDONLY); + ret = mmap(addr, size, prot, flags | MAP_PRIVATE, fd, 0); + close(fd); + } + else + { + ret = mmap(addr, size, prot, flags | MAP_PRIVATE, -1, 0); + } + } +#elif hpux_HOST_OS + ret = mmap(addr, size, prot, flags | MAP_ANONYMOUS | MAP_PRIVATE, -1, 0); #elif linux_HOST_OS ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); if (ret == (void *)-1 && errno == EPERM) { @@ -191,6 +193,7 @@ my_mmap (void *addr, W_ size, int operation) #else ret = mmap(addr, size, prot, flags | MAP_ANON | MAP_PRIVATE, -1, 0); #endif +#endif if (ret == (void *)-1) { if (errno == ENOMEM || From git at git.haskell.org Fri Aug 7 04:40:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 04:40:04 +0000 (UTC) Subject: [commit: ghc] master: base: Add missing Traversable instance for ZipList (a1c934c) Message-ID: <20150807044004.9F0C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1c934c1b97a09db841d20da4811e0e1310f7511/ghc >--------------------------------------------------------------- commit a1c934c1b97a09db841d20da4811e0e1310f7511 Author: Ben Gamari Date: Fri Aug 7 05:50:22 2015 +0200 base: Add missing Traversable instance for ZipList >--------------------------------------------------------------- a1c934c1b97a09db841d20da4811e0e1310f7511 libraries/base/Control/Applicative.hs | 5 +++-- libraries/base/Data/Traversable.hs | 7 ++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs index 39b6466..a2f342f 100644 --- a/libraries/base/Control/Applicative.hs +++ b/libraries/base/Control/Applicative.hs @@ -122,8 +122,9 @@ instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@ -- newtype ZipList a = ZipList { getZipList :: [a] } - deriving ( Show, Eq, Ord, Read, Functor, Foldable - , Generic, Generic1) + deriving ( Show, Eq, Ord, Read, Functor + , Foldable, Generic, Generic1) +-- See Data.Traversable for Traversabel instance due to import loops instance Applicative ZipList where pure x = ZipList (repeat x) diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs index 535db00..81e639c 100644 --- a/libraries/base/Data/Traversable.hs +++ b/libraries/base/Data/Traversable.hs @@ -46,7 +46,9 @@ module Data.Traversable ( foldMapDefault, ) where -import Control.Applicative ( Const(..) ) +-- It is convenient to use 'Const' here but this means we must +-- define a few instances here which really belong in Control.Applicative +import Control.Applicative ( Const(..), ZipList(..) ) import Data.Either ( Either(..) ) import Data.Foldable ( Foldable ) import Data.Functor @@ -217,6 +219,9 @@ instance Traversable First where instance Traversable Last where traverse f (Last x) = Last <$> traverse f x +instance Traversable ZipList where + traverse f (ZipList x) = ZipList <$> traverse f x + -- general functions -- | 'for' is 'traverse' with its arguments flipped. For a version From git at git.haskell.org Fri Aug 7 05:30:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 05:30:08 +0000 (UTC) Subject: [commit: ghc] master: Big batch of Backpack documentation edits. (6cab3af) Message-ID: <20150807053008.A95423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/6cab3afe90264b00e2a92f1aef09d6ca4e7a1680/ghc >--------------------------------------------------------------- commit 6cab3afe90264b00e2a92f1aef09d6ca4e7a1680 Author: Edward Z. Yang Date: Thu Aug 6 22:31:17 2015 -0700 Big batch of Backpack documentation edits. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 6cab3afe90264b00e2a92f1aef09d6ca4e7a1680 docs/backpack/algorithm.tex | 1529 ++++++++++++++++++------------------- docs/backpack/backpack-manual.tex | 265 +++++-- 2 files changed, 965 insertions(+), 829 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 6cab3afe90264b00e2a92f1aef09d6ca4e7a1680 From git at git.haskell.org Fri Aug 7 11:32:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 11:32:56 +0000 (UTC) Subject: [commit: ghc] master: Test Trac #10753 (79e0a10) Message-ID: <20150807113256.BBF7F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/79e0a10e541724713f1149c468ba966b7fc819d3/ghc >--------------------------------------------------------------- commit 79e0a10e541724713f1149c468ba966b7fc819d3 Author: Simon Peyton Jones Date: Fri Aug 7 12:32:09 2015 +0100 Test Trac #10753 >--------------------------------------------------------------- 79e0a10e541724713f1149c468ba966b7fc819d3 .../tests/indexed-types/should_compile/T10753.hs | 23 ++++++++++++++++++++++ testsuite/tests/indexed-types/should_compile/all.T | 2 ++ 2 files changed, 25 insertions(+) diff --git a/testsuite/tests/indexed-types/should_compile/T10753.hs b/testsuite/tests/indexed-types/should_compile/T10753.hs new file mode 100644 index 0000000..6939ce1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T10753.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-missing-methods #-} +module T10753 where + + +class MonadState s m | m -> s where + get :: m s + +newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } +instance (Monad m) => Monad (StateT s m) where +instance (Functor m, Monad m) => Applicative (StateT s m) where +instance (Functor m) => Functor (StateT s m) where + +instance (Monad m) => MonadState s (StateT s m) where + +class HasConns (m :: * -> *) where + type Conn m + +foo :: (Monad m) => StateT (Conn m) m () +foo = + do _ <- get + return () diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index ff5070b..7bbb04b 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -261,3 +261,5 @@ test('T10226', normal, compile, ['']) test('T10507', normal, compile, ['']) test('T10634', normal, compile, ['']) test('T10713', normal, compile, ['']) +test('T10753', normal, compile, ['']) + From git at git.haskell.org Fri Aug 7 11:32:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 11:32:59 +0000 (UTC) Subject: [commit: ghc] master: Comments only (a192d6b) Message-ID: <20150807113259.A04313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a192d6b46d86141b7f184df219b36c13c420e6ef/ghc >--------------------------------------------------------------- commit a192d6b46d86141b7f184df219b36c13c420e6ef Author: Simon Peyton Jones Date: Fri Aug 7 12:32:48 2015 +0100 Comments only >--------------------------------------------------------------- a192d6b46d86141b7f184df219b36c13c420e6ef compiler/typecheck/TcCanonical.hs | 4 ++-- compiler/typecheck/TcFlatten.hs | 9 +++++---- compiler/typecheck/TcSMonad.hs | 2 +- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index f37ad3e..ed3955d 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -1128,7 +1128,7 @@ canEqTyVarTyVar ev eq_rel swapped tv1 tv2 | incompat_kind = incompatibleKind ev xi1 k1 xi2 k2 -- We don't do this any more --- See Note [Orientation of equalities with fmvs] in TcSMonad +-- See Note [Orientation of equalities with fmvs] in TcFlatten -- | isFmvTyVar tv1 = do_fmv swapped tv1 xi1 xi2 co1 co2 -- | isFmvTyVar tv2 = do_fmv (flipSwap swapped) tv2 xi2 xi1 co2 co1 @@ -1159,7 +1159,7 @@ canEqTyVarTyVar ev eq_rel swapped tv1 tv2 , cc_rhs = xi2, cc_eq_rel = eq_rel }) {- We don't do this any more - See Note [Orientation of equalities with fmvs] in TcSMonad + See Note [Orientation of equalities with fmvs] in TcFlatten -- tv1 is the flatten meta-var do_fmv swapped tv1 xi1 xi2 co1 co2 | same_kind diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 9df0690..052c158 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -264,8 +264,9 @@ This is a real dilemma. CURRENT SOLUTION: CFunEqCan F fmv ~ fmv, because fmv := F fmv would make an ininite type. Instead we unify fmv:=a, AND record that we have done so. - If any such "non-CFunEqCan unifications" take place, iterate the - entire process. This is done by the 'go' loop in solveSimpleWanteds. + If any such "non-CFunEqCan unifications" take place (in + unflatten_eq in TcFlatten.unflatten) iterate the entire process. + This is done by the 'go' loop in solveSimpleWanteds. This story does not feel right but it's the best I can do; and the iteration only happens in pretty obscure circumstances. @@ -1368,7 +1369,7 @@ unflatten tv_eqs funeqs ; funeqs <- foldrBagM (unflatten_funeq dflags) emptyCts funeqs ; traceTcS "Unflattening 1" $ braces (pprCts funeqs) - -- Step 2: unify the irreds, if possible + -- Step 2: unify the tv_eqs, if possible ; tv_eqs <- foldrBagM (unflatten_eq dflags tclvl) emptyCts tv_eqs ; traceTcS "Unflattening 2" $ braces (pprCts tv_eqs) @@ -1376,7 +1377,7 @@ unflatten tv_eqs funeqs ; funeqs <- mapBagM finalise_funeq funeqs ; traceTcS "Unflattening 3" $ braces (pprCts funeqs) - -- Step 4: remove any irreds that look like ty ~ ty + -- Step 4: remove any tv_eqs that look like ty ~ ty ; tv_eqs <- foldrBagM finalise_eq emptyCts tv_eqs ; let all_flat = tv_eqs `andCts` funeqs diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index cd3d3c9..3721975 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -994,7 +994,7 @@ Note [Examples of how the inert_model helps completeness] [D] d4: fmv2 ~ a At this point we are stuck so we unflatten this set: - See Note [Orientation of equalities with fmvs] + See Note [Orientation of equalities with fmvs] in TcFlatten [W] w1: F fmv2 ~ fmv1 [W] w2: UnF fmv1 ~ fmv2 [W] w5: fmv1 ~ fsk1 From git at git.haskell.org Fri Aug 7 12:03:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:03:48 +0000 (UTC) Subject: [commit: ghc] branch 'wip/type-app' created Message-ID: <20150807120348.5B9E63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/type-app Referencing: 9041d03faa5dcf13a64879af2136d2fdeaba0fb1 From git at git.haskell.org Fri Aug 7 12:03:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:03:51 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Remove vestigial prefixq{var, con}sym from parser. (6e4e962) Message-ID: <20150807120351.1B3F93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/6e4e962d43df25094ce40a318c222d70818a136c/ghc >--------------------------------------------------------------- commit 6e4e962d43df25094ce40a318c222d70818a136c Author: Richard Eisenberg Date: Sat Jun 27 12:55:36 2015 -0400 Remove vestigial prefixq{var,con}sym from parser. >--------------------------------------------------------------- 6e4e962d43df25094ce40a318c222d70818a136c compiler/parser/Lexer.x | 6 +----- compiler/parser/Parser.y | 7 ------- 2 files changed, 1 insertion(+), 12 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 5839a41..935e3ac 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -634,8 +634,6 @@ data Token | ITqconid (FastString,FastString) | ITqvarsym (FastString,FastString) | ITqconsym (FastString,FastString) - | ITprefixqvarsym (FastString,FastString) - | ITprefixqconsym (FastString,FastString) | ITdupipvarid FastString -- GHC extension: implicit param: ?x @@ -1144,11 +1142,9 @@ varid span buf len = conid :: StringBuffer -> Int -> Token conid buf len = ITconid $! lexemeToFastString buf len -qvarsym, qconsym, prefixqvarsym, prefixqconsym :: StringBuffer -> Int -> Token +qvarsym, qconsym :: StringBuffer -> Int -> Token qvarsym buf len = ITqvarsym $! splitQualName buf len False qconsym buf len = ITqconsym $! splitQualName buf len False -prefixqvarsym buf len = ITprefixqvarsym $! splitQualName buf len True -prefixqconsym buf len = ITprefixqconsym $! splitQualName buf len True varsym, consym :: Action varsym = sym ITvarsym diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index d5d8c6c..5fcf070 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -514,8 +514,6 @@ for some background. QCONID { L _ (ITqconid _) } QVARSYM { L _ (ITqvarsym _) } QCONSYM { L _ (ITqconsym _) } - PREFIXQVARSYM { L _ (ITprefixqvarsym _) } - PREFIXQCONSYM { L _ (ITprefixqconsym _) } IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension @@ -2854,7 +2852,6 @@ qtyconop :: { Located RdrName } -- Qualified or unqualified qtycon :: { Located RdrName } -- Qualified or unqualified : QCONID { sL1 $1 $! mkQual tcClsName (getQCONID $1) } - | PREFIXQCONSYM { sL1 $1 $! mkQual tcClsName (getPREFIXQCONSYM $1) } | tycon { $1 } tycon :: { Located RdrName } -- Unqualified @@ -2952,7 +2949,6 @@ qvar :: { Located RdrName } qvarid :: { Located RdrName } : varid { $1 } | QVARID { sL1 $1 $! mkQual varName (getQVARID $1) } - | PREFIXQVARSYM { sL1 $1 $! mkQual varName (getPREFIXQVARSYM $1) } -- Note that 'role' and 'family' get lexed separately regardless of -- the use of extensions. However, because they are listed here, this @@ -3017,7 +3013,6 @@ special_sym : '!' {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] } qconid :: { Located RdrName } -- Qualified or unqualified : conid { $1 } | QCONID { sL1 $1 $! mkQual dataName (getQCONID $1) } - | PREFIXQCONSYM { sL1 $1 $! mkQual dataName (getPREFIXQCONSYM $1) } conid :: { Located RdrName } : CONID { sL1 $1 $ mkUnqual dataName (getCONID $1) } @@ -3116,8 +3111,6 @@ getQVARID (L _ (ITqvarid x)) = x getQCONID (L _ (ITqconid x)) = x getQVARSYM (L _ (ITqvarsym x)) = x getQCONSYM (L _ (ITqconsym x)) = x -getPREFIXQVARSYM (L _ (ITprefixqvarsym x)) = x -getPREFIXQCONSYM (L _ (ITprefixqconsym x)) = x getIPDUPVARID (L _ (ITdupipvarid x)) = x getCHAR (L _ (ITchar _ x)) = x getSTRING (L _ (ITstring _ x)) = x From git at git.haskell.org Fri Aug 7 12:03:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:03:54 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Add VTA tests (ee4076e) Message-ID: <20150807120354.4972A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/ee4076eb0bb8125f7467ef2225bd251d3651d820/ghc >--------------------------------------------------------------- commit ee4076eb0bb8125f7467ef2225bd251d3651d820 Author: Richard Eisenberg Date: Fri Jun 26 17:12:57 2015 -0400 Add VTA tests >--------------------------------------------------------------- ee4076eb0bb8125f7467ef2225bd251d3651d820 testsuite/tests/parser/should_compile/VtaParse.hs | 53 +++++++++++++ testsuite/tests/parser/should_compile/all.T | 1 + testsuite/tests/typecheck/should_compile/Vta1.hs | 96 +++++++++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + testsuite/tests/typecheck/should_fail/VtaFail1.hs | 57 ++++++++++++++ testsuite/tests/typecheck/should_fail/all.T | 1 + 6 files changed, 209 insertions(+) diff --git a/testsuite/tests/parser/should_compile/VtaParse.hs b/testsuite/tests/parser/should_compile/VtaParse.hs new file mode 100644 index 0000000..0258917 --- /dev/null +++ b/testsuite/tests/parser/should_compile/VtaParse.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE TypeApplications #-} + +module VtaParse where + +data Foo = Foo { first :: Int, second :: Bool} deriving Show + +f :: a -> b -> (a,b) +f u v = (u, v) + +g :: Int -> Int -> (Int, Int) +g u v = f @(Int) @Int u v + +dblTuple :: (a, b) -> ((a, b), b) +dblTuple e@(_,y) = (e, y) + + +-- interesting note: +-- listpair :: forall a. [a] -> ([a], [a]) +-- therefore when explicitly applying, you do NOT put the type in "[ ]" + +listpair :: [a] -> ([a], [a]) +listpair [] = ([], []) +listpair b@(_:_) = (b, b) + +-- suggested two cases by R. Eisenberg +newtype N = MkN { unMkN :: forall a. Show a => a -> String } +n = MkN show +foo :: Bool -> String +foo = unMkN n @Bool -- Fails without parens! Not anymore! + +boo = unMkN @Bool n +-- boo :: Bool -> String --(compiler doesn't infer this type! It infers a -> String!) +-- boo = unMkN (n @Bool) + +(&&) :: Bool -> Bool -> Bool +(b at True) && True = True +_ && _ = False + +(*@&) :: a -> a -> (a, a) +x *@& y = (x, y) + +(@&) :: a -> a -> (a, a) +x @& y = (x, y) + +main :: IO () +main = do + print $ g 5 12 + print $ ((id @String (concat ["hello ", "world ", []])):"Hamidhasan":[]) + print $ dblTuple @(Foo) @String ((Foo 5 True), "hello") + print $ listpair @(Maybe Int) [Just 12, Nothing] + print $ listpair @(Maybe Bool) $ (Just True) : (Just False) : (Nothing @Bool) : [] + print $ dblTuple @Foo @[Maybe Int] ((Foo 7 False), ([Just 5, Nothing])) + print $ 12 @& 5 diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index eec0a12..17cf31e 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -101,3 +101,4 @@ test('T5682', normal, compile, ['']) test('T9723a', normal, compile, ['']) test('T9723b', normal, compile, ['']) test('T10188', normal, compile, ['']) +test('VtaParse', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_compile/Vta1.hs b/testsuite/tests/typecheck/should_compile/Vta1.hs new file mode 100644 index 0000000..7c41b21 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/Vta1.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE TypeApplications, ScopedTypeVariables #-} + +-- tests about visible type application + +module Vta1 where + +quad :: a -> b -> c -> d -> (a, b, c, d) +quad = (,,,) + +silly :: (a, Bool, Char, b) +silly = quad @_ @Bool @Char @_ 5 True 'a' "Hello" + +pairup_nosig x y = (x, y) + +pairup_sig :: a -> b -> (a,b) +pairup_sig u w = (u, w) + +answer_sig = pairup_sig @Bool @Int False 7 -- +-- (False, 7) :: (Bool, Int) + +answer_read = show (read @Int "3") -- "3" :: String +answer_show = show @Integer (read "5") -- "5" :: String +answer_showread = show @Int (read @Int "7") -- "7" :: String + +intcons a = (:) @Int a + +intpair x y = pairup_sig @Int x y + +answer_pairup = pairup_sig @Int 5 True -- (5, True) :: (Int, Bool) +answer_intpair = intpair 1 "hello" -- (1, "hello") :: (Int, String) +answer_intcons = intcons 7 [] -- [7] :: [Int] + +type family F a +type instance F Char = Bool + +g :: F a -> a +g _ = undefined + +f :: Char +f = g True + +answer = g @Char False + +mapSame :: forall b. (forall a. a -> a) -> [b] -> [b] +mapSame _ [] = [] +mapSame fun (x:xs) = fun @b x : (mapSame @b fun xs) + +pair :: forall a. a-> (forall b. b -> (a, b)) +pair x y = (x, y) + +a = pair @Int @Bool 3 True +b = pair @Int 3 @Bool True +c = mapSame id [1,2,3] +d = pair 3 @Bool True + +pairnum :: forall a. Num a => forall b. b -> (a, b) +pairnum = pair 3 + +e = (pair 3 :: forall a. Num a => forall b. b -> (a, b)) @Int @Bool True +h = pairnum @Int @Bool True + +data First (a :: * -> *) = F +data Proxy (a :: k) = P -- This expands to P (kind variable) (type variable) +data Three (a :: * -> k -> *) = T + +foo :: Proxy a -> Int +foo _ = 0 + +first :: First a -> Int +first _ = 0 + +fTest = first F +fMaybe = first @Maybe F + +test = foo P +bar = foo @Bool P -- should work + +too :: Three a -> Int +too _ = 3 + +threeBase = too T +threeOk = too @Either T + +blah = Nothing @Int + +newtype N = MkN { unMkN :: forall a. Show a => a -> String } + +n = MkN show + +boo = unMkN @Bool n + +boo2 :: forall (a :: * -> *) . Proxy a -> Bool +boo2 _ = False + +base = boo2 Proxy +bar'= boo2 @Maybe Proxy -- should work diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 178f9f3..a938b81 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -465,3 +465,4 @@ test('T10428', normal, compile, ['']) test('RepArrow', normal, compile, ['']) test('T10562', normal, compile, ['']) test('T10564', normal, compile, ['']) +test('Vta1', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/VtaFail1.hs b/testsuite/tests/typecheck/should_fail/VtaFail1.hs new file mode 100644 index 0000000..cd84e65 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/VtaFail1.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE TypeApplications #-} + +module VtaFail1 where + +pairup_nosig x y = (x, y) + +answer_nosig = pairup_nosig @Int @Bool 5 True + +addOne :: Num a => a -> a +addOne x = x + 1 + +answer_constraint_fail = addOne @Bool 5 + +answer_lambda = (\x -> x) @Int 12 + +pair :: forall a. a -> forall b. b -> (a, b) +pair = (,) + +a = pair 3 @Int @Bool True + +data First (a :: * -> *) = F + +first :: First a -> Int +first _ = 0 + +fInt = first @Int F -- should fail + +data Proxy (a :: k) = P -- This expands to P (kind variable) (type variable) + +foo :: Proxy a -> Int +foo _ = 0 + +baz = foo @Bool (P :: Proxy Int) -- should fail + +data Three (a :: * -> k -> *) = T + +too :: Three a -> Int +too _ = 3 + +threeBad = too @Maybe T +threeWorse = too @( -> ) (T :: Three Either) + +plus :: Int -> Int -> Int +plus = (+) + +b = plus @Int 5 7 +c = plus @Rational 5 10 +d = (+) @Int @Int @Int 12 14 + + +e = show @Int @Float (read "5") +f = show (read @Int @Bool @Float "3") + +silly :: a -> Bool +silly _ = False + +g = silly @Maybe -- should fail diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 7b0f5fb..2addf6a 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -368,3 +368,4 @@ test('T10351', normal, compile_fail, ['']) test('T10534', extra_clean(['T10534a.hi', 'T10534a.o']), multimod_compile_fail, ['T10534', '-v0']) test('T10495', normal, compile_fail, ['']) +test('VtaFail', normal, compile_fail, ['']) From git at git.haskell.org Fri Aug 7 12:03:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:03:57 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Lexing/parsing complete. (b1bc45c) Message-ID: <20150807120357.2F4803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/b1bc45cf65c30294855013be46d35ea9ac5e42fa/ghc >--------------------------------------------------------------- commit b1bc45cf65c30294855013be46d35ea9ac5e42fa Author: Richard Eisenberg Date: Sat Jun 27 12:01:50 2015 -0400 Lexing/parsing complete. >--------------------------------------------------------------- b1bc45cf65c30294855013be46d35ea9ac5e42fa compiler/hsSyn/HsExpr.hs | 6 +++- compiler/main/DynFlags.hs | 2 ++ compiler/parser/ApiAnnotation.hs | 2 +- compiler/parser/Lexer.x | 43 +++++++++++++++++++++++ compiler/parser/Parser.y | 9 +++++ testsuite/tests/parser/should_compile/VtaParse.hs | 16 ++++++++- 6 files changed, 75 insertions(+), 3 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b1bc45cf65c30294855013be46d35ea9ac5e42fa From git at git.haskell.org Fri Aug 7 12:04:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:00 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Only thing left is the typechecker (3cb8e91) Message-ID: <20150807120400.1BC743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/3cb8e91dd576b6691a383ea81d24629ef885bbe3/ghc >--------------------------------------------------------------- commit 3cb8e91dd576b6691a383ea81d24629ef885bbe3 Author: Richard Eisenberg Date: Sat Jun 27 12:50:20 2015 -0400 Only thing left is the typechecker >--------------------------------------------------------------- 3cb8e91dd576b6691a383ea81d24629ef885bbe3 compiler/deSugar/DsExpr.hs | 2 +- compiler/hsSyn/HsExpr.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 0 3 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index a6cb98d..abc2eea 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -680,7 +680,7 @@ dsExpr (EWildPat {}) = panic "dsExpr:EWildPat" dsExpr (EAsPat {}) = panic "dsExpr:EAsPat" dsExpr (EViewPat {}) = panic "dsExpr:EViewPat" dsExpr (ELazyPat {}) = panic "dsExpr:ELazyPat" -dsExpr (HsType {}) = panic "dsExpr:HsType" +dsExpr (HsType {}) = panic "dsExpr:HsType" -- removed by typechecker dsExpr (HsDo {}) = panic "dsExpr:HsDo" diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index b6b190c..9b6b6c6 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -725,7 +725,7 @@ ppr_expr (HsSCC _ (_,lbl) expr) pprParendExpr expr ] ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn -ppr_expr (HsType id) = ppr id +ppr_expr (HsType ty) = char '@' <> pprParendHsType (unLoc ty) ppr_expr (HsSpliceE s) = pprSplice s ppr_expr (HsBracket b) = pprHsBracket b From git at git.haskell.org Fri Aug 7 12:04:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:03 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Retain System naems until the end of typechecking (c6bd3c5) Message-ID: <20150807120403.1E8263A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/c6bd3c58d3552ea95fbbc428ba2dfed8f9311ecc/ghc >--------------------------------------------------------------- commit c6bd3c58d3552ea95fbbc428ba2dfed8f9311ecc Author: Richard Eisenberg Date: Sun Jun 28 13:53:32 2015 -0400 Retain System naems until the end of typechecking >--------------------------------------------------------------- c6bd3c58d3552ea95fbbc428ba2dfed8f9311ecc compiler/basicTypes/Name.hs | 6 +++++ compiler/basicTypes/Var.hs | 7 +++++- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcExpr.hs | 53 +++++++++++++++++++++++++++++++++++++++++++ compiler/typecheck/TcHsSyn.hs | 11 ++++++--- compiler/typecheck/TcMType.hs | 4 +++- 6 files changed, 77 insertions(+), 6 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 c6bd3c58d3552ea95fbbc428ba2dfed8f9311ecc From git at git.haskell.org Fri Aug 7 12:04:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:06 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite stuff from previous commit (fca02ce) Message-ID: <20150807120406.093393A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/fca02ceba1f56fc94815cffdf9bbf9826df1c092/ghc >--------------------------------------------------------------- commit fca02ceba1f56fc94815cffdf9bbf9826df1c092 Author: Richard Eisenberg Date: Sun Jun 28 16:55:09 2015 -0400 Testsuite stuff from previous commit >--------------------------------------------------------------- fca02ceba1f56fc94815cffdf9bbf9826df1c092 compiler/typecheck/TcBinds.hs | 8 ++-- testsuite/tests/gadt/gadt-escape1.stderr | 18 +++---- testsuite/tests/gadt/gadt13.stderr | 12 ++--- testsuite/tests/gadt/gadt7.stderr | 20 ++++---- testsuite/tests/ghc-api/annotations/T10280.stderr | 2 +- testsuite/tests/ghc-api/annotations/T10357.stderr | 6 +-- .../tests/ghci.debugger/scripts/break012.stdout | 2 +- .../tests/ghci.debugger/scripts/print003.stdout | 8 ++-- .../tests/ghci.debugger/scripts/print006.stdout | 6 +-- .../tests/ghci.debugger/scripts/print008.stdout | 6 +-- .../tests/ghci.debugger/scripts/print010.stdout | 4 +- .../tests/ghci.debugger/scripts/print012.stdout | 6 +-- .../tests/ghci.debugger/scripts/print019.stdout | 2 +- .../tests/ghci.debugger/scripts/print034.stdout | 2 +- testsuite/tests/ghci/prog009/ghci.prog009.stdout | 8 ++-- testsuite/tests/ghci/scripts/Defer02.stderr | 20 ++++---- testsuite/tests/ghci/scripts/T10122.stdout | 4 +- testsuite/tests/ghci/scripts/T10321.stdout | 2 +- testsuite/tests/ghci/scripts/T2766.stdout | 4 +- testsuite/tests/ghci/scripts/T7587.stdout | 2 +- testsuite/tests/ghci/scripts/T7627.stdout | 8 ++-- testsuite/tests/ghci/scripts/T7688.stdout | 2 +- testsuite/tests/ghci/scripts/T7730.stdout | 8 ++-- testsuite/tests/ghci/scripts/T7939.stdout | 14 +++--- testsuite/tests/ghci/scripts/T8776.stdout | 2 +- testsuite/tests/ghci/scripts/T8959.stdout | 12 ++--- testsuite/tests/ghci/scripts/T8959b.stderr | 8 ++-- testsuite/tests/ghci/scripts/T9658.stdout | 2 +- testsuite/tests/ghci/scripts/ghci001.stdout | 4 +- testsuite/tests/ghci/scripts/ghci013.stdout | 2 +- testsuite/tests/ghci/scripts/ghci023.stdout | 2 +- testsuite/tests/ghci/scripts/ghci036.stdout | 6 +-- testsuite/tests/ghci/scripts/ghci038.stdout | 10 ++-- .../should_compile/PushedInAsGivens.stderr | 24 +++++----- .../indexed-types/should_fail/ExtraTcsUntch.stderr | 12 ++--- .../tests/indexed-types/should_fail/T1897b.stderr | 8 ++-- .../tests/indexed-types/should_fail/T2693.stderr | 10 ++-- .../tests/indexed-types/should_fail/T7354.stderr | 10 ++-- .../tests/indexed-types/should_fail/T7354a.stderr | 6 +-- .../tests/indexed-types/should_fail/T8518.stderr | 6 +-- .../tests/indexed-types/should_fail/T9171.stderr | 8 ++-- testsuite/tests/module/mod121.stderr | 2 +- testsuite/tests/module/mod147.stderr | 2 +- testsuite/tests/module/mod160.stderr | 2 +- testsuite/tests/module/mod71.stderr | 6 +-- testsuite/tests/module/mod72.stderr | 2 +- testsuite/tests/module/mod87.stderr | 2 +- testsuite/tests/module/mod97.stderr | 2 +- testsuite/tests/parser/should_fail/T7848.stderr | 28 +++++------ .../tests/parser/should_fail/readFail003.stderr | 8 ++-- .../partial-sigs/should_compile/T10403.stderr | 50 ++++++++++--------- .../partial-sigs/should_compile/T10438.stderr | 4 +- .../WarningWildcardInstantiations.stderr | 31 ++++++------ .../should_fail/Defaulting1MROff.stderr | 4 +- .../partial-sigs/should_fail/TidyClash.stderr | 10 ++-- .../partial-sigs/should_fail/Trac10045.stderr | 16 +++---- .../should_fail/WildcardInstantiations.stderr | 31 ++++++------ .../WildcardsInPatternAndExprSig.stderr | 56 +++++++++++----------- .../should_run/GHCiWildcardKind.stdout | 2 +- testsuite/tests/patsyn/should_run/ghci.stdout | 2 +- testsuite/tests/polykinds/T6068.stdout | 2 +- testsuite/tests/polykinds/T7438.stderr | 14 +++--- testsuite/tests/polykinds/T7594.stderr | 16 +++---- testsuite/tests/rename/should_fail/T2993.stderr | 2 +- testsuite/tests/rename/should_fail/T7937.stderr | 2 +- testsuite/tests/rename/should_fail/mc13.stderr | 2 +- testsuite/tests/rename/should_fail/mc14.stderr | 2 +- testsuite/tests/roles/should_compile/Roles1.stderr | 4 +- testsuite/tests/safeHaskell/ghci/p16.stderr | 2 +- testsuite/tests/safeHaskell/ghci/p4.stderr | 2 +- testsuite/tests/safeHaskell/ghci/p6.stderr | 2 +- .../tests/typecheck/should_compile/T10072.stderr | 6 +-- .../tests/typecheck/should_compile/holes.stderr | 8 ++-- .../tests/typecheck/should_compile/holes3.stderr | 8 ++-- .../tests/typecheck/should_compile/tc141.stderr | 34 ++++++------- .../tests/typecheck/should_compile/tc168.stderr | 4 +- .../tests/typecheck/should_compile/tc211.stderr | 18 +++---- .../typecheck/should_fail/FDsFromGivens2.stderr | 18 +++---- .../typecheck/should_fail/FrozenErrorTests.stderr | 36 +++++++------- .../tests/typecheck/should_fail/T10351.stderr | 2 +- .../tests/typecheck/should_fail/T1897a.stderr | 4 +- testsuite/tests/typecheck/should_fail/T2534.stderr | 10 ++-- testsuite/tests/typecheck/should_fail/T5853.stderr | 18 +++---- testsuite/tests/typecheck/should_fail/T6022.stderr | 2 +- testsuite/tests/typecheck/should_fail/T7264.stderr | 14 +++--- testsuite/tests/typecheck/should_fail/T7453.stderr | 42 ++++++++-------- testsuite/tests/typecheck/should_fail/T7734.stderr | 8 ++-- testsuite/tests/typecheck/should_fail/T7857.stderr | 6 +-- testsuite/tests/typecheck/should_fail/T7869.stderr | 30 ++++++------ testsuite/tests/typecheck/should_fail/T8142.stderr | 10 ++-- testsuite/tests/typecheck/should_fail/T8262.stderr | 4 +- testsuite/tests/typecheck/should_fail/T8883.stderr | 6 +-- testsuite/tests/typecheck/should_fail/T9109.stderr | 12 ++--- testsuite/tests/typecheck/should_fail/mc22.stderr | 24 +++++----- testsuite/tests/typecheck/should_fail/mc23.stderr | 8 ++-- testsuite/tests/typecheck/should_fail/mc24.stderr | 8 ++-- testsuite/tests/typecheck/should_fail/mc25.stderr | 8 ++-- .../tests/typecheck/should_fail/tcfail002.stderr | 8 ++-- .../tests/typecheck/should_fail/tcfail004.stderr | 6 +-- .../tests/typecheck/should_fail/tcfail005.stderr | 8 ++-- .../tests/typecheck/should_fail/tcfail013.stderr | 7 +-- .../tests/typecheck/should_fail/tcfail016.stderr | 28 +++++------ .../tests/typecheck/should_fail/tcfail032.stderr | 12 ++--- .../tests/typecheck/should_fail/tcfail033.stderr | 8 ++-- .../tests/typecheck/should_fail/tcfail049.stderr | 2 +- .../tests/typecheck/should_fail/tcfail050.stderr | 2 +- .../tests/typecheck/should_fail/tcfail080.stderr | 4 +- .../tests/typecheck/should_fail/tcfail099.stderr | 8 ++-- .../tests/typecheck/should_fail/tcfail122.stderr | 7 +-- .../tests/typecheck/should_fail/tcfail140.stderr | 14 +++--- .../tests/typecheck/should_fail/tcfail174.stderr | 22 ++++----- .../tests/typecheck/should_fail/tcfail178.stderr | 14 +++--- .../tests/typecheck/should_fail/tcfail181.stderr | 6 +-- .../tests/typecheck/should_fail/tcfail198.stderr | 14 +++--- 114 files changed, 573 insertions(+), 561 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 fca02ceba1f56fc94815cffdf9bbf9826df1c092 From git at git.haskell.org Fri Aug 7 12:04:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:08 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Midway through redesign of the type inference alg. (d7037fe) Message-ID: <20150807120408.F1CBA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/d7037fed721567623fc63639514bc6d16cd3ddb1/ghc >--------------------------------------------------------------- commit d7037fed721567623fc63639514bc6d16cd3ddb1 Author: Richard Eisenberg Date: Mon Jun 29 23:28:47 2015 -0400 Midway through redesign of the type inference alg. >--------------------------------------------------------------- d7037fed721567623fc63639514bc6d16cd3ddb1 compiler/typecheck/Inst.hs | 101 +++++++++--- compiler/typecheck/TcBinds.hs | 8 +- compiler/typecheck/TcExpr.hs | 336 ++++++++++++++++++++++------------------ compiler/typecheck/TcMatches.hs | 10 +- compiler/typecheck/TcPat.hs | 65 +++----- compiler/typecheck/TcType.hs | 54 +++++-- compiler/typecheck/TcUnify.hs | 190 +++++++++++++++++------ 7 files changed, 482 insertions(+), 282 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 d7037fed721567623fc63639514bc6d16cd3ddb1 From git at git.haskell.org Fri Aug 7 12:04:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:11 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Starting to compile. (af71f48) Message-ID: <20150807120411.E7D643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/af71f48c36b2a3201999f434ad9eaf0c9a0f5bdb/ghc >--------------------------------------------------------------- commit af71f48c36b2a3201999f434ad9eaf0c9a0f5bdb Author: Richard Eisenberg Date: Tue Jun 30 16:07:56 2015 -0400 Starting to compile. >--------------------------------------------------------------- af71f48c36b2a3201999f434ad9eaf0c9a0f5bdb compiler/hsSyn/HsExpr.hs | 33 +++- compiler/rename/RnSplice.hs | 4 +- compiler/typecheck/Inst.hs | 113 ++++--------- compiler/typecheck/TcArrows.hs | 24 ++- compiler/typecheck/TcBinds.hs | 12 +- compiler/typecheck/TcExpr.hs | 338 ++++++++++++++++++++------------------ compiler/typecheck/TcExpr.hs-boot | 13 +- compiler/typecheck/TcMatches.hs | 122 ++++++++------ compiler/typecheck/TcPat.hs | 21 +-- compiler/typecheck/TcPatSyn.hs | 13 +- compiler/typecheck/TcRnDriver.hs | 9 +- compiler/typecheck/TcRnTypes.hs | 4 + compiler/typecheck/TcRules.hs | 5 +- compiler/typecheck/TcSplice.hs | 40 +++-- compiler/typecheck/TcType.hs | 54 ++---- compiler/typecheck/TcUnify.hs | 115 +++++++++---- 16 files changed, 483 insertions(+), 437 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 af71f48c36b2a3201999f434ad9eaf0c9a0f5bdb From git at git.haskell.org Fri Aug 7 12:04:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:14 +0000 (UTC) Subject: [commit: ghc] wip/type-app: It compiles. (f42fd27) Message-ID: <20150807120414.D39003A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/f42fd27566f8af160625fd203c5a143318ba0345/ghc >--------------------------------------------------------------- commit f42fd27566f8af160625fd203c5a143318ba0345 Author: Richard Eisenberg Date: Tue Jun 30 17:25:02 2015 -0400 It compiles. >--------------------------------------------------------------- f42fd27566f8af160625fd203c5a143318ba0345 compiler/hsSyn/HsExpr.hs | 33 +------------ compiler/hsSyn/HsUtils.hs | 30 ++++++++++++ compiler/typecheck/Inst.hs | 21 ++++----- compiler/typecheck/TcArrows.hs | 7 ++- compiler/typecheck/TcExpr.hs | 97 ++++++++++++++++++++------------------- compiler/typecheck/TcExpr.hs-boot | 2 +- compiler/typecheck/TcMatches.hs | 8 ++-- compiler/typecheck/TcPat.hs | 15 ++++-- compiler/typecheck/TcRnDriver.hs | 3 +- compiler/typecheck/TcSplice.hs | 5 +- compiler/typecheck/TcUnify.hs | 59 +++++++++++++++--------- 11 files changed, 153 insertions(+), 127 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc f42fd27566f8af160625fd203c5a143318ba0345 From git at git.haskell.org Fri Aug 7 12:04:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:17 +0000 (UTC) Subject: [commit: ghc] wip/type-app: In the process of eager skolemisation (8a20399) Message-ID: <20150807120417.AAA8A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/8a20399ff205706fffb9eb8eeef8d97aa2113db7/ghc >--------------------------------------------------------------- commit 8a20399ff205706fffb9eb8eeef8d97aa2113db7 Author: Richard Eisenberg Date: Wed Jul 1 08:29:32 2015 -0400 In the process of eager skolemisation >--------------------------------------------------------------- 8a20399ff205706fffb9eb8eeef8d97aa2113db7 compiler/typecheck/TcExpr.hs | 202 +++++++++++++++++++++-------------------- compiler/typecheck/TcSplice.hs | 11 +-- compiler/typecheck/TcUnify.hs | 121 +++++++++++++++--------- 3 files changed, 185 insertions(+), 149 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8a20399ff205706fffb9eb8eeef8d97aa2113db7 From git at git.haskell.org Fri Aug 7 12:04:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:20 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Some bugfixing (2b6989c) Message-ID: <20150807120420.9DA423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/2b6989ca014a5f0c4156c2e91893839c32bb2654/ghc >--------------------------------------------------------------- commit 2b6989ca014a5f0c4156c2e91893839c32bb2654 Author: Richard Eisenberg Date: Wed Jul 1 12:09:16 2015 -0400 Some bugfixing >--------------------------------------------------------------- 2b6989ca014a5f0c4156c2e91893839c32bb2654 compiler/typecheck/TcExpr.hs | 21 ++++---- compiler/typecheck/TcMatches.hs | 34 +++++++----- compiler/typecheck/TcUnify.hs | 117 +++++++++++++++------------------------- 3 files changed, 76 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 2b6989ca014a5f0c4156c2e91893839c32bb2654 From git at git.haskell.org Fri Aug 7 12:04:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:24 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Checkpoint in bugfixing (4a6ab14) Message-ID: <20150807120424.28CBB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/4a6ab143ecf44a32f9618ac7e7d3c80e011c118b/ghc >--------------------------------------------------------------- commit 4a6ab143ecf44a32f9618ac7e7d3c80e011c118b Author: Richard Eisenberg Date: Wed Jul 1 17:14:37 2015 -0400 Checkpoint in bugfixing >--------------------------------------------------------------- 4a6ab143ecf44a32f9618ac7e7d3c80e011c118b compiler/deSugar/DsExpr.hs | 5 +- compiler/hsSyn/HsExpr.hs | 4 + compiler/hsSyn/HsUtils.hs | 16 ++- compiler/typecheck/Inst.hs | 80 ++++++++++-- compiler/typecheck/TcExpr.hs | 160 +++++++++++++++-------- compiler/typecheck/TcHsSyn.hs | 3 + compiler/typecheck/TcHsType.hs-boot | 8 ++ compiler/typecheck/TcMatches.hs | 11 +- compiler/typecheck/TcTyClsDecls.hs | 25 ++-- compiler/typecheck/TcType.hs | 16 ++- compiler/typecheck/TcUnify.hs | 133 +++++++++++++++---- testsuite/tests/typecheck/should_compile/Vta1.hs | 14 +- 12 files changed, 354 insertions(+), 121 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4a6ab143ecf44a32f9618ac7e7d3c80e011c118b From git at git.haskell.org Fri Aug 7 12:04:27 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:27 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Vta1 passes (0067224) Message-ID: <20150807120427.107E13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/006722400485d7525827c4acff4f99e7eda558e2/ghc >--------------------------------------------------------------- commit 006722400485d7525827c4acff4f99e7eda558e2 Author: Richard Eisenberg Date: Wed Jul 1 17:29:18 2015 -0400 Vta1 passes >--------------------------------------------------------------- 006722400485d7525827c4acff4f99e7eda558e2 compiler/typecheck/Inst.hs | 11 ++++++----- compiler/typecheck/TcUnify.hs | 5 ++++- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index bc98be8..6d66a8e 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -232,13 +232,14 @@ top_instantiate :: Bool -- True <=> instantiate *all* variables -> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) top_instantiate inst_all orig ty | not (null tvs && null theta) - = do { let (inst_tvs, leave_tvs) = span should_inst tvs - inst_theta - | null leave_tvs = theta - | otherwise = [] + = do { let (inst_tvs, leave_tvs) = span should_inst tvs + (inst_theta, leave_theta) + | null leave_tvs = (theta, []) + | otherwise = ([], theta) ; (subst, inst_tvs') <- tcInstTyVars inst_tvs ; let inst_theta' = substTheta subst inst_theta - sigma' = substTy subst (mkForAllTys leave_tvs rho) + sigma' = substTy subst (mkForAllTys leave_tvs $ + mkFunTys leave_theta rho) ; wrap1 <- instCall orig (mkTyVarTys inst_tvs') inst_theta' ; traceTc "Instantiating (inferred only)" diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index e74dab0..889fbd0 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -216,6 +216,7 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty | Just (Just hs_ty_arg) <- fmap isLHsTypeExpr_maybe arg = do { let origin = case ea of Expected -> panic "match_fun_tys" Actual orig -> orig + ; traceTc "RAE1" (ppr arg $$ ppr args $$ ppr ty) ; (wrap1, upsilon_ty) <- topInstantiateInferred origin ty -- wrap1 :: ty "->" upsilon_ty ; case tcSplitForAllTy_maybe upsilon_ty of @@ -224,6 +225,7 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty do { let kind = tyVarKind tv ; ty_arg <- tcCheckLHsType hs_ty_arg kind ; let insted_ty = substTyWith [tv] [ty_arg] inner_ty + ; traceTc "RAE3" (ppr upsilon_ty $$ ppr tv $$ ppr inner_ty $$ ppr insted_ty $$ ppr ty_arg) ; (inner_wrap, arg_tys, res_ty) <- go args insted_ty -- inner_wrap :: insted_ty "->" arg_tys -> res_ty ; let inst_wrap = mkWpTyApps [ty_arg] @@ -234,7 +236,8 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty go args ty | not (null tvs && null theta) - = do { (wrap, (arg_tys, res_ty)) <- exposeRhoType ea ty $ \rho -> + = do { traceTc "RAE2" (ppr args $$ ppr ty) + ; (wrap, (arg_tys, res_ty)) <- exposeRhoType ea ty $ \rho -> do { (inner_wrap, arg_tys, res_ty) <- go args rho ; return (inner_wrap, (arg_tys, res_ty)) } ; return (wrap, arg_tys, res_ty) } From git at git.haskell.org Fri Aug 7 12:04:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:29 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Working on failing test (8caa8b1) Message-ID: <20150807120429.E43833A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/8caa8b1b187d1bd77e9ac47d4b55585b38a6f4db/ghc >--------------------------------------------------------------- commit 8caa8b1b187d1bd77e9ac47d4b55585b38a6f4db Author: Richard Eisenberg Date: Wed Jul 1 23:56:57 2015 -0400 Working on failing test >--------------------------------------------------------------- 8caa8b1b187d1bd77e9ac47d4b55585b38a6f4db testsuite/tests/typecheck/should_fail/{VtaFail1.hs => VtaFail.hs} | 0 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/VtaFail1.hs b/testsuite/tests/typecheck/should_fail/VtaFail.hs similarity index 100% rename from testsuite/tests/typecheck/should_fail/VtaFail1.hs rename to testsuite/tests/typecheck/should_fail/VtaFail.hs From git at git.haskell.org Fri Aug 7 12:04:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:32 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Some bugfixing (2c1a913) Message-ID: <20150807120432.B91E83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/2c1a91380ab5c4728b412da62636507f19ff925e/ghc >--------------------------------------------------------------- commit 2c1a91380ab5c4728b412da62636507f19ff925e Author: Richard Eisenberg Date: Tue Jul 7 22:05:59 2015 -0400 Some bugfixing >--------------------------------------------------------------- 2c1a91380ab5c4728b412da62636507f19ff925e compiler/typecheck/Inst.hs | 5 ++-- compiler/typecheck/TcExpr.hs | 57 ++++++++++++++++++++++------------------ compiler/typecheck/TcMatches.hs | 16 ++++++----- compiler/typecheck/TcRnDriver.hs | 2 +- compiler/typecheck/TcRules.hs | 12 ++++++++- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcUnify.hs | 30 ++++++++++----------- 7 files changed, 71 insertions(+), 53 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 2c1a91380ab5c4728b412da62636507f19ff925e From git at git.haskell.org Fri Aug 7 12:04:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:35 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Checkpoint on undoing a lot of sigma-type stuff. (10f710c) Message-ID: <20150807120435.B15363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/10f710c84b868bb420119cf414154a493e044c03/ghc >--------------------------------------------------------------- commit 10f710c84b868bb420119cf414154a493e044c03 Author: Richard Eisenberg Date: Tue Jul 7 23:29:20 2015 -0400 Checkpoint on undoing a lot of sigma-type stuff. >--------------------------------------------------------------- 10f710c84b868bb420119cf414154a493e044c03 compiler/typecheck/Inst.hs | 1 - compiler/typecheck/TcArrows.hs | 15 ++-- compiler/typecheck/TcExpr.hs | 153 +++++++++++++++++---------------------- compiler/typecheck/TcMatches.hs | 8 +- compiler/typecheck/TcPat.hs | 17 +++-- compiler/typecheck/TcRnDriver.hs | 5 +- compiler/typecheck/TcRnTypes.hs | 4 - compiler/typecheck/TcRules.hs | 7 +- compiler/typecheck/TcSplice.hs | 10 +-- compiler/typecheck/TcUnify.hs | 109 +++++++++++----------------- 10 files changed, 138 insertions(+), 191 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 10f710c84b868bb420119cf414154a493e044c03 From git at git.haskell.org Fri Aug 7 12:04:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:38 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Checkpoint in more undoing. (6161d23) Message-ID: <20150807120438.90A323A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/6161d237e0527853f51f8f693d23ccba8bbd5dce/ghc >--------------------------------------------------------------- commit 6161d237e0527853f51f8f693d23ccba8bbd5dce Author: Richard Eisenberg Date: Tue Jul 7 23:39:03 2015 -0400 Checkpoint in more undoing. >--------------------------------------------------------------- 6161d237e0527853f51f8f693d23ccba8bbd5dce compiler/typecheck/TcArrows.hs | 14 +++++++------- compiler/typecheck/TcExpr.hs | 21 ++++++++++++++++++--- compiler/typecheck/TcExpr.hs-boot | 6 +++--- 3 files changed, 28 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcArrows.hs b/compiler/typecheck/TcArrows.hs index 4e89ed5..c92a6ef 100644 --- a/compiler/typecheck/TcArrows.hs +++ b/compiler/typecheck/TcArrows.hs @@ -9,7 +9,7 @@ Typecheck arrow notation module TcArrows ( tcProc ) where -import {-# SOURCE #-} TcExpr( tcPolyExpr, tcInferSigma, tcSyntaxOp, tcCheckId, tcPolyExpr ) +import {-# SOURCE #-} TcExpr( tcMonoExpr, tcInferSigma, tcSyntaxOp, tcCheckId, tcPolyExpr ) import HsSyn import TcMatches @@ -80,7 +80,7 @@ Note that tcProc :: InPat Name -> LHsCmdTop Name -- proc pat -> expr -> TcRhoType -- Expected type of whole proc expression - -> TcM (OutPat TcId, LHsCmdTop TcId, HsWrapper) + -> TcM (OutPat TcId, LHsCmdTop TcId, TcCoercion) tcProc pat cmd exp_ty = newArrowScope $ @@ -153,7 +153,7 @@ tc_cmd env in_cmd@(HsCmdCase scrut matches) (stk, res_ty) mc_body body res_ty' = tcCmd env body (stk, res_ty') tc_cmd env (HsCmdIf Nothing pred b1 b2) res_ty -- Ordinary 'if' - = do { pred' <- tcPolyExpr pred boolTy + = do { pred' <- tcMonoExpr pred boolTy ; b1' <- tcCmd env b1 res_ty ; b2' <- tcCmd env b2 res_ty ; return (HsCmdIf Nothing pred' b1' b2') @@ -170,7 +170,7 @@ tc_cmd env (HsCmdIf (Just fun) pred b1 b2) res_ty -- Rebindable syntax for if ; checkTc (not (r_tv `elemVarSet` tyVarsOfType pred_ty)) (ptext (sLit "Predicate type of `ifThenElse' depends on result type")) ; fun' <- tcSyntaxOp IfOrigin fun if_ty - ; pred' <- tcPolyExpr pred pred_ty + ; pred' <- tcMonoExpr pred pred_ty ; b1' <- tcCmd env b1 res_ty ; b2' <- tcCmd env b2 res_ty ; return (HsCmdIf (Just fun') pred' b1' b2') @@ -196,9 +196,9 @@ tc_cmd env cmd@(HsCmdArrApp fun arg _ ho_app lr) (_, res_ty) = addErrCtxt (cmdCtxt cmd) $ do { arg_ty <- newFlexiTyVarTy openTypeKind ; let fun_ty = mkCmdArrTy env arg_ty res_ty - ; fun' <- select_arrow_scope (tcPolyExpr fun fun_ty) + ; fun' <- select_arrow_scope (tcMonoExpr fun fun_ty) - ; arg' <- tcPolyExpr arg arg_ty + ; arg' <- tcMonoExpr arg arg_ty ; return (HsCmdArrApp fun' arg' fun_ty ho_app lr) } where @@ -223,7 +223,7 @@ tc_cmd env cmd@(HsCmdApp fun arg) (cmd_stk, res_ty) = addErrCtxt (cmdCtxt cmd) $ do { arg_ty <- newFlexiTyVarTy openTypeKind ; fun' <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty) - ; arg' <- tcPolyExpr arg arg_ty + ; arg' <- tcMonoExpr arg arg_ty ; return (HsCmdApp fun' arg') } ------------------------------------------- diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 6103388..3040e42 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -8,8 +8,8 @@ c% {-# LANGUAGE CPP #-} -module TcExpr ( tcPolyExpr, tcPolyExprNC, - tcInferSigma, tcInferSigmaNC, +module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC, + tcInferSigma, tcInferSigmaNC, tcInferRho, tcInferRhoNC, tcSyntaxOp, tcCheckId, addExprErrCtxt, tcSkolemiseExpr ) where @@ -92,6 +92,21 @@ tcPolyExprNC (L loc expr) res_ty tcExpr expr res_ty ; return (L loc expr') } +tcMonoExpr, tcMonoExprNC + :: LHsExpr Name -- Expression to type check + -> TcRhoType -- Expected type (must not be a polytype) + -> TcM (LHsExpr TcId) -- Generalised expr with expected type + +tcMonoExpr expr res_ty + = addExprErrCtxt expr $ + do { traceTc "tcMonoExpr" (ppr res_ty); tcMonoExprNC expr res_ty } + +tcMonoExprNC (L loc expr) res_ty + = setSrcSpan loc $ + do { traceTc "tcPolyExprNC" (ppr res_ty) + ; expr' <- tcExpr expr res_ty + ; return (L loc expr') } + --------------- tcInferSigma, tcInferSigmaNC :: LHsExpr Name -> TcM (LHsExpr TcId, TcSigmaType) -- Infer a *sigma*-type. @@ -460,7 +475,7 @@ tcExpr (HsDo do_or_lc stmts _) res_ty tcExpr (HsProc pat cmd) res_ty = do { (pat', cmd', coi) <- tcProc pat cmd res_ty - ; return $ mkHsWrap coi (HsProc pat' cmd') } + ; return $ mkHsWrapCo coi (HsProc pat' cmd') } tcExpr (HsStatic expr) res_ty = do { staticPtrTyCon <- tcLookupTyCon staticPtrTyConName diff --git a/compiler/typecheck/TcExpr.hs-boot b/compiler/typecheck/TcExpr.hs-boot index 944ac4f..7f335b6 100644 --- a/compiler/typecheck/TcExpr.hs-boot +++ b/compiler/typecheck/TcExpr.hs-boot @@ -1,12 +1,12 @@ module TcExpr where import HsSyn ( HsExpr, LHsExpr ) import Name ( Name ) -import TcType ( TcType, TcSigmaType ) +import TcType ( TcType, TcRhoType ) import TcRnTypes( TcM, TcId, CtOrigin ) -tcPolyExpr, tcPolyExprNC :: +tcMonoExpr, tcMonoExprNC :: LHsExpr Name - -> TcSigmaType + -> TcRhoType -> TcM (LHsExpr TcId) tcInferSigma, tcInferSigmaNC :: From git at git.haskell.org Fri Aug 7 12:04:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:41 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Yet another checkpoint (6e99ae5) Message-ID: <20150807120441.77B693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/6e99ae5d1987cf227b6139a277284cf823970988/ghc >--------------------------------------------------------------- commit 6e99ae5d1987cf227b6139a277284cf823970988 Author: Richard Eisenberg Date: Tue Jul 7 23:51:50 2015 -0400 Yet another checkpoint >--------------------------------------------------------------- 6e99ae5d1987cf227b6139a277284cf823970988 compiler/typecheck/TcBinds.hs | 4 +- compiler/typecheck/TcExpr.hs | 88 ++++++++++++++++++++++--------------------- 2 files changed, 47 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 6e99ae5d1987cf227b6139a277284cf823970988 From git at git.haskell.org Fri Aug 7 12:04:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:44 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Massive simplification: always deeply skolemise (683fce2) Message-ID: <20150807120444.554233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/683fce2dcdd26cbef2ea381eec486faccc490f15/ghc >--------------------------------------------------------------- commit 683fce2dcdd26cbef2ea381eec486faccc490f15 Author: Richard Eisenberg Date: Wed Jul 8 09:12:34 2015 -0400 Massive simplification: always deeply skolemise >--------------------------------------------------------------- 683fce2dcdd26cbef2ea381eec486faccc490f15 compiler/hsSyn/HsUtils.hs | 30 --------- compiler/typecheck/TcExpr.hs | 63 +++++++++--------- compiler/typecheck/TcExpr.hs-boot | 13 +++- compiler/typecheck/TcMatches.hs | 137 +++++++++++++++----------------------- compiler/typecheck/TcPat.hs | 11 +-- compiler/typecheck/TcRnDriver.hs | 4 +- compiler/typecheck/TcRules.hs | 10 +-- compiler/typecheck/TcSplice.hs | 12 ++-- compiler/typecheck/TcUnify.hs | 99 +++++++++++++++------------ 9 files changed, 167 insertions(+), 212 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 683fce2dcdd26cbef2ea381eec486faccc490f15 From git at git.haskell.org Fri Aug 7 12:04:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:47 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Checkpoint in bugfixing (bfaa6a4) Message-ID: <20150807120447.34FC73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/bfaa6a4b354d88f9d605887a3ba93a62461cb271/ghc >--------------------------------------------------------------- commit bfaa6a4b354d88f9d605887a3ba93a62461cb271 Author: Richard Eisenberg Date: Wed Jul 8 14:33:54 2015 -0400 Checkpoint in bugfixing >--------------------------------------------------------------- bfaa6a4b354d88f9d605887a3ba93a62461cb271 compiler/deSugar/Coverage.hs | 9 +++-- compiler/deSugar/DsArrows.hs | 11 ++++-- compiler/hsSyn/HsExpr.hs | 12 +++--- compiler/hsSyn/HsUtils.hs | 11 ++++-- compiler/hsSyn/PlaceHolder.hs | 5 +++ compiler/parser/RdrHsSyn.hs | 2 +- compiler/rename/RnExpr.hs | 10 ++--- compiler/typecheck/Inst.hs | 36 ++++++++++-------- compiler/typecheck/TcArrows.hs | 12 +++--- compiler/typecheck/TcBinds.hs | 20 +++++----- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcExpr.hs | 21 +++++++---- compiler/typecheck/TcHsSyn.hs | 17 +++++---- compiler/typecheck/TcMType.hs | 21 +++++++---- compiler/typecheck/TcMatches.hs | 73 +++++++++++++++++++++++++++++------- compiler/typecheck/TcMatches.hs-boot | 9 ++++- compiler/typecheck/TcPat.hs | 9 ++--- compiler/typecheck/TcSMonad.hs | 2 +- compiler/typecheck/TcType.hs | 27 ++++++++----- compiler/typecheck/TcUnify.hs | 1 + 20 files changed, 200 insertions(+), 110 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc bfaa6a4b354d88f9d605887a3ba93a62461cb271 From git at git.haskell.org Fri Aug 7 12:04:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:50 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Undoing some changes (311b8ad) Message-ID: <20150807120450.166C83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/311b8ad593e52aa30b87b5acefd9941bbf92fb4b/ghc >--------------------------------------------------------------- commit 311b8ad593e52aa30b87b5acefd9941bbf92fb4b Author: Richard Eisenberg Date: Wed Jul 8 16:41:33 2015 -0400 Undoing some changes >--------------------------------------------------------------- 311b8ad593e52aa30b87b5acefd9941bbf92fb4b compiler/typecheck/Inst.hs | 36 +++++++++++++---------------- compiler/typecheck/TcBinds.hs | 20 ++++++++-------- compiler/typecheck/TcMatches.hs | 45 +++++------------------------------- compiler/typecheck/TcMatches.hs-boot | 9 +------- 4 files changed, 32 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 311b8ad593e52aa30b87b5acefd9941bbf92fb4b From git at git.haskell.org Fri Aug 7 12:04:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:53 +0000 (UTC) Subject: [commit: ghc] wip/type-app: `base` compiles (8d8a235) Message-ID: <20150807120453.2FCBA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/8d8a235703f996ac6f58a8e56bcb459f56ba7a80/ghc >--------------------------------------------------------------- commit 8d8a235703f996ac6f58a8e56bcb459f56ba7a80 Author: Richard Eisenberg Date: Wed Jul 8 22:17:07 2015 -0400 `base` compiles >--------------------------------------------------------------- 8d8a235703f996ac6f58a8e56bcb459f56ba7a80 compiler/deSugar/DsBinds.hs | 8 ++++---- compiler/deSugar/Match.hs | 2 +- compiler/hsSyn/HsExpr.hs | 7 +++++++ compiler/typecheck/TcEvidence.hs | 18 +++++++++++++----- compiler/typecheck/TcHsSyn.hs | 9 ++++----- compiler/typecheck/TcMatches.hs | 34 ++++++++++++++++++++++------------ compiler/typecheck/TcUnify.hs | 25 ++++++++++++++++++------- 7 files changed, 69 insertions(+), 34 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 8d8a235703f996ac6f58a8e56bcb459f56ba7a80 From git at git.haskell.org Fri Aug 7 12:04:56 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:56 +0000 (UTC) Subject: [commit: ghc] wip/type-app: *** Use global url for .gitmodules (d2228af) Message-ID: <20150807120456.01B523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/d2228af2b996dba11437975ea570b2b6fb60a62c/ghc >--------------------------------------------------------------- commit d2228af2b996dba11437975ea570b2b6fb60a62c Author: Richard Eisenberg Date: Wed Jul 8 23:24:56 2015 -0400 *** Use global url for .gitmodules >--------------------------------------------------------------- d2228af2b996dba11437975ea570b2b6fb60a62c .gitmodules | 58 +++++++++++++++++++++++++++++----------------------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/.gitmodules b/.gitmodules index 662f6d6..d7dcb0f 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,117 +1,117 @@ [submodule "libraries/binary"] path = libraries/binary - url = ../packages/binary.git + url = git://git.haskell.org/packages/binary.git ignore = untracked [submodule "libraries/bytestring"] path = libraries/bytestring - url = ../packages/bytestring.git + url = git://git.haskell.org/packages/bytestring.git ignore = untracked [submodule "libraries/Cabal"] path = libraries/Cabal - url = ../packages/Cabal.git + url = git://git.haskell.org/packages/Cabal.git ignore = untracked [submodule "libraries/containers"] path = libraries/containers - url = ../packages/containers.git + url = git://git.haskell.org/packages/containers.git ignore = untracked [submodule "libraries/haskeline"] path = libraries/haskeline - url = ../packages/haskeline.git + url = git://git.haskell.org/packages/haskeline.git ignore = untracked [submodule "libraries/pretty"] path = libraries/pretty - url = ../packages/pretty.git + url = git://git.haskell.org/packages/pretty.git ignore = untracked [submodule "libraries/terminfo"] path = libraries/terminfo - url = ../packages/terminfo.git + url = git://git.haskell.org/packages/terminfo.git ignore = untracked [submodule "libraries/transformers"] path = libraries/transformers - url = ../packages/transformers.git + url = git://git.haskell.org/packages/transformers.git ignore = untracked [submodule "libraries/xhtml"] path = libraries/xhtml - url = ../packages/xhtml.git + url = git://git.haskell.org/packages/xhtml.git ignore = untracked [submodule "libraries/Win32"] path = libraries/Win32 - url = ../packages/Win32.git + url = git://git.haskell.org/packages/Win32.git ignore = untracked [submodule "libraries/primitive"] path = libraries/primitive - url = ../packages/primitive.git + url = git://git.haskell.org/packages/primitive.git ignore = untracked [submodule "libraries/vector"] path = libraries/vector - url = ../packages/vector.git + url = git://git.haskell.org/packages/vector.git ignore = untracked [submodule "libraries/time"] path = libraries/time - url = ../packages/time.git + url = git://git.haskell.org/packages/time.git ignore = untracked [submodule "libraries/random"] path = libraries/random - url = ../packages/random.git + url = git://git.haskell.org/packages/random.git ignore = untracked [submodule "libraries/array"] path = libraries/array - url = ../packages/array.git + url = git://git.haskell.org/packages/array.git ignore = none [submodule "libraries/deepseq"] path = libraries/deepseq - url = ../packages/deepseq.git + url = git://git.haskell.org/packages/deepseq.git ignore = none [submodule "libraries/directory"] path = libraries/directory - url = ../packages/directory.git + url = git://git.haskell.org/packages/directory.git ignore = none [submodule "libraries/filepath"] path = libraries/filepath - url = ../packages/filepath.git + url = git://git.haskell.org/packages/filepath.git ignore = none [submodule "libraries/hoopl"] path = libraries/hoopl - url = ../packages/hoopl.git + url = git://git.haskell.org/packages/hoopl.git ignore = none [submodule "libraries/hpc"] path = libraries/hpc - url = ../packages/hpc.git + url = git://git.haskell.org/packages/hpc.git ignore = none [submodule "libraries/process"] path = libraries/process - url = ../packages/process.git + url = git://git.haskell.org/packages/process.git ignore = none [submodule "libraries/unix"] path = libraries/unix - url = ../packages/unix.git + url = git://git.haskell.org/packages/unix.git ignore = none [submodule "libraries/parallel"] path = libraries/parallel - url = ../packages/parallel.git + url = git://git.haskell.org/packages/parallel.git ignore = none [submodule "libraries/stm"] path = libraries/stm - url = ../packages/stm.git + url = git://git.haskell.org/packages/stm.git ignore = none [submodule "libraries/dph"] path = libraries/dph - url = ../packages/dph.git + url = git://git.haskell.org/packages/dph.git ignore = none [submodule "utils/haddock"] path = utils/haddock - url = ../haddock.git + url = git://git.haskell.org/haddock.git ignore = none branch = ghc-head [submodule "nofib"] path = nofib - url = ../nofib.git + url = git://git.haskell.org/nofib.git ignore = none [submodule "utils/hsc2hs"] path = utils/hsc2hs - url = ../hsc2hs.git + url = git://git.haskell.org/hsc2hs.git ignore = none [submodule "libffi-tarballs"] path = libffi-tarballs - url = ../libffi-tarballs.git + url = git://git.haskell.org/libffi-tarballs.git ignore = none From git at git.haskell.org Fri Aug 7 12:04:59 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:04:59 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Comments only (de87a55) Message-ID: <20150807120459.20CA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/de87a55205732ab35d8c3931d1d2884d18dc3146/ghc >--------------------------------------------------------------- commit de87a55205732ab35d8c3931d1d2884d18dc3146 Author: Richard Eisenberg Date: Thu Jul 9 13:13:13 2015 -0400 Comments only >--------------------------------------------------------------- de87a55205732ab35d8c3931d1d2884d18dc3146 compiler/coreSyn/MkCore.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 3b76aef..24e46dc 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -735,7 +735,7 @@ Notice the 'OpenKind' (manifested as openAlphaTyVar in the code). This ensures t * unboxed as well as boxed types * polymorphic types This is OK because it never returns, so the return type is irrelevant. -See Note [OpenTypeKind accepts foralls] in TcUnify. +See Note [OpenTypeKind accepts foralls] in TcType. ************************************************************************ From git at git.haskell.org Fri Aug 7 12:05:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:02 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Fix [OpenTypeKind accepts foralls] (6ffacbb) Message-ID: <20150807120502.05D293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/6ffacbb5d090ec1d348c3222fca5264762df1a3b/ghc >--------------------------------------------------------------- commit 6ffacbb5d090ec1d348c3222fca5264762df1a3b Author: Richard Eisenberg Date: Thu Jul 9 13:20:43 2015 -0400 Fix [OpenTypeKind accepts foralls] >--------------------------------------------------------------- 6ffacbb5d090ec1d348c3222fca5264762df1a3b compiler/coreSyn/MkCore.hs | 2 +- compiler/typecheck/TcMType.hs | 38 ++++++++++++++++++++++++++------------ compiler/typecheck/TcType.hs | 41 ++++++++--------------------------------- compiler/typecheck/TcUnify.hs | 2 -- 4 files changed, 35 insertions(+), 48 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 6ffacbb5d090ec1d348c3222fca5264762df1a3b From git at git.haskell.org Fri Aug 7 12:05:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:04 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Stage 2 succeeds (ebac2cb) Message-ID: <20150807120504.E6BC83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/ebac2cb34ea21c95a141fbdfc39b211033c61604/ghc >--------------------------------------------------------------- commit ebac2cb34ea21c95a141fbdfc39b211033c61604 Author: Richard Eisenberg Date: Thu Jul 9 13:40:56 2015 -0400 Stage 2 succeeds >--------------------------------------------------------------- ebac2cb34ea21c95a141fbdfc39b211033c61604 compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcMType.hs | 3 ++- compiler/typecheck/TcMatches.hs | 3 ++- compiler/typecheck/TcRnDriver.hs | 1 - compiler/typecheck/TcSplice.hs | 1 + compiler/typecheck/TcType.hs | 6 +++--- compiler/typecheck/TcUnify.hs | 12 +++++++----- 7 files changed, 16 insertions(+), 12 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 3f2cd2f..dd65965 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -456,7 +456,7 @@ tcExpr (HsIf Nothing pred b1 b2) res_ty -- Ordinary 'if' = do { pred' <- tcMonoExpr pred boolTy -- this forces the branches to be fully instantiated -- (See #10619) - ; tau_ty <- newFlexiMonoTyVarTy openTypeKind + ; tau_ty <- newFlexiTyVarTy openTypeKind ; wrap <- tcSubTypeHR tau_ty res_ty ; tau_ty <- zonkTcType tau_ty ; b1' <- tcMonoExpr b1 tau_ty diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 01a3b5b..48d3312 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -67,6 +67,7 @@ module TcMType ( import TypeRep import TcType import Type +import Kind ( isOpenTypeKind ) import Class import Var import VarEnv @@ -452,7 +453,7 @@ tcInstTyVarX subst tyvar ; let info | isOpenTypeKind (tyVarKind tyvar) = ReturnTv -- See Note [OpenTypeKind accepts foralls] | otherwise = TauTv VanillaTau - ; details <- newMetaDetails (TauTv VanillaTau) + ; details <- newMetaDetails info ; let name = mkSystemName uniq (getOccName tyvar) -- See Note [Name of an instantiated type variable] kind = substTy subst (tyVarKind tyvar) diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index b744af7..a5410a9 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -190,7 +190,8 @@ tcMatches ctxt pat_tys rhs_ty group@(MG { mg_alts = matches, mg_origin = origin if isSingletonMatchGroup group -- no need to monomorphise the RHS if there's only one then return (idHsWrapper, rhs_ty) - else do { tau_ty <- newFlexiMonoTyVarTy openTypeKind + -- TODO (RAE): Document this behavior. + else do { tau_ty <- newFlexiTyVarTy openTypeKind ; wrap <- tcSubTypeDS GenSigCtxt tau_ty rhs_ty ; tau_ty <- zonkTcType tau_ty -- seems more efficient to zonk just once diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index b01d0a2..0e3ee2d 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -39,7 +39,6 @@ import TidyPgm ( globaliseAndTidyId ) import TysWiredIn ( unitTy, mkListTy ) import DynamicLoading ( loadPlugins ) import Plugins ( tcPlugin ) -import Inst ( topInstantiate ) #endif import DynFlags diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 040bab9..831fe31 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -65,6 +65,7 @@ import TypeRep import FamInst import FamInstEnv import InstEnv +import Inst import NameEnv import PrelNames import OccName diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 87613ec..136295b 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1243,7 +1243,7 @@ occurCheckExpand dflags tv ty where details = ASSERT2( isTcTyVar tv, ppr tv ) tcTyVarDetails tv - impredicative = canUnifyWithPolyType dflags details (tyVarKind tv) + impredicative = canUnifyWithPolyType dflags details -- Check 'ty' is a tyvar, or can be expanded into one go_sig_tv ty@(TyVarTy {}) = OC_OK ty @@ -1296,8 +1296,8 @@ occurCheckExpand dflags tv ty | otherwise -> bad -- Failing that, try to expand a synonym -canUnifyWithPolyType :: DynFlags -> TcTyVarDetails -> TcKind -> Bool -canUnifyWithPolyType dflags details kind +canUnifyWithPolyType :: DynFlags -> TcTyVarDetails -> Bool +canUnifyWithPolyType dflags details = case details of MetaTv { mtv_info = ReturnTv } -> True -- See Note [ReturnTv] MetaTv { mtv_info = SigTv } -> False diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 519bd43..e4a2456 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -677,7 +677,7 @@ tc_sub_type_ds origin ctxt ty_actual ty_expected = go ty_actual ty_expected (ppr tv_e <+> text "-->" <+> ppr ty_e') ; tc_sub_type origin ctxt ty_a ty_e' } Unfilled details - | canUnifyWithPolyType dflags details (tyVarKind tv_e) + | canUnifyWithPolyType dflags details && isTouchableMetaTyVar tclvl tv_e -- don't want skolems here -> coToHsWrapper <$> uType origin ty_a ty_e @@ -1205,9 +1205,11 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2 ty2 = mkTyVarTy tv2 nicer_to_update_tv1 :: TcTyVar -> MetaInfo -> MetaInfo -> Bool -nicer_to_update_tv1 _ _ SigTv = True -nicer_to_update_tv1 _ SigTv _ = False -nicer_to_update_tv1 tv1 _ _ = isSystemName (Var.varName tv1) +nicer_to_update_tv1 _ ReturnTv _ = True +nicer_to_update_tv1 _ _ ReturnTv = False +nicer_to_update_tv1 _ _ SigTv = True +nicer_to_update_tv1 _ SigTv _ = False +nicer_to_update_tv1 tv1 _ _ = isSystemName (Var.varName tv1) -- Try not to update SigTvs or AlwaysMonoTaus; and try to update sys-y type -- variables in preference to ones gotten (say) by -- instantiating a polymorphic function with a user-written @@ -1265,7 +1267,7 @@ checkTauTvUpdate dflags tv ty details = ASSERT2( isMetaTyVar tv, ppr tv ) tcTyVarDetails tv info = mtv_info details is_return_tv = isReturnTyVar tv - impredicative = canUnifyWithPolyType dflags details (tyVarKind tv) + impredicative = canUnifyWithPolyType dflags details defer_me :: TcType -> Bool -- Checks for (a) occurrence of tv From git at git.haskell.org Fri Aug 7 12:05:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:08 +0000 (UTC) Subject: [commit: ghc] wip/type-app: VTA tests work (4348c62) Message-ID: <20150807120508.3D7D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/4348c621aa863f9a5f2dc50e32d889d1d7a35ad3/ghc >--------------------------------------------------------------- commit 4348c621aa863f9a5f2dc50e32d889d1d7a35ad3 Author: Richard Eisenberg Date: Thu Jul 9 13:57:48 2015 -0400 VTA tests work >--------------------------------------------------------------- 4348c621aa863f9a5f2dc50e32d889d1d7a35ad3 compiler/typecheck/TcUnify.hs | 7 +- testsuite/tests/typecheck/should_fail/VtaFail.hs | 2 +- .../tests/typecheck/should_fail/VtaFail.stderr | 94 ++++++++++++++++++++++ 3 files changed, 99 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index e4a2456..d863338 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -324,9 +324,10 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty else ptext (sLit "has only") <+> speakN n_args] ty_app_err ty arg - = failWith $ - text "Cannot not apply expression of type" <+> quotes (ppr ty) $$ - text "to a visible type argument" <+> quotes (ppr arg) + = do { (_, ty) <- zonkTidyTcType emptyTidyEnv ty + ; failWith $ + text "Cannot not apply expression of type" <+> quotes (ppr ty) $$ + text "to a visible type argument" <+> quotes (ppr arg) } {- Note [Foralls to left of arrow] diff --git a/testsuite/tests/typecheck/should_fail/VtaFail.hs b/testsuite/tests/typecheck/should_fail/VtaFail.hs index cd84e65..250f9e2 100644 --- a/testsuite/tests/typecheck/should_fail/VtaFail.hs +++ b/testsuite/tests/typecheck/should_fail/VtaFail.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeApplications, RankNTypes, PolyKinds #-} module VtaFail1 where diff --git a/testsuite/tests/typecheck/should_fail/VtaFail.stderr b/testsuite/tests/typecheck/should_fail/VtaFail.stderr new file mode 100644 index 0000000..676d64c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/VtaFail.stderr @@ -0,0 +1,94 @@ + +VtaFail.hs:7:16: error: + Cannot not apply expression of type ?t0 -> t1 -> (t0, t1)? + to a visible type argument ?Int? + In the expression: pairup_nosig @Int @Bool 5 True + In an equation for ?answer_nosig?: + answer_nosig = pairup_nosig @Int @Bool 5 True + +VtaFail.hs:12:26: error: + No instance for (Num Bool) arising from an application + In the expression: addOne @Bool 5 + In an equation for ?answer_constraint_fail?: + answer_constraint_fail = addOne @Bool 5 + +VtaFail.hs:14:17: error: + Cannot not apply expression of type ?r0 -> r0? + to a visible type argument ?Int? + In the expression: (\ x -> x) @Int 12 + In an equation for ?answer_lambda?: + answer_lambda = (\ x -> x) @Int 12 + +VtaFail.hs:19:5: error: + Cannot not apply expression of type ?Int -> (a0, Int)? + to a visible type argument ?Bool? + In the expression: pair 3 @Int @Bool True + In an equation for ?a?: a = pair 3 @Int @Bool True + +VtaFail.hs:26:15: error: + Expected kind ?* -> *?, but ?Int? has kind ?*? + In the type ?Int? + In the expression: first @Int F + In an equation for ?fInt?: fInt = first @Int F + +VtaFail.hs:33:18: error: + Couldn't match type ?Int? with ?Bool? + Expected type: Proxy Bool + Actual type: Proxy Int + In the second argument of ?foo?, namely ?(P :: Proxy Int)? + In the expression: foo @Bool (P :: Proxy Int) + In an equation for ?baz?: baz = foo @Bool (P :: Proxy Int) + +VtaFail.hs:40:17: error: + Expected kind ?* -> k0 -> *?, but ?Maybe? has kind ?* -> *? + In the type ?Maybe? + In the expression: too @Maybe T + In an equation for ?threeBad?: threeBad = too @Maybe T + +VtaFail.hs:41:27: error: + Couldn't match type ?Either? with ?(->)? + Expected type: Three (->) + Actual type: Three Either + In the second argument of ?too?, namely ?(T :: Three Either)? + In the expression: too @(->) (T :: Three Either) + In an equation for ?threeWorse?: + threeWorse = too @(->) (T :: Three Either) + +VtaFail.hs:46:5: error: + Cannot not apply expression of type ?Int -> Int -> Int? + to a visible type argument ?Int? + In the expression: plus @Int 5 7 + In an equation for ?b?: b = plus @Int 5 7 + +VtaFail.hs:47:5: error: + Cannot not apply expression of type ?Int -> Int -> Int? + to a visible type argument ?Rational? + In the expression: plus @Rational 5 10 + In an equation for ?c?: c = plus @Rational 5 10 + +VtaFail.hs:48:5: error: + Cannot not apply expression of type ?Int -> Int -> Int? + to a visible type argument ?Int? + In the expression: (+) @Int @Int @Int 12 14 + In an equation for ?d?: d = (+) @Int @Int @Int 12 14 + +VtaFail.hs:51:5: error: + Cannot not apply expression of type ?Int -> String? + to a visible type argument ?Float? + In the expression: show @Int @Float (read "5") + In an equation for ?e?: e = show @Int @Float (read "5") + +VtaFail.hs:52:11: error: + Cannot not apply expression of type ?String -> Int? + to a visible type argument ?Bool? + In the first argument of ?show?, namely + ?(read @Int @Bool @Float "3")? + In the expression: show (read @Int @Bool @Float "3") + In an equation for ?f?: f = show (read @Int @Bool @Float "3") + +VtaFail.hs:57:12: error: + Expecting one more argument to ?Maybe? + Expected kind ?*?, but ?Maybe? has kind ?* -> *? + In the type ?Maybe? + In the expression: silly @Maybe + In an equation for ?g?: g = silly @Maybe From git at git.haskell.org Fri Aug 7 12:05:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:11 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Bugfixing (890058c) Message-ID: <20150807120511.184D03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/890058c1d215d2d9de327542bd1c28ab83e92655/ghc >--------------------------------------------------------------- commit 890058c1d215d2d9de327542bd1c28ab83e92655 Author: Richard Eisenberg Date: Thu Jul 9 14:35:15 2015 -0400 Bugfixing >--------------------------------------------------------------- 890058c1d215d2d9de327542bd1c28ab83e92655 compiler/typecheck/TcBinds.hs | 2 +- testsuite/tests/typecheck/should_fail/all.T | 2 +- testsuite/tests/typecheck/should_fail/tcfail165.hs | 3 ++- testsuite/tests/typecheck/should_fail/tcfail165.stderr | 12 ------------ 4 files changed, 4 insertions(+), 15 deletions(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index fda3bbb..1b2f72f 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -1279,7 +1279,7 @@ tcMonoBinds is_rec sig_fn no_gen -- e.g. f = \(x::forall a. a->a) -> -- We want to infer a higher-rank type for f setSrcSpan b_loc $ - do { rhs_ty <- newFlexiTyVarTy openTypeKind + do { rhs_ty <- newReturnTyVarTy openTypeKind ; mono_id <- newNoSigLetBndr no_gen name rhs_ty ; (co_fn, matches') <- tcExtendIdBndrs [TcIdBndr mono_id NotTopLevel] $ -- We extend the error context even for a non-recursive diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 2addf6a..3a3137e 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -147,7 +147,7 @@ test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) test('tcfail162', normal, compile_fail, ['']) test('tcfail164', normal, compile_fail, ['']) -test('tcfail165', normal, compile_fail, ['']) +test('tcfail165', normal, compile, ['']) test('tcfail166', normal, compile_fail, ['']) test('tcfail167', normal, compile_fail, ['']) test('tcfail168', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.hs b/testsuite/tests/typecheck/should_fail/tcfail165.hs index c23a7f3..8b4cabd 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail165.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail165.hs @@ -11,6 +11,7 @@ import Control.Concurrent -- -- In GHC 7.0 it fails again! (and rightly so) +-- With the Visible Type Application patch, this succeeds again. + foo = do var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String)) putMVar var (show :: forall b. Show b => b -> String) - diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.stderr b/testsuite/tests/typecheck/should_fail/tcfail165.stderr deleted file mode 100644 index 2b8b434..0000000 --- a/testsuite/tests/typecheck/should_fail/tcfail165.stderr +++ /dev/null @@ -1,12 +0,0 @@ - -tcfail165.hs:15:23: - Couldn't match expected type ?forall a. Show a => a -> String? - with actual type ?b0 -> String? - In the second argument of ?putMVar?, namely - ?(show :: forall b. Show b => b -> String)? - In a stmt of a 'do' block: - putMVar var (show :: forall b. Show b => b -> String) - In the expression: - do { var <- newEmptyMVar :: - IO (MVar (forall a. Show a => a -> String)); - putMVar var (show :: forall b. Show b => b -> String) } From git at git.haskell.org Fri Aug 7 12:05:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:13 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Remove SkolemiseMode -- always go deep. (b4194ab) Message-ID: <20150807120513.DD4F13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/b4194abe0e2bc24a3ff63f491e266bb048b526a9/ghc >--------------------------------------------------------------- commit b4194abe0e2bc24a3ff63f491e266bb048b526a9 Author: Richard Eisenberg Date: Thu Jul 9 14:39:16 2015 -0400 Remove SkolemiseMode -- always go deep. >--------------------------------------------------------------- b4194abe0e2bc24a3ff63f491e266bb048b526a9 compiler/typecheck/Inst.hs | 44 +---------------------------------------- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcExpr.hs | 11 +++++------ compiler/typecheck/TcMatches.hs | 2 +- compiler/typecheck/TcUnify.hs | 17 +++++++--------- 5 files changed, 15 insertions(+), 61 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 2eac549..338bd0d 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -9,7 +9,7 @@ The @Inst@ type: dictionaries or method instances {-# LANGUAGE CPP #-} module Inst ( - skolemise, SkolemiseMode(..), + deeplySkolemise, topInstantiate, topInstantiateInferred, deeplyInstantiate, instCall, instDFunType, instStupidTheta, newWanted, newWanteds, @@ -146,48 +146,6 @@ ToDo: this eta-abstraction plays fast and loose with termination, fix this -} --- | How should we skolemise a type? -data SkolemiseMode - = SkolemiseDeeply - -- ^ Skolemise all inferred and specified variables, and all - -- constraints, from the top type and to the right of arrows. - -- See also 'deeplySkolemise' - - | SkolemiseTop - -- ^ Skolemise all variables and all constraints, at the top level only. - -- Does not look past non-constraint arrows. - --- | Skolemise a type according to the provided 'SkolemiseMode'. --- The caller will likely want to bind the returns variables and --- givens. The 'HsWrapper' returned has type @skol_ty -> sigma at . -skolemise :: SkolemiseMode -> TcSigmaType - -> TcM (HsWrapper, [TyVar], [EvVar], TcType) -skolemise SkolemiseDeeply = deeplySkolemise -skolemise SkolemiseTop = topSkolemise - --- | Skolemise top-level quantified variables and constraints. -topSkolemise :: TcSigmaType - -> TcM (HsWrapper, [TyVar], [EvVar], TcRhoType) -topSkolemise sigma - | null tvs && null theta - = return (idHsWrapper, [], [], rho) - - | otherwise - = do { (subst, tvs') <- tcInstSkolTyVars tvs - ; let theta' = substTheta subst theta - rho' = substTy subst rho - ; ev_vars <- newEvVars theta' - ; (wrap, inner_tvs', inner_ev_vars, inner_rho) <- topSkolemise rho' - -- This handles types like - -- forall a. Num a => forall b. Ord b => ... - - ; return ( mkWpTyLams tvs' <.> mkWpLams ev_vars <.> wrap - , tvs' ++ inner_tvs' - , ev_vars ++ inner_ev_vars - , inner_rho ) } - where - (tvs, theta, rho) = tcSplitSigmaTy sigma - deeplySkolemise :: TcSigmaType -> TcM (HsWrapper, [TyVar], [EvVar], TcRhoType) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 1b2f72f..3c081e3 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -1048,7 +1048,7 @@ tcSpecWrapper :: UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper -- See Note [Handling SPECIALISE pragmas], wrinkle 1 tcSpecWrapper ctxt poly_ty spec_ty = do { (sk_wrap, inst_wrap) - <- tcSkolemise SkolemiseDeeply ctxt spec_ty $ \ _ spec_tau -> + <- tcSkolemise ctxt spec_ty $ \ _ spec_tau -> do { (inst_wrap, tau) <- topInstantiate orig poly_ty ; _ <- unifyType spec_tau tau -- Deliberately ignore the evidence diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index dd65965..11889e7 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -88,7 +88,7 @@ tcPolyExpr expr res_ty tcPolyExprNC (L loc expr) res_ty = setSrcSpan loc $ do { traceTc "tcPolyExprNC" (ppr res_ty) - ; expr' <- tcSkolemiseExpr SkolemiseDeeply res_ty $ \ res_ty -> + ; expr' <- tcSkolemiseExpr res_ty $ \ res_ty -> tcExpr expr res_ty ; return (L loc expr') } @@ -210,7 +210,7 @@ tcExpr (ExprWithTySig expr sig_ty wcs) res_ty ; tcExtendTyVarEnv nwc_tvs $ do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty ; (gen_fn, expr') - <- tcSkolemise SkolemiseTop ExprSigCtxt sig_tc_ty $ + <- tcSkolemise ExprSigCtxt sig_tc_ty $ \ skol_tvs res_ty -> -- Remember to extend the lexical type-variable environment; @@ -1571,12 +1571,11 @@ checkMissingFields data_con rbinds -- | Convenient wrapper for skolemising a type during typechecking an expression. -- Always does uses a 'GenSigCtxt'. -tcSkolemiseExpr :: SkolemiseMode - -> TcSigmaType +tcSkolemiseExpr :: TcSigmaType -> (TcRhoType -> TcM (HsExpr TcId)) -> (TcM (HsExpr TcId)) -tcSkolemiseExpr mode res_ty thing_inside - = do { (wrap, expr) <- tcSkolemise mode GenSigCtxt res_ty $ +tcSkolemiseExpr res_ty thing_inside + = do { (wrap, expr) <- tcSkolemise GenSigCtxt res_ty $ \_ rho -> thing_inside rho ; return (mkHsWrap wrap expr) } diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index a5410a9..58b68a8 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -79,7 +79,7 @@ tcMatchesFun fun_name inf matches exp_ty ; checkArgs fun_name matches ; (wrap_gen, (wrap_fun, group)) - <- tcSkolemise SkolemiseDeeply (FunSigCtxt fun_name True) exp_ty $ + <- tcSkolemise (FunSigCtxt fun_name True) exp_ty $ \ _ exp_rho -> -- Note [Polymorphic expected type for tcMatchesFun] matchFunTys herald arity exp_rho $ \ pat_tys rhs_ty -> diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index d863338..021139f 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -10,7 +10,7 @@ Type subsumption and unification module TcUnify ( -- Full-blown subsumption - tcWrapResult, tcSkolemise, SkolemiseMode(..), + tcWrapResult, tcSkolemise, tcSubTypeHR, tcSubType, tcSubType_NC, tcSubTypeDS, tcSubTypeDS_NC, checkConstraints, @@ -87,7 +87,7 @@ exposeRhoType :: ExpOrAct -> TcSigmaType -> TcM (HsWrapper, a) exposeRhoType Expected ty thing_inside = do { (wrap1, (wrap2, result)) <- - tcSkolemise SkolemiseTop GenSigCtxt ty $ \_ -> thing_inside + tcSkolemise GenSigCtxt ty $ \_ -> thing_inside ; return (wrap1 <.> wrap2, result) } exposeRhoType (Actual orig) ty thing_inside = do { (wrap1, rho) <- topInstantiate orig ty @@ -645,7 +645,7 @@ tc_sub_type origin ctxt ty_actual ty_expected uType origin ty_actual ty_expected } | otherwise -- See Note [Deep skolemisation] - = do { (sk_wrap, inner_wrap) <- tcSkolemise SkolemiseDeeply ctxt ty_expected $ + = do { (sk_wrap, inner_wrap) <- tcSkolemise ctxt ty_expected $ \ _ sk_rho -> tc_sub_type_ds origin ctxt ty_actual sk_rho ; return (sk_wrap <.> inner_wrap) } @@ -759,20 +759,17 @@ tcInfer tc_check -- | Take an "expected type" and strip off quantifiers to expose the -- type underneath, binding the new skolems for the @thing_inside at . --- The 'SkolemiseMode' parameter tells 'tcSkolemise' which quantifiers --- to skolemise. The returned 'HsWrapper' has type --- @specific_ty -> expected_ty at . -tcSkolemise :: SkolemiseMode - -> UserTypeCtxt -> TcSigmaType +-- The returned 'HsWrapper' has type @specific_ty -> expected_ty at . +tcSkolemise :: UserTypeCtxt -> TcSigmaType -> ([TcTyVar] -> TcType -> TcM result) -> TcM (HsWrapper, result) -- The expression has type: spec_ty -> expected_ty -tcSkolemise mode ctxt expected_ty thing_inside +tcSkolemise ctxt expected_ty thing_inside -- We expect expected_ty to be a forall-type -- If not, the call is a no-op = do { traceTc "tcSkolemise" Outputable.empty - ; (wrap, tvs', given, rho') <- skolemise mode expected_ty + ; (wrap, tvs', given, rho') <- deeplySkolemise expected_ty ; when debugIsOn $ traceTc "tcSkolemise" $ vcat [ From git at git.haskell.org Fri Aug 7 12:05:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:16 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Imported ids without signatures are still inferred. (0dbc250) Message-ID: <20150807120516.E4B9E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/0dbc250d06dd349607ec905f61b5f9401246a00a/ghc >--------------------------------------------------------------- commit 0dbc250d06dd349607ec905f61b5f9401246a00a Author: Richard Eisenberg Date: Thu Jul 9 20:08:47 2015 -0400 Imported ids without signatures are still inferred. >--------------------------------------------------------------- 0dbc250d06dd349607ec905f61b5f9401246a00a compiler/basicTypes/Id.hs | 37 ++++++++++---------- compiler/basicTypes/IdInfo.hs | 51 +++++++++++++++++++++------- compiler/basicTypes/Name.hs | 7 +++- compiler/basicTypes/Var.hs | 12 +++++-- compiler/coreSyn/CoreTidy.hs | 4 +-- compiler/coreSyn/CoreUtils.hs | 2 +- compiler/coreSyn/MkCore.hs | 2 +- compiler/deSugar/DsBinds.hs | 6 ++-- compiler/deSugar/DsExpr.hs | 2 +- compiler/deSugar/DsMeta.hs | 4 +-- compiler/ghci/ByteCodeGen.hs | 2 +- compiler/iface/IfaceSyn.hs | 32 ++++++++++------- compiler/iface/IfaceType.hs | 12 ++++--- compiler/iface/MkIface.hs | 8 +++-- compiler/iface/TcIface.hs | 27 ++++++++------- compiler/simplCore/OccurAnal.hs | 2 +- compiler/simplCore/SetLevels.hs | 2 +- compiler/simplCore/SimplUtils.hs | 2 +- compiler/simplCore/Simplify.hs | 2 +- compiler/specialise/SpecConstr.hs | 2 +- compiler/specialise/Specialise.hs | 15 ++++---- compiler/typecheck/TcArrows.hs | 4 +-- compiler/typecheck/TcBinds.hs | 8 ++--- compiler/typecheck/TcEnv.hs | 2 +- compiler/typecheck/TcExpr.hs | 4 +-- compiler/typecheck/TcForeign.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 9 ++--- compiler/typecheck/TcInstDcls.hs | 6 ++-- compiler/typecheck/TcMType.hs | 6 ++-- compiler/typecheck/TcMatches.hs | 6 ++-- compiler/typecheck/TcPat.hs | 8 +++-- compiler/typecheck/TcPatSyn.hs | 4 +-- compiler/typecheck/TcRnDriver.hs | 4 +-- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRules.hs | 5 ++- compiler/typecheck/TcTyClsDecls.hs | 4 +-- compiler/typecheck/TcType.hs | 16 +++++++++ compiler/vectorise/Vectorise/Monad/Naming.hs | 6 ++-- 38 files changed, 199 insertions(+), 130 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 0dbc250d06dd349607ec905f61b5f9401246a00a From git at git.haskell.org Fri Aug 7 12:05:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:19 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Suggest TypeApplications when it's off (b771c62) Message-ID: <20150807120519.C01AE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/b771c627f4e0f698e1a71aa29b6cf19efe694962/ghc >--------------------------------------------------------------- commit b771c627f4e0f698e1a71aa29b6cf19efe694962 Author: Richard Eisenberg Date: Thu Jul 9 21:01:28 2015 -0400 Suggest TypeApplications when it's off >--------------------------------------------------------------- b771c627f4e0f698e1a71aa29b6cf19efe694962 compiler/rename/RnExpr.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 4a48b06..e154142 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1352,7 +1352,8 @@ sectionErr expr patSynErr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars) patSynErr e = do { addErr (sep [ptext (sLit "Pattern syntax in expression context:"), - nest 4 (ppr e)]) + nest 4 (ppr e)] $$ + text "Did you mean to enable TypeApplications?") ; return (EWildPat, emptyFVs) } badIpBinds :: Outputable a => SDoc -> a -> SDoc From git at git.haskell.org Fri Aug 7 12:05:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:22 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Support wildcards in type applications (de20454) Message-ID: <20150807120522.9E7A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/de20454b97f1261a46be24701dbe19e3da05e0cc/ghc >--------------------------------------------------------------- commit de20454b97f1261a46be24701dbe19e3da05e0cc Author: Richard Eisenberg Date: Thu Jul 9 21:46:54 2015 -0400 Support wildcards in type applications >--------------------------------------------------------------- de20454b97f1261a46be24701dbe19e3da05e0cc compiler/deSugar/Coverage.hs | 2 +- compiler/hsSyn/HsExpr.hs | 7 ++++++- compiler/hsSyn/HsUtils.hs | 13 +++++++------ compiler/parser/Parser.y | 2 +- compiler/rename/RnExpr.hs | 6 +++--- compiler/typecheck/TcExpr.hs | 10 +++++----- compiler/typecheck/TcHsType.hs | 17 ++++++++++++++++- compiler/typecheck/TcHsType.hs-boot | 4 ++-- compiler/typecheck/TcType.hs | 2 ++ compiler/typecheck/TcUnify.hs | 6 +++--- compiler/typecheck/TcValidity.hs | 4 +++- testsuite/tests/typecheck/should_compile/Vta1.hs | 8 ++++---- 12 files changed, 53 insertions(+), 28 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc de20454b97f1261a46be24701dbe19e3da05e0cc From git at git.haskell.org Fri Aug 7 12:05:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:25 +0000 (UTC) Subject: [commit: ghc] wip/type-app: TypeApplications implies AllowAmbiguousTypes (db0f0a3) Message-ID: <20150807120525.82E093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/db0f0a382a1431b6eee92dbc574a690f24aa4085/ghc >--------------------------------------------------------------- commit db0f0a382a1431b6eee92dbc574a690f24aa4085 Author: Richard Eisenberg Date: Thu Jul 9 23:05:54 2015 -0400 TypeApplications implies AllowAmbiguousTypes >--------------------------------------------------------------- db0f0a382a1431b6eee92dbc574a690f24aa4085 compiler/main/DynFlags.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c05cb8f..966cf9f 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3273,6 +3273,8 @@ impliedXFlags , (Opt_DeriveTraversable, turnOn, Opt_DeriveFunctor) , (Opt_DeriveTraversable, turnOn, Opt_DeriveFoldable) + + , (Opt_TypeApplications, turnOn, Opt_AllowAmbiguousTypes) ] -- Note [Documenting optimisation flags] From git at git.haskell.org Fri Aug 7 12:05:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:28 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Propagate polytypes into if and case. (0dedbfa) Message-ID: <20150807120528.65B893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/0dedbfa0ae5695d9afad7e47afc4112fc0f23035/ghc >--------------------------------------------------------------- commit 0dedbfa0ae5695d9afad7e47afc4112fc0f23035 Author: Richard Eisenberg Date: Fri Jul 10 10:15:15 2015 -0400 Propagate polytypes into if and case. >--------------------------------------------------------------- 0dedbfa0ae5695d9afad7e47afc4112fc0f23035 compiler/typecheck/TcExpr.hs | 6 ++---- compiler/typecheck/TcMType.hs | 21 +++++++++++++++++++++ compiler/typecheck/TcMatches.hs | 11 ++++------- 3 files changed, 27 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index ca7cbc3..26ce358 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -456,12 +456,10 @@ tcExpr (HsIf Nothing pred b1 b2) res_ty -- Ordinary 'if' = do { pred' <- tcMonoExpr pred boolTy -- this forces the branches to be fully instantiated -- (See #10619) - ; tau_ty <- newFlexiTyVarTy openTypeKind - ; wrap <- tcSubTypeHR tau_ty res_ty - ; tau_ty <- zonkTcType tau_ty + ; tau_ty <- tauTvsForReturnTvs res_ty ; b1' <- tcMonoExpr b1 tau_ty ; b2' <- tcMonoExpr b2 tau_ty - ; return $ mkHsWrap wrap $ HsIf Nothing pred' b1' b2' } + ; tcWrapResult (HsIf Nothing pred' b1' b2') tau_ty res_ty } tcExpr (HsIf (Just fun) pred b1 b2) res_ty -- Note [Rebindable syntax for if] diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 4bf725f..01853dc 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -22,6 +22,7 @@ module TcMType ( newReturnTyVar, newReturnTyVarTy, newMetaKindVar, newMetaKindVars, mkTcTyVarName, cloneMetaTyVar, + tauTvsForReturnTvs, newMetaTyVar, readMetaTyVar, writeMetaTyVar, writeMetaTyVarRef, newMetaDetails, isFilledMetaTyVar, isUnfilledMetaTyVar, @@ -435,6 +436,26 @@ newReturnTyVar kind = newMetaTyVar ReturnTv kind newReturnTyVarTy :: Kind -> TcM TcType newReturnTyVarTy kind = TyVarTy <$> newReturnTyVar kind +-- | Replace all the ReturnTvs in a type with TauTvs. These types are +-- *not* then unified. The caller may wish to do that. No variables +-- are looked through here. Similarly, no synonyms are looked through, +-- as doing so won't expose more ReturnTvs. +tauTvsForReturnTvs :: TcType -> TcM TcType +tauTvsForReturnTvs = go emptyTvSubst + where + go env ty@(TyVarTy tv) + | isReturnTyVar tv = newFlexiTyVarTy (substTy env (tyVarKind tv)) + | otherwise = return $ substTy env ty + go env (AppTy ty1 ty2) = AppTy <$> go env ty1 <*> go env ty2 + go env (TyConApp tc tys) = TyConApp tc <$> mapM (go env) tys + go env (FunTy ty1 ty2) = FunTy <$> go env ty1 <*> go env ty2 + go env (ForAllTy tv ty) + = do { k <- go env (tyVarKind tv) + ; let tv' = setTyVarKind tv k + env' = extendTvSubst env tv (TyVarTy tv') + ; ForAllTy tv' <$> go env' ty } + go _ ty@(LitTy {}) = return ty + tcInstTyVars :: [TKVar] -> TcM (TvSubst, [TcTyVar]) -- Instantiate with META type variables -- Note that this works for a sequence of kind and type diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index fc3c18a..940679c 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -186,17 +186,14 @@ data TcMatchCtxt body -- c.f. TcStmtCtxt, also in this module tcMatches ctxt pat_tys rhs_ty group@(MG { mg_alts = matches, mg_origin = origin }) = ASSERT( not (null matches) ) -- Ensure that rhs_ty is filled in - do { (wrap, rhs_ty') <- + do { rhs_ty' <- if isSingletonMatchGroup group -- no need to monomorphise the RHS if there's only one - then return (idHsWrapper, rhs_ty) + then return rhs_ty -- TODO (RAE): Document this behavior. - else do { tau_ty <- newFlexiTyVarTy openTypeKind - ; wrap <- tcSubTypeDS GenSigCtxt tau_ty rhs_ty - ; tau_ty <- zonkTcType tau_ty - -- seems more efficient to zonk just once - ; return (wrap, tau_ty) } + else tauTvsForReturnTvs rhs_ty ; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty') matches + ; wrap <- tcSubTypeHR rhs_ty' rhs_ty ; return (wrap, MG { mg_alts = matches' , mg_arg_tys = pat_tys , mg_res_ty = rhs_ty' From git at git.haskell.org Fri Aug 7 12:05:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:31 +0000 (UTC) Subject: [commit: ghc] wip/type-app: bug in test case (fc39801) Message-ID: <20150807120531.5176F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/fc39801d98288fd13ea4b3d59485120f8efaa88d/ghc >--------------------------------------------------------------- commit fc39801d98288fd13ea4b3d59485120f8efaa88d Author: Richard Eisenberg Date: Fri Jul 10 12:47:48 2015 -0400 bug in test case >--------------------------------------------------------------- fc39801d98288fd13ea4b3d59485120f8efaa88d testsuite/tests/parser/should_compile/VtaParse.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/testsuite/tests/parser/should_compile/VtaParse.hs b/testsuite/tests/parser/should_compile/VtaParse.hs index b65ea53..b1cfd7d 100644 --- a/testsuite/tests/parser/should_compile/VtaParse.hs +++ b/testsuite/tests/parser/should_compile/VtaParse.hs @@ -30,10 +30,6 @@ n = MkN show foo :: Bool -> String foo = unMkN n @Bool -- Fails without parens! Not anymore! -boo = unMkN @Bool n --- boo :: Bool -> String --(compiler doesn't infer this type! It infers a -> String!) --- boo = unMkN (n @Bool) - (&&) :: Bool -> Bool -> Bool (b at True) && True = True _ && _ = False From git at git.haskell.org Fri Aug 7 12:05:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:34 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Add another test case (9370e6f) Message-ID: <20150807120534.8E2693A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/9370e6fcbdb3cdfc602a55d8cf5c59d57aab5762/ghc >--------------------------------------------------------------- commit 9370e6fcbdb3cdfc602a55d8cf5c59d57aab5762 Author: Richard Eisenberg Date: Fri Jul 10 12:48:39 2015 -0400 Add another test case >--------------------------------------------------------------- 9370e6fcbdb3cdfc602a55d8cf5c59d57aab5762 testsuite/tests/typecheck/should_compile/Vta2.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/Vta2.hs b/testsuite/tests/typecheck/should_compile/Vta2.hs new file mode 100644 index 0000000..2851b06 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/Vta2.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE RankNTypes, TypeApplications #-} + + +module Vta2 where + +checkIf :: Bool -> (forall a. a -> a) -> (Bool, Int) +checkIf _ = if True + then \f -> (f True, f 5) + else \f -> (f False, f @Int 3) + +checkCase :: Bool -> (forall a. a -> a) -> (Bool, Int) +checkCase _ = case True of + True -> \f -> (f True, f 5) + False -> \f -> (f False, f @Int 3) From git at git.haskell.org Fri Aug 7 12:05:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:37 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Add new test to all.T (8b25c7a) Message-ID: <20150807120537.614C33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/8b25c7a6567df77b11b043cfb6bebdf5583ae24b/ghc >--------------------------------------------------------------- commit 8b25c7a6567df77b11b043cfb6bebdf5583ae24b Author: Richard Eisenberg Date: Fri Jul 10 13:03:14 2015 -0400 Add new test to all.T >--------------------------------------------------------------- 8b25c7a6567df77b11b043cfb6bebdf5583ae24b testsuite/tests/typecheck/should_compile/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index a938b81..98a2e73 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -466,3 +466,4 @@ test('RepArrow', normal, compile, ['']) test('T10562', normal, compile, ['']) test('T10564', normal, compile, ['']) test('Vta1', normal, compile, ['']) +test('Vta2', normal, compile, ['']) From git at git.haskell.org Fri Aug 7 12:05:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:40 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Fix bug in TcLambdaCase (ceea8af) Message-ID: <20150807120540.55F803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/ceea8afc2392569d551ad2538cb9d8c3c6caff16/ghc >--------------------------------------------------------------- commit ceea8afc2392569d551ad2538cb9d8c3c6caff16 Author: Richard Eisenberg Date: Wed Jul 15 13:23:56 2015 -0400 Fix bug in TcLambdaCase >--------------------------------------------------------------- ceea8afc2392569d551ad2538cb9d8c3c6caff16 compiler/typecheck/TcEvidence.hs | 5 ++++- compiler/typecheck/TcExpr.hs | 3 ++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 299e6a2..0848008 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -595,7 +595,10 @@ WpHole <.> c = c c <.> WpHole = c c1 <.> c2 = c1 `WpCompose` c2 -mkWpFun :: HsWrapper -> HsWrapper -> TcType -> TcType -> HsWrapper +mkWpFun :: HsWrapper -> HsWrapper + -> TcType -- the "from" type of the first wrapper + -> TcType -- the "to" type of the second wrapper + -> HsWrapper mkWpFun WpHole WpHole _ _ = WpHole mkWpFun WpHole (WpCast co2) t1 _ = WpCast (mkTcFunCo Representational (mkTcRepReflCo t1) co2) mkWpFun (WpCast co1) WpHole _ t2 = WpCast (mkTcFunCo Representational (mkTcSymCo co1) (mkTcRepReflCo t2)) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 26ce358..d93f5ba 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -200,7 +200,8 @@ tcExpr e@(HsLamCase _ matches) res_ty = do {(wrap1, [arg_ty], body_ty) <- matchExpectedFunTys Expected msg 1 res_ty ; (wrap2, matches') <- tcMatchesCase match_ctxt arg_ty matches body_ty - ; return $ mkHsWrap (wrap1 <.> wrap2) $ HsLamCase arg_ty matches' } + ; return $ mkHsWrap (wrap1 <.> mkWpFun idHsWrapper wrap2 arg_ty body_ty) $ + HsLamCase arg_ty matches' } where msg = sep [ ptext (sLit "The function") <+> quotes (ppr e) , ptext (sLit "requires")] match_ctxt = MC { mc_what = CaseAlt, mc_body = tcBody } From git at git.haskell.org Fri Aug 7 12:05:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:43 +0000 (UTC) Subject: [commit: ghc] wip/type-app: New test (3c860c7) Message-ID: <20150807120543.2C1CD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/3c860c747e0148b0d530e66dd272eb29f0485e8e/ghc >--------------------------------------------------------------- commit 3c860c747e0148b0d530e66dd272eb29f0485e8e Author: Richard Eisenberg Date: Wed Jul 29 15:19:23 2015 -0400 New test >--------------------------------------------------------------- 3c860c747e0148b0d530e66dd272eb29f0485e8e testsuite/tests/typecheck/should_compile/all.T | 1 + 1 file changed, 1 insertion(+) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 98a2e73..0b014c4 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -467,3 +467,4 @@ test('T10562', normal, compile, ['']) test('T10564', normal, compile, ['']) test('Vta1', normal, compile, ['']) test('Vta2', normal, compile, ['']) +test('VtaInvis', normal, compile, ['']) From git at git.haskell.org Fri Aug 7 12:05:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:46 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Instantiate when inferring types (a0453c1) Message-ID: <20150807120546.108D23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/a0453c12e878f402e594dd1b2459cac67e0ca10e/ghc >--------------------------------------------------------------- commit a0453c12e878f402e594dd1b2459cac67e0ca10e Author: Richard Eisenberg Date: Wed Jul 29 15:19:38 2015 -0400 Instantiate when inferring types >--------------------------------------------------------------- a0453c12e878f402e594dd1b2459cac67e0ca10e compiler/deSugar/DsBinds.hs | 29 ++++++---- compiler/hsSyn/HsBinds.hs | 36 ++++++++++--- compiler/typecheck/TcBinds.hs | 113 +++++++++++++++++++++++++++++++-------- compiler/typecheck/TcClassDcl.hs | 9 ++-- compiler/typecheck/TcHsSyn.hs | 7 ++- compiler/typecheck/TcInstDcls.hs | 19 ++++--- 6 files changed, 161 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 a0453c12e878f402e594dd1b2459cac67e0ca10e From git at git.haskell.org Fri Aug 7 12:05:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:48 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Avoid unnecessary call to tcSubType (fff3d43) Message-ID: <20150807120548.E6A623A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/fff3d4388a14e45ae302df7d6368a0956fd34464/ghc >--------------------------------------------------------------- commit fff3d4388a14e45ae302df7d6368a0956fd34464 Author: Richard Eisenberg Date: Wed Jul 29 15:41:06 2015 -0400 Avoid unnecessary call to tcSubType The unnecessary call resulted in an unexpected ambiguity check. >--------------------------------------------------------------- fff3d4388a14e45ae302df7d6368a0956fd34464 compiler/deSugar/DsBinds.hs | 2 +- compiler/typecheck/TcMatches.hs | 15 ++++++++------- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index da1a014..a17f710 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -145,11 +145,11 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts ; let core_bind = Rec (fromOL bind_prs) ; ds_binds <- dsTcEvBinds_s ev_binds ; inner_rhs <- dsHsWrapper inst_wrap $ - mkCoreLets ds_binds $ Let core_bind $ Var local ; rhs <- dsHsWrapper wrap $ -- Usually the identity mkLams tyvars $ mkLams dicts $ + mkCoreLets ds_binds $ inner_rhs ; (spec_binds, rules) <- dsSpecs rhs prags diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index 940679c..d635c54 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -186,14 +186,15 @@ data TcMatchCtxt body -- c.f. TcStmtCtxt, also in this module tcMatches ctxt pat_tys rhs_ty group@(MG { mg_alts = matches, mg_origin = origin }) = ASSERT( not (null matches) ) -- Ensure that rhs_ty is filled in - do { rhs_ty' <- + do { (matches', wrap, rhs_ty') <- if isSingletonMatchGroup group - -- no need to monomorphise the RHS if there's only one - then return rhs_ty - -- TODO (RAE): Document this behavior. - else tauTvsForReturnTvs rhs_ty - ; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty') matches - ; wrap <- tcSubTypeHR rhs_ty' rhs_ty + then do { matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches + ; return (matches', idHsWrapper, rhs_ty) } + else do { rhs_ty' <- tauTvsForReturnTvs rhs_ty + -- TODO (RAE): Document this behavior. + ; matches' <- mapM (tcMatch ctxt pat_tys rhs_ty') matches + ; wrap <- tcSubTypeHR rhs_ty' rhs_ty + ; return (matches', wrap, rhs_ty') } ; return (wrap, MG { mg_alts = matches' , mg_arg_tys = pat_tys , mg_res_ty = rhs_ty' From git at git.haskell.org Fri Aug 7 12:05:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:51 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Instantiate scrutinees. (ec34019) Message-ID: <20150807120551.CF1A13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/ec3401941ebc47b6906061df3a3f8bd7a888d07f/ghc >--------------------------------------------------------------- commit ec3401941ebc47b6906061df3a3f8bd7a888d07f Author: Richard Eisenberg Date: Wed Jul 29 15:49:39 2015 -0400 Instantiate scrutinees. >--------------------------------------------------------------- ec3401941ebc47b6906061df3a3f8bd7a888d07f compiler/typecheck/TcExpr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index d93f5ba..83919fe 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -444,7 +444,7 @@ tcExpr (HsCase scrut matches) exp_ty -- -- But now, in the GADT world, we need to typecheck the scrutinee -- first, to get type info that may be refined in the case alternatives - (scrut', scrut_ty) <- tcInferSigma scrut + (scrut', scrut_ty) <- tcInferRho scrut ; traceTc "HsCase" (ppr scrut_ty) ; (wrap, matches') <- tcMatchesCase match_ctxt scrut_ty matches exp_ty From git at git.haskell.org Fri Aug 7 12:05:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:54 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Fix broken test code (572d846) Message-ID: <20150807120554.CB2DB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/572d8461727d035d030d043ae58377f69524af08/ghc >--------------------------------------------------------------- commit 572d8461727d035d030d043ae58377f69524af08 Author: Richard Eisenberg Date: Wed Jul 29 17:03:18 2015 -0400 Fix broken test code >--------------------------------------------------------------- 572d8461727d035d030d043ae58377f69524af08 testsuite/tests/rts/T9045.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testsuite/tests/rts/T9045.hs b/testsuite/tests/rts/T9045.hs index 1e581ef..f52db46 100644 --- a/testsuite/tests/rts/T9045.hs +++ b/testsuite/tests/rts/T9045.hs @@ -14,7 +14,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 Fri Aug 7 12:05:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:05:57 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Use a Flexi, not a ReturnTv, when checking seq. (ae0cbcc) Message-ID: <20150807120557.BD41C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/ae0cbcc78f797d11af5e728e05ae03b3a8b19cf2/ghc >--------------------------------------------------------------- commit ae0cbcc78f797d11af5e728e05ae03b3a8b19cf2 Author: Richard Eisenberg Date: Wed Jul 29 17:16:38 2015 -0400 Use a Flexi, not a ReturnTv, when checking seq. >--------------------------------------------------------------- ae0cbcc78f797d11af5e728e05ae03b3a8b19cf2 compiler/typecheck/TcExpr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 83919fe..5505bb0 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1291,7 +1291,7 @@ tcSeq loc fun_name args res_ty -> do { ty_arg1 <- tcHsTypeApp hs_ty_arg1 liftedTypeKind ; return (ty_arg1, args1) } - _ -> do { arg_ty1 <- newReturnTyVarTy liftedTypeKind + _ -> do { arg_ty1 <- newFlexiTyVarTy liftedTypeKind ; return (arg_ty1, args) } ; (arg1, arg2) <- case args1 of From git at git.haskell.org Fri Aug 7 12:06:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:00 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Start toward tracking origins better (9ea7393) Message-ID: <20150807120600.A597E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/9ea73932c60253bfbfb2374c4b31fcdb63a6cb02/ghc >--------------------------------------------------------------- commit 9ea73932c60253bfbfb2374c4b31fcdb63a6cb02 Author: Richard Eisenberg Date: Thu Jul 9 15:52:26 2015 -0400 Start toward tracking origins better >--------------------------------------------------------------- 9ea73932c60253bfbfb2374c4b31fcdb63a6cb02 compiler/typecheck/TcExpr.hs | 112 ++++++++++++++++++++-------------------- compiler/typecheck/TcRnTypes.hs | 8 ++- compiler/typecheck/TcUnify.hs | 13 +++-- 3 files changed, 70 insertions(+), 63 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 9ea73932c60253bfbfb2374c4b31fcdb63a6cb02 From git at git.haskell.org Fri Aug 7 12:06:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:03 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Propagate CtOrigins for better errors (26a8956) Message-ID: <20150807120603.C71713A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/26a8956d864eb4d3b886f821dbb92fd066fa9fc9/ghc >--------------------------------------------------------------- commit 26a8956d864eb4d3b886f821dbb92fd066fa9fc9 Author: Richard Eisenberg Date: Tue Aug 4 11:47:18 2015 -0400 Propagate CtOrigins for better errors >--------------------------------------------------------------- 26a8956d864eb4d3b886f821dbb92fd066fa9fc9 compiler/hsSyn/HsExpr.hs | 8 +- compiler/typecheck/TcArrows.hs | 12 ++- compiler/typecheck/TcBinds.hs | 118 ++++++++++++-------- compiler/typecheck/TcExpr.hs | 204 +++++++++++++++++++++-------------- compiler/typecheck/TcExpr.hs-boot | 7 +- compiler/typecheck/TcMatches.hs | 98 +++++++++-------- compiler/typecheck/TcMatches.hs-boot | 6 +- compiler/typecheck/TcPat.hs | 61 ++++++----- compiler/typecheck/TcRnTypes.hs | 26 ++++- compiler/typecheck/TcSplice.hs | 2 +- compiler/typecheck/TcUnify.hs | 43 +++++--- 11 files changed, 353 insertions(+), 232 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 26a8956d864eb4d3b886f821dbb92fd066fa9fc9 From git at git.haskell.org Fri Aug 7 12:06:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:06 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Improve error messages (d51f42b) Message-ID: <20150807120606.A4C4B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/d51f42b87d2a9af0277a3c2100cc0f853426019f/ghc >--------------------------------------------------------------- commit d51f42b87d2a9af0277a3c2100cc0f853426019f Author: Richard Eisenberg Date: Tue Aug 4 21:34:41 2015 -0400 Improve error messages >--------------------------------------------------------------- d51f42b87d2a9af0277a3c2100cc0f853426019f compiler/typecheck/TcBinds.hs | 29 ++++++++-- compiler/typecheck/TcExpr.hs | 31 +++++----- compiler/typecheck/TcSplice.hs | 9 ++- compiler/typecheck/TcUnify.hs | 66 ++++++++++++++-------- .../tests/typecheck/should_fail/T10285.stderr | 14 ++--- .../tests/typecheck/should_fail/T10495.stderr | 7 +-- .../tests/typecheck/should_fail/T2846b.stderr | 4 +- 7 files changed, 100 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 d51f42b87d2a9af0277a3c2100cc0f853426019f From git at git.haskell.org Fri Aug 7 12:06:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:09 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Improve ddump-tc-trace in TcErrors (a4df09a) Message-ID: <20150807120609.9653C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/a4df09af7b78703fd38104b08efc5cf673eadd9d/ghc >--------------------------------------------------------------- commit a4df09af7b78703fd38104b08efc5cf673eadd9d Author: Richard Eisenberg Date: Tue Aug 4 21:36:45 2015 -0400 Improve ddump-tc-trace in TcErrors >--------------------------------------------------------------- a4df09af7b78703fd38104b08efc5cf673eadd9d compiler/typecheck/TcErrors.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 79f65c1..c16a64c 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1642,7 +1642,8 @@ relevantBindings want_filtering ctxt ct vcat [ ppr ct , pprCtOrigin (ctLocOrigin loc) , ppr ct_tvs - , ppr [id | TcIdBndr id _ <- tcl_bndrs lcl_env] ] + , pprWithCommas id [ ppr id <+> dcolon <+> ppr (idType id) + | TcIdBndr id _ <- tcl_bndrs lcl_env ] ] ; (tidy_env', docs, discards) <- go env1 ct_tvs (maxRelevantBinds dflags) From git at git.haskell.org Fri Aug 7 12:06:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:12 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Cleverly use a *landmark* context when it might be empty (4f46f9a) Message-ID: <20150807120612.6BDFB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/4f46f9a5c3f4e907cba24d7fb5742240ff6bb0a7/ghc >--------------------------------------------------------------- commit 4f46f9a5c3f4e907cba24d7fb5742240ff6bb0a7 Author: Richard Eisenberg Date: Tue Aug 4 22:04:45 2015 -0400 Cleverly use a *landmark* context when it might be empty >--------------------------------------------------------------- 4f46f9a5c3f4e907cba24d7fb5742240ff6bb0a7 compiler/typecheck/TcExpr.hs | 65 +++++++++++++++++++++++------------------ compiler/typecheck/TcRnMonad.hs | 14 ++++++++- 2 files changed, 49 insertions(+), 30 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index fad8485..3d07539 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -44,7 +44,6 @@ import Type import TcEvidence import Var import VarSet -import VarEnv import TysWiredIn import TysPrim( intPrimTy, addrPrimTy ) import PrimOp( tagToEnumKey ) @@ -54,7 +53,6 @@ import SrcLoc import Util import ListSetOps import Maybes -import ErrUtils import Outputable import FastString import Control.Monad @@ -996,7 +994,7 @@ tcApp m_herald orig_fun orig_args res_ty -- Both actual_res_ty and res_ty are deeply skolemised -- Rather like tcWrapResult, but (perhaps for historical reasons) -- we do this before typechecking the arguments - ; wrap_res <- addErrCtxtM (funResCtxt True (unLoc fun) actual_res_ty res_ty) $ + ; wrap_res <- addFunResCtxt True (unLoc fun) actual_res_ty res_ty $ tcSubTypeDS_NC GenSigCtxt actual_res_ty res_ty -- Typecheck the arguments @@ -1167,7 +1165,7 @@ tcCheckId :: Name -> TcRhoType -> TcM (HsExpr TcId) tcCheckId name res_ty = do { (expr, actual_res_ty) <- tcInferId name ; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty]) - ; addErrCtxtM (funResCtxt False (HsVar name) actual_res_ty res_ty) $ + ; addFunResCtxt False (HsVar name) actual_res_ty res_ty $ fst <$> tcWrapResult expr actual_res_ty res_ty (OccurrenceOf name) } ------------------------ @@ -1642,36 +1640,45 @@ funAppCtxt fun arg arg_no quotes (ppr fun) <> text ", namely"]) 2 (quotes (ppr arg)) -funResCtxt :: Bool -- There is at least one argument - -> HsExpr Name -> TcType -> TcType - -> TidyEnv -> TcM (TidyEnv, MsgDoc) +addFunResCtxt :: Bool -- There is at least one argument + -> HsExpr Name -> TcType -> TcType + -> TcM a -> TcM a -- When we have a mis-match in the return type of a function -- try to give a helpful message about too many/few arguments -- -- Used for naked variables too; but with has_args = False -funResCtxt has_args fun fun_res_ty env_ty tidy_env - = do { fun_res' <- zonkTcType fun_res_ty - ; env' <- zonkTcType env_ty - ; let (args_fun, res_fun) = tcSplitFunTys fun_res' - (args_env, res_env) = tcSplitFunTys env' - n_fun = length args_fun - n_env = length args_env - info | n_fun == n_env = Outputable.empty - | n_fun > n_env - , not_fun res_env = ptext (sLit "Probable cause:") <+> quotes (ppr fun) - <+> ptext (sLit "is applied to too few arguments") - | has_args - , not_fun res_fun = ptext (sLit "Possible cause:") <+> quotes (ppr fun) - <+> ptext (sLit "is applied to too many arguments") - | otherwise = Outputable.empty -- Never suggest that a naked variable is - -- applied to too many args! - ; return (tidy_env, info) } +addFunResCtxt has_args fun fun_res_ty env_ty + = addLandmarkErrCtxtM (\env -> (env, ) <$> mk_msg) + -- NB: use a landmark error context, so that an empty context + -- doesn't suppress some more useful context where - not_fun ty -- ty is definitely not an arrow type, - -- and cannot conceivably become one - = case tcSplitTyConApp_maybe ty of - Just (tc, _) -> isAlgTyCon tc - Nothing -> False + mk_msg + = do { fun_res' <- zonkTcType fun_res_ty + ; env' <- zonkTcType env_ty + ; let (args_fun, res_fun) = tcSplitFunTys fun_res' + (args_env, res_env) = tcSplitFunTys env' + n_fun = length args_fun + n_env = length args_env + info | n_fun == n_env = Outputable.empty + | n_fun > n_env + , not_fun res_env + = ptext (sLit "Probable cause:") <+> quotes (ppr fun) + <+> ptext (sLit "is applied to too few arguments") + + | has_args + , not_fun res_fun + = ptext (sLit "Possible cause:") <+> quotes (ppr fun) + <+> ptext (sLit "is applied to too many arguments") + + | otherwise + = Outputable.empty -- Never suggest that a naked variable is -- applied to too many args! + ; return info } + where + not_fun ty -- ty is definitely not an arrow type, + -- and cannot conceivably become one + = case tcSplitTyConApp_maybe ty of + Just (tc, _) -> isAlgTyCon tc + Nothing -> False badFieldTypes :: [(Name,TcType)] -> SDoc badFieldTypes prs diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index cf875e8..7b3ae75 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -939,14 +939,26 @@ getErrCtxt = do { env <- getLclEnv; return (tcl_ctxt env) } setErrCtxt :: [ErrCtxt] -> TcM a -> TcM a setErrCtxt ctxt = updLclEnv (\ env -> env { tcl_ctxt = ctxt }) +-- | Add a fixed message to the error context. This message should not +-- do any tidying. addErrCtxt :: MsgDoc -> TcM a -> TcM a addErrCtxt msg = addErrCtxtM (\env -> return (env, msg)) +-- | Add a message to the error context. This message may do tidying. addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, MsgDoc)) -> TcM a -> TcM a addErrCtxtM ctxt = updCtxt (\ ctxts -> (False, ctxt) : ctxts) +-- | Add a fixed landmark message to the error context. A landmark +-- message is always sure to be reported, even if there is a lot of +-- context. It also doesn't count toward the maximum number of contexts +-- reported. addLandmarkErrCtxt :: MsgDoc -> TcM a -> TcM a -addLandmarkErrCtxt msg = updCtxt (\ctxts -> (True, \env -> return (env,msg)) : ctxts) +addLandmarkErrCtxt msg = addLandmarkErrCtxtM (\env -> return (env, msg)) + +-- | Variant of 'addLandmarkErrCtxt' that allows for monadic operations +-- and tidying. +addLandmarkErrCtxtM :: (TidyEnv -> TcM (TidyEnv, MsgDoc)) -> TcM a -> TcM a +addLandmarkErrCtxtM ctxt = updCtxt (\ctxts -> (True, ctxt) : ctxts) -- Helper function for the above updCtxt :: ([ErrCtxt] -> [ErrCtxt]) -> TcM a -> TcM a From git at git.haskell.org Fri Aug 7 12:06:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:15 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (cf25338) Message-ID: <20150807120615.566433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/cf253385d1fc78777b74ba964414a4835a3a5949/ghc >--------------------------------------------------------------- commit cf253385d1fc78777b74ba964414a4835a3a5949 Author: Richard Eisenberg Date: Tue Aug 4 22:18:15 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- cf253385d1fc78777b74ba964414a4835a3a5949 testsuite/tests/typecheck/should_fail/T5095.stderr | 2 +- testsuite/tests/typecheck/should_fail/T5689.stderr | 2 ++ testsuite/tests/typecheck/should_fail/T5853.stderr | 2 +- testsuite/tests/typecheck/should_fail/T6022.stderr | 2 +- testsuite/tests/typecheck/should_fail/T7264.stderr | 1 + testsuite/tests/typecheck/should_fail/T7453.stderr | 28 +++++++++++++++------- testsuite/tests/typecheck/should_fail/T7734.stderr | 14 ++++++----- 7 files changed, 33 insertions(+), 18 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index 0cf8854..f7f8e93 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -1,5 +1,5 @@ -T5095.hs:9:11: +T5095.hs:9:9: error: Overlapping instances for Eq a arising from a use of ?==? Matching instances: instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31 diff --git a/testsuite/tests/typecheck/should_fail/T5689.stderr b/testsuite/tests/typecheck/should_fail/T5689.stderr index f8294f4..f5c71a0 100644 --- a/testsuite/tests/typecheck/should_fail/T5689.stderr +++ b/testsuite/tests/typecheck/should_fail/T5689.stderr @@ -6,3 +6,5 @@ T5689.hs:10:36: error: r :: IORef (t -> t) (bound at T5689.hs:7:14) In the expression: v In the expression: if v then False else True + In the second argument of ?writeIORef?, namely + ?(\ v -> if v then False else True)? diff --git a/testsuite/tests/typecheck/should_fail/T5853.stderr b/testsuite/tests/typecheck/should_fail/T5853.stderr index eb8f7b7..2bfee12 100644 --- a/testsuite/tests/typecheck/should_fail/T5853.stderr +++ b/testsuite/tests/typecheck/should_fail/T5853.stderr @@ -1,5 +1,5 @@ -T5853.hs:15:52: error: +T5853.hs:15:46: error: Could not deduce: Subst t1 (Elem t2) ~ t2 from the context: (F t0, Subst t0 (Elem t2) ~ t2, diff --git a/testsuite/tests/typecheck/should_fail/T6022.stderr b/testsuite/tests/typecheck/should_fail/T6022.stderr index acde64e..7593b12 100644 --- a/testsuite/tests/typecheck/should_fail/T6022.stderr +++ b/testsuite/tests/typecheck/should_fail/T6022.stderr @@ -1,5 +1,5 @@ -T6022.hs:3:9: error: +T6022.hs:3:7: error: No instance for (Eq ([a0] -> a0)) arising from a use of ?==? (maybe you haven't applied a function to enough arguments?) In the expression: x == head diff --git a/testsuite/tests/typecheck/should_fail/T7264.stderr b/testsuite/tests/typecheck/should_fail/T7264.stderr index 3ed15e9..7dd90a1 100644 --- a/testsuite/tests/typecheck/should_fail/T7264.stderr +++ b/testsuite/tests/typecheck/should_fail/T7264.stderr @@ -10,3 +10,4 @@ T7264.hs:13:19: error: mkFoo2 :: a0 -> Maybe Foo (bound at T7264.hs:13:1) In the first argument of ?mmap?, namely ?Foo? In the expression: mmap Foo (Just val) + In an equation for ?mkFoo2?: mkFoo2 val = mmap Foo (Just val) diff --git a/testsuite/tests/typecheck/should_fail/T7453.stderr b/testsuite/tests/typecheck/should_fail/T7453.stderr index c5383f1..0442983 100644 --- a/testsuite/tests/typecheck/should_fail/T7453.stderr +++ b/testsuite/tests/typecheck/should_fail/T7453.stderr @@ -1,6 +1,6 @@ T7453.hs:10:30: error: - Couldn't match expected type ?t? with actual type ?t0? + Couldn't match expected type ?t? with actual type ?r0? because type variable ?t? would escape its scope This (rigid, skolem) type variable is bound by the type signature for: z :: Id t @@ -8,13 +8,14 @@ T7453.hs:10:30: error: Relevant bindings include aux :: Id t (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) - v :: t0 (bound at T7453.hs:7:7) - cast1 :: t0 -> a0 (bound at T7453.hs:7:1) + v :: r0 (bound at T7453.hs:7:7) + cast1 :: r0 -> a0 (bound at T7453.hs:7:1) In the first argument of ?Id?, namely ?v? In the expression: Id v + In an equation for ?aux?: aux = Id v T7453.hs:16:33: error: - Couldn't match expected type ?t? with actual type ?t0? + Couldn't match expected type ?t? with actual type ?r0? because type variable ?t? would escape its scope This (rigid, skolem) type variable is bound by the type signature for: z :: () -> t @@ -22,13 +23,14 @@ T7453.hs:16:33: error: Relevant bindings include aux :: b0 -> t (bound at T7453.hs:16:21) z :: () -> t (bound at T7453.hs:15:11) - v :: t0 (bound at T7453.hs:13:7) - cast2 :: t0 -> t1 (bound at T7453.hs:13:1) + v :: r0 (bound at T7453.hs:13:7) + cast2 :: r0 -> t0 (bound at T7453.hs:13:1) In the first argument of ?const?, namely ?v? In the expression: const v + In an equation for ?aux?: aux = const v T7453.hs:21:15: error: - Couldn't match expected type ?t? with actual type ?t0? + Couldn't match expected type ?t? with actual type ?r0? because type variable ?t? would escape its scope This (rigid, skolem) type variable is bound by the type signature for: z :: t @@ -36,10 +38,18 @@ T7453.hs:21:15: error: Relevant bindings include aux :: forall b0. b0 -> t (bound at T7453.hs:22:21) z :: t (bound at T7453.hs:21:11) - v :: t0 (bound at T7453.hs:19:7) - cast3 :: t0 -> t1 (bound at T7453.hs:19:1) + v :: r0 (bound at T7453.hs:19:7) + cast3 :: r0 -> forall t. t (bound at T7453.hs:19:1) In the expression: v In an equation for ?z?: z = v where aux = const v + In an equation for ?cast3?: + cast3 v + = z + where + z :: t + z = v + where + aux = const v diff --git a/testsuite/tests/typecheck/should_fail/T7734.stderr b/testsuite/tests/typecheck/should_fail/T7734.stderr index ae19834..2c7c620 100644 --- a/testsuite/tests/typecheck/should_fail/T7734.stderr +++ b/testsuite/tests/typecheck/should_fail/T7734.stderr @@ -1,16 +1,18 @@ T7734.hs:4:13: error: - Occurs check: cannot construct the infinite type: t2 ~ t2 -> t1 + Occurs check: cannot construct the infinite type: r2 ~ r2 -> r1 Relevant bindings include - x :: t2 -> t1 (bound at T7734.hs:4:1) - f :: (t2 -> t1) -> t0 -> t1 (bound at T7734.hs:4:1) + x :: r2 -> r1 (bound at T7734.hs:4:1) + f :: (r2 -> r1) -> r0 -> r1 (bound at T7734.hs:4:1) In the first argument of ?x?, namely ?x? In the expression: x x + In an equation for ?f?: x `f` y = x x T7734.hs:5:13: error: - Occurs check: cannot construct the infinite type: t2 ~ t2 -> t1 + Occurs check: cannot construct the infinite type: r2 ~ r2 -> r1 Relevant bindings include - x :: t2 -> t1 (bound at T7734.hs:5:5) - (&) :: (t2 -> t1) -> t0 -> t1 (bound at T7734.hs:5:1) + x :: r2 -> r1 (bound at T7734.hs:5:5) + (&) :: (r2 -> r1) -> r0 -> r1 (bound at T7734.hs:5:1) In the first argument of ?x?, namely ?x? In the expression: x x + In an equation for ?&?: (&) x y = x x From git at git.haskell.org Fri Aug 7 12:06:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:18 +0000 (UTC) Subject: [commit: ghc] wip/type-app: More error improving (44b5d1d) Message-ID: <20150807120618.3239E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/44b5d1d76084643038d39f1d25ca162a572e95c2/ghc >--------------------------------------------------------------- commit 44b5d1d76084643038d39f1d25ca162a572e95c2 Author: Richard Eisenberg Date: Tue Aug 4 22:23:30 2015 -0400 More error improving >--------------------------------------------------------------- 44b5d1d76084643038d39f1d25ca162a572e95c2 compiler/typecheck/TcExpr.hs | 6 ++++-- testsuite/tests/typecheck/should_fail/T7851.stderr | 6 +++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 3d07539..c9776b9 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -1655,8 +1655,10 @@ addFunResCtxt has_args fun fun_res_ty env_ty mk_msg = do { fun_res' <- zonkTcType fun_res_ty ; env' <- zonkTcType env_ty - ; let (args_fun, res_fun) = tcSplitFunTys fun_res' - (args_env, res_env) = tcSplitFunTys env' + ; let (_, _, fun_tau) = tcSplitSigmaTy fun_res' + (_, _, env_tau) = tcSplitSigmaTy env' + (args_fun, res_fun) = tcSplitFunTys fun_tau + (args_env, res_env) = tcSplitFunTys env_tau n_fun = length args_fun n_env = length args_env info | n_fun == n_env = Outputable.empty diff --git a/testsuite/tests/typecheck/should_fail/T7851.stderr b/testsuite/tests/typecheck/should_fail/T7851.stderr index 6414851..8dee324 100644 --- a/testsuite/tests/typecheck/should_fail/T7851.stderr +++ b/testsuite/tests/typecheck/should_fail/T7851.stderr @@ -1,8 +1,12 @@ -T7851.hs:5:10: +T7851.hs:5:10: error: Couldn't match expected type ?IO a0? with actual type ?a1 -> IO ()? Probable cause: ?print? is applied to too few arguments In a stmt of a 'do' block: print In the expression: do { print; print "Hello" } + In an equation for ?bar?: + bar + = do { print; + print "Hello" } From git at git.haskell.org Fri Aug 7 12:06:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:21 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (cbcf289) Message-ID: <20150807120621.0CDC73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/cbcf28937bbb85e43ae2c951124d2d394a4328f8/ghc >--------------------------------------------------------------- commit cbcf28937bbb85e43ae2c951124d2d394a4328f8 Author: Richard Eisenberg Date: Tue Aug 4 22:38:11 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- cbcf28937bbb85e43ae2c951124d2d394a4328f8 testsuite/tests/typecheck/should_fail/T7857.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/T8262.stderr | 2 +- testsuite/tests/typecheck/should_fail/T8428.stderr | 8 +++----- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/T7857.stderr b/testsuite/tests/typecheck/should_fail/T7857.stderr index 4e046e8..cfacdfe 100644 --- a/testsuite/tests/typecheck/should_fail/T7857.stderr +++ b/testsuite/tests/typecheck/should_fail/T7857.stderr @@ -1,10 +1,10 @@ T7857.hs:8:11: error: - Could not deduce (PrintfType r0) arising from a use of ?printf? + Could not deduce (PrintfType a0) arising from a use of ?printf? from the context: PrintfArg t0 bound by the inferred type of g :: PrintfArg t0 => t0 -> b0 at T7857.hs:8:1-21 - The type variable ?r0? is ambiguous + The type variable ?a0? is ambiguous Note: there are several potential instances: instance [safe] (a ~ ()) => PrintfType (IO a) -- Defined in ?Text.Printf? diff --git a/testsuite/tests/typecheck/should_fail/T8262.stderr b/testsuite/tests/typecheck/should_fail/T8262.stderr index dade165..2b19f3a 100644 --- a/testsuite/tests/typecheck/should_fail/T8262.stderr +++ b/testsuite/tests/typecheck/should_fail/T8262.stderr @@ -5,7 +5,7 @@ T8262.hs:5:15: error: a0 :: * Int# :: # Relevant bindings include - foo :: t0 -> Maybe a0 (bound at T8262.hs:5:1) + foo :: r0 -> Maybe a0 (bound at T8262.hs:5:1) In the first argument of ?Just?, namely ?(1#)? In the expression: Just (1#) In an equation for ?foo?: foo x = Just (1#) diff --git a/testsuite/tests/typecheck/should_fail/T8428.stderr b/testsuite/tests/typecheck/should_fail/T8428.stderr index 49c20a5..8999cc1 100644 --- a/testsuite/tests/typecheck/should_fail/T8428.stderr +++ b/testsuite/tests/typecheck/should_fail/T8428.stderr @@ -1,10 +1,8 @@ -T8428.hs:11:19: - Couldn't match type ?(forall s. ST s) a? with ?forall s. ST s a? +T8428.hs:11:19: error: + Couldn't match type ?forall s1. ST s1? with ?ST s? Expected type: IdentityT (forall s. ST s) a -> forall s. ST s a Actual type: IdentityT (forall s. ST s) a -> (forall s. ST s) a - Relevant bindings include - runIdST :: IdentityT (forall s. ST s) a -> a - (bound at T8428.hs:11:1) In the second argument of ?(.)?, namely ?runIdentityT? In the expression: runST . runIdentityT + In an equation for ?runIdST?: runIdST = runST . runIdentityT From git at git.haskell.org Fri Aug 7 12:06:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:23 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Track full type better in matchExpectedFunTys (b08d21b) Message-ID: <20150807120623.D66DA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/b08d21bae713d3dbf5eef2d684b83ac7b4c98f9d/ghc >--------------------------------------------------------------- commit b08d21bae713d3dbf5eef2d684b83ac7b4c98f9d Author: Richard Eisenberg Date: Tue Aug 4 22:59:09 2015 -0400 Track full type better in matchExpectedFunTys >--------------------------------------------------------------- b08d21bae713d3dbf5eef2d684b83ac7b4c98f9d compiler/typecheck/TcUnify.hs | 52 +++++++++++++++++++++++++------------------ 1 file changed, 30 insertions(+), 22 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 510fff1..94dd813 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -205,15 +205,20 @@ match_fun_tys -- If allocated (fresh-meta-var1 -> fresh-meta-var2) and unified, we'd -- hide the forall inside a meta-variable -match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty +match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args id orig_ty where -- If go n ty = (co, [t1,..,tn], ty_r) -- then Actual: wrap : ty "->" (t1 -> .. -> tn -> ty_r) -- Expected: wrap : (t1 -> .. -> tn -> ty_r) "->" ty - go [] ty = return (idHsWrapper, [], ty) + go :: [Maybe (LHsExpr Name)] + -> (TcSigmaType -> TcSigmaType) + -- this goes from the "remainder type" to the full type + -> TcSigmaType -- the remainder of the type as we're processing + -> TcM (HsWrapper, [TcSigmaType], TcSigmaType) + go [] _ ty = return (idHsWrapper, [], ty) - go (arg:args) ty + go (arg:args) mk_full_ty ty | Just (Just hs_ty_arg) <- fmap isLHsTypeExpr_maybe arg = do { let origin = case ea of Expected -> panic "match_fun_tys" Actual orig -> orig @@ -225,7 +230,8 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty do { let kind = tyVarKind tv ; ty_arg <- tcHsTypeApp hs_ty_arg kind ; let insted_ty = substTyWith [tv] [ty_arg] inner_ty - ; (inner_wrap, arg_tys, res_ty) <- go args insted_ty + ; (inner_wrap, arg_tys, res_ty) + <- go args mk_full_ty insted_ty -- inner_wrap :: insted_ty "->" arg_tys -> res_ty ; let inst_wrap = mkWpTyApps [ty_arg] -- inst_wrap :: upsilon_ty "->" insted_ty @@ -233,32 +239,33 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty , arg_tys, res_ty ) } Nothing -> ty_app_err upsilon_ty (fst hs_ty_arg) } - go args ty + go args mk_full_ty ty | not (null tvs && null theta) = do { (wrap, (arg_tys, res_ty)) <- exposeRhoType ea ty $ \rho -> - do { (inner_wrap, arg_tys, res_ty) <- go args rho + do { (inner_wrap, arg_tys, res_ty) <- go args mk_full_ty rho ; return (inner_wrap, (arg_tys, res_ty)) } ; return (wrap, arg_tys, res_ty) } where (tvs, theta, _) = tcSplitSigmaTy ty - go args ty - | Just ty' <- tcView ty = go args ty' + go args mk_full_ty ty + | Just ty' <- tcView ty = go args mk_full_ty ty' - go (_arg:args) (FunTy arg_ty res_ty) + go (_arg:args) mk_full_ty (FunTy arg_ty res_ty) | not (isPredTy arg_ty) - = do { (wrap_res, tys, ty_r) <- go args res_ty + = do { let mk_full_ty' res_ty' = mk_full_ty (mkFunTy arg_ty res_ty') + ; (wrap_res, tys, ty_r) <- go args mk_full_ty' res_ty ; let rhs_ty = case ea of Expected -> res_ty Actual _ -> mkFunTys tys ty_r ; return ( mkWpFun idHsWrapper wrap_res arg_ty rhs_ty , arg_ty:tys, ty_r ) } - go args ty@(TyVarTy tv) + go args mk_full_ty ty@(TyVarTy tv) | ASSERT( isTcTyVar tv) isMetaTyVar tv = do { cts <- readMetaTyVar tv ; case cts of - Indirect ty' -> go args ty' + Indirect ty' -> go args mk_full_ty ty' Flexi -> defer args ty (isReturnTyVar tv) } -- In all other cases we bale out into ordinary unification @@ -276,8 +283,8 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty -- -- But in that case we add specialized type into error context -- anyway, because it may be useful. See also Trac #9605. - go args ty = addErrCtxtM mk_ctxt $ - defer args ty False + go args mk_full_ty ty = addErrCtxtM (mk_ctxt (mk_full_ty ty)) $ + defer args ty False ------------ -- If we decide that a ReturnTv (see Note [ReturnTv] in TcType) should @@ -306,18 +313,19 @@ match_fun_tys ea herald orig_fun orig_args orig_ty = go orig_args orig_ty , hang (text "I do not know enough about the function's type") 2 (ppr orig_ty) ] - mk_ctxt :: TidyEnv -> TcM (TidyEnv, MsgDoc) - mk_ctxt env = do { (env', ty) <- zonkTidyTcType env orig_ty - ; let (args, _) = tcSplitFunTys ty - n_actual = length args - (env'', orig_ty') = tidyOpenType env' orig_ty - ; return (env'', mk_msg orig_ty' ty n_actual) } + mk_ctxt :: TcSigmaType -> TidyEnv -> TcM (TidyEnv, MsgDoc) + mk_ctxt full_ty env + = do { (env', ty) <- zonkTidyTcType env full_ty + ; let (args, _) = tcSplitFunTys ty + n_actual = length args + (env'', full_ty') = tidyOpenType env' full_ty + ; return (env'', mk_msg full_ty' ty n_actual) } arity = length orig_args - mk_msg orig_ty ty n_args + mk_msg full_ty ty n_args = herald <+> speakNOf arity (text "argument") <> comma $$ if n_args == arity - then ptext (sLit "its type is") <+> quotes (pprType orig_ty) <> + then ptext (sLit "its type is") <+> quotes (pprType full_ty) <> comma $$ ptext (sLit "it is specialized to") <+> quotes (pprType ty) else sep [ptext (sLit "but its type") <+> quotes (pprType ty), From git at git.haskell.org Fri Aug 7 12:06:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:26 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibble (e6ebc5d) Message-ID: <20150807120626.BCD8F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/e6ebc5db45feee48e9e4929e0869347fa03258a4/ghc >--------------------------------------------------------------- commit e6ebc5db45feee48e9e4929e0869347fa03258a4 Author: Richard Eisenberg Date: Tue Aug 4 23:04:20 2015 -0400 Testsuite wibble >--------------------------------------------------------------- e6ebc5db45feee48e9e4929e0869347fa03258a4 testsuite/tests/typecheck/should_fail/T9109.stderr | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/T9109.stderr b/testsuite/tests/typecheck/should_fail/T9109.stderr index 5ad7601..187ccfe 100644 --- a/testsuite/tests/typecheck/should_fail/T9109.stderr +++ b/testsuite/tests/typecheck/should_fail/T9109.stderr @@ -1,14 +1,14 @@ T9109.hs:8:13: error: - Couldn't match expected type ?t0? with actual type ?Bool? - ?t0? is untouchable - inside the constraints: t1 ~ Bool + Couldn't match expected type ?r0? with actual type ?Bool? + ?r0? is untouchable + inside the constraints: t0 ~ Bool bound by a pattern with constructor: GBool :: G Bool, in an equation for ?foo? at T9109.hs:8:5-9 - ?t0? is a rigid type variable bound by - the inferred type of foo :: G t1 -> t0 at T9109.hs:8:1 + ?r0? is a rigid type variable bound by + the inferred type of foo :: G t0 -> r0 at T9109.hs:8:1 Possible fix: add a type signature for ?foo? - Relevant bindings include foo :: G t1 -> t0 (bound at T9109.hs:8:1) + Relevant bindings include foo :: G t0 -> r0 (bound at T9109.hs:8:1) In the expression: True In an equation for ?foo?: foo GBool = True From git at git.haskell.org Fri Aug 7 12:06:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:29 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Avoid expanding synonyms in tcSubType (977dab8) Message-ID: <20150807120629.9EA553A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/977dab880fe8a1c03d5fbcafd5cc5051db2f89a6/ghc >--------------------------------------------------------------- commit 977dab880fe8a1c03d5fbcafd5cc5051db2f89a6 Author: Richard Eisenberg Date: Tue Aug 4 23:14:35 2015 -0400 Avoid expanding synonyms in tcSubType >--------------------------------------------------------------- 977dab880fe8a1c03d5fbcafd5cc5051db2f89a6 compiler/typecheck/TcUnify.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 94dd813..764bb6a 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -696,16 +696,17 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected go ty_a ty_e | Just ty_a' <- tcView ty_a = go ty_a' ty_e | Just ty_e' <- tcView ty_e = go ty_a ty_e' - go ty_a@(TyVarTy tv_a) ty_e + go (TyVarTy tv_a) ty_e = do { lookup_res <- lookupTcTyVar tv_a ; case lookup_res of Filled ty_a' -> do { traceTc "tcSubTypeDS_NC_O following filled act meta-tyvar:" (ppr tv_a <+> text "-->" <+> ppr ty_a') ; tc_sub_type_ds eq_orig inst_orig ctxt ty_a' ty_e } - Unfilled _ -> coToHsWrapper <$> uType eq_orig ty_a ty_e } + Unfilled _ -> coToHsWrapper <$> unify } - go ty_a ty_e@(TyVarTy tv_e) + + go ty_a (TyVarTy tv_e) = do { dflags <- getDynFlags ; tclvl <- getTcLevel ; lookup_res <- lookupTcTyVar tv_e @@ -717,7 +718,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected Unfilled details | canUnifyWithPolyType dflags details && isTouchableMetaTyVar tclvl tv_e -- don't want skolems here - -> coToHsWrapper <$> uType eq_orig ty_a ty_e + -> coToHsWrapper <$> unify -- We've avoided instantiating ty_actual just in case ty_expected is -- polymorphic. But we've now assiduously determined that it is *not* @@ -725,7 +726,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected -- typecheck/should_compile/T4284. | otherwise -> do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_a - ; cow <- uType eq_orig rho_a ty_e + ; cow <- uType eq_orig rho_a ty_expected ; return (coToHsWrapper cow <.> wrap) } } go (FunTy act_arg act_res) (FunTy exp_arg exp_res) @@ -747,9 +748,12 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected ; return (body_wrap <.> in_wrap) } | otherwise -- Revert to unification - = do { cow <- uType eq_orig ty_a ty_e + = do { cow <- unify ; return (coToHsWrapper cow) } + -- use versions without synonyms expanded + unify = uType eq_orig ty_actual ty_expected + ----------------- tcWrapResult :: HsExpr TcId -> TcSigmaType -> TcRhoType -> CtOrigin -> TcM (HsExpr TcId, CtOrigin) From git at git.haskell.org Fri Aug 7 12:06:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:32 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (4379b94) Message-ID: <20150807120632.80DFF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/4379b948d57791847fcecf6c3b4da484ea6359a5/ghc >--------------------------------------------------------------- commit 4379b948d57791847fcecf6c3b4da484ea6359a5 Author: Richard Eisenberg Date: Wed Aug 5 08:03:18 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 4379b948d57791847fcecf6c3b4da484ea6359a5 .../tests/typecheck/should_fail/TcCoercibleFail.stderr | 4 ---- .../typecheck/should_fail/TcStaticPointersFail01.stderr | 3 ++- testsuite/tests/typecheck/should_fail/VtaFail.stderr | 2 +- testsuite/tests/typecheck/should_fail/mc19.stderr | 7 ++++--- testsuite/tests/typecheck/should_fail/mc21.stderr | 8 +++++--- testsuite/tests/typecheck/should_fail/mc22.stderr | 2 ++ testsuite/tests/typecheck/should_fail/mc25.stderr | 1 + testsuite/tests/typecheck/should_fail/tcfail001.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/tcfail007.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail010.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail014.stderr | 9 +++++---- testsuite/tests/typecheck/should_fail/tcfail016.stderr | 2 ++ testsuite/tests/typecheck/should_fail/tcfail029.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail032.stderr | 6 +++--- testsuite/tests/typecheck/should_fail/tcfail033.stderr | 1 + testsuite/tests/typecheck/should_fail/tcfail034.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail049.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail050.stderr | 2 +- testsuite/tests/typecheck/should_fail/tcfail065.stderr | 13 +++++++------ 19 files changed, 41 insertions(+), 33 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 4379b948d57791847fcecf6c3b4da484ea6359a5 From git at git.haskell.org Fri Aug 7 12:06:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:35 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Preserve yet more synonyms (720b6eb) Message-ID: <20150807120635.754293A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/720b6ebc64aa56dae7dc5528f63aee849c82832a/ghc >--------------------------------------------------------------- commit 720b6ebc64aa56dae7dc5528f63aee849c82832a Author: Richard Eisenberg Date: Wed Aug 5 08:16:58 2015 -0400 Preserve yet more synonyms >--------------------------------------------------------------- 720b6ebc64aa56dae7dc5528f63aee849c82832a compiler/typecheck/TcUnify.hs | 2 +- .../tests/typecheck/should_fail/tcfail068.stderr | 112 +++++++++++++-------- 2 files changed, 72 insertions(+), 42 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 764bb6a..7bee699 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -725,7 +725,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected -- polymorphic. So instantiate away. This is needed for e.g. test -- typecheck/should_compile/T4284. | otherwise - -> do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_a + -> do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual ; cow <- uType eq_orig rho_a ty_expected ; return (coToHsWrapper cow <.> wrap) } } diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr index d7c8ed7..1cb2b7f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr @@ -1,13 +1,13 @@ -tcfail068.hs:14:9: +tcfail068.hs:14:9: error: Couldn't match type ?s1? with ?s? - ?s1? is a rigid type variable bound by - a type expected by the context: ST s1 (IndTree s a) - at tcfail068.hs:13:9 - ?s? is a rigid type variable bound by - the type signature for: - itgen :: Constructed a => (Int, Int) -> a -> IndTree s a - at tcfail068.hs:11:10 + ?s1? is a rigid type variable bound by + a type expected by the context: ST s1 (IndTree s a) + at tcfail068.hs:13:9 + ?s? is a rigid type variable bound by + the type signature for: + itgen :: Constructed a => (Int, Int) -> a -> IndTree s a + at tcfail068.hs:11:10 Expected type: ST s1 (IndTree s a) Actual type: ST s1 (STArray s1 (Int, Int) a) Relevant bindings include @@ -16,17 +16,19 @@ tcfail068.hs:14:9: In the first argument of ?runST?, namely ?(newSTArray ((1, 1), n) x)? In the expression: runST (newSTArray ((1, 1), n) x) + In an equation for ?itgen?: + itgen n x = runST (newSTArray ((1, 1), n) x) -tcfail068.hs:19:21: +tcfail068.hs:19:21: error: Couldn't match type ?s? with ?s1? - ?s? is a rigid type variable bound by - the type signature for: - itiap :: Constructed a => - (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a - at tcfail068.hs:16:10 - ?s1? is a rigid type variable bound by - a type expected by the context: ST s1 (IndTree s a) - at tcfail068.hs:18:9 + ?s? is a rigid type variable bound by + the type signature for: + itiap :: Constructed a => + (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a + at tcfail068.hs:16:10 + ?s1? is a rigid type variable bound by + a type expected by the context: ST s1 (IndTree s a) + at tcfail068.hs:18:9 Expected type: STArray s1 (Int, Int) a Actual type: IndTree s a Relevant bindings include @@ -35,17 +37,20 @@ tcfail068.hs:19:21: (bound at tcfail068.hs:17:1) In the first argument of ?readSTArray?, namely ?arr? In the first argument of ?(>>=)?, namely ?readSTArray arr i? + In the first argument of ?runST?, namely + ?(readSTArray arr i + >>= \ val -> writeSTArray arr i (f val) >> return arr)? -tcfail068.hs:24:36: +tcfail068.hs:24:36: error: Couldn't match type ?s? with ?s1? - ?s? is a rigid type variable bound by - the type signature for: - itrap :: Constructed a => - ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a - at tcfail068.hs:23:10 - ?s1? is a rigid type variable bound by - a type expected by the context: ST s1 (IndTree s a) - at tcfail068.hs:24:29 + ?s? is a rigid type variable bound by + the type signature for: + itrap :: Constructed a => + ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a + at tcfail068.hs:23:10 + ?s1? is a rigid type variable bound by + a type expected by the context: ST s1 (IndTree s a) + at tcfail068.hs:24:29 Expected type: ST s1 (IndTree s a) Actual type: ST s (IndTree s a) Relevant bindings include @@ -59,23 +64,34 @@ tcfail068.hs:24:36: (bound at tcfail068.hs:24:1) In the first argument of ?runST?, namely ?(itrap' i k)? In the expression: runST (itrap' i k) + In an equation for ?itrap?: + itrap ((i, k), (j, l)) f arr + = runST (itrap' i k) + where + itrap' i k + = if k > l then return arr else (itrapsnd i k >> itrap' i (k + 1)) + itrapsnd i k + = if i > j then + return arr + else + (readSTArray arr (i, k) >>= \ val -> ...) -tcfail068.hs:36:46: +tcfail068.hs:36:46: error: Couldn't match type ?s? with ?s1? - ?s? is a rigid type variable bound by - the type signature for: - itrapstate :: Constructed b => - ((Int, Int), (Int, Int)) - -> (a -> b -> (a, b)) - -> ((Int, Int) -> c -> a) - -> (a -> c) - -> c - -> IndTree s b - -> (c, IndTree s b) - at tcfail068.hs:34:15 - ?s1? is a rigid type variable bound by - a type expected by the context: ST s1 (c, IndTree s b) - at tcfail068.hs:36:40 + ?s? is a rigid type variable bound by + the type signature for: + itrapstate :: Constructed b => + ((Int, Int), (Int, Int)) + -> (a -> b -> (a, b)) + -> ((Int, Int) -> c -> a) + -> (a -> c) + -> c + -> IndTree s b + -> (c, IndTree s b) + at tcfail068.hs:34:15 + ?s1? is a rigid type variable bound by + a type expected by the context: ST s1 (c, IndTree s b) + at tcfail068.hs:36:40 Expected type: ST s1 (c, IndTree s b) Actual type: ST s (c, IndTree s b) Relevant bindings include @@ -94,3 +110,17 @@ tcfail068.hs:36:46: (bound at tcfail068.hs:36:1) In the first argument of ?runST?, namely ?(itrapstate' i k s)? In the expression: runST (itrapstate' i k s) + In an equation for ?itrapstate?: + itrapstate ((i, k), (j, l)) f c d s arr + = runST (itrapstate' i k s) + where + itrapstate' i k s + = if k > l then + return (s, arr) + else + (itrapstatesnd i k s >>= \ (s, arr) -> ...) + itrapstatesnd i k s + = if i > j then + return (s, arr) + else + (readSTArray arr (i, k) >>= \ val -> ...) From git at git.haskell.org Fri Aug 7 12:06:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:38 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (fbb7ea9) Message-ID: <20150807120638.4907F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/fbb7ea9022fda9a807cd8e5adcf80860227a0b71/ghc >--------------------------------------------------------------- commit fbb7ea9022fda9a807cd8e5adcf80860227a0b71 Author: Richard Eisenberg Date: Wed Aug 5 08:31:09 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- fbb7ea9022fda9a807cd8e5adcf80860227a0b71 .../tests/typecheck/should_fail/tcfail076.stderr | 15 ++++++++------- .../tests/typecheck/should_fail/tcfail099.stderr | 7 ++++--- .../tests/typecheck/should_fail/tcfail103.stderr | 11 ++++++----- .../tests/typecheck/should_fail/tcfail104.stderr | 20 ++++++++++++-------- .../tests/typecheck/should_fail/tcfail123.stderr | 2 +- .../tests/typecheck/should_fail/tcfail133.stderr | 13 ++++++------- .../tests/typecheck/should_fail/tcfail140.stderr | 6 +++--- .../tests/typecheck/should_fail/tcfail143.stderr | 8 ++++---- .../tests/typecheck/should_fail/tcfail168.stderr | 8 +++++++- testsuite/tests/typecheck/should_fail/tcfail174.hs | 2 +- .../tests/typecheck/should_fail/tcfail174.stderr | 16 ++++++---------- .../tests/typecheck/should_fail/tcfail175.stderr | 10 +++++----- .../tests/typecheck/should_fail/tcfail178.stderr | 2 ++ .../tests/typecheck/should_fail/tcfail179.stderr | 17 +++++++++-------- .../tests/typecheck/should_fail/tcfail181.stderr | 2 +- .../tests/typecheck/should_fail/tcfail185.stderr | 8 +++++++- .../tests/typecheck/should_fail/tcfail191.stderr | 8 +++++--- .../tests/typecheck/should_fail/tcfail193.stderr | 7 ++++--- .../tests/typecheck/should_fail/tcfail198.stderr | 1 + 19 files changed, 92 insertions(+), 71 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc fbb7ea9022fda9a807cd8e5adcf80860227a0b71 From git at git.haskell.org Fri Aug 7 12:06:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:41 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Wibble to TypeEqOrigin for better errors (25aa251) Message-ID: <20150807120641.1EB773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/25aa2519b7ffed668bd1a22e80830865d8b4f840/ghc >--------------------------------------------------------------- commit 25aa2519b7ffed668bd1a22e80830865d8b4f840 Author: Richard Eisenberg Date: Wed Aug 5 08:36:00 2015 -0400 Wibble to TypeEqOrigin for better errors >--------------------------------------------------------------- 25aa2519b7ffed668bd1a22e80830865d8b4f840 compiler/typecheck/TcUnify.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 7bee699..7dbe72e 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -726,7 +726,9 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected -- typecheck/should_compile/T4284. | otherwise -> do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual - ; cow <- uType eq_orig rho_a ty_expected + ; cow <- unifyType rho_a ty_expected + -- NB: unifyType, not uType. We want to refresh + -- the TypeEqOrigin to use the inst'ed type ; return (coToHsWrapper cow <.> wrap) } } go (FunTy act_arg act_res) (FunTy exp_arg exp_res) From git at git.haskell.org Fri Aug 7 12:06:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:43 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (0dcce27) Message-ID: <20150807120643.D3D6E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/0dcce275899f5abdb1500422c9334ecde999e972/ghc >--------------------------------------------------------------- commit 0dcce275899f5abdb1500422c9334ecde999e972 Author: Richard Eisenberg Date: Wed Aug 5 08:36:20 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 0dcce275899f5abdb1500422c9334ecde999e972 .../tests/typecheck/should_fail/tcfail201.stderr | 11 ++++---- .../tests/typecheck/should_fail/tcfail204.stderr | 6 ++--- .../tests/typecheck/should_fail/tcfail206.stderr | 31 +++++++++++----------- .../tests/typecheck/should_fail/tcfail208.stderr | 2 +- 4 files changed, 26 insertions(+), 24 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/tcfail201.stderr b/testsuite/tests/typecheck/should_fail/tcfail201.stderr index 3e67742..ebcfa10 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail201.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail201.stderr @@ -1,11 +1,11 @@ tcfail201.hs:17:58: error: Couldn't match expected type ?a? with actual type ?HsDoc id0? - ?a? is a rigid type variable bound by - the type signature for: - gfoldl' :: (forall a1 b. c (a1 -> b) -> a1 -> c b) - -> (forall g. g -> c g) -> a -> c a - at tcfail201.hs:15:12 + ?a? is a rigid type variable bound by + the type signature for: + gfoldl' :: (forall a1 b. c (a1 -> b) -> a1 -> c b) + -> (forall g. g -> c g) -> a -> c a + at tcfail201.hs:15:12 Relevant bindings include hsDoc :: a (bound at tcfail201.hs:16:13) gfoldl' :: (forall a1 b. c (a1 -> b) -> a1 -> c b) @@ -13,3 +13,4 @@ tcfail201.hs:17:58: error: (bound at tcfail201.hs:16:1) In the first argument of ?z?, namely ?DocEmpty? In the expression: z DocEmpty + In a case alternative: DocEmpty -> z DocEmpty diff --git a/testsuite/tests/typecheck/should_fail/tcfail204.stderr b/testsuite/tests/typecheck/should_fail/tcfail204.stderr index e8ecfc0..057e191 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail204.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail204.stderr @@ -1,13 +1,13 @@ -tcfail204.hs:10:15: Warning: +tcfail204.hs:10:15: warning: Defaulting the following constraint(s) to type ?Double? (Fractional a0) arising from the literal ?6.3? at tcfail204.hs:10:15-17 (RealFrac a0) - arising from a use of ?ceiling? at tcfail204.hs:10:7-13 + arising from a use of ?ceiling? at tcfail204.hs:10:7-17 In the first argument of ?ceiling?, namely ?6.3? In the expression: ceiling 6.3 In an equation for ?foo?: foo = ceiling 6.3 -: +: error: Failing due to -Werror. diff --git a/testsuite/tests/typecheck/should_fail/tcfail206.stderr b/testsuite/tests/typecheck/should_fail/tcfail206.stderr index bd3d90d..988eaf6 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail206.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail206.stderr @@ -1,50 +1,51 @@ -tcfail206.hs:5:5: +tcfail206.hs:5:5: error: Couldn't match type ?Bool? with ?Int? Expected type: Bool -> (Int, Bool) - Actual type: Bool -> (Bool, Bool) + Actual type: Int -> (Int, Bool) In the expression: (, True) In an equation for ?a?: a = (, True) -tcfail206.hs:8:5: +tcfail206.hs:8:5: error: Couldn't match type ?(Integer, Int)? with ?Bool -> (Int, Bool)? Expected type: Int -> Bool -> (Int, Bool) Actual type: Int -> (Integer, Int) In the expression: (1,) In an equation for ?b?: b = (1,) -tcfail206.hs:11:5: +tcfail206.hs:11:5: error: Couldn't match type ?a? with ?Bool? - ?a? is a rigid type variable bound by - the type signature for: c :: a -> (a, Bool) at tcfail206.hs:10:6 + ?a? is a rigid type variable bound by + the type signature for: c :: a -> (a, Bool) at tcfail206.hs:10:6 Expected type: a -> (a, Bool) - Actual type: a -> (a, a) + Actual type: Bool -> (a, Bool) Relevant bindings include c :: a -> (a, Bool) (bound at tcfail206.hs:11:1) In the expression: (True || False,) In an equation for ?c?: c = (True || False,) -tcfail206.hs:14:5: +tcfail206.hs:14:5: error: Couldn't match type ?Bool? with ?Int? Expected type: Bool -> (# Int, Bool #) - Actual type: Bool -> (# Bool, Bool #) + Actual type: Int -> (# Int, Bool #) In the expression: (# , True #) In an equation for ?d?: d = (# , True #) -tcfail206.hs:17:5: +tcfail206.hs:17:5: error: Couldn't match type ?(# Integer, Int #)? - with ?Bool -> (# Int, Bool #)? + with ?Bool -> (# Int, Bool #)? Expected type: Int -> Bool -> (# Int, Bool #) Actual type: Int -> (# Integer, Int #) In the expression: (# 1, #) In an equation for ?e?: e = (# 1, #) -tcfail206.hs:20:5: +tcfail206.hs:20:5: error: Couldn't match type ?a? with ?Bool? - ?a? is a rigid type variable bound by - the type signature for: f :: a -> (# a, Bool #) at tcfail206.hs:19:6 + ?a? is a rigid type variable bound by + the type signature for: f :: a -> (# a, Bool #) + at tcfail206.hs:19:6 Expected type: a -> (# a, Bool #) - Actual type: a -> (# a, a #) + Actual type: Bool -> (# a, Bool #) Relevant bindings include f :: a -> (# a, Bool #) (bound at tcfail206.hs:20:1) In the expression: (# True || False, #) diff --git a/testsuite/tests/typecheck/should_fail/tcfail208.stderr b/testsuite/tests/typecheck/should_fail/tcfail208.stderr index 4b88fc0..4605f85 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail208.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail208.stderr @@ -1,5 +1,5 @@ -tcfail208.hs:4:19: +tcfail208.hs:4:10: error: Could not deduce (Eq (m a)) arising from a use of ?==? from the context: (Monad m, Eq a) bound by the type signature for: From git at git.haskell.org Fri Aug 7 12:06:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:46 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (c2fcd95) Message-ID: <20150807120646.A60943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/c2fcd95e7a748ed1ff8bb26b8c341b43b14f7430/ghc >--------------------------------------------------------------- commit c2fcd95e7a748ed1ff8bb26b8c341b43b14f7430 Author: Richard Eisenberg Date: Wed Aug 5 08:40:49 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- c2fcd95e7a748ed1ff8bb26b8c341b43b14f7430 testsuite/tests/typecheck/should_fail/T1899.stderr | 7 ++++--- testsuite/tests/typecheck/should_fail/T2414.stderr | 3 ++- testsuite/tests/typecheck/should_fail/T2534.stderr | 1 + testsuite/tests/typecheck/should_fail/T2688.stderr | 11 ++++++----- 4 files changed, 13 insertions(+), 9 deletions(-) diff --git a/testsuite/tests/typecheck/should_fail/T1899.stderr b/testsuite/tests/typecheck/should_fail/T1899.stderr index 1702afc..3b15266 100644 --- a/testsuite/tests/typecheck/should_fail/T1899.stderr +++ b/testsuite/tests/typecheck/should_fail/T1899.stderr @@ -1,9 +1,9 @@ T1899.hs:14:36: error: Couldn't match type ?a? with ?Proposition a0? - ?a? is a rigid type variable bound by - the type signature for: transRHS :: [a] -> Int -> Constraint a - at T1899.hs:9:14 + ?a? is a rigid type variable bound by + the type signature for: transRHS :: [a] -> Int -> Constraint a + at T1899.hs:9:14 Expected type: [Proposition a0] Actual type: [a] Relevant bindings include @@ -11,3 +11,4 @@ T1899.hs:14:36: error: transRHS :: [a] -> Int -> Constraint a (bound at T1899.hs:10:2) In the first argument of ?Auxiliary?, namely ?varSet? In the first argument of ?Prop?, namely ?(Auxiliary varSet)? + In the expression: Prop (Auxiliary varSet) diff --git a/testsuite/tests/typecheck/should_fail/T2414.stderr b/testsuite/tests/typecheck/should_fail/T2414.stderr index 0f797da..f9504ad 100644 --- a/testsuite/tests/typecheck/should_fail/T2414.stderr +++ b/testsuite/tests/typecheck/should_fail/T2414.stderr @@ -1,7 +1,8 @@ -T2414.hs:9:13: +T2414.hs:9:13: error: Occurs check: cannot construct the infinite type: b0 ~ (Bool, b0) Expected type: b0 -> Maybe (Bool, b0) Actual type: (Bool, b0) -> Maybe (Bool, b0) In the first argument of ?unfoldr?, namely ?Just? In the expression: unfoldr Just + In an equation for ?f?: f = unfoldr Just diff --git a/testsuite/tests/typecheck/should_fail/T2534.stderr b/testsuite/tests/typecheck/should_fail/T2534.stderr index df3a934..a65e051 100644 --- a/testsuite/tests/typecheck/should_fail/T2534.stderr +++ b/testsuite/tests/typecheck/should_fail/T2534.stderr @@ -6,3 +6,4 @@ T2534.hs:3:13: error: Relevant bindings include foo :: [b0] (bound at T2534.hs:3:1) In the first argument of ?foldr?, namely ?(>>=)? In the expression: foldr (>>=) [] [] + In an equation for ?foo?: foo = foldr (>>=) [] [] diff --git a/testsuite/tests/typecheck/should_fail/T2688.stderr b/testsuite/tests/typecheck/should_fail/T2688.stderr index 4b28d7d..ad2e1ea 100644 --- a/testsuite/tests/typecheck/should_fail/T2688.stderr +++ b/testsuite/tests/typecheck/should_fail/T2688.stderr @@ -1,13 +1,14 @@ -T2688.hs:8:22: +T2688.hs:8:22: error: Couldn't match expected type ?v? with actual type ?s? - ?s? is a rigid type variable bound by - the class declaration for ?VectorSpace? at T2688.hs:5:21 - ?v? is a rigid type variable bound by - the class declaration for ?VectorSpace? at T2688.hs:5:19 + ?s? is a rigid type variable bound by + the class declaration for ?VectorSpace? at T2688.hs:5:21 + ?v? is a rigid type variable bound by + the class declaration for ?VectorSpace? at T2688.hs:5:19 Relevant bindings include s :: s (bound at T2688.hs:8:10) v :: v (bound at T2688.hs:8:5) (^/) :: v -> s -> v (bound at T2688.hs:8:5) In the second argument of ?(/)?, namely ?s? In the second argument of ?(*^)?, namely ?(1 / s)? + In the expression: v *^ (1 / s) From git at git.haskell.org Fri Aug 7 12:06:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:49 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Error message tweak (642777c) Message-ID: <20150807120649.870783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/642777c06130b669b7a17e57939d1e72698198e4/ghc >--------------------------------------------------------------- commit 642777c06130b669b7a17e57939d1e72698198e4 Author: Richard Eisenberg Date: Wed Aug 5 09:25:34 2015 -0400 Error message tweak >--------------------------------------------------------------- 642777c06130b669b7a17e57939d1e72698198e4 compiler/typecheck/TcUnify.hs | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 7dbe72e..e14d4d8 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -726,9 +726,22 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected -- typecheck/should_compile/T4284. | otherwise -> do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual - ; cow <- unifyType rho_a ty_expected - -- NB: unifyType, not uType. We want to refresh - -- the TypeEqOrigin to use the inst'ed type + + -- if we haven't recurred through an arrow, then + -- the eq_orig will list ty_actual. In this case, + -- we want to update the origin to reflect the + -- instantiation. If we *have* recurred through + -- an arrow, it's better not to update. + ; let eq_orig' = case eq_orig of + TypeEqOrigin { uo_actual = orig_ty_actual + , uo_expected = orig_ty_expected } + | orig_ty_actual `tcEqType` ty_actual + -> TypeEqOrigin + { uo_actual = rho_a + , uo_expected = orig_ty_expected } + _ -> eq_orig + + ; cow <- uType eq_orig' rho_a ty_expected ; return (coToHsWrapper cow <.> wrap) } } go (FunTy act_arg act_res) (FunTy exp_arg exp_res) @@ -761,7 +774,10 @@ tcWrapResult :: HsExpr TcId -> TcSigmaType -> TcRhoType -> CtOrigin -> TcM (HsExpr TcId, CtOrigin) -- returning the origin is very convenient in TcExpr tcWrapResult expr actual_ty res_ty orig - = do { cow <- tcSubTypeDS_NC_O orig GenSigCtxt actual_ty res_ty + = do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty + , text "Expected:" <+> ppr res_ty + , text "Origin:" <+> pprCtOrigin orig ]) + ; cow <- tcSubTypeDS_NC_O orig GenSigCtxt actual_ty res_ty ; return (mkHsWrap cow expr, orig) } ----------------------------------- From git at git.haskell.org Fri Aug 7 12:06:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:52 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (bc493ff) Message-ID: <20150807120652.7AA6D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/bc493ff3b48c34f2a764af56bc80120536172e23/ghc >--------------------------------------------------------------- commit bc493ff3b48c34f2a764af56bc80120536172e23 Author: Richard Eisenberg Date: Wed Aug 5 09:28:20 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- bc493ff3b48c34f2a764af56bc80120536172e23 testsuite/tests/typecheck/should_fail/T3102.stderr | 7 ++++--- testsuite/tests/typecheck/should_fail/T3613.stderr | 9 +++++++-- testsuite/tests/typecheck/should_fail/T3950.stderr | 8 +++++++- testsuite/tests/typecheck/should_fail/T6069.stderr | 9 ++++++--- testsuite/tests/typecheck/should_fail/T7368.stderr | 1 + testsuite/tests/typecheck/should_fail/T8142.stderr | 1 + testsuite/tests/typecheck/should_fail/mc23.stderr | 1 + testsuite/tests/typecheck/should_fail/mc24.stderr | 2 ++ testsuite/tests/typecheck/should_fail/tcfail174.stderr | 12 ++++++------ testsuite/tests/typecheck/should_fail/tcfail189.stderr | 4 +++- 10 files changed, 38 insertions(+), 16 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 bc493ff3b48c34f2a764af56bc80120536172e23 From git at git.haskell.org Fri Aug 7 12:06:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:55 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Remove unused def'n in hs-boot file (e5b506f) Message-ID: <20150807120655.7689F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/e5b506fa64451b8c6f72023c883f9d7e824c7f4a/ghc >--------------------------------------------------------------- commit e5b506fa64451b8c6f72023c883f9d7e824c7f4a Author: Richard Eisenberg Date: Wed Aug 5 10:39:33 2015 -0400 Remove unused def'n in hs-boot file >--------------------------------------------------------------- e5b506fa64451b8c6f72023c883f9d7e824c7f4a compiler/typecheck/TcExpr.hs-boot | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcExpr.hs-boot b/compiler/typecheck/TcExpr.hs-boot index 5839ed2..2b11abb 100644 --- a/compiler/typecheck/TcExpr.hs-boot +++ b/compiler/typecheck/TcExpr.hs-boot @@ -23,7 +23,7 @@ tcInferSigma, tcInferSigmaNC :: LHsExpr Name -> TcM (LHsExpr TcId, TcSigmaType, CtOrigin) -tcInferRho, tcInferRhoNC :: +tcInferRho :: LHsExpr Name -> TcM (LHsExpr TcId, TcRhoType) From git at git.haskell.org Fri Aug 7 12:06:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:06:58 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Move visible type app stuff from TcUnify to TcExpr (705f64b) Message-ID: <20150807120658.8DD093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/705f64b0007f96c0c15581d92b75e3c017867cdf/ghc >--------------------------------------------------------------- commit 705f64b0007f96c0c15581d92b75e3c017867cdf Author: Richard Eisenberg Date: Wed Aug 5 10:49:29 2015 -0400 Move visible type app stuff from TcUnify to TcExpr >--------------------------------------------------------------- 705f64b0007f96c0c15581d92b75e3c017867cdf compiler/typecheck/TcEvidence.hs | 3 +- compiler/typecheck/TcExpr.hs | 88 +++++++++++++++++++++++++--------------- compiler/typecheck/TcUnify.hs | 2 +- 3 files changed, 58 insertions(+), 35 deletions(-) diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index 0848008..3212b62 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -597,7 +597,8 @@ c1 <.> c2 = c1 `WpCompose` c2 mkWpFun :: HsWrapper -> HsWrapper -> TcType -- the "from" type of the first wrapper - -> TcType -- the "to" type of the second wrapper + -> TcType -- either type of the second wrapper (used only when the + -- second wrapper is the identity) -> HsWrapper mkWpFun WpHole WpHole _ _ = WpHole mkWpFun WpHole (WpCast co2) t1 _ = WpCast (mkTcFunCo Representational (mkTcRepReflCo t1) co2) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index c9776b9..432a665 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -51,6 +51,7 @@ import PrelNames import DynFlags import SrcLoc import Util +import VarEnv ( emptyTidyEnv ) import ListSetOps import Maybes import Outputable @@ -983,24 +984,15 @@ tcApp m_herald orig_fun orig_args res_ty = do { -- Type-check the function ; (fun1, fun_sigma, orig) <- tcInferFun fun - -- Extract its argument types - ; (wrap_fun, expected_arg_tys, actual_res_ty) - <- matchExpectedFunTys_Args orig - (m_herald `orElse` mk_app_msg fun) - fun args fun_sigma - - -- Typecheck the result, thereby propagating - -- info (if any) from result into the argument types - -- Both actual_res_ty and res_ty are deeply skolemised - -- Rather like tcWrapResult, but (perhaps for historical reasons) - -- we do this before typechecking the arguments - ; wrap_res <- addFunResCtxt True (unLoc fun) actual_res_ty res_ty $ - tcSubTypeDS_NC GenSigCtxt actual_res_ty res_ty + ; (wrap_fun, args1, actual_res_ty) + <- tcArgs fun fun_sigma orig args + (m_herald `orElse` mk_app_msg fun) - -- Typecheck the arguments - ; args1 <- tcArgs fun args expected_arg_tys + -- this is just like tcWrapResult, but the types don't line + -- up to call that function + ; wrap_res <- addFunResCtxt True (unLoc fun) actual_res_ty res_ty $ + tcSubTypeDS_NC_O orig GenSigCtxt actual_res_ty res_ty - -- Assemble the result ; return (wrap_res, mkLHsWrap wrap_fun fun1, args1, orig) } mk_app_msg :: LHsExpr Name -> SDoc @@ -1029,24 +1021,54 @@ tcInferFun fun ; return (fun, fun_ty', orig) } ---------------- -tcArgs :: LHsExpr Name -- The function (for error messages) - -> [LHsExpr Name] -> [TcSigmaType] -- Actual arguments and expected arg types - -> TcM [LHsExpr TcId] -- Resulting args - -tcArgs fun orig_args orig_arg_tys = go 1 orig_args orig_arg_tys +-- | Type-check the arguments to a function, possibly including visible type +-- applications +tcArgs :: LHsExpr Name -- ^ The function itself (for err msgs only) + -> TcSigmaType -- ^ the (uninstantiated) type of the function + -> CtOrigin -- ^ the origin for the function's type + -> [LHsExpr Name] -- ^ the args + -> SDoc -- ^ the herald for matchExpectedFunTys + -> TcM (HsWrapper, [LHsExpr TcId], TcSigmaType) + -- ^ (a wrapper for the function, the tc'd args, result type) +tcArgs fun orig_fun_ty fun_orig orig_args herald + = go 1 orig_fun_ty orig_args where - go _ [] [] = return [] - go n (arg:args) all_arg_tys - | Just (hs_ty, _) <- isLHsTypeExpr_maybe arg - = do { args' <- go (n+1) args all_arg_tys - ; return (L (getLoc arg) (HsTypeOut hs_ty) : args') } - - go n (arg:args) (arg_ty:arg_tys) - = do { arg' <- tcArg fun (arg, arg_ty, n) - ; args' <- go (n+1) args arg_tys - ; return (arg':args') } - - go _ _ _ = pprPanic "tcArgs" (ppr fun $$ ppr orig_args $$ ppr orig_arg_tys) + go _ fun_ty [] = return (idHsWrapper, [], fun_ty) + + go n fun_ty (arg:args) + | Just hs_ty_arg@(hs_ty, _wcs) <- isLHsTypeExpr_maybe arg + = do { (wrap1, upsilon_ty) <- topInstantiateInferred fun_orig fun_ty + -- wrap1 :: fun_ty "->" upsilon_ty + ; case tcSplitForAllTy_maybe upsilon_ty of + Just (tv, inner_ty) -> + ASSERT( isSpecifiedTyVar tv ) + do { let kind = tyVarKind tv + ; ty_arg <- tcHsTypeApp hs_ty_arg kind + ; let insted_ty = substTyWith [tv] [ty_arg] inner_ty + ; (inner_wrap, args', res_ty) <- go (n+1) insted_ty args + -- inner_wrap :: insted_ty "->" (map typeOf args') -> res_ty + ; let inst_wrap = mkWpTyApps [ty_arg] + ; return ( inner_wrap <.> inst_wrap <.> wrap1 + , L (getLoc arg) (HsTypeOut hs_ty) : args' + , res_ty ) } + Nothing -> ty_app_err upsilon_ty hs_ty } + + | otherwise -- not a type application. + = do { (wrap, [arg_ty], res_ty) + <- matchExpectedFunTys (Actual fun_orig) herald 1 fun_ty + -- wrap :: fun_ty "->" arg_ty -> res_ty + ; arg' <- tcArg fun (arg, arg_ty, n) + ; (inner_wrap, args', inner_res_ty) <- go (n+1) res_ty args + -- inner_wrap :: res_ty "->" (map typeOf args') -> inner_res_ty + ; return ( mkWpFun idHsWrapper inner_wrap arg_ty res_ty <.> wrap + , arg' : args' + , inner_res_ty ) } + + ty_app_err ty arg + = do { (_, ty) <- zonkTidyTcType emptyTidyEnv ty + ; failWith $ + text "Cannot not apply expression of type" <+> quotes (ppr ty) $$ + text "to a visible type argument" <+> quotes (ppr arg) } ---------------- tcArg :: LHsExpr Name -- The function (for error messages) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index e14d4d8..7fa8fab 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -12,7 +12,7 @@ module TcUnify ( -- Full-blown subsumption tcWrapResult, tcSkolemise, tcSubTypeHR, tcSubType, tcSubType_NC, tcSubTypeDS, tcSubTypeDS_O, - tcSubTypeDS_NC, + tcSubTypeDS_NC, tcSubTypeDS_NC_O, checkConstraints, -- Various unifications From git at git.haskell.org Fri Aug 7 12:07:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:01 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Remove the abominable matchExpectedFunTys_Args (e4c35cd) Message-ID: <20150807120701.7A3B43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/e4c35cd229069cb9a40e59de7bc42e8ad5cab27d/ghc >--------------------------------------------------------------- commit e4c35cd229069cb9a40e59de7bc42e8ad5cab27d Author: Richard Eisenberg Date: Wed Aug 5 11:10:46 2015 -0400 Remove the abominable matchExpectedFunTys_Args >--------------------------------------------------------------- e4c35cd229069cb9a40e59de7bc42e8ad5cab27d compiler/typecheck/TcHsType.hs-boot | 8 --- compiler/typecheck/TcUnify.hs | 105 +++++++----------------------------- 2 files changed, 19 insertions(+), 94 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc e4c35cd229069cb9a40e59de7bc42e8ad5cab27d From git at git.haskell.org Fri Aug 7 12:07:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:04 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (ffc812d) Message-ID: <20150807120704.736E73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/ffc812d946e3b06971ffe317939dd052a7b8a830/ghc >--------------------------------------------------------------- commit ffc812d946e3b06971ffe317939dd052a7b8a830 Author: Richard Eisenberg Date: Wed Aug 5 11:36:54 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- ffc812d946e3b06971ffe317939dd052a7b8a830 testsuite/tests/typecheck/bug1465/bug1465.stderr | 1 + .../tests/typecheck/should_compile/FD1.stderr | 10 ++++----- .../tests/typecheck/should_compile/FD2.stderr | 21 ++++++++++--------- .../tests/typecheck/should_compile/T2494.stderr | 24 ++++++++++++---------- 4 files changed, 30 insertions(+), 26 deletions(-) diff --git a/testsuite/tests/typecheck/bug1465/bug1465.stderr b/testsuite/tests/typecheck/bug1465/bug1465.stderr index 1c67068..4e31c7f 100644 --- a/testsuite/tests/typecheck/bug1465/bug1465.stderr +++ b/testsuite/tests/typecheck/bug1465/bug1465.stderr @@ -6,3 +6,4 @@ C.hs:6:11: error: ?bug1465-1.0:A.T? is defined in ?A? in package ?bug1465-1.0? In the expression: B2.f In the expression: [B1.f, B2.f] + In an equation for ?x?: x = [B1.f, B2.f] diff --git a/testsuite/tests/typecheck/should_compile/FD1.stderr b/testsuite/tests/typecheck/should_compile/FD1.stderr index 2b0ac17..08318d8 100644 --- a/testsuite/tests/typecheck/should_compile/FD1.stderr +++ b/testsuite/tests/typecheck/should_compile/FD1.stderr @@ -1,9 +1,9 @@ -FD1.hs:16:1: - Couldn't match expected type ?Int -> Int? with actual type ?a? - ?a? is a rigid type variable bound by - the type signature for: plus :: E a (Int -> Int) => Int -> a - at FD1.hs:15:9 +FD1.hs:16:1: error: + Couldn't match expected type ?a? with actual type ?Int -> Int? + ?a? is a rigid type variable bound by + the type signature for: plus :: E a (Int -> Int) => Int -> a + at FD1.hs:15:9 Relevant bindings include plus :: Int -> a (bound at FD1.hs:16:1) The equation(s) for ?plus? have two arguments, but its type ?Int -> a? has only one diff --git a/testsuite/tests/typecheck/should_compile/FD2.stderr b/testsuite/tests/typecheck/should_compile/FD2.stderr index 0134d87..e0efc60 100644 --- a/testsuite/tests/typecheck/should_compile/FD2.stderr +++ b/testsuite/tests/typecheck/should_compile/FD2.stderr @@ -1,19 +1,20 @@ -FD2.hs:26:34: - Couldn't match expected type ?e1? with actual type ?e? - ?e? is a rigid type variable bound by - the type signature for: - foldr1 :: Elem a e => (e -> e -> e) -> a -> e - at FD2.hs:21:13 - ?e1? is a rigid type variable bound by - the type signature for: - mf :: Elem a e1 => e1 -> Maybe e1 -> Maybe e1 - at FD2.hs:24:18 +FD2.hs:26:36: error: + Couldn't match expected type ?e? with actual type ?e1? + ?e1? is a rigid type variable bound by + the type signature for: + mf :: Elem a e1 => e1 -> Maybe e1 -> Maybe e1 + at FD2.hs:24:18 + ?e? is a rigid type variable bound by + the type signature for: + foldr1 :: Elem a e => (e -> e -> e) -> a -> e + at FD2.hs:21:13 Relevant bindings include y :: e1 (bound at FD2.hs:26:23) x :: e1 (bound at FD2.hs:26:15) mf :: e1 -> Maybe e1 -> Maybe e1 (bound at FD2.hs:25:12) f :: e -> e -> e (bound at FD2.hs:22:10) foldr1 :: (e -> e -> e) -> a -> e (bound at FD2.hs:22:3) + In the first argument of ?f?, namely ?x? In the first argument of ?Just?, namely ?(f x y)? In the expression: Just (f x y) diff --git a/testsuite/tests/typecheck/should_compile/T2494.stderr b/testsuite/tests/typecheck/should_compile/T2494.stderr index 0346e62..6784c2e 100644 --- a/testsuite/tests/typecheck/should_compile/T2494.stderr +++ b/testsuite/tests/typecheck/should_compile/T2494.stderr @@ -1,10 +1,10 @@ -T2494.hs:15:14: +T2494.hs:15:14: error: Couldn't match type ?b? with ?a? - ?b? is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:14:16 - ?a? is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:13:16 + ?b? is a rigid type variable bound by + the RULE "foo/foo" at T2494.hs:14:16 + ?a? is a rigid type variable bound by + the RULE "foo/foo" at T2494.hs:13:16 Expected type: Maybe (m a) -> Maybe (m a) Actual type: Maybe (m b) -> Maybe (m b) Relevant bindings include @@ -15,14 +15,15 @@ T2494.hs:15:14: x :: Maybe a (bound at T2494.hs:14:65) In the first argument of ?foo?, namely ?g? In the second argument of ?foo?, namely ?(foo g x)? + In the expression: foo f (foo g x) -T2494.hs:15:30: +T2494.hs:15:30: error: Couldn't match type ?b? with ?a? - ?b? is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:14:16 - ?a? is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:13:16 - Expected type: Maybe (m a) -> Maybe (m a) + ?b? is a rigid type variable bound by + the RULE "foo/foo" at T2494.hs:14:16 + ?a? is a rigid type variable bound by + the RULE "foo/foo" at T2494.hs:13:16 + Expected type: Maybe (m b) -> Maybe (m a) Actual type: Maybe (m b) -> Maybe (m b) Relevant bindings include f :: forall (m :: * -> *). Monad m => Maybe (m a) -> Maybe (m a) @@ -32,3 +33,4 @@ T2494.hs:15:30: x :: Maybe a (bound at T2494.hs:14:65) In the second argument of ?(.)?, namely ?g? In the first argument of ?foo?, namely ?(f . g)? + In the expression: foo (f . g) x From git at git.haskell.org Fri Aug 7 12:07:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:07 +0000 (UTC) Subject: [commit: ghc] wip/type-app: More info with Shouldn'tHappenOrigin (f433073) Message-ID: <20150807120707.8017B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/f4330738b1f0496128f3cf8e4b6a341e6acfc303/ghc >--------------------------------------------------------------- commit f4330738b1f0496128f3cf8e4b6a341e6acfc303 Author: Richard Eisenberg Date: Wed Aug 5 11:37:09 2015 -0400 More info with Shouldn'tHappenOrigin >--------------------------------------------------------------- f4330738b1f0496128f3cf8e4b6a341e6acfc303 compiler/typecheck/TcArrows.hs | 2 +- compiler/typecheck/TcBinds.hs | 9 +++-- compiler/typecheck/TcExpr.hs | 79 ++++++++++++++++++++++------------------- compiler/typecheck/TcMatches.hs | 6 ++-- compiler/typecheck/TcRnTypes.hs | 10 +++--- compiler/typecheck/TcSplice.hs | 4 +-- compiler/typecheck/TcUnify.hs | 5 +-- 7 files changed, 65 insertions(+), 50 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 f4330738b1f0496128f3cf8e4b6a341e6acfc303 From git at git.haskell.org Fri Aug 7 12:07:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:10 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Argument types *can* get instantiated. (9b9f3c7) Message-ID: <20150807120710.8F5683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/9b9f3c7d3a215d2e271dc5d6f92c8bd37e9cdfe6/ghc >--------------------------------------------------------------- commit 9b9f3c7d3a215d2e271dc5d6f92c8bd37e9cdfe6 Author: Richard Eisenberg Date: Wed Aug 5 11:52:23 2015 -0400 Argument types *can* get instantiated. >--------------------------------------------------------------- 9b9f3c7d3a215d2e271dc5d6f92c8bd37e9cdfe6 compiler/typecheck/TcUnify.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index d6e5b75..04f8498 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -683,7 +683,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected = -- See Note [Co/contra-variance of subsumption checking] do { res_wrap <- tc_sub_type_ds eq_orig inst_orig ctxt act_res exp_res ; arg_wrap - <- tc_sub_type eq_orig (Shouldn'tHappenOrigin "tc_sub_type_ds") + <- tc_sub_type eq_orig (GivenOrigin (SigSkol GenSigCtxt exp_arg)) ctxt exp_arg act_arg ; return (mkWpFun arg_wrap res_wrap exp_arg exp_res) } -- arg_wrap :: exp_arg ~ act_arg From git at git.haskell.org Fri Aug 7 12:07:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:13 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (53ef5e0) Message-ID: <20150807120713.77D523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/53ef5e0d042843b97caef039ff90df61f425da8c/ghc >--------------------------------------------------------------- commit 53ef5e0d042843b97caef039ff90df61f425da8c Author: Richard Eisenberg Date: Wed Aug 5 11:54:18 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 53ef5e0d042843b97caef039ff90df61f425da8c .../tests/typecheck/should_compile/tc141.stderr | 12 +++-- .../tests/typecheck/should_compile/tc211.stderr | 55 +++------------------- .../tests/typecheck/should_compile/tc243.stderr | 4 +- 3 files changed, 18 insertions(+), 53 deletions(-) diff --git a/testsuite/tests/typecheck/should_compile/tc141.stderr b/testsuite/tests/typecheck/should_compile/tc141.stderr index cca4b60..d8ff76f 100644 --- a/testsuite/tests/typecheck/should_compile/tc141.stderr +++ b/testsuite/tests/typecheck/should_compile/tc141.stderr @@ -19,6 +19,7 @@ tc141.hs:11:31: error: f :: (a0, a0) -> (t0, a0) (bound at tc141.hs:11:1) In the expression: q :: a In the expression: (q :: a, p) + In the expression: let (p :: a, q :: a) = x in (q :: a, p) tc141.hs:13:13: error: You cannot bind scoped type variable ?a? @@ -33,14 +34,19 @@ tc141.hs:13:13: error: in v tc141.hs:15:18: error: - Couldn't match expected type ?a? with actual type ?t0? + Couldn't match expected type ?a? with actual type ?r0? because type variable ?a? would escape its scope This (rigid, skolem) type variable is bound by the type signature for: v :: a at tc141.hs:14:19 Relevant bindings include v :: a (bound at tc141.hs:15:14) - b :: t0 (bound at tc141.hs:13:5) - g :: a0 -> t0 -> a1 (bound at tc141.hs:13:1) + b :: r0 (bound at tc141.hs:13:5) + g :: a0 -> r0 -> forall a. a (bound at tc141.hs:13:1) In the expression: b In an equation for ?v?: v = b + In the expression: + let + v :: a + v = b + in v diff --git a/testsuite/tests/typecheck/should_compile/tc211.stderr b/testsuite/tests/typecheck/should_compile/tc211.stderr index 14483bf..026cc15 100644 --- a/testsuite/tests/typecheck/should_compile/tc211.stderr +++ b/testsuite/tests/typecheck/should_compile/tc211.stderr @@ -1,53 +1,6 @@ -tc211.hs:17:8: error: - Couldn't match expected type ?forall a. a -> a? - with actual type ?a2 -> a2? - In the expression: - (:) :: - (forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a] - In the expression: - ((:) :: - (forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a]) - (head foo) foo - -tc211.hs:18:22: error: - Couldn't match type ?forall a3. a3 -> a3? with ?a -> a? - Expected type: [a -> a] - Actual type: [forall a. a -> a] - In the first argument of ?head?, namely ?foo? - In the first argument of ?(:) :: - (forall a. a -> a) - -> [forall a. a -> a] -> [forall a. a -> a]?, namely - ?(head foo)? - -tc211.hs:59:18: error: - Couldn't match expected type ?forall a. a -> a? - with actual type ?a1 -> a1? - In the expression: - Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a) - In an equation for ?cons?: - cons - = Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a) - -tc211.hs:65:8: error: - Couldn't match expected type ?forall a. a -> a? - with actual type ?a0 -> a0? - In the expression: - Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a) - In the expression: - (Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a)) - (\ x -> x) Nil - tc211.hs:73:9: error: - Couldn't match type ?forall a4. a4 -> a4? with ?a -> a? + Couldn't match type ?forall a1. a1 -> a1? with ?a -> a? Expected type: List (forall a1. a1 -> a1) -> (forall a1. a1 -> a1) -> a -> a Actual type: List (a -> a) -> (a -> a) -> a -> a @@ -59,3 +12,9 @@ tc211.hs:73:9: error: List (forall a. a -> a) -> (forall a. a -> a) -> (forall a. a -> a)) xs1 (\ x -> x) + In an equation for ?bar4?: + bar4 + = (foo2 :: + List (forall a. a -> a) + -> (forall a. a -> a) -> (forall a. a -> a)) + xs1 (\ x -> x) diff --git a/testsuite/tests/typecheck/should_compile/tc243.stderr b/testsuite/tests/typecheck/should_compile/tc243.stderr index 31cc3c9..0219817 100644 --- a/testsuite/tests/typecheck/should_compile/tc243.stderr +++ b/testsuite/tests/typecheck/should_compile/tc243.stderr @@ -1,3 +1,3 @@ -tc243.hs:10:1: Warning: - Top-level binding with no type signature: (.+.) :: forall t. t +tc243.hs:10:1: warning: + Top-level binding with no type signature: (.+.) :: forall a. a From git at git.haskell.org Fri Aug 7 12:07:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:16 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Workin' the testsuite (a258aed) Message-ID: <20150807120716.82A1C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/a258aedc0e522db6d95f53904f8aae0a34316028/ghc >--------------------------------------------------------------- commit a258aedc0e522db6d95f53904f8aae0a34316028 Author: Richard Eisenberg Date: Wed Aug 5 12:28:19 2015 -0400 Workin' the testsuite >--------------------------------------------------------------- a258aedc0e522db6d95f53904f8aae0a34316028 compiler/typecheck/TcExpr.hs | 16 ++++++++----- compiler/typecheck/TcUnify.hs | 28 ++++++++++++++++++---- testsuite/tests/typecheck/should_fail/T2688.stderr | 5 ++-- testsuite/tests/typecheck/should_fail/T3613.stderr | 7 +++--- testsuite/tests/typecheck/should_fail/T3950.stderr | 7 +++--- testsuite/tests/typecheck/should_fail/T8603.stderr | 5 ++-- 6 files changed, 45 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 a258aedc0e522db6d95f53904f8aae0a34316028 From git at git.haskell.org Fri Aug 7 12:07:19 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:19 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (085235b) Message-ID: <20150807120719.9041A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/085235b7f26f6f105fc679e2730a1b2ebd57fdce/ghc >--------------------------------------------------------------- commit 085235b7f26f6f105fc679e2730a1b2ebd57fdce Author: Richard Eisenberg Date: Wed Aug 5 12:31:47 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 085235b7f26f6f105fc679e2730a1b2ebd57fdce testsuite/tests/typecheck/should_fail/T9774.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/tcfail065.stderr | 8 +++++--- testsuite/tests/typecheck/should_fail/tcfail068.stderr | 17 ++++++++++++----- testsuite/tests/typecheck/should_fail/tcfail103.stderr | 12 ++++++++---- testsuite/tests/typecheck/should_fail/tcfail131.stderr | 9 +++++---- testsuite/tests/typecheck/should_fail/tcfail153.stderr | 11 +++++------ testsuite/tests/typecheck/should_fail/tcfail179.stderr | 10 ++++++---- testsuite/tests/typecheck/should_fail/tcfail201.stderr | 8 +++++--- 8 files changed, 48 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 085235b7f26f6f105fc679e2730a1b2ebd57fdce From git at git.haskell.org Fri Aug 7 12:07:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:22 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Refactor overloaded literals back to Inst (7b815d8) Message-ID: <20150807120722.8D7673A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/7b815d8e772ace0092103c781182c058feed8ee1/ghc >--------------------------------------------------------------- commit 7b815d8e772ace0092103c781182c058feed8ee1 Author: Richard Eisenberg Date: Wed Aug 5 12:47:27 2015 -0400 Refactor overloaded literals back to Inst >--------------------------------------------------------------- 7b815d8e772ace0092103c781182c058feed8ee1 compiler/typecheck/Inst.hs | 41 +++++++++++++++++++++++++++++++++++++++-- compiler/typecheck/TcExpr.hs | 6 ++++-- compiler/typecheck/TcPat.hs | 4 ++-- compiler/typecheck/TcUnify.hs | 41 +---------------------------------------- 4 files changed, 46 insertions(+), 46 deletions(-) diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 338bd0d..c0f4081 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -6,7 +6,7 @@ The @Inst@ type: dictionaries or method instances -} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, TupleSections #-} module Inst ( deeplySkolemise, @@ -15,7 +15,7 @@ module Inst ( newWanted, newWanteds, emitWanted, emitWanteds, - newNonTrivialOverloadedLit, mkOverLit, + newOverloadedLit, newNonTrivialOverloadedLit, mkOverLit, newClsInst, tcGetInsts, tcGetInstEnvs, getOverlapFlag, @@ -331,6 +331,43 @@ instStupidTheta orig theta -} +{- +In newOverloadedLit we convert directly to an Int or Integer if we +know that's what we want. This may save some time, by not +temporarily generating overloaded literals, but it won't catch all +cases (the rest are caught in lookupInst). + +-} + +newOverloadedLit :: HsOverLit Name + -> TcSigmaType -- if nec'y, this type is instantiated... + -> CtOrigin -- ... using this CtOrigin + -> TcM (HsWrapper, HsOverLit TcId) + -- wrapper :: input type "->" type of result +newOverloadedLit + lit@(OverLit { ol_val = val, ol_rebindable = rebindable }) res_ty res_orig + | not rebindable + -- all built-in overloaded lits are not higher-rank, so skolemise. + -- this is necessary for shortCutLit. + = do { (wrap, insted_ty) <- deeplyInstantiate res_orig res_ty + ; dflags <- getDynFlags + ; case shortCutLit dflags val insted_ty of + -- Do not generate a LitInst for rebindable syntax. + -- Reason: If we do, tcSimplify will call lookupInst, which + -- will call tcSyntaxName, which does unification, + -- which tcSimplify doesn't like + Just expr -> return ( wrap + , lit { ol_witness = expr, ol_type = insted_ty + , ol_rebindable = False } ) + Nothing -> (wrap, ) <$> + newNonTrivialOverloadedLit orig lit insted_ty } + + | otherwise + = do { lit' <- newNonTrivialOverloadedLit orig lit res_ty + ; return (idHsWrapper, lit') } + where + orig = LiteralOrigin lit + -- Does not handle things that 'shortCutLit' can handle. See also -- newOverloadedLit in TcUnify newNonTrivialOverloadedLit :: CtOrigin diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 96bbbbd..f066d8a 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -192,8 +192,10 @@ tcExpr (HsCoreAnn src lbl expr) res_ty ; return (HsCoreAnn src lbl expr', orig) } tcExpr (HsOverLit lit) res_ty - = do { (wrap, lit') <- newOverloadedLit Expected lit res_ty - ; return (mkHsWrap wrap $ HsOverLit lit', LiteralOrigin lit) } + = do { (_wrap, lit') <- newOverloadedLit lit res_ty + (Shouldn'tHappenOrigin "HsOverLit") + ; MASSERT( isIdHsWrapper _wrap ) + ; return (HsOverLit lit', LiteralOrigin lit) } tcExpr (NegApp expr neg_expr) res_ty = do { neg_expr' <- tcSyntaxOp NegateOrigin neg_expr diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 9fa58e8..3997ed6 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -636,7 +636,7 @@ tc_pat _ (LitPat simple_lit) pat_ty thing_inside tc_pat (PE { pe_orig = pat_orig }) (NPat (L l over_lit) mb_neg eq) pat_ty thing_inside = do { let orig = LiteralOrigin over_lit - ; (wrap, lit') <- newOverloadedLit (Actual pat_orig) over_lit pat_ty + ; (wrap, lit') <- newOverloadedLit over_lit pat_ty pat_orig ; eq' <- tcSyntaxOp orig eq (mkFunTys [pat_ty, pat_ty] boolTy) ; mb_neg' <- case mb_neg of Nothing -> return Nothing -- Positive literal @@ -651,7 +651,7 @@ tc_pat penv (NPlusKPat (L nm_loc name) (L loc lit) ge minus) pat_ty thing_inside = do { (co, bndr_id) <- setSrcSpan nm_loc (tcPatBndr penv name pat_ty) ; let pat_ty' = idType bndr_id orig = LiteralOrigin lit - ; (wrap_lit, lit') <- newOverloadedLit (Actual $ pe_orig penv) lit pat_ty' + ; (wrap_lit, lit') <- newOverloadedLit lit pat_ty' (pe_orig penv) -- The '>=' and '-' parts are re-mappable syntax ; ge' <- tcSyntaxOp orig ge (mkFunTys [pat_ty', pat_ty'] boolTy) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 7e12449..507eb40 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -29,7 +29,6 @@ module TcUnify ( matchExpectedAppTy, matchExpectedFunTys, matchExpectedFunTysPart, matchExpectedFunKind, - newOverloadedLit, wrapFunResCoercion ) where @@ -41,10 +40,9 @@ import TypeRep import TcMType import TcRnMonad import TcType -import TcHsSyn ( shortCutLit ) import Type import TcEvidence -import Name ( Name, isSystemName ) +import Name ( isSystemName ) import Inst import Kind import TyCon @@ -409,43 +407,6 @@ matchExpectedAppTy orig_ty -- not enough to lose sleep over. {- -In newOverloadedLit we convert directly to an Int or Integer if we -know that's what we want. This may save some time, by not -temporarily generating overloaded literals, but it won't catch all -cases (the rest are caught in lookupInst). - -This is here because of its dependency on the Expected/Actual -functions above. --} - -newOverloadedLit :: ExpOrAct - -> HsOverLit Name - -> TcSigmaType - -> TcM (HsWrapper, HsOverLit TcId) -newOverloadedLit ea - lit@(OverLit { ol_val = val, ol_rebindable = rebindable }) res_ty - | not rebindable - -- all built-in overloaded lits are not higher-rank, so skolemise. - -- this is necessary for shortCutLit. - = exposeRhoType ea res_ty $ \ res_rho -> liftM (idHsWrapper,) $ - do { dflags <- getDynFlags - ; case shortCutLit dflags val res_rho of - -- Do not generate a LitInst for rebindable syntax. - -- Reason: If we do, tcSimplify will call lookupInst, which - -- will call tcSyntaxName, which does unification, - -- which tcSimplify doesn't like - Just expr -> return (lit { ol_witness = expr, ol_type = res_rho - , ol_rebindable = False }) - Nothing -> newNonTrivialOverloadedLit orig lit res_rho } - - | otherwise - = do { lit' <- newNonTrivialOverloadedLit orig lit res_ty - ; return (idHsWrapper, lit') } - where - orig = LiteralOrigin lit - - -{- ************************************************************************ * * Subsumption checking From git at git.haskell.org Fri Aug 7 12:07:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:25 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Comments only (ad57520) Message-ID: <20150807120725.711F33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/ad575207905a37c7501c3aa54bec33fb5c9741b0/ghc >--------------------------------------------------------------- commit ad575207905a37c7501c3aa54bec33fb5c9741b0 Author: Richard Eisenberg Date: Wed Aug 5 13:10:52 2015 -0400 Comments only >--------------------------------------------------------------- ad575207905a37c7501c3aa54bec33fb5c9741b0 compiler/typecheck/TcMatches.hs | 5 +++-- compiler/typecheck/TcUnify.hs | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index fdebca0..eb641f7 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -116,7 +116,8 @@ tcMatchesCase ctxt scrut_ty matches res_ty | otherwise = tcMatches ctxt [scrut_ty] res_ty matches -tcMatchLambda :: MatchGroup Name (LHsExpr Name) -> TcRhoType +tcMatchLambda :: MatchGroup Name (LHsExpr Name) + -> TcRhoType -- deeply skolemised -> TcM (HsWrapper, MatchGroup TcId (LHsExpr TcId), CtOrigin) tcMatchLambda match res_ty = matchFunTys herald n_pats res_ty $ \ pat_tys rhs_ty -> @@ -144,7 +145,7 @@ tcGRHSsPat grhss res_ty = tcGRHSs match_ctxt grhss res_ty matchFunTys :: SDoc -- See Note [Herald for matchExpecteFunTys] in TcUnify -> Arity - -> TcRhoType + -> TcRhoType -- deeply skolemised -> ([TcSigmaType] -> TcRhoType -> TcM (HsWrapper, a, b)) -- "a" is always a MatchGroup. wrapper :: a's res_ty "->" TcRhoType -> TcM (HsWrapper, a, b) diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 507eb40..1e541f3 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -67,7 +67,7 @@ import Control.Monad * * ************************************************************************ -The matchExpected functions operate in one of two modes: "Expected" mode, +matchExpectedFunTys functions operate in one of two modes: "Expected" mode, where the provided type is skolemised before matching, and "Actual" mode, where the provided type is instantiated before matching. The produced HsWrappers are oriented accordingly. From git at git.haskell.org Fri Aug 7 12:07:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:28 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Test pushing into conditionals (5dc5624) Message-ID: <20150807120728.CC8A93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/5dc5624964120799b1c84f2b37f00bb905fb80bc/ghc >--------------------------------------------------------------- commit 5dc5624964120799b1c84f2b37f00bb905fb80bc Author: Richard Eisenberg Date: Wed Aug 5 13:17:38 2015 -0400 Test pushing into conditionals >--------------------------------------------------------------- 5dc5624964120799b1c84f2b37f00bb905fb80bc testsuite/tests/typecheck/should_compile/PushHRIf.hs | 7 +++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 2 files changed, 8 insertions(+) diff --git a/testsuite/tests/typecheck/should_compile/PushHRIf.hs b/testsuite/tests/typecheck/should_compile/PushHRIf.hs new file mode 100644 index 0000000..f683913 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/PushHRIf.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes #-} + +module PushHRIf where + +foo = (if True then id else id) :: forall a. a -> a + +bar = (foo 'x', foo True) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 0b014c4..b334b00 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -468,3 +468,4 @@ test('T10564', normal, compile, ['']) test('Vta1', normal, compile, ['']) test('Vta2', normal, compile, ['']) test('VtaInvis', normal, compile, ['']) +test('PushHRIf', normal, compile, ['']) From git at git.haskell.org Fri Aug 7 12:07:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:31 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Move Note [Visible type application] (e0e2417) Message-ID: <20150807120731.C8F643A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/e0e2417e87d0e7d2bb01d393663bff5a99b4e45b/ghc >--------------------------------------------------------------- commit e0e2417e87d0e7d2bb01d393663bff5a99b4e45b Author: Richard Eisenberg Date: Wed Aug 5 13:20:30 2015 -0400 Move Note [Visible type application] >--------------------------------------------------------------- e0e2417e87d0e7d2bb01d393663bff5a99b4e45b compiler/basicTypes/Name.hs | 4 +-- compiler/basicTypes/Var.hs | 4 +-- compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcExpr.hs | 54 --------------------------------------- compiler/typecheck/TcHsSyn.hs | 4 +-- compiler/typecheck/TcMType.hs | 2 +- compiler/typecheck/TcType.hs | 59 ++++++++++++++++++++++++++++++++++++++++--- 7 files changed, 64 insertions(+), 65 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 e0e2417e87d0e7d2bb01d393663bff5a99b4e45b From git at git.haskell.org Fri Aug 7 12:07:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:34 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Comments only (5c7e535) Message-ID: <20150807120734.A48B93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/5c7e53591852dcd18d8275f739c871dcdf6a0173/ghc >--------------------------------------------------------------- commit 5c7e53591852dcd18d8275f739c871dcdf6a0173 Author: Richard Eisenberg Date: Wed Aug 5 13:27:48 2015 -0400 Comments only >--------------------------------------------------------------- 5c7e53591852dcd18d8275f739c871dcdf6a0173 compiler/typecheck/TcMatches.hs | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index eb641f7..30c3f4a 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -168,6 +168,27 @@ matchFunTys herald arity res_ty thing_inside \subsection{tcMatch} * * ************************************************************************ + +Note [Case branches must be taus] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + case ... of + ... -> \(x :: forall a. a -> a) -> x + ... -> \y -> y + +Should that type-check? The problem is that, if we check the second branch +first, then we'll get a type (b -> b) for the branches, which won't unify +with the polytype in the first branch. If we check the first branch first, +then everything is OK. This order-dependency is terrible. So we want only +proper tau-types in branches. This is what tauTvsForReturnsTvs ensures: +it gets rid of those pesky ReturnTvs that might unify with polytypes. + +But we make a special case for a one-branch case. This is so that + + f = \(x :: forall a. a -> a) -> x + +still gets assigned a polytype. -} -- | Type-check a MatchGroup. This deeply instantiates the return @@ -195,7 +216,7 @@ tcMatches ctxt pat_tys rhs_ty group@(MG { mg_alts = matches, mg_origin = origin ; return ([match'], idHsWrapper, rhs_ty, ct_orig) } Nothing -> do { rhs_ty' <- tauTvsForReturnTvs rhs_ty - -- TODO (RAE): Document this behavior. + -- See Note [Case branches must be taus] ; (matches', _) <- mapAndUnzipM (tcMatch ctxt pat_tys rhs_ty') matches ; wrap <- tcSubTypeHR (Shouldn'tHappenOrigin "tcMatches1") From git at git.haskell.org Fri Aug 7 12:07:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:37 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (85a0aa9) Message-ID: <20150807120737.AFD3A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/85a0aa998e90046122d6cf6e2f28e4dc28e42b53/ghc >--------------------------------------------------------------- commit 85a0aa998e90046122d6cf6e2f28e4dc28e42b53 Author: Richard Eisenberg Date: Thu Aug 6 09:42:02 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 85a0aa998e90046122d6cf6e2f28e4dc28e42b53 libraries/base/tests/T9681.stderr | 2 +- .../tests/annotations/should_fail/annfail08.stderr | 2 +- testsuite/tests/arrows/should_fail/T5380.stderr | 23 ++++++++++++---------- .../tests/deSugar/should_compile/T2431.stderr | 5 +++-- testsuite/tests/driver/T2182.stderr | 4 ++-- 5 files changed, 20 insertions(+), 16 deletions(-) diff --git a/libraries/base/tests/T9681.stderr b/libraries/base/tests/T9681.stderr index 7945ff7..af6e7dc 100644 --- a/libraries/base/tests/T9681.stderr +++ b/libraries/base/tests/T9681.stderr @@ -1,5 +1,5 @@ -T9681.hs:3:9: +T9681.hs:3:7: error: No instance for (Num [Char]) arising from a use of ?+? In the expression: 1 + "\n" In an equation for ?foo?: foo = 1 + "\n" diff --git a/testsuite/tests/annotations/should_fail/annfail08.stderr b/testsuite/tests/annotations/should_fail/annfail08.stderr index 66e9c7e..68d5f0d 100644 --- a/testsuite/tests/annotations/should_fail/annfail08.stderr +++ b/testsuite/tests/annotations/should_fail/annfail08.stderr @@ -4,7 +4,7 @@ annfail08.hs:9:1: error: (maybe you haven't applied a function to enough arguments?) In the annotation: {-# ANN f (id + 1) #-} -annfail08.hs:9:15: error: +annfail08.hs:9:12: error: No instance for (Num (a0 -> a0)) arising from a use of ?+? (maybe you haven't applied a function to enough arguments?) In the annotation: {-# ANN f (id + 1) #-} diff --git a/testsuite/tests/arrows/should_fail/T5380.stderr b/testsuite/tests/arrows/should_fail/T5380.stderr index bff48f5..a2b5869 100644 --- a/testsuite/tests/arrows/should_fail/T5380.stderr +++ b/testsuite/tests/arrows/should_fail/T5380.stderr @@ -1,23 +1,25 @@ -T5380.hs:7:27: +T5380.hs:7:27: error: Couldn't match expected type ?Bool? with actual type ?not_bool? - ?not_bool? is a rigid type variable bound by - the type signature for: - testB :: not_bool -> (() -> ()) -> () -> not_unit - at T5380.hs:6:10 + ?not_bool? is a rigid type variable bound by + the type signature for: + testB :: not_bool -> (() -> ()) -> () -> not_unit + at T5380.hs:6:10 Relevant bindings include b :: not_bool (bound at T5380.hs:7:7) testB :: not_bool -> (() -> ()) -> () -> not_unit (bound at T5380.hs:7:1) In the expression: b In the expression: proc () -> if b then f -< () else f -< () + In an equation for ?testB?: + testB b f = proc () -> if b then f -< () else f -< () -T5380.hs:7:34: +T5380.hs:7:34: error: Couldn't match type ?not_unit? with ?()? - ?not_unit? is a rigid type variable bound by - the type signature for: - testB :: not_bool -> (() -> ()) -> () -> not_unit - at T5380.hs:6:10 + ?not_unit? is a rigid type variable bound by + the type signature for: + testB :: not_bool -> (() -> ()) -> () -> not_unit + at T5380.hs:6:10 Expected type: () -> not_unit Actual type: () -> () Relevant bindings include @@ -25,3 +27,4 @@ T5380.hs:7:34: (bound at T5380.hs:7:1) In the expression: f In the command: f -< () + In the expression: proc () -> if b then f -< () else f -< () diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index 607ecc1..745ceaa 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -13,8 +13,9 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ _N absurd :: forall a. Int :~: Bool -> a -[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType b] -absurd = \ (@ a) (x :: Int :~: Bool) -> case x of _ [Occ=Dead] { } +[GblId[sig], Arity=1, Caf=NoCafRefs, Str=DmdType b] +absurd = + \ (@ a) (ds :: Int :~: Bool) -> case ds of _ [Occ=Dead] { } diff --git a/testsuite/tests/driver/T2182.stderr b/testsuite/tests/driver/T2182.stderr index 0585e4c..b5a5f1d 100644 --- a/testsuite/tests/driver/T2182.stderr +++ b/testsuite/tests/driver/T2182.stderr @@ -5,7 +5,7 @@ T2182.hs:5:5: error: In the expression: show (\ x -> x) In an equation for ?y?: y = show (\ x -> x) -T2182.hs:6:15: error: +T2182.hs:6:5: error: No instance for (Eq (t0 -> t0)) arising from a use of ?==? (maybe you haven't applied a function to enough arguments?) In the expression: (\ x -> x) == (\ y -> y) @@ -17,7 +17,7 @@ T2182.hs:5:5: error: In the expression: show (\ x -> x) In an equation for ?y?: y = show (\ x -> x) -T2182.hs:6:15: error: +T2182.hs:6:5: error: No instance for (Eq (t0 -> t0)) arising from a use of ?==? (maybe you haven't applied a function to enough arguments?) In the expression: (\ x -> x) == (\ y -> y) From git at git.haskell.org Fri Aug 7 12:07:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:40 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Stub for manual entry (1bd7f94) Message-ID: <20150807120740.99FBC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/1bd7f94297ef9f47b2c060039d78ef3b760a217b/ghc >--------------------------------------------------------------- commit 1bd7f94297ef9f47b2c060039d78ef3b760a217b Author: Richard Eisenberg Date: Thu Aug 6 09:55:53 2015 -0400 Stub for manual entry >--------------------------------------------------------------- 1bd7f94297ef9f47b2c060039d78ef3b760a217b docs/users_guide/glasgow_exts.xml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 4625092..e8258cf 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2617,6 +2617,13 @@ to allow the import or export of a data constructor without its parent type cons + +Visible type application + +TODO + + + @@ -12918,4 +12925,3 @@ Here are some examples: ;;; ispell-local-dictionary: "british" *** ;;; End: *** --> - From git at git.haskell.org Fri Aug 7 12:07:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:43 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Bump submodule libraries/Cabal for new extension (53014aa) Message-ID: <20150807120743.99ACE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/53014aafd312a3982842ca57d94b6ecd22a8a35a/ghc >--------------------------------------------------------------- commit 53014aafd312a3982842ca57d94b6ecd22a8a35a Author: Richard Eisenberg Date: Thu Aug 6 09:56:07 2015 -0400 Bump submodule libraries/Cabal for new extension >--------------------------------------------------------------- 53014aafd312a3982842ca57d94b6ecd22a8a35a libraries/Cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Cabal b/libraries/Cabal index 03530bf..0a0de88 160000 --- a/libraries/Cabal +++ b/libraries/Cabal @@ -1 +1 @@ -Subproject commit 03530bf99d96f8e8ab00cd18a18222eeba064734 +Subproject commit 0a0de881f0402b36dd8d6c978b58bce920579017 From git at git.haskell.org Fri Aug 7 12:07:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:46 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (c26f25e) Message-ID: <20150807120746.8952C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/c26f25e6c2e4d85f4ccb52016487238b3bfc200c/ghc >--------------------------------------------------------------- commit c26f25e6c2e4d85f4ccb52016487238b3bfc200c Author: Richard Eisenberg Date: Thu Aug 6 10:35:35 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- c26f25e6c2e4d85f4ccb52016487238b3bfc200c testsuite/tests/gadt/T3169.stderr | 13 ++- testsuite/tests/gadt/gadt-escape1.stderr | 14 +-- testsuite/tests/gadt/gadt13.stderr | 13 +-- testsuite/tests/gadt/gadt7.stderr | 19 ++-- testsuite/tests/gadt/rw.stderr | 23 ++-- testsuite/tests/ghc-api/annotations/T10280.stderr | 4 +- testsuite/tests/ghc-api/annotations/T10357.stderr | 8 +- .../tests/ghci.debugger/scripts/break003.stderr | 2 +- .../tests/ghci.debugger/scripts/break005.stdout | 2 +- .../tests/ghci.debugger/scripts/break006.stderr | 16 +-- .../tests/ghci.debugger/scripts/break006.stdout | 12 +-- .../ghci.debugger/scripts/break022/break022.stdout | 2 +- .../tests/ghci.debugger/scripts/break027.stdout | 8 +- .../tests/ghci.debugger/scripts/hist001.stdout | 18 ++-- .../tests/ghci.debugger/scripts/print022.stdout | 6 +- .../tests/ghci.debugger/scripts/print025.stdout | 2 +- testsuite/tests/ghci/scripts/Defer02.stderr | 11 +- testsuite/tests/ghci/scripts/T10508.stderr | 14 ++- testsuite/tests/ghci/scripts/T2182ghci.stderr | 10 +- testsuite/tests/ghci/scripts/T8649.stderr | 1 + testsuite/tests/ghci/scripts/ghci047.stderr | 6 +- testsuite/tests/ghci/scripts/ghci050.stderr | 1 + testsuite/tests/ghci/scripts/ghci052.stderr | 3 + testsuite/tests/ghci/scripts/ghci053.stderr | 2 + testsuite/tests/ghci/scripts/ghci055.stdout | 2 +- .../should_compile/PushedInAsGivens.stderr | 1 + .../indexed-types/should_fail/GADTwrong1.stderr | 15 +-- .../tests/indexed-types/should_fail/T2544.stderr | 2 + .../tests/indexed-types/should_fail/T2664.stderr | 30 ++++-- .../tests/indexed-types/should_fail/T2693.stderr | 6 ++ .../tests/indexed-types/should_fail/T3330a.stderr | 27 ++--- .../tests/indexed-types/should_fail/T3330c.stderr | 1 + .../tests/indexed-types/should_fail/T3440.stderr | 19 ++-- .../tests/indexed-types/should_fail/T4099.stderr | 6 +- .../tests/indexed-types/should_fail/T4179.stderr | 3 +- .../tests/indexed-types/should_fail/T4485.stderr | 7 +- .../tests/indexed-types/should_fail/T5439.stderr | 8 +- .../tests/indexed-types/should_fail/T7010.stderr | 3 +- .../tests/indexed-types/should_fail/T7194.stderr | 3 +- .../tests/indexed-types/should_fail/T7354.stderr | 1 + .../tests/indexed-types/should_fail/T7354a.stderr | 1 + .../tests/indexed-types/should_fail/T7729.stderr | 1 + .../tests/indexed-types/should_fail/T7729a.stderr | 3 +- .../tests/indexed-types/should_fail/T7788.stderr | 7 +- .../tests/indexed-types/should_fail/T8227.stderr | 6 +- .../tests/indexed-types/should_fail/T8518.stderr | 18 ++-- .../tests/indexed-types/should_fail/T9554.stderr | 6 +- .../tests/indexed-types/should_fail/T9662.stderr | 120 ++++++++++++--------- testsuite/tests/module/mod69.stderr | 4 +- testsuite/tests/module/mod70.stderr | 4 +- testsuite/tests/module/mod71.stderr | 10 +- testsuite/tests/module/mod72.stderr | 2 +- .../tests/numeric/should_compile/T7116.stdout | 31 +++--- testsuite/tests/parser/should_compile/T2245.stderr | 12 +-- .../tests/parser/should_compile/read014.stderr-ghc | 10 +- testsuite/tests/parser/should_fail/T7848.stderr | 24 ++--- .../partial-sigs/should_compile/T10438.stderr | 4 +- .../partial-sigs/should_fail/Forall1Bad.stderr | 4 +- .../should_fail/NamedWildcardsNotEnabled.stderr | 17 +-- .../should_fail/ScopedNamedWildcardsBad.stderr | 3 +- .../partial-sigs/should_fail/Trac10045.stderr | 14 +-- 61 files changed, 370 insertions(+), 275 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 c26f25e6c2e4d85f4ccb52016487238b3bfc200c From git at git.haskell.org Fri Aug 7 12:07:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:49 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Use ExprSigOrigin where appropriate (9536809) Message-ID: <20150807120749.75BBF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/95368091a1c293e9023c90eadce59366a924d024/ghc >--------------------------------------------------------------- commit 95368091a1c293e9023c90eadce59366a924d024 Author: Richard Eisenberg Date: Thu Aug 6 10:40:02 2015 -0400 Use ExprSigOrigin where appropriate >--------------------------------------------------------------- 95368091a1c293e9023c90eadce59366a924d024 compiler/typecheck/TcExpr.hs | 22 ++++++---------------- 1 file changed, 6 insertions(+), 16 deletions(-) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 298639d..9f342f6 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -84,25 +84,15 @@ tcPolyExpr expr res_ty = addExprErrCtxt expr $ do { traceTc "tcPolyExpr" (ppr res_ty); tcPolyExprNC expr res_ty } -tcPolyExprNC expr res_ty - = fst <$> tcPolyExprNC_O expr res_ty - --- variant of tcPolyExpr that returns the origin -tcPolyExprNC_O - :: LHsExpr Name -- Expression to type check - -> TcSigmaType -- Expected type (could be a polytype) - -> TcM (LHsExpr TcId, CtOrigin) -- Generalised expr with expected type - -- The origin is useful if you ever need to instantiate the type - -tcPolyExprNC_O (L loc expr) res_ty +tcPolyExprNC (L loc expr) res_ty = do { traceTc "tcPolyExprNC_O" (ppr res_ty) - ; (wrap, (expr', orig)) + ; (wrap, (expr', _)) <- tcSkolemise GenSigCtxt res_ty $ \ _ res_ty -> setSrcSpan loc $ -- NB: setSrcSpan *after* skolemising, so we get better -- skolem locations tcExpr expr res_ty - ; return (L loc (mkHsWrap wrap expr'), orig) } + ; return $ L loc (mkHsWrap wrap expr') } --------------- tcMonoExpr, tcMonoExprNC @@ -239,7 +229,7 @@ tcExpr (ExprWithTySig expr sig_ty wcs) res_ty = do { nwc_tvs <- mapM newWildcardVarMetaKind wcs ; tcExtendTyVarEnv nwc_tvs $ do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty - ; (gen_fn, (expr', orig)) + ; (gen_fn, expr') <- tcSkolemise ExprSigCtxt sig_tc_ty $ \ skol_tvs res_ty -> @@ -248,13 +238,13 @@ tcExpr (ExprWithTySig expr sig_ty wcs) res_ty tcExtendTyVarEnv2 [(n,tv) | (Just n, tv) <- findScopedTyVars sig_ty sig_tc_ty skol_tvs] $ - tcPolyExprNC_O expr res_ty + tcPolyExprNC expr res_ty ; let inner_expr = ExprWithTySigOut (mkLHsWrap gen_fn expr') sig_ty ; addErrCtxt (pprSigCtxt ExprSigCtxt empty (ppr sig_ty)) $ emitWildcardHoleConstraints (zip wcs nwc_tvs) - ; tcWrapResult inner_expr sig_tc_ty res_ty orig } } + ; tcWrapResult inner_expr sig_tc_ty res_ty ExprSigOrigin } } tcExpr (HsType ty _) _ = failWithTc (sep [ text "Type argument used outside of a function argument:" From git at git.haskell.org Fri Aug 7 12:07:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:52 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (56dd690) Message-ID: <20150807120752.6B97A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/56dd690b9e4e5e7a6d0265922789c176b3c09394/ghc >--------------------------------------------------------------- commit 56dd690b9e4e5e7a6d0265922789c176b3c09394 Author: Richard Eisenberg Date: Thu Aug 6 10:46:27 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 56dd690b9e4e5e7a6d0265922789c176b3c09394 testsuite/tests/polykinds/T7438.stderr | 18 ++++---- testsuite/tests/polykinds/T7594.stderr | 1 + testsuite/tests/polykinds/T9144.stderr | 4 +- testsuite/tests/rename/should_compile/T3823.stderr | 3 +- testsuite/tests/rename/should_fail/T2993.stderr | 2 +- .../tests/rename/should_fail/rnfail016.stderr | 8 +++- .../tests/rename/should_fail/rnfail051.stderr | 3 +- .../tests/roles/should_compile/Roles13.stderr | 2 +- testsuite/tests/roles/should_compile/T8958.stderr | 4 +- .../tests/simplCore/should_compile/T3234.stderr | 20 ++++----- .../tests/simplCore/should_compile/T3717.stderr | 4 +- .../tests/simplCore/should_compile/T3772.stdout | 12 +++--- .../tests/simplCore/should_compile/T4908.stderr | 4 +- .../tests/simplCore/should_compile/T4930.stderr | 10 ++--- .../tests/simplCore/should_compile/T7360.stderr | 14 +++--- .../tests/simplCore/should_compile/T9400.stderr | 2 +- .../tests/simplCore/should_compile/rule2.stderr | 4 +- .../tests/simplCore/should_compile/simpl017.stderr | 50 ++++++++-------------- .../simplCore/should_compile/spec-inline.stderr | 14 +++--- 19 files changed, 87 insertions(+), 92 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 56dd690b9e4e5e7a6d0265922789c176b3c09394 From git at git.haskell.org Fri Aug 7 12:07:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:55 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (acae6fa) Message-ID: <20150807120755.696893A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/acae6faea2546c8cd879c4a1f5cef291c862b0ba/ghc >--------------------------------------------------------------- commit acae6faea2546c8cd879c4a1f5cef291c862b0ba Author: Richard Eisenberg Date: Thu Aug 6 10:50:19 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- acae6faea2546c8cd879c4a1f5cef291c862b0ba testsuite/tests/th/T8577.stderr | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/testsuite/tests/th/T8577.stderr b/testsuite/tests/th/T8577.stderr index 734007e..ef95cc3 100644 --- a/testsuite/tests/th/T8577.stderr +++ b/testsuite/tests/th/T8577.stderr @@ -1,7 +1,8 @@ -T8577.hs:9:11: +T8577.hs:9:11: error: Couldn't match type ?Int? with ?Bool? Expected type: Q (TExp (A Bool)) Actual type: Q (TExp (A Int)) In the expression: y In the Template Haskell splice $$y + In the expression: $$y From git at git.haskell.org Fri Aug 7 12:07:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:07:58 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Remove spurious test (0cef131) Message-ID: <20150807120758.52BAA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/0cef131b8e00e0488416b58f5cb6fbdc07981b92/ghc >--------------------------------------------------------------- commit 0cef131b8e00e0488416b58f5cb6fbdc07981b92 Author: Richard Eisenberg Date: Thu Aug 6 10:53:55 2015 -0400 Remove spurious test >--------------------------------------------------------------- 0cef131b8e00e0488416b58f5cb6fbdc07981b92 testsuite/tests/typecheck/should_compile/all.T | 1 - 1 file changed, 1 deletion(-) diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index b334b00..00ba4fe 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -467,5 +467,4 @@ test('T10562', normal, compile, ['']) test('T10564', normal, compile, ['']) test('Vta1', normal, compile, ['']) test('Vta2', normal, compile, ['']) -test('VtaInvis', normal, compile, ['']) test('PushHRIf', normal, compile, ['']) From git at git.haskell.org Fri Aug 7 12:08:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:01 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (183156f) Message-ID: <20150807120801.3A13E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/183156ff8e12069324f60875fc2dbb2c11f63831/ghc >--------------------------------------------------------------- commit 183156ff8e12069324f60875fc2dbb2c11f63831 Author: Richard Eisenberg Date: Thu Aug 6 11:25:17 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 183156ff8e12069324f60875fc2dbb2c11f63831 testsuite/tests/ghci.debugger/scripts/break001.stdout | 4 ++-- testsuite/tests/ghci.debugger/scripts/break003.stdout | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/testsuite/tests/ghci.debugger/scripts/break001.stdout b/testsuite/tests/ghci.debugger/scripts/break001.stdout index c3146e2..02ba1bb 100644 --- a/testsuite/tests/ghci.debugger/scripts/break001.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break001.stdout @@ -1,12 +1,12 @@ Breakpoint 0 activated at ../Test2.hs:3:1-9 Breakpoint 1 activated at ../Test2.hs:5:1-7 Stopped at ../Test2.hs:3:1-9 -_result :: t = _ +_result :: r = _ Stopped at ../Test2.hs:3:7-9 _result :: Integer = _ x :: Integer = 1 Stopped at ../Test2.hs:5:1-7 -_result :: t = _ +_result :: r = _ Stopped at ../Test2.hs:5:7 _result :: Integer = _ y :: Integer = 1 diff --git a/testsuite/tests/ghci.debugger/scripts/break003.stdout b/testsuite/tests/ghci.debugger/scripts/break003.stdout index a48f74c..ed41883 100644 --- a/testsuite/tests/ghci.debugger/scripts/break003.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break003.stdout @@ -1,6 +1,6 @@ Breakpoint 0 activated at ../Test3.hs:2:18-31 Stopped at ../Test3.hs:2:18-31 -_result :: [t1] = _ -f :: t -> t1 = _ +_result :: [a] = _ +f :: t -> a = _ x :: t = _ xs :: [t] = [_] From git at git.haskell.org Fri Aug 7 12:08:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:04 +0000 (UTC) Subject: [commit: ghc] wip/type-app: User manual (6a01257) Message-ID: <20150807120804.364093A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/6a012575e2b69b1a5ada908899a849b3db7ef7ac/ghc >--------------------------------------------------------------- commit 6a012575e2b69b1a5ada908899a849b3db7ef7ac Author: Richard Eisenberg Date: Thu Aug 6 11:30:16 2015 -0400 User manual >--------------------------------------------------------------- 6a012575e2b69b1a5ada908899a849b3db7ef7ac docs/users_guide/glasgow_exts.xml | 52 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 1 deletion(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index e8258cf..d77eacc 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2620,7 +2620,45 @@ to allow the import or export of a data constructor without its parent type cons Visible type application -TODO +The extension allows you to use +visible type application in expressions. Here is an +example: show (read @Int 5). The @Int +is the visible type application; it specifies the value of the type variable +in read's type. + +A visible type application is preceded with an @ +sign. (To disambiguate the syntax, the @ must be +preceded with a non-identifier letter, usually a space. For example, +read at Int 5 would not parse.) It can be used whenever +the full polymorphic type of the function is known. If the function +is an identifier (the common case), its type is considered known only when +the identifier has been given a type signature. If the identifier does +not have a type signature, visible type application cannot be used. + +Here are the details: + + + If an identifier's type signature does not include an + explicit forall, the type variable arguments appear + in the left-to-right order in which the variables appear in the type. + So, foo :: Monad m => a b -> m (a c) + will have its type variables + ordered as m, a, b, c. + + + Class methods' type arguments include the class type + variables, followed by any variables an individual method is polymorphic + in. So, class Monad m where return :: a -> m a means + that return's type arguments are m, a. + + + With the extension + (), it is possible to declare + type arguments somewhere other than the beginning of a type. For example, + we can have pair :: forall a. a -> forall b. b -> (a, b) + and then say pair @Bool True @Char which would have + type Char -> (Bool, Char). + @@ -2789,6 +2827,18 @@ The following syntax is stolen: + + + + varid @ + (as used in an as-pattern, with a space between the identifier + and the @) + + + Stolen by: + + + From git at git.haskell.org Fri Aug 7 12:08:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:07 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Allow @_ to be used without fuss (2d2d3a9) Message-ID: <20150807120807.27FED3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/2d2d3a906d4c67018579f583d2e174aca8eab21a/ghc >--------------------------------------------------------------- commit 2d2d3a906d4c67018579f583d2e174aca8eab21a Author: Richard Eisenberg Date: Thu Aug 6 11:39:57 2015 -0400 Allow @_ to be used without fuss >--------------------------------------------------------------- 2d2d3a906d4c67018579f583d2e174aca8eab21a compiler/typecheck/TcHsType.hs | 7 +++---- testsuite/tests/typecheck/should_compile/Vta1.hs | 3 +-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 6dea9e3..1b181af 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -237,12 +237,11 @@ tcHsTypeApp (hs_ty, wcs) kind = do { nwc_tvs <- mapM newWildcardVarMetaKind wcs ; tcExtendTyVarEnv nwc_tvs $ do { ty <- tcCheckLHsType hs_ty kind - - ; addErrCtxt (pprSigCtxt TypeAppCtxt empty (ppr hs_ty)) $ - emitWildcardHoleConstraints (zip wcs nwc_tvs) - ; checkValidType TypeAppCtxt ty ; return ty } } + -- NB: we don't call emitWildcardHoleConstraints here, because + -- we want any holes in visible type applications to be used + -- without fuss. No errors, warnings, extensions, etc. {- These functions are used during knot-tying in diff --git a/testsuite/tests/typecheck/should_compile/Vta1.hs b/testsuite/tests/typecheck/should_compile/Vta1.hs index cb70916..c3ba43d 100644 --- a/testsuite/tests/typecheck/should_compile/Vta1.hs +++ b/testsuite/tests/typecheck/should_compile/Vta1.hs @@ -1,7 +1,6 @@ {-# LANGUAGE TypeApplications, ScopedTypeVariables, PolyKinds, - TypeFamilies, RankNTypes, PartialTypeSignatures, + TypeFamilies, RankNTypes, FlexibleContexts #-} -{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-} -- tests about visible type application module Vta1 where From git at git.haskell.org Fri Aug 7 12:08:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:10 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Update user manual re @_. (556af58) Message-ID: <20150807120810.128213A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/556af581baa8f6c934849231b8dd4859cacf61e7/ghc >--------------------------------------------------------------- commit 556af581baa8f6c934849231b8dd4859cacf61e7 Author: Richard Eisenberg Date: Thu Aug 6 11:43:44 2015 -0400 Update user manual re @_. >--------------------------------------------------------------- 556af581baa8f6c934849231b8dd4859cacf61e7 docs/users_guide/glasgow_exts.xml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index d77eacc..b523210 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2658,6 +2658,16 @@ not have a type signature, visible type application cannot be used. we can have pair :: forall a. a -> forall b. b -> (a, b) and then say pair @Bool True @Char which would have type Char -> (Bool, Char). + + Partial type signatures () work nicely with visible type + application. If you want to specify only the second type argument to + wurble, then you can say wurble @_ @Int. + The first argument is a wildcard, just like in a partial type signature. + However, if used in a visible type application, it is not + necessary to specify and your + code will not generate a warning informing you of the omitted type. + From git at git.haskell.org Fri Aug 7 12:08:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:15 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Merge remote-tracking branch 'origin/master' into wip/type-app (a97ef28) Message-ID: <20150807120815.624583A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/a97ef2812d5f61f9c5211eaefec9cf0796a964cc/ghc >--------------------------------------------------------------- commit a97ef2812d5f61f9c5211eaefec9cf0796a964cc Merge: 556af58 64dba51 Author: Richard Eisenberg Date: Thu Aug 6 12:55:12 2015 -0400 Merge remote-tracking branch 'origin/master' into wip/type-app Conflicts: compiler/iface/TcIface.hs compiler/main/DynFlags.hs compiler/typecheck/TcBinds.hs compiler/typecheck/TcClassDcl.hs compiler/typecheck/TcErrors.hs compiler/typecheck/TcExpr.hs compiler/typecheck/TcMType.hs compiler/typecheck/TcPat.hs compiler/typecheck/TcSMonad.hs compiler/typecheck/TcType.hs compiler/typecheck/TcValidity.hs libraries/Cabal testsuite/tests/ghci.debugger/scripts/break003.stderr testsuite/tests/ghci.debugger/scripts/break006.stderr testsuite/tests/ghci/scripts/Defer02.stderr testsuite/tests/ghci/scripts/T2182ghci.stderr testsuite/tests/ghci/scripts/T7730.stdout testsuite/tests/ghci/scripts/ghci047.stderr testsuite/tests/numeric/should_compile/T7116.stdout testsuite/tests/parser/should_compile/all.T testsuite/tests/partial-sigs/should_compile/T10403.stderr testsuite/tests/partial-sigs/should_compile/T10438.stderr testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr testsuite/tests/partial-sigs/should_fail/Defaulting1MROff.stderr testsuite/tests/partial-sigs/should_fail/TidyClash.stderr testsuite/tests/partial-sigs/should_fail/Trac10045.stderr testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr testsuite/tests/patsyn/should_run/ghci.stdout testsuite/tests/safeHaskell/ghci/p16.stderr testsuite/tests/safeHaskell/ghci/p4.stderr testsuite/tests/safeHaskell/ghci/p6.stderr testsuite/tests/typecheck/should_compile/T10072.stderr testsuite/tests/typecheck/should_compile/all.T testsuite/tests/typecheck/should_fail/T10351.stderr testsuite/tests/typecheck/should_fail/T6022.stderr testsuite/tests/typecheck/should_fail/T8883.stderr testsuite/tests/typecheck/should_fail/all.T testsuite/tests/typecheck/should_fail/tcfail198.stderr >--------------------------------------------------------------- Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a97ef2812d5f61f9c5211eaefec9cf0796a964cc From git at git.haskell.org Fri Aug 7 12:08:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:20 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Merge remote-tracking branch 'origin/master' into wip/type-app (cb50691) Message-ID: <20150807120820.925933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/cb506915005222cf25c80267569a4531a62b7374/ghc >--------------------------------------------------------------- commit cb506915005222cf25c80267569a4531a62b7374 Merge: a97ef28 bc43d23 Author: Richard Eisenberg Date: Thu Aug 6 16:02:31 2015 -0400 Merge remote-tracking branch 'origin/master' into wip/type-app >--------------------------------------------------------------- cb506915005222cf25c80267569a4531a62b7374 compiler/llvmGen/LlvmMangler.hs | 183 +++++++++------------ compiler/main/DynFlags.hs | 36 +++- compiler/main/GHC.hs | 27 +-- libraries/base/Control/Applicative.hs | 3 +- libraries/base/Data/Complex.hs | 16 +- libraries/base/Data/Functor/Identity.hs | 3 +- libraries/base/Foreign/Storable.hs | 6 + libraries/base/changelog.md | 9 +- rts/posix/OSMem.c | 59 +++---- testsuite/tests/driver/{T8101.hs => T8101b.hs} | 0 .../tests/driver/{T8101.stderr => T8101b.stderr} | 2 +- testsuite/tests/driver/all.T | 2 + testsuite/tests/ghc-api/T10052/T10052.stderr | 2 +- .../tests/ghci.debugger/scripts/print007.stderr | 5 +- .../should_compile => ghci/should_fail}/Makefile | 0 testsuite/tests/ghci/should_fail/T10549.hs | 15 ++ testsuite/tests/ghci/should_fail/T10549.script | 1 + .../should_fail/T10549.stderr} | 2 +- testsuite/tests/ghci/should_fail/all.T | 3 + 19 files changed, 208 insertions(+), 166 deletions(-) From git at git.haskell.org Fri Aug 7 12:08:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:23 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Fix compiler errors from merging (3c061dc) Message-ID: <20150807120823.8C2193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/3c061dc766845d148ce23236d3c0122a6dcd0eda/ghc >--------------------------------------------------------------- commit 3c061dc766845d148ce23236d3c0122a6dcd0eda Author: Richard Eisenberg Date: Thu Aug 6 16:25:57 2015 -0400 Fix compiler errors from merging >--------------------------------------------------------------- 3c061dc766845d148ce23236d3c0122a6dcd0eda compiler/typecheck/TcBinds.hs | 2 +- compiler/typecheck/TcExpr.hs | 2 +- compiler/typecheck/TcHsType.hs | 2 +- compiler/typecheck/TcMatches.hs | 4 ++++ 4 files changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 01648a9..874b7a1 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -1802,7 +1802,7 @@ instTcTySig ctxt hs_ty sigma_ty extra_cts nwcs name = CompleteSig $ mkLocalId name sigma_ty HasSigId -- non-partial | otherwise = PartialSig { sig_name = name, sig_nwcs = nwcs - , sig_cts = extra_ctx, sig_hs_ty = hs_ty } + , sig_cts = extra_cts, sig_hs_ty = hs_ty } ; return (TISI { sig_bndr = bndr , sig_tvs = findScopedTyVars hs_ty sigma_ty inst_tvs , sig_theta = theta diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 72b54e3..c9cdb29 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -243,7 +243,7 @@ tcExpr (ExprWithTySig expr sig_ty wcs) res_ty ; let inner_expr = ExprWithTySigOut (mkLHsWrap gen_fn expr') sig_ty - ; tcWrapResult inner_expr sig_tc_ty res_ty ExprSigOrigin } } + ; tcWrapResult inner_expr sig_tc_ty res_ty ExprSigOrigin } tcExpr (HsType ty _) _ = failWithTc (sep [ text "Type argument used outside of a function argument:" diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index a5478f7..9ad4a5d 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -238,7 +238,7 @@ tcHsTypeApp (hs_ty, wcs) kind = tcWildcardBinders wcs $ \ wc_prs -> do { ty <- tcCheckLHsType hs_ty kind ; checkValidType TypeAppCtxt ty - ; return ty } } + ; return ty } -- NB: we don't call emitWildcardHoleConstraints here, because -- we want any holes in visible type applications to be used -- without fuss. No errors, warnings, extensions, etc. diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index 30c3f4a..18e3df0 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -43,6 +43,10 @@ import MkCore import Control.Monad +#if __GLASGOW_HASKELL__ < 709 +import Data.Traversable ( traverse ) +#endif + #include "HsVersions.h" {- From git at git.haskell.org Fri Aug 7 12:08:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:26 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (40d6e73) Message-ID: <20150807120826.870A63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/40d6e73321b6e5d6162dc66b1e36cc006dc67e3a/ghc >--------------------------------------------------------------- commit 40d6e73321b6e5d6162dc66b1e36cc006dc67e3a Author: Richard Eisenberg Date: Thu Aug 6 20:15:07 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 40d6e73321b6e5d6162dc66b1e36cc006dc67e3a .../tests/ghci.debugger/scripts/break003.stderr | 2 +- .../tests/ghci.debugger/scripts/break006.stderr | 16 ++-- testsuite/tests/ghci/scripts/Defer02.stderr | 87 ++++++++++++---------- testsuite/tests/ghci/scripts/T2182ghci.stderr | 10 +-- testsuite/tests/ghci/scripts/T7730.stdout | 8 +- testsuite/tests/ghci/scripts/ghci047.stderr | 6 +- .../tests/numeric/should_compile/T7116.stdout | 31 ++++---- .../partial-sigs/should_compile/SplicesUsed.stderr | 42 +++++------ .../partial-sigs/should_compile/T10403.stderr | 50 +++++++------ .../partial-sigs/should_compile/T10438.stderr | 14 ++-- .../should_fail/Defaulting1MROff.stderr | 2 +- .../partial-sigs/should_fail/TidyClash.stderr | 10 ++- .../partial-sigs/should_fail/Trac10045.stderr | 20 ++--- .../should_fail/WildcardInstantiations.stderr | 30 ++++---- .../WildcardsInPatternAndExprSig.stderr | 56 +++++++------- 15 files changed, 199 insertions(+), 185 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 40d6e73321b6e5d6162dc66b1e36cc006dc67e3a From git at git.haskell.org Fri Aug 7 12:08:30 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:30 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Tidy classes before printing during validity checks (97ef728) Message-ID: <20150807120830.1FBC33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/97ef728fa2a796d3917d262298e76dbd3a95805f/ghc >--------------------------------------------------------------- commit 97ef728fa2a796d3917d262298e76dbd3a95805f Author: Richard Eisenberg Date: Thu Aug 6 21:08:32 2015 -0400 Tidy classes before printing during validity checks >--------------------------------------------------------------- 97ef728fa2a796d3917d262298e76dbd3a95805f compiler/typecheck/FunDeps.hs | 6 +++++- compiler/typecheck/TcValidity.hs | 21 ++++++++++++++------- testsuite/tests/polykinds/TidyClassKinds.hs | 13 +++++++++++++ testsuite/tests/polykinds/TidyClassKinds.stderr | 8 ++++++++ testsuite/tests/polykinds/all.T | 1 + 5 files changed, 41 insertions(+), 8 deletions(-) diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs index fd347a1..5b5ffb5 100644 --- a/compiler/typecheck/FunDeps.hs +++ b/compiler/typecheck/FunDeps.hs @@ -382,7 +382,11 @@ checkInstCoverage be_liberal clas theta inst_taus conserv_undet_tvs = rs_tvs `minusVarSet` closeOverKinds ls_tvs -- closeOverKinds: see Note [Closing over kinds in coverage] - undet_list = varSetElemsKvsFirst undetermined_tvs + -- we do need to tidy, because it's possible that we're about + -- to report about a GHC-generated kind variable + -- for example, test case polykinds/T10570 + undet_list = snd $ tidyOpenTyVars emptyTidyEnv $ + varSetElemsKvsFirst undetermined_tvs msg = vcat [ -- text "ls_tvs" <+> ppr ls_tvs -- , text "closed ls_tvs" <+> ppr (closeOverKinds ls_tvs) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 9eba27d..189e3d3 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -964,8 +964,15 @@ checkValidInstance :: UserTypeCtxt -> LHsType Name -> Type checkValidInstance ctxt hs_type ty | Just (clas,inst_tys) <- getClassPredTys_maybe tau , inst_tys `lengthIs` classArity clas - = do { setSrcSpan head_loc (checkValidInstHead ctxt clas inst_tys) - ; checkValidTheta ctxt theta + = do { let (tidy_env0, tidy_tys) = tidyOpenTypes emptyTidyEnv inst_tys + (tidy_env1, tidy_theta) = tidyOpenTypes tidy_env0 theta + (_, tidy_ty) = tidyOpenType tidy_env1 ty + -- even though the inst_tys are user-specified, we still must + -- tidy, because of the possibility of kind variables. See, + -- for example, test case polykinds/TidyClassKinds + + ; setSrcSpan head_loc (checkValidInstHead ctxt clas tidy_tys) + ; checkValidTheta ctxt tidy_theta -- The Termination and Coverate Conditions -- Check that instance inference will terminate (if we care) @@ -979,12 +986,12 @@ checkValidInstance ctxt hs_type ty -- in the constraint than in the head ; undecidable_ok <- xoptM Opt_UndecidableInstances ; if undecidable_ok - then checkAmbiguity ctxt ty - else checkInstTermination inst_tys theta + then checkAmbiguity ctxt tidy_ty + else checkInstTermination tidy_tys tidy_theta - ; case (checkInstCoverage undecidable_ok clas theta inst_tys) of - IsValid -> return () -- Check succeeded - NotValid msg -> addErrTc (instTypeErr clas inst_tys msg) + ; case (checkInstCoverage undecidable_ok clas tidy_theta tidy_tys) of + IsValid -> return () -- Check succeeded + NotValid msg -> addErrTc (instTypeErr clas tidy_tys msg) ; return (tvs, theta, clas, inst_tys) } diff --git a/testsuite/tests/polykinds/TidyClassKinds.hs b/testsuite/tests/polykinds/TidyClassKinds.hs new file mode 100644 index 0000000..83f6eaa --- /dev/null +++ b/testsuite/tests/polykinds/TidyClassKinds.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE MultiParamTypeClasses, PolyKinds #-} +{-# OPTIONS_GHC -fprint-explicit-kinds #-} + +module TidyClassKinds where + +import Data.Proxy + +class Poly a b + +type ProxySyn = Proxy + +instance Poly ProxySyn ProxySyn + -- output should really talk about k1 and k2, not about k and k! diff --git a/testsuite/tests/polykinds/TidyClassKinds.stderr b/testsuite/tests/polykinds/TidyClassKinds.stderr new file mode 100644 index 0000000..e9ff41f --- /dev/null +++ b/testsuite/tests/polykinds/TidyClassKinds.stderr @@ -0,0 +1,8 @@ + +TidyClassKinds.hs:12:10: error: + Illegal instance declaration for + ?Poly (k0 -> *) (k1 -> *) (ProxySyn k0) (ProxySyn k1)? + (All instance types must be of the form (T t1 ... tn) + where T is not a synonym. + Use TypeSynonymInstances if you want to disable this.) + In the instance declaration for ?Poly ProxySyn ProxySyn? diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index c073c1b..8a71d45 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -121,3 +121,4 @@ test('T10670', normal, compile, ['']) test('T10670a', normal, compile, ['']) test('T10134', normal, multimod_compile, ['T10134.hs','-v0']) test('T10742', normal, compile, ['']) +test('TidyClassKinds', normal, compile_fail, ['-fprint-explicit-kinds']) From git at git.haskell.org Fri Aug 7 12:08:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:32 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Tidy in checkValidType. (4ed3770) Message-ID: <20150807120832.EE9303A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/4ed37701e4c421b2a9d75ee9793483ecbccb21e0/ghc >--------------------------------------------------------------- commit 4ed37701e4c421b2a9d75ee9793483ecbccb21e0 Author: Richard Eisenberg Date: Fri Aug 7 08:00:34 2015 -0400 Tidy in checkValidType. This is necessary in testcase typecheck/should_fail/T10351, for example. >--------------------------------------------------------------- 4ed37701e4c421b2a9d75ee9793483ecbccb21e0 compiler/typecheck/TcValidity.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 189e3d3..323e48a 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -263,6 +263,7 @@ checkValidType :: UserTypeCtxt -> Type -> TcM () -- Not used for instance decls; checkValidInstance instead checkValidType ctxt ty = do { traceTc "checkValidType" (ppr ty <+> text "::" <+> ppr (typeKind ty)) + ; let (_, tidy_ty) = tidyOpenType emptyTidyEnv ty ; rankn_flag <- xoptM Opt_RankNTypes ; let gen_rank :: Rank -> Rank gen_rank r | rankn_flag = ArbitraryRank @@ -297,17 +298,17 @@ checkValidType ctxt ty -- Can't happen; not used for *user* sigs -- Check the internal validity of the type itself - ; check_type ctxt rank ty + ; check_type ctxt rank tidy_ty -- Check that the thing has kind Type, and is lifted if necessary. -- Do this *after* check_type, because we can't usefully take -- the kind of an ill-formed type such as (a~Int) - ; check_kind ctxt ty + ; check_kind ctxt tidy_ty -- Check for ambiguous types. See Note [When to call checkAmbiguity] -- NB: this will happen even for monotypes, but that should be cheap; -- and there may be nested foralls for the subtype test to examine - ; checkAmbiguity ctxt ty + ; checkAmbiguity ctxt tidy_ty ; traceTc "checkValidType done" (ppr ty <+> text "::" <+> ppr (typeKind ty)) } @@ -593,6 +594,13 @@ applying the instance decl would show up two uses of ?x. Trac #8912. checkValidTheta :: UserTypeCtxt -> ThetaType -> TcM () checkValidTheta ctxt theta + = checkValidTidyTheta ctxt tidy_theta + where + (_, tidy_theta) = tidyOpenTypes emptyTidyEnv theta + +-- | Variant of 'checkValidTheta' that assumes the input is already tidy +checkValidTidyTheta :: UserTypeCtxt -> ThetaType -> TcM () +checkValidTidyTheta ctxt theta = addErrCtxt (checkThetaCtxt ctxt theta) (check_valid_theta ctxt theta) ------------------------- @@ -972,7 +980,7 @@ checkValidInstance ctxt hs_type ty -- for example, test case polykinds/TidyClassKinds ; setSrcSpan head_loc (checkValidInstHead ctxt clas tidy_tys) - ; checkValidTheta ctxt tidy_theta + ; checkValidTidyTheta ctxt tidy_theta -- The Termination and Coverate Conditions -- Check that instance inference will terminate (if we care) From git at git.haskell.org Fri Aug 7 12:08:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:08:36 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Testsuite wibbles (9041d03) Message-ID: <20150807120836.113873A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/9041d03faa5dcf13a64879af2136d2fdeaba0fb1/ghc >--------------------------------------------------------------- commit 9041d03faa5dcf13a64879af2136d2fdeaba0fb1 Author: Richard Eisenberg Date: Fri Aug 7 08:03:02 2015 -0400 Testsuite wibbles >--------------------------------------------------------------- 9041d03faa5dcf13a64879af2136d2fdeaba0fb1 testsuite/tests/polykinds/T10570.stderr | 2 +- testsuite/tests/rename/should_fail/T10618.stderr | 2 +- testsuite/tests/safeHaskell/ghci/p16.stderr | 2 +- testsuite/tests/safeHaskell/ghci/p4.stderr | 2 +- testsuite/tests/safeHaskell/ghci/p6.stderr | 2 +- testsuite/tests/stranal/should_compile/T10694.stdout | 2 +- testsuite/tests/typecheck/should_compile/T10072.stderr | 6 +++--- .../tests/typecheck/should_fail/ExpandSynsFail2.stderr | 3 +++ testsuite/tests/typecheck/should_fail/T10351.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/T6022.stderr | 4 ++-- testsuite/tests/typecheck/should_fail/T8883.stderr | 8 ++++---- testsuite/tests/typecheck/should_fail/tcfail198.stderr | 13 +++++++------ 12 files changed, 27 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 9041d03faa5dcf13a64879af2136d2fdeaba0fb1 From git at git.haskell.org Fri Aug 7 12:12:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:12:13 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Revert "*** Use global url for .gitmodules" (91db569) Message-ID: <20150807121213.B6D5D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/91db569611f047bb5d348fab585218a7080231c6/ghc >--------------------------------------------------------------- commit 91db569611f047bb5d348fab585218a7080231c6 Author: Richard Eisenberg Date: Fri Aug 7 08:11:51 2015 -0400 Revert "*** Use global url for .gitmodules" This reverts commit d2228af2b996dba11437975ea570b2b6fb60a62c. >--------------------------------------------------------------- 91db569611f047bb5d348fab585218a7080231c6 .gitmodules | 58 +++++++++++++++++++++++++++++----------------------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/.gitmodules b/.gitmodules index d7dcb0f..662f6d6 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,117 +1,117 @@ [submodule "libraries/binary"] path = libraries/binary - url = git://git.haskell.org/packages/binary.git + url = ../packages/binary.git ignore = untracked [submodule "libraries/bytestring"] path = libraries/bytestring - url = git://git.haskell.org/packages/bytestring.git + url = ../packages/bytestring.git ignore = untracked [submodule "libraries/Cabal"] path = libraries/Cabal - url = git://git.haskell.org/packages/Cabal.git + url = ../packages/Cabal.git ignore = untracked [submodule "libraries/containers"] path = libraries/containers - url = git://git.haskell.org/packages/containers.git + url = ../packages/containers.git ignore = untracked [submodule "libraries/haskeline"] path = libraries/haskeline - url = git://git.haskell.org/packages/haskeline.git + url = ../packages/haskeline.git ignore = untracked [submodule "libraries/pretty"] path = libraries/pretty - url = git://git.haskell.org/packages/pretty.git + url = ../packages/pretty.git ignore = untracked [submodule "libraries/terminfo"] path = libraries/terminfo - url = git://git.haskell.org/packages/terminfo.git + url = ../packages/terminfo.git ignore = untracked [submodule "libraries/transformers"] path = libraries/transformers - url = git://git.haskell.org/packages/transformers.git + url = ../packages/transformers.git ignore = untracked [submodule "libraries/xhtml"] path = libraries/xhtml - url = git://git.haskell.org/packages/xhtml.git + url = ../packages/xhtml.git ignore = untracked [submodule "libraries/Win32"] path = libraries/Win32 - url = git://git.haskell.org/packages/Win32.git + url = ../packages/Win32.git ignore = untracked [submodule "libraries/primitive"] path = libraries/primitive - url = git://git.haskell.org/packages/primitive.git + url = ../packages/primitive.git ignore = untracked [submodule "libraries/vector"] path = libraries/vector - url = git://git.haskell.org/packages/vector.git + url = ../packages/vector.git ignore = untracked [submodule "libraries/time"] path = libraries/time - url = git://git.haskell.org/packages/time.git + url = ../packages/time.git ignore = untracked [submodule "libraries/random"] path = libraries/random - url = git://git.haskell.org/packages/random.git + url = ../packages/random.git ignore = untracked [submodule "libraries/array"] path = libraries/array - url = git://git.haskell.org/packages/array.git + url = ../packages/array.git ignore = none [submodule "libraries/deepseq"] path = libraries/deepseq - url = git://git.haskell.org/packages/deepseq.git + url = ../packages/deepseq.git ignore = none [submodule "libraries/directory"] path = libraries/directory - url = git://git.haskell.org/packages/directory.git + url = ../packages/directory.git ignore = none [submodule "libraries/filepath"] path = libraries/filepath - url = git://git.haskell.org/packages/filepath.git + url = ../packages/filepath.git ignore = none [submodule "libraries/hoopl"] path = libraries/hoopl - url = git://git.haskell.org/packages/hoopl.git + url = ../packages/hoopl.git ignore = none [submodule "libraries/hpc"] path = libraries/hpc - url = git://git.haskell.org/packages/hpc.git + url = ../packages/hpc.git ignore = none [submodule "libraries/process"] path = libraries/process - url = git://git.haskell.org/packages/process.git + url = ../packages/process.git ignore = none [submodule "libraries/unix"] path = libraries/unix - url = git://git.haskell.org/packages/unix.git + url = ../packages/unix.git ignore = none [submodule "libraries/parallel"] path = libraries/parallel - url = git://git.haskell.org/packages/parallel.git + url = ../packages/parallel.git ignore = none [submodule "libraries/stm"] path = libraries/stm - url = git://git.haskell.org/packages/stm.git + url = ../packages/stm.git ignore = none [submodule "libraries/dph"] path = libraries/dph - url = git://git.haskell.org/packages/dph.git + url = ../packages/dph.git ignore = none [submodule "utils/haddock"] path = utils/haddock - url = git://git.haskell.org/haddock.git + url = ../haddock.git ignore = none branch = ghc-head [submodule "nofib"] path = nofib - url = git://git.haskell.org/nofib.git + url = ../nofib.git ignore = none [submodule "utils/hsc2hs"] path = utils/hsc2hs - url = git://git.haskell.org/hsc2hs.git + url = ../hsc2hs.git ignore = none [submodule "libffi-tarballs"] path = libffi-tarballs - url = git://git.haskell.org/libffi-tarballs.git + url = ../libffi-tarballs.git ignore = none From git at git.haskell.org Fri Aug 7 12:12:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 12:12:16 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Release note (9f35dd5) Message-ID: <20150807121216.B63203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/9f35dd5ea72df8c7dfb56a5d86b2401163ea7d74/ghc >--------------------------------------------------------------- commit 9f35dd5ea72df8c7dfb56a5d86b2401163ea7d74 Author: Richard Eisenberg Date: Fri Aug 7 08:13:54 2015 -0400 Release note >--------------------------------------------------------------- 9f35dd5ea72df8c7dfb56a5d86b2401163ea7d74 docs/users_guide/7.12.1-notes.xml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index b026507..b80db1d 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -72,6 +72,13 @@ + GHC now supports visible type application, allowing programmers + to easily specify how type parameters should be instantiated + when calling a function. See for the details. + + + + To conform to the common case, the default role assigned to parameters of datatypes declared in hs-boot files is representational. However, if the constructor(s) From git at git.haskell.org Fri Aug 7 15:58:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 7 Aug 2015 15:58:55 +0000 (UTC) Subject: [commit: ghc] master: Sync base/changelog.md with GHC 7.10.2 release (f1b4864) Message-ID: <20150807155855.477253A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f1b4864d06c080b4b1234f2a5f16a6def25cd615/ghc >--------------------------------------------------------------- commit f1b4864d06c080b4b1234f2a5f16a6def25cd615 Author: Herbert Valerio Riedel Date: Fri Aug 7 17:59:25 2015 +0200 Sync base/changelog.md with GHC 7.10.2 release [skip ci] >--------------------------------------------------------------- f1b4864d06c080b4b1234f2a5f16a6def25cd615 libraries/base/changelog.md | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 2306d36..9ceef87 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -29,8 +29,6 @@ - `Data.Ratio.{denominator,numerator}` have no `Integral` constraint anymore - **TODO** - * New module `GHC.SrcLoc` - * New `GHC.Generics.packageName` operation * New `GHC.Stack.CallStack` data type @@ -58,12 +56,15 @@ * Made `PatternMatchFail`, `RecSelError`, `RecConError`, `RecUpdError`, `NoMethodError`, and `AssertionFailed` newtypes (#10738) -## 4.8.1.0 *TBA* +## 4.8.1.0 *Jul 2015* * Bundled with GHC 7.10.2 * `Lifetime` is now exported from `GHC.Event` + * Implicit-parameter based source location support exposed in `GHC.SrcLoc`. + See GHC User's Manual for more information. + ## 4.8.0.0 *Mar 2015* * Bundled with GHC 7.10.1 From git at git.haskell.org Sat Aug 8 07:30:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Aug 2015 07:30:28 +0000 (UTC) Subject: [commit: ghc] master: Make oneShot open-kinded (590aa0f) Message-ID: <20150808073028.DDC163A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/590aa0f03dda8bb71c7b6910e64aa6e7f951fbbf/ghc >--------------------------------------------------------------- commit 590aa0f03dda8bb71c7b6910e64aa6e7f951fbbf Author: Joachim Breitner Date: Fri Aug 7 10:36:32 2015 +0200 Make oneShot open-kinded akio wants to use oneShot with unlifted types as well, and there is no good reason not to let him. This changes the type of the built-in oneShot definition to open kinds, and also expand the documentation a little bit. Differential Revision: https://phabricator.haskell.org/D1136 >--------------------------------------------------------------- 590aa0f03dda8bb71c7b6910e64aa6e7f951fbbf compiler/basicTypes/MkId.hs | 4 ++-- libraries/ghc-prim/GHC/Magic.hs | 7 +++++++ testsuite/tests/typecheck/should_compile/T10744.hs | 17 +++++++++++++++++ testsuite/tests/typecheck/should_compile/all.T | 1 + 4 files changed, 27 insertions(+), 2 deletions(-) diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 11f8f78..29e0e64 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -1142,11 +1142,11 @@ oneShotId = pcMiscPrelId oneShotName ty info where info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma `setUnfoldingInfo` mkCompulsoryUnfolding rhs - ty = mkForAllTys [alphaTyVar, betaTyVar] (mkFunTy fun_ty fun_ty) + ty = mkForAllTys [openAlphaTyVar, openBetaTyVar] (mkFunTy fun_ty fun_ty) fun_ty = mkFunTy alphaTy betaTy [body, x] = mkTemplateLocals [fun_ty, alphaTy] x' = setOneShotLambda x - rhs = mkLams [alphaTyVar, betaTyVar, body, x'] $ Var body `App` Var x + rhs = mkLams [openAlphaTyVar, openBetaTyVar, body, x'] $ Var body `App` Var x -------------------------------------------------------------------------------- diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs index 1a6af92..22db69f 100644 --- a/libraries/ghc-prim/GHC/Magic.hs +++ b/libraries/ghc-prim/GHC/Magic.hs @@ -69,6 +69,13 @@ lazy x = x -- argument will be called at most once, which may (or may not) enable certain -- optimizations. It can be useful to improve the performance of code in continuation -- passing style. +-- +-- If 'oneShot' is used wrongly, then it may be that computations whose result +-- that would otherwise be shared are re-evaluated every time they are used. Otherwise, +-- the use of `oneShot` is safe. +-- +-- 'oneShot' is open kinded, i.e. the type variables can refer to unlifted +-- types as well. oneShot :: (a -> b) -> (a -> b) oneShot f = f -- Implementation note: This is wired in in MkId.lhs, so the code here is diff --git a/testsuite/tests/typecheck/should_compile/T10744.hs b/testsuite/tests/typecheck/should_compile/T10744.hs new file mode 100644 index 0000000..64219ad --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T10744.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE MagicHash #-} +module T10744 where + +import GHC.Exts +import GHC.Magic + +-- Checks if oneShot is open-kinded + +f0 :: Int -> Int +f0 = oneShot $ \n -> n + +f1 :: Int# -> Int +f1 = oneShot $ \n# -> I# n# + +f2 :: Int -> Int# +f2 = oneShot $ \(I# n#) -> n# + diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 47a154a..d9f2bd8 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -468,3 +468,4 @@ test('T10562', normal, compile, ['']) test('T10564', normal, compile, ['']) test('T10632', normal, compile, ['']) test('T10642', normal, compile, ['']) +test('T10744', normal, compile, ['']) From git at git.haskell.org Sat Aug 8 07:30:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Aug 2015 07:30:31 +0000 (UTC) Subject: [commit: ghc] master: cmmCreateSwitchPlan: Handle singletons up-front (92f35cd) Message-ID: <20150808073031.B14DE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/92f35cd9829db7555397aa3dc8cd243d17694fee/ghc >--------------------------------------------------------------- commit 92f35cd9829db7555397aa3dc8cd243d17694fee Author: Joachim Breitner Date: Fri Aug 7 10:56:09 2015 +0200 cmmCreateSwitchPlan: Handle singletons up-front and make sure these are implemented with an equality check, which is a shorter instruction. This was suggested by rwbarton in #10677. Differential Revision: https://phabricator.haskell.org/D1137 >--------------------------------------------------------------- 92f35cd9829db7555397aa3dc8cd243d17694fee compiler/cmm/CmmSwitch.hs | 15 +++++++++++++-- testsuite/tests/perf/compiler/all.T | 4 +++- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/CmmSwitch.hs b/compiler/cmm/CmmSwitch.hs index 09abec6..604e759 100644 --- a/compiler/cmm/CmmSwitch.hs +++ b/compiler/cmm/CmmSwitch.hs @@ -258,12 +258,23 @@ targetSupportsSwitch _ = False -- | This function creates a SwitchPlan from a SwitchTargets value, breaking it -- down into smaller pieces suitable for code generation. createSwitchPlan :: SwitchTargets -> SwitchPlan -createSwitchPlan (SwitchTargets signed mbdef range m) = +-- Lets do the common case of a singleton map quicky and efficiently (#10677) +createSwitchPlan (SwitchTargets _signed _range (Just defLabel) m) + | [(x, l)] <- M.toList m + = IfEqual x l (Unconditionally defLabel) +-- And another common case, matching booleans +createSwitchPlan (SwitchTargets _signed (lo,hi) Nothing m) + | [(x1, l1), (x2,l2)] <- M.toAscList m + , x1 == lo + , x2 == hi + , x1 + 1 == x2 + = IfEqual x1 l1 (Unconditionally l2) +createSwitchPlan (SwitchTargets signed range mbdef m) = -- pprTrace "createSwitchPlan" (text (show ids) $$ text (show (range,m)) $$ text (show pieces) $$ text (show flatPlan) $$ text (show plan)) $ plan where pieces = concatMap breakTooSmall $ splitAtHoles maxJumpTableHole m - flatPlan = findSingleValues $ mkFlatSwitchPlan signed range mbdef pieces + flatPlan = findSingleValues $ mkFlatSwitchPlan signed mbdef range pieces plan = buildTree signed $ flatPlan diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 66b13bd..affc267 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -416,7 +416,7 @@ test('T783', # 2014-09-03: 223377364 (Windows) better specialisation, raft of core-to-core optimisations # 2014-12-22: 235002220 (Windows) not sure why - (wordsize(64), 548288760, 10)]), + (wordsize(64), 470738808, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -437,6 +437,8 @@ test('T783', # this test seems to be an extreme outlier.) # 2015-05-16: 548288760 (amd64/Linux) # (improved sequenceBlocks in nativeCodeGen, #10422) + # 2015-08-07: 470738808 (amd64/Linux) + # (simplifying the switch plan code path for simple checks, #10677) extra_hc_opts('-static') ], compile,['']) From git at git.haskell.org Sat Aug 8 18:25:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Aug 2015 18:25:31 +0000 (UTC) Subject: [commit: ghc] wip/type-app: Visible type application (6d2bf73) Message-ID: <20150808182531.2E83B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/6d2bf73e8d207efcec503c75e996da6a8d85d2fa/ghc >--------------------------------------------------------------- commit 6d2bf73e8d207efcec503c75e996da6a8d85d2fa Author: Richard Eisenberg Date: Fri Aug 7 08:13:54 2015 -0400 Visible type application Summary: This implements visible type application into GHC, as described in http://www.seas.upenn.edu/~sweirich/papers/type-app-extended.pdf Very briefly, this means (with new extension `TypeApplications` enabled) that you can say `show (read @Int "5")` and get the behavior that you want. This is a sizable change to the type-checker, because it means that `tcExpr` does //not// instantiate types it infers. Instead, types are instantiated only when required. The details are in the paper. * At this point, kind variables may not be visibly instantiated. I expect to fix this deficiency in the merging type/kind work. * Visible type application is not yet available in patterns, only expressions. I expect to fix this, also. * This patch also adds some more tidying to TcValidity, necessary for good error messages. This actually fixes a bug unrelated to visible type application. * There are some open design questions. I will post to #5296, as Trac seems a better forum for design issues. There is one part of this patch which is atrociously ugly. As described in the paper, we must keep track of the difference between specified type variables (as given by the user) and inferred type variables (as generated by GHC). There is not a convenient place to mark this distinction. BUT, there //is// a convenient place in my merging types/kinds patch, which should land for 7.12. So I did an ugly thing: I put the bit in the `Name` of the type variable, using `System` names for inferred variables and `Internal` names for specified ones. This was actually only a small change from existing practice, but I well know that having type-checking depend on a variable's `Name` is terrible. However, I think it's better for this patch to land separate from my types/kinds patch, and changing `ForAllTy` to note the specified/inferred distinction would duplicate a bunch of effort in my other patch. Thus the compromise seen here. This behavior will be removed when this patch is merged into my other one. If this is just too ugly, I can accept that and merge this with my other patch internally, without going via `master`. Test Plan: ./validate Reviewers: simonpj, bgamari, austin, hvr Subscribers: thomie, mpickering Differential Revision: https://phabricator.haskell.org/D1138 GHC Trac Issues: #5296, #10619, #10589, #10709. >--------------------------------------------------------------- 6d2bf73e8d207efcec503c75e996da6a8d85d2fa docs/users_guide/7.12.1-notes.xml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index b026507..b80db1d 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -72,6 +72,13 @@ + GHC now supports visible type application, allowing programmers + to easily specify how type parameters should be instantiated + when calling a function. See for the details. + + + + To conform to the common case, the default role assigned to parameters of datatypes declared in hs-boot files is representational. However, if the constructor(s) From git at git.haskell.org Sat Aug 8 18:25:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 8 Aug 2015 18:25:34 +0000 (UTC) Subject: [commit: ghc] wip/type-app: User manual wibbles (b346f48) Message-ID: <20150808182534.19D1C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/type-app Link : http://ghc.haskell.org/trac/ghc/changeset/b346f486811f6bdf8ac5cad16434f51bba64d65e/ghc >--------------------------------------------------------------- commit b346f486811f6bdf8ac5cad16434f51bba64d65e Author: Richard Eisenberg Date: Sat Aug 8 14:26:50 2015 -0400 User manual wibbles >--------------------------------------------------------------- b346f486811f6bdf8ac5cad16434f51bba64d65e docs/users_guide/7.12.1-notes.xml | 7 ++++--- docs/users_guide/glasgow_exts.xml | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index b80db1d..bdab650 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -72,9 +72,10 @@ - GHC now supports visible type application, allowing programmers - to easily specify how type parameters should be instantiated - when calling a function. See for the details. + GHC now supports visible type application, allowing + programmers to easily specify how type parameters should be + instantiated when calling a function. See for the details. diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index ec13dbf..16d2024 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -2622,7 +2622,7 @@ to allow the import or export of a data constructor without its parent type cons The extension allows you to use visible type application in expressions. Here is an -example: show (read @Int 5). The @Int +example: show (read @Int "5"). The @Int is the visible type application; it specifies the value of the type variable in read's type. From git at git.haskell.org Sun Aug 9 06:16:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Aug 2015 06:16:21 +0000 (UTC) Subject: [commit: ghc] master: Update transformers submodule to 0.4.3.0 release (2c4a7d3) Message-ID: <20150809061621.C2F8B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2c4a7d3abb4e35b0cd8c5596b6ada50b9e34bfa8/ghc >--------------------------------------------------------------- commit 2c4a7d3abb4e35b0cd8c5596b6ada50b9e34bfa8 Author: Herbert Valerio Riedel Date: Sat Aug 8 11:13:52 2015 +0200 Update transformers submodule to 0.4.3.0 release Differential Revision: https://phabricator.haskell.org/D1140 >--------------------------------------------------------------- 2c4a7d3abb4e35b0cd8c5596b6ada50b9e34bfa8 libraries/transformers | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/transformers b/libraries/transformers index c55953c..078c7da 160000 --- a/libraries/transformers +++ b/libraries/transformers @@ -1 +1 @@ -Subproject commit c55953c1298a5b63e250dfcd402154f6d187825e +Subproject commit 078c7daf36ea1fa1ecb63b04dbe667a443e13044 From git at git.haskell.org Sun Aug 9 14:12:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Aug 2015 14:12:57 +0000 (UTC) Subject: [commit: ghc] master: Fix unused-matches warnings in CmmLex.x (f04c7be) Message-ID: <20150809141257.993363A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f04c7bedbbeb2d530c22a3fec050d4451bbd8599/ghc >--------------------------------------------------------------- commit f04c7bedbbeb2d530c22a3fec050d4451bbd8599 Author: Thomas Miedema Date: Sat Jul 4 15:13:19 2015 +0200 Fix unused-matches warnings in CmmLex.x >--------------------------------------------------------------- f04c7bedbbeb2d530c22a3fec050d4451bbd8599 compiler/cmm/CmmLex.x | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x index 89ae796..a9ad3e5 100644 --- a/compiler/cmm/CmmLex.x +++ b/compiler/cmm/CmmLex.x @@ -189,10 +189,10 @@ pop :: Action pop _span _buf _len = popLexState >> lexToken special_char :: Action -special_char span buf len = return (L span (CmmT_SpecChar (currentChar buf))) +special_char span buf _len = return (L span (CmmT_SpecChar (currentChar buf))) kw :: CmmToken -> Action -kw tok span buf len = return (L span tok) +kw tok span _buf _len = return (L span tok) global_regN :: (Int -> GlobalReg) -> Action global_regN con span buf len @@ -201,7 +201,7 @@ global_regN con span buf len n = parseUnsignedInteger buf' (len-1) 10 octDecDigit global_reg :: GlobalReg -> Action -global_reg r span buf len = return (L span (CmmT_GlobalReg r)) +global_reg r span _buf _len = return (L span (CmmT_GlobalReg r)) strtoken :: (String -> CmmToken) -> Action strtoken f span buf len = @@ -319,7 +319,7 @@ lexToken = do AlexSkip inp2 _ -> do setInput inp2 lexToken - AlexToken inp2@(end,buf2) len t -> do + AlexToken inp2@(end,_buf2) len t -> do setInput inp2 let span = mkRealSrcSpan loc1 end span `seq` setLastToken span len From git at git.haskell.org Sun Aug 9 14:13:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 9 Aug 2015 14:13:00 +0000 (UTC) Subject: [commit: ghc] master: Update testsuite/.gitignore [skip ci] (a40ec75) Message-ID: <20150809141300.6B3A03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a40ec755d8e020cd4b87975f5a751f1e35c36977/ghc >--------------------------------------------------------------- commit a40ec755d8e020cd4b87975f5a751f1e35c36977 Author: Thomas Miedema Date: Sat Jul 18 22:14:26 2015 +0200 Update testsuite/.gitignore [skip ci] >--------------------------------------------------------------- a40ec755d8e020cd4b87975f5a751f1e35c36977 testsuite/.gitignore | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index c92ce71..7496958 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -55,8 +55,8 @@ tmp.d *.so *bindisttest_install___dir_bin_ghc.mk *bindisttest_install___dir_bin_ghc.exe.mk -mk/ghcconfig*_bin_ghc-*.mk -mk/ghcconfig*_bin_ghc-*.exe.mk +mk/ghcconfig*_bin_ghc*.mk +mk/ghcconfig*_bin_ghc*.exe.mk *.imports # ----------------------------------------------------------------------------- From git at git.haskell.org Mon Aug 10 11:39:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 10 Aug 2015 11:39:24 +0000 (UTC) Subject: [commit: ghc] master: Replace HsBang type with HsSrcBang and HsImplBang (b4ed130) Message-ID: <20150810113924.495683A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b4ed13000cf0cbbb5916727dad018d91c10f1fd8/ghc >--------------------------------------------------------------- commit b4ed13000cf0cbbb5916727dad018d91c10f1fd8 Author: Adam Sandberg Eriksson Date: Mon Aug 10 12:55:50 2015 +0200 Replace HsBang type with HsSrcBang and HsImplBang Updates haddock submodule. Reviewers: tibbe, goldfire, simonpj, austin, bgamari Reviewed By: simonpj, bgamari Subscribers: goldfire, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D1069 >--------------------------------------------------------------- b4ed13000cf0cbbb5916727dad018d91c10f1fd8 compiler/basicTypes/DataCon.hs | 127 +++++++++++----------- compiler/basicTypes/MkId.hs | 139 +++++++++++++++---------- compiler/hsSyn/HsTypes.hs | 7 +- compiler/iface/BuildTyCl.hs | 32 +++--- compiler/iface/IfaceSyn.hs | 47 ++++++--- compiler/iface/MkIface.hs | 9 +- compiler/iface/TcIface.hs | 30 ++++-- compiler/parser/Parser.y | 4 +- compiler/prelude/TysWiredIn.hs | 4 +- compiler/typecheck/TcSplice.hs | 11 +- compiler/typecheck/TcTyClsDecls.hs | 6 +- compiler/vectorise/Vectorise/Generic/PData.hs | 10 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 1 + docs/users_guide/7.12.1-notes.xml | 12 ++- utils/haddock | 2 +- 15 files changed, 270 insertions(+), 171 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b4ed13000cf0cbbb5916727dad018d91c10f1fd8 From git at git.haskell.org Tue Aug 11 13:04:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Aug 2015 13:04:00 +0000 (UTC) Subject: [commit: ghc] master: User manual update, as prodded by #10760. (2da06d7) Message-ID: <20150811130400.5CD8E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2da06d7c3fb0da894f5b5a6770c4e41aeee012cd/ghc >--------------------------------------------------------------- commit 2da06d7c3fb0da894f5b5a6770c4e41aeee012cd Author: Richard Eisenberg Date: Tue Aug 11 09:05:30 2015 -0400 User manual update, as prodded by #10760. This clarifies that kind variables are inputs to type families and can be used to distinguish instances. >--------------------------------------------------------------- 2da06d7c3fb0da894f5b5a6770c4e41aeee012cd docs/users_guide/glasgow_exts.xml | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index d1a908e..8b597da 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6247,7 +6247,18 @@ F Char [Int] Bool -- OK! Kind: * F IO Bool -- WRONG: kind mismatch in the first argument F Bool -- WRONG: unsaturated application - + + + + The result kind annotation is optional and defaults to + * (like argument kinds) if + omitted. Polykinded type families can be + declared using a parameter in the kind annotation: + +type family F a :: k + +In this case the kind parameter k is actually an implicit +parameter of the type family. @@ -6365,7 +6376,7 @@ type instance G Int Char Float = Double -- WRONG: must be two type parameters are restricted to be compatible. Two type patterns are compatible if -all corresponding types in the patterns are apart, or +all corresponding types and implicit kinds in the patterns are apart, or the two patterns unify producing a substitution, and the right-hand sides are equal under that substitution. Two types are considered apart if, for all possible @@ -6392,7 +6403,17 @@ type instance G (Char, a) = [a] -- ILLEGAL overlap, as [Char] /= [Int] Note that this compatibility condition is independent of whether the type family is associated or not, and it is not only a matter of consistency, but - one of type safety. + one of type safety. + + For a polykinded type family, the kinds are checked for + apartness just like types. For example, the following is accepted: + +type family J a :: k +type instance J Int = Bool +type instance J Int = Maybe + + These instances are compatible because they differ in their implicit kind parameter; the first uses * while the second uses * -> *. + The definition for "compatible" uses a notion of "apart", whose definition From git at git.haskell.org Tue Aug 11 22:34:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 11 Aug 2015 22:34:00 +0000 (UTC) Subject: [commit: ghc] master: Add missing to User's guide to fix the build (2b4710b) Message-ID: <20150811223400.7A41F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2b4710b116e7f6e122e0234ca140d44287d55435/ghc >--------------------------------------------------------------- commit 2b4710b116e7f6e122e0234ca140d44287d55435 Author: Thomas Miedema Date: Wed Aug 12 00:34:04 2015 +0200 Add missing to User's guide to fix the build >--------------------------------------------------------------- 2b4710b116e7f6e122e0234ca140d44287d55435 docs/users_guide/glasgow_exts.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 8b597da..909d841 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6259,6 +6259,7 @@ type family F a :: k In this case the kind parameter k is actually an implicit parameter of the type family. + From git at git.haskell.org Wed Aug 12 08:51:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 08:51:35 +0000 (UTC) Subject: [commit: ghc] master: Bump template-haskell to new major version 2.11 (8cce7e4) Message-ID: <20150812085135.4F2423A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8cce7e4bc8f17f1c9ef4d4028b5145829fc3334b/ghc >--------------------------------------------------------------- commit 8cce7e4bc8f17f1c9ef4d4028b5145829fc3334b Author: Herbert Valerio Riedel Date: Wed Aug 12 09:48:53 2015 +0200 Bump template-haskell to new major version 2.11 ...since we already have introduced backward compat breakage that breaks packages such as QuickCheck-2.8.1 Differential Revision: https://phabricator.haskell.org/D1144 >--------------------------------------------------------------- 8cce7e4bc8f17f1c9ef4d4028b5145829fc3334b libraries/template-haskell/changelog.md | 7 +++++++ libraries/template-haskell/template-haskell.cabal | 2 +- testsuite/tests/th/TH_Roles2.stderr | 2 +- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index f205ed5..864abe5 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -1,5 +1,12 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.11.0.0 *TBA* + + * Bundled with GHC 7.12.1 + + * TODO: document API changes and important bugfixes + + ## 2.10.0.0 *Mar 2015* * Bundled with GHC 7.10.1 diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index de71132..4bfd1a9 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -1,5 +1,5 @@ name: template-haskell -version: 2.10.0.0 +version: 2.11.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr index 98029ab..8611b92 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -6,7 +6,7 @@ COERCION AXIOMS Dependent modules: [] Dependent packages: [pretty-1.1.2.0, deepseq-1.4.1.1, array-0.5.1.0, base-4.8.2.0, ghc-prim-0.4.0.0, integer-gmp-1.0.0.0, - template-haskell-2.10.0.0] + template-haskell-2.11.0.0] ==================== Typechecker ==================== From git at git.haskell.org Wed Aug 12 09:23:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 09:23:12 +0000 (UTC) Subject: [commit: ghc] master: Pretty: bugfix fillNB (#10735) (67576dd) Message-ID: <20150812092312.376FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/67576ddc67f39bef43c473f30af0887d22011710/ghc >--------------------------------------------------------------- commit 67576ddc67f39bef43c473f30af0887d22011710 Author: Thomas Miedema Date: Tue Aug 4 22:32:06 2015 +0200 Pretty: bugfix fillNB (#10735) This is a backport of a bug fix by Benedikt Huber (#2393), from commit 1e50748beaa4bd2281d323b18ea51c786bba04a1 in the pretty library. From https://mail.haskell.org/pipermail/libraries/2008-June/009991.html: Law states that > sep (ps++[empty]++qs) = sep (ps ++ qs) > ...ditto hsep, hcat, vcat, fill... In the current implementation, this fails for the paragraph fill variants. > render' $ fsep [ text "c", text "c",empty, text "c", text "b"] > where render' = renderStyle (Style PageMode 7 1.4) >> c c c >> b >--------------------------------------------------------------- 67576ddc67f39bef43c473f30af0887d22011710 compiler/utils/Pretty.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 0bde5fa..607d265 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -815,6 +815,7 @@ fillNB _ _ k _ | k `seq` False = undefined fillNB g (Nest _ p) k ys = fillNB g p k ys -- Never triggered, because of invariant (2) fillNB _ Empty _ [] = Empty +fillNB g Empty k (Empty:ys) = fillNB g Empty k ys fillNB g Empty k (y:ys) = fillNBE g k y ys fillNB g p k ys = fill1 g p k ys From git at git.haskell.org Wed Aug 12 09:23:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 09:23:14 +0000 (UTC) Subject: [commit: ghc] master: Pretty: fix a broken invariant (#10735) (5d57087) Message-ID: <20150812092314.F1F943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/5d57087e314bd484dbe14958f9b422be3ac6641a/ghc >--------------------------------------------------------------- commit 5d57087e314bd484dbe14958f9b422be3ac6641a Author: Thomas Miedema Date: Wed Aug 5 11:31:21 2015 +0200 Pretty: fix a broken invariant (#10735) This is a backport of a bug fix from 6cfbd0444981c074bae10a3cf72733bcb8597bef in libraries/pretty: Fix a broken invariant Patch from #694, for the problem "empty is an identity for <> and $$" is currently broken by eg. isEmpty (empty<>empty)" >--------------------------------------------------------------- 5d57087e314bd484dbe14958f9b422be3ac6641a compiler/utils/Pretty.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 99566d3..d07bd3d 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -623,12 +623,17 @@ union_ = Union -- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty. -- ($$) :: Doc -> Doc -> Doc -p $$ q = Above p False q +p $$ q = above_ p False q -- | Above, with no overlapping. -- '$+$' is associative, with identity 'empty'. ($+$) :: Doc -> Doc -> Doc -p $+$ q = Above p True q +p $+$ q = above_ p True q + +above_ :: Doc -> Bool -> Doc -> Doc +above_ p _ Empty = p +above_ Empty _ q = q +above_ p g q = Above p g q above :: Doc -> Bool -> RDoc -> RDoc above (Above p g1 q1) g2 q2 = above p g1 (above q1 g2 q2) @@ -679,12 +684,17 @@ nilAboveNest g k q | not g && k > 0 -- No newline if no overlap -- | Beside. -- '<>' is associative, with identity 'empty'. (<>) :: Doc -> Doc -> Doc -p <> q = Beside p False q +p <> q = beside_ p False q -- | Beside, separated by space, unless one of the arguments is 'empty'. -- '<+>' is associative, with identity 'empty'. (<+>) :: Doc -> Doc -> Doc -p <+> q = Beside p True q +p <+> q = beside_ p True q + +beside_ :: Doc -> Bool -> Doc -> Doc +beside_ p _ Empty = p +beside_ Empty _ q = q +beside_ p g q = Beside p g q -- Specification: beside g p q = p q beside :: Doc -> Bool -> RDoc -> RDoc From git at git.haskell.org Wed Aug 12 09:23:17 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 09:23:17 +0000 (UTC) Subject: [commit: ghc] master: Pretty: fix potential bad formatting of error message (#10735) (bcfae08) Message-ID: <20150812092317.B59CA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/bcfae08c0be0fa8604e2025733dfae57e37c2083/ghc >--------------------------------------------------------------- commit bcfae08c0be0fa8604e2025733dfae57e37c2083 Author: Thomas Miedema Date: Wed Aug 5 10:58:54 2015 +0200 Pretty: fix potential bad formatting of error message (#10735) This is a backport of a bug fix by Benedikt Huber for the same problem in the pretty library (#1337), from commit 8d8866a8379c2fe8108ef034893c59e06d5e752f. The original explanation for the fix is attached below. Ticket #1776 originally reported an infinite loop when printing error message. This promptly got fixed in: commit 2d52ee06786e5caf0c2d65a4b4bb7c45c6493190 Author: simonpj at microsoft.com Date: Thu Mar 1 11:45:13 2007 +0000 Do not go into an infinite loop when pretty-printer finds a negative indent (Trac #1176) SPJ reports in the ticket: "So infinite loop is fixed, but the bad formatting remains. I've added a test, tcfail177." tcfail177 however hasn't triggered the formatting problem for years (as Ian reported in c9e0e6067a47c574d9ff3721afe58e30ca1be3e4). This patch updates the test to a version that at least still failed with ghc-7.0 (from #1776#comment:7). ------------------- From https://mail.haskell.org/pipermail/libraries/2008-June/010013.html, by Benedikt Huber: Concerning ticket #1337, we have to change the formal specification of fill (it doesn't match the implementation): -- Current Specification: -- fill [] = empty -- fill [p] = p -- fill (p1:p2:ps) = oneLiner p1 <#> nest (length p1) -- (fill (oneLiner p2 : ps)) -- `union` -- p1 $$ fill ps Problem 1: We want to `unnest' the second argument of (p1 $$ fill ps), but not the first one In the definition above we have e.g. > getSecondLayout $ > fillDef False [text "a", text "b", text "a"] >> text "ab"; nilabove; nest -1; text "a"; empty >> |ab| >> |.a| Problem 2: The overlapping $$ should only be used for those layouts of p1 which aren't one liners (otherwise violating the invariant "Left union arg has shorter first line"). I suggest the following specification (i believe it almost matches the current implementation, modulo [fillNB: fix bug #1337] (see below): -- Revised Specification: -- fill g docs = fill' 0 docs -- gap g = if g then 1 else 0 -- fill' n [] = [] -- fill' n [p] = [p] -- fill' n (p1:p2:ps) = -- oneLiner p1 (fill' (n+length p1+gap g) (oneLiner p2 : ps)) -- `union` -- (p1 $*$ nest (-n) (fill' g ps)) -- -- $*$ is defined for layouts (One-Layout Documents) as -- -- layout1 $*$ layout2 | isOneLiner layout1 = layout1 $+$ layout2 -- | otherwise = layout1 $$ layout2 I've also implemented the specification in HughesPJQuickCheck.hs, and checked them against the patched pretty printer. Concerning Bug #1337: ~~~~~~~~~~~~~~~~~~~~~ If the above formal specification is fine, it is easy to fix: elide the nests of (oneLiner p2) [see attached patch, record bug #1337]. > PrettyPrint(0) $ ./Bug1337 > ....ab > ...c The (long) explanation follows below. =========================================================== Explanation of Bug #1337: Consider > fcat [ nest 1 $ text "a", nest 2 $ text "b", text "c"] --> expected: (nest 1; text "a"; text "b"; nest -3; "c") --> actual : (nest 1; text "a"; text "b"; nest -5; "c") Reduction: === (nest 1; text a) <> (fill (-2) (p2:ps)) ==> (nest 2 (text "b") $+$ text "c") ==> (nest 2 (text "b")) `nilabove` (nest (-3) (text "c")) ==> (nest 1; text a; text b; nest -5 c) The problem is that if we decide to layout (p1:p2:ps) as | p1 p2 | ps (call it layout A), then we want to have > (p1 <> p2) $+$ ps. But following law this means that > fcat_A [p1:nest k p2:ps] is equivalent to > fcat_A [p1,p2,ps] so the nest of p2 has to be removed. This is somewhat similar to bug #667, but easier to fix from a semantic point of view: p1,p2 and ps are distinct layouts - we only have to preserve the individual layouts, and no combinations of them. >--------------------------------------------------------------- bcfae08c0be0fa8604e2025733dfae57e37c2083 compiler/utils/Pretty.hs | 5 +- testsuite/tests/typecheck/should_fail/tcfail177.hs | 63 +++++--- .../tests/typecheck/should_fail/tcfail177.stderr | 180 ++------------------- 3 files changed, 65 insertions(+), 183 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 bcfae08c0be0fa8604e2025733dfae57e37c2083 From git at git.haskell.org Wed Aug 12 09:23:20 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 09:23:20 +0000 (UTC) Subject: [commit: ghc] master: Pretty: show rational as is (#10735) (85bf76a) Message-ID: <20150812092320.729313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/85bf76a8f8015ed6adb65095d53d8af933080354/ghc >--------------------------------------------------------------- commit 85bf76a8f8015ed6adb65095d53d8af933080354 Author: Thomas Miedema Date: Wed Aug 5 13:17:56 2015 +0200 Pretty: show rational as is (#10735) Following libraries/pretty. I'm not sure why it converted to Double before. This function isn't used by GHC itself. It is exported from these two places: * compiler/utils/Outputable * libraries/template-haskell/Language/Haskell/TH/PprLib.hs >--------------------------------------------------------------- 85bf76a8f8015ed6adb65095d53d8af933080354 compiler/utils/Pretty.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index d07bd3d..29a7b84 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -205,7 +205,6 @@ module Pretty ( import BufWrite import FastString import Panic -import Numeric (fromRat) import System.IO import Prelude hiding (error) @@ -499,8 +498,7 @@ int n = text (show n) integer n = text (show n) float n = text (show n) double n = text (show n) -rational n = text (show (fromRat n :: Double)) ---rational n = text (show (fromRationalX n)) -- _showRational 30 n) +rational n = text (show n) parens :: Doc -> Doc -- ^ Wrap document in @(...)@ brackets :: Doc -> Doc -- ^ Wrap document in @[...]@ From git at git.haskell.org Wed Aug 12 14:21:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 14:21:07 +0000 (UTC) Subject: [commit: ghc] master: Pretty: improving the space/time performance of vcat, hsep, hcat (#10735) (f903949) Message-ID: <20150812142107.7201E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f903949beee3a4e0a925003b5553066c9f513c11/ghc >--------------------------------------------------------------- commit f903949beee3a4e0a925003b5553066c9f513c11 Author: Thomas Miedema Date: Wed Aug 5 10:31:46 2015 +0200 Pretty: improving the space/time performance of vcat, hsep, hcat (#10735) After 5d57087e314bd484dbe14958f9b422be3ac6641a ("Pretty: fix a broken invariant"), T3294 showed 50% more max_bytes_used (#3294). After this commit, max_bytes_used is back to what it was before, and the test passes again. This is a backport of a bug fix by Benedikt Huber (#2393), from commit 1e50748beaa4bd2281d323b18ea51c786bba04a1 in the pretty library. From https://mail.haskell.org/pipermail/libraries/2008-June/009991.html: vcat (hsep,cat) is implemented in an unneccessarily strict way. We only get some output after all of vcat's arguments are evaluated and checked against being Empty. This can be improved by only checking the right argument of foldr against being Empty, and then applying an Empty-filter on the resulting Doc. Space improvement is obvious. The microbenchmark (code.haskell.org/~bhuber/Text/PrettyPrint/ HughesPJPerfCheck.hs) suggests that the improvements in time are remarkable too. >--------------------------------------------------------------- f903949beee3a4e0a925003b5553066c9f513c11 compiler/utils/Pretty.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 29a7b84..4aae2c8 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -529,15 +529,15 @@ reduceDoc p = p -- | List version of '<>'. hcat :: [Doc] -> Doc -hcat = foldr (<>) empty +hcat = reduceAB . foldr (beside_' False) empty -- | List version of '<+>'. hsep :: [Doc] -> Doc -hsep = foldr (<+>) empty +hsep = reduceAB . foldr (beside_' True) empty -- | List version of '$$'. vcat :: [Doc] -> Doc -vcat = foldr ($$) empty +vcat = reduceAB . foldr (above_' False) empty -- | Nest (or indent) a document by a given number of positions -- (which may also be negative). 'nest' satisfies the laws: @@ -584,6 +584,19 @@ mkUnion :: Doc -> Doc -> Doc mkUnion Empty _ = Empty mkUnion p q = p `union_` q +beside_' :: Bool -> Doc -> Doc -> Doc +beside_' _ p Empty = p +beside_' g p q = Beside p g q + +above_' :: Bool -> Doc -> Doc -> Doc +above_' _ p Empty = p +above_' g p q = Above p g q + +reduceAB :: Doc -> Doc +reduceAB (Above Empty _ q) = q +reduceAB (Beside Empty _ q) = q +reduceAB doc = doc + nilAbove_ :: RDoc -> RDoc nilAbove_ = NilAbove From git at git.haskell.org Wed Aug 12 15:36:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 15:36:39 +0000 (UTC) Subject: [commit: ghc] master: Upgrade GCC to 5.2.0 for Windows x86 and x86_64 (7b211b4) Message-ID: <20150812153639.438FF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7b211b4e5a38efca437d76ea442495370da7cc9a/ghc >--------------------------------------------------------------- commit 7b211b4e5a38efca437d76ea442495370da7cc9a Author: Tamar Christina Date: Wed Aug 12 13:33:13 2015 +0200 Upgrade GCC to 5.2.0 for Windows x86 and x86_64 This patch does a few things - Moved GHC x86 to MinGW-w64 (Using Awson's patch) - Moves Both GHCs to MSYS2 toolchains - Completely removes the dependencies on the git tarball repo - Downloads only the required tarball for the architecture for which we are building - Downloads the perl tarball is missing as well - Fixed a few bugs in the linker to fix tests on Windows The links currently point to repo.msys2.org and GitHub, it might be more desirable to mirror them on http://downloads.haskell.org/~ghc/mingw/ as with the previous patch attempt. For more details on what the MSYS2 packages I include see #10726 (Awson's comment). but it should contain all we need and no python or fortran, which makes the uncompressed tar a 1-2 hundreds mb smaller. The `GCC 5.2.0` in the package supports `libgcc` as a shared library, this is a problem since when compiling with -shared the produced dll now has a dependency on `libgcc_s_sjlj-1.dll`. To solve this the flag `-static-libgcc` is now being used for all GCC calls on windows. Test Plan: ./validate was ran both on x86 and x86_64 windows and compared against the baseline. A few test were failing due to Ld no longer being noisy. These were updated. The changes to the configure script *should* be validated by the build bots for the other platforms before landing Reviewers: simonmar, awson, bgamari, austin, thomie Reviewed By: thomie Subscribers: #ghc_windows_task_force, thomie, awson Differential Revision: https://phabricator.haskell.org/D1123 GHC Trac Issues: #10726, #9014, #9218, #10435 >--------------------------------------------------------------- 7b211b4e5a38efca437d76ea442495370da7cc9a compiler/main/SysTools.hs | 28 +- configure.ac | 182 ++++--- driver/gcc/gcc.c | 10 +- rts/Linker.c | 574 +++++++++++---------- tarballs | 13 - testsuite/tests/driver/shared001.stderr | 1 - .../tests/ghci/linking/ghcilink002.stderr-mingw32 | 1 - .../tests/ghci/linking/ghcilink005.stderr-mingw32 | 1 - testsuite/tests/rts/T5435_dyn_asm.stderr-mingw32 | 1 - testsuite/tests/rts/T5435_dyn_gcc.stderr-mingw32 | 1 - 10 files changed, 452 insertions(+), 360 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 7b211b4e5a38efca437d76ea442495370da7cc9a From git at git.haskell.org Wed Aug 12 15:36:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 15:36:42 +0000 (UTC) Subject: [commit: ghc] master: Update mingw tarball location (e415369) Message-ID: <20150812153642.0AA883A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e415369e91347d23f149a1a750b267da2ee5d74c/ghc >--------------------------------------------------------------- commit e415369e91347d23f149a1a750b267da2ee5d74c Author: Ben Gamari Date: Wed Aug 12 14:06:37 2015 +0200 Update mingw tarball location >--------------------------------------------------------------- e415369e91347d23f149a1a750b267da2ee5d74c configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index a46110b..e7f9144 100644 --- a/configure.ac +++ b/configure.ac @@ -364,7 +364,7 @@ download_and_extract() { } set_up_tarballs() { - local mingw_base_url="http://repo.msys2.org/mingw" + local mingw_base_url="https://downloads.haskell.org/~ghc/mingw" local package_prefix="mingw-w64" local format_url="${mingw_base_url}/${mingw_arch}/${package_prefix}-${mingw_arch}" From git at git.haskell.org Wed Aug 12 15:36:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 15:36:44 +0000 (UTC) Subject: [commit: ghc] master: SysTools: Fix whitespace in error message (8c5b087) Message-ID: <20150812153644.C8CA03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8c5b087b85624092a76465b844dd74d220fcc417/ghc >--------------------------------------------------------------- commit 8c5b087b85624092a76465b844dd74d220fcc417 Author: Ben Gamari Date: Wed Aug 12 16:31:46 2015 +0200 SysTools: Fix whitespace in error message >--------------------------------------------------------------- 8c5b087b85624092a76465b844dd74d220fcc417 compiler/main/SysTools.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 080cc0b..af1f546 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -610,7 +610,7 @@ runClang dflags args = do (\(err :: SomeException) -> do errorMsg dflags $ text ("Error running clang! you need clang installed to use the" ++ - "LLVM backend") $+$ + " LLVM backend") $+$ text "(or GHC tried to execute clang incorrectly)" throwIO err ) From git at git.haskell.org Wed Aug 12 15:36:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 12 Aug 2015 15:36:47 +0000 (UTC) Subject: [commit: ghc] master: template-haskell: Add changelog entry to infix type operators (b0dee61) Message-ID: <20150812153647.AD6C73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b0dee6104fed18f6a6c894caaa621a8488d9965f/ghc >--------------------------------------------------------------- commit b0dee6104fed18f6a6c894caaa621a8488d9965f Author: Ben Gamari Date: Wed Aug 12 13:32:08 2015 +0200 template-haskell: Add changelog entry to infix type operators >--------------------------------------------------------------- b0dee6104fed18f6a6c894caaa621a8488d9965f libraries/template-haskell/changelog.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index 864abe5..3620d22 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -4,6 +4,12 @@ * Bundled with GHC 7.12.1 + * The compiler can now resolve infix operator fixities in types on its own. + The `UInfixT` constructor of `Type` is analoguous to `UInfixE` for expressions + and can contain a tree of infix type applications which will be reassociated + according to the fixities of the operators. The `ParensT` constructor can be + used to explicitly group expressions. + * TODO: document API changes and important bugfixes From git at git.haskell.org Thu Aug 13 19:05:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Aug 2015 19:05:58 +0000 (UTC) Subject: [commit: ghc] master: DynFlags: Prohibit hpc and byte-code interpreter (d2dd5af) Message-ID: <20150813190558.3F81A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d2dd5af433be80464883735f133f3e4dea9c8bd4/ghc >--------------------------------------------------------------- commit d2dd5af433be80464883735f133f3e4dea9c8bd4 Author: Ben Gamari Date: Thu Aug 13 20:17:06 2015 +0200 DynFlags: Prohibit hpc and byte-code interpreter The user's guide says hpc is incompatible with GHCi and #9903 would agree. Fixes #9903. >--------------------------------------------------------------- d2dd5af433be80464883735f133f3e4dea9c8bd4 compiler/main/DynFlags.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4f0bfc5..5fa62b4 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -4179,6 +4179,10 @@ makeDynFlagsConsistent dflags else let dflags' = dflags { hscTarget = HscLlvm } warn = "Compiler not unregisterised, so using LLVM rather than compiling via C" in loop dflags' warn + | gopt Opt_Hpc dflags && hscTarget dflags == HscInterpreted + = let dflags' = gopt_unset dflags Opt_Hpc + warn = "Hpc can't be used with byte-code interpreter. Ignoring -fhpc." + in loop dflags' warn | hscTarget dflags == HscAsm && platformUnregisterised (targetPlatform dflags) = loop (dflags { hscTarget = HscC }) From git at git.haskell.org Thu Aug 13 19:06:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 13 Aug 2015 19:06:01 +0000 (UTC) Subject: [commit: ghc] master: Name: Show NameSort in warning (ec68618) Message-ID: <20150813190601.16D953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ec68618bac918f365a7760062eb351cba3e4ddb3/ghc >--------------------------------------------------------------- commit ec68618bac918f365a7760062eb351cba3e4ddb3 Author: Ben Gamari Date: Thu Aug 13 20:18:56 2015 +0200 Name: Show NameSort in warning This is quite useful information to know. Spotted when looking at #10769. >--------------------------------------------------------------- ec68618bac918f365a7760062eb351cba3e4ddb3 compiler/basicTypes/Name.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index ce8619a..506b60f 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -127,6 +127,12 @@ data NameSort | System -- A system-defined Id or TyVar. Typically the -- OccName is very uninformative (like 's') +instance Outputable NameSort where + ppr (External _) = text "external" + ppr (WiredIn _ _ _) = text "wired-in" + ppr Internal = text "internal" + ppr System = text "system" + -- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples, -- which have special syntactic forms. They aren't in scope -- as such. @@ -216,7 +222,10 @@ isInternalName name = not (isExternalName name) isHoleName :: Name -> Bool isHoleName = isHoleModule . nameModule -nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name) +nameModule name = + nameModule_maybe name `orElse` + pprPanic "nameModule" (ppr (n_sort name) <+> ppr name) + nameModule_maybe :: Name -> Maybe Module nameModule_maybe (Name { n_sort = External mod}) = Just mod nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod From git at git.haskell.org Fri Aug 14 09:25:37 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 14 Aug 2015 09:25:37 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Several important performance/memory fixes (771ed2c) Message-ID: <20150814092537.DF6C13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/771ed2cffb96d6f0fa92d42f65fdb7e3ab1e684b/ghc >--------------------------------------------------------------- commit 771ed2cffb96d6f0fa92d42f65fdb7e3ab1e684b Author: George Karachalias Date: Fri Aug 14 11:26:01 2015 +0200 Several important performance/memory fixes * Added literals in the pattern language. We generate far less constraints this way, since literal pattern matching is handled immediately instead of generating semantically empty value set abstractions. (Treated similarly to data constructors). * Changed translation of as-patterns: Instead of generating [x, p <- x] for an as-pattern x at p, we instead generate [p, x <- p]. Hence, we record the equality of `x' and `p' but the main pattern to be checked is `p' and not the variable `x' and less non-satisfiable cases are generated (For this change to work, a pattern vector has to be cast into an expression, hence function `coercePmPat'). * Replace guards we cannot reason about with a single such guard. In `translateGuards' we replace all guards of the form (p <- e) where * p can fail (not a variable) * e is really arbitrary (the solver will ignore) with a single guard (True <- x). Instead of branching for every guard and feeding the solver with cases it cannot reason about, we denote the possibility of failure of such cases with a single guard we cannot reason about. * Short circuit guard handling if there is an `otherwise'. In `process_guards' we do not call `patVectProc' on the guards if we know that it's impossible to fail (still needs to be improved) * Stopped pruning the uncovered set on every step. Since Delta is always extended (we never remove constraints from it), it is semantically equivalent to prune it once at the end. * Do not run the algorithm on generated code (deriving etc). `handleWarnings' used to ignore the results of the check but call it nonetheless. Insted, if the results are going to be ignored, do not run it at all. >--------------------------------------------------------------- 771ed2cffb96d6f0fa92d42f65fdb7e3ab1e684b compiler/deSugar/Check.hs | 226 +++++++++++++++++++++++++++++++++++++------ compiler/deSugar/Match.hs | 6 +- compiler/deSugar/TmOracle.hs | 85 +++++++++------- 3 files changed, 250 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 771ed2cffb96d6f0fa92d42f65fdb7e3ab1e684b From git at git.haskell.org Sat Aug 15 13:56:04 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Aug 2015 13:56:04 +0000 (UTC) Subject: [commit: ghc] branch 'wip/pretty' created Message-ID: <20150815135604.B45E23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/pretty Referencing: 8e62060a28f041b267a004967ad8efa3cb465500 From git at git.haskell.org Sat Aug 15 13:56:07 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Aug 2015 13:56:07 +0000 (UTC) Subject: [commit: ghc] wip/pretty: Resolve foldr-strictness stack overflow bug (cb828c0) Message-ID: <20150815135607.9F2353A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pretty Link : http://ghc.haskell.org/trac/ghc/changeset/cb828c0d43148dfdfa407a82310279ce98601233/ghc >--------------------------------------------------------------- commit cb828c0d43148dfdfa407a82310279ce98601233 Author: Eyal Lotem Date: Fri Jun 28 23:03:21 2013 +0300 Resolve foldr-strictness stack overflow bug This is a backport of 307b8173f41cd776eae8f547267df6d72bff2d68 from libraries/pretty. From https://github.com/haskell/pretty/pull/9: The foldr applications in vcat, hsep, and hcat use a function which is strict on its second argument. This is a recipe for stack overflows which indeed happen when trying to build very large Doc values. Added a test to reproduce the problem. The fix is moving the canonization of Empty values into reduceAB, and doing it in a maximally-lazy fashion. >--------------------------------------------------------------- cb828c0d43148dfdfa407a82310279ce98601233 compiler/utils/Pretty.hs | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 4aae2c8..49be9ee 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -529,15 +529,15 @@ reduceDoc p = p -- | List version of '<>'. hcat :: [Doc] -> Doc -hcat = reduceAB . foldr (beside_' False) empty +hcat = reduceAB . foldr (\p q -> Beside p False q) empty -- | List version of '<+>'. hsep :: [Doc] -> Doc -hsep = reduceAB . foldr (beside_' True) empty +hsep = reduceAB . foldr (\p q -> Beside p True q) empty -- | List version of '$$'. vcat :: [Doc] -> Doc -vcat = reduceAB . foldr (above_' False) empty +vcat = reduceAB . foldr (\p q -> Above p False q) empty -- | Nest (or indent) a document by a given number of positions -- (which may also be negative). 'nest' satisfies the laws: @@ -584,18 +584,33 @@ mkUnion :: Doc -> Doc -> Doc mkUnion Empty _ = Empty mkUnion p q = p `union_` q -beside_' :: Bool -> Doc -> Doc -> Doc -beside_' _ p Empty = p -beside_' g p q = Beside p g q - -above_' :: Bool -> Doc -> Doc -> Doc -above_' _ p Empty = p -above_' g p q = Above p g q - reduceAB :: Doc -> Doc -reduceAB (Above Empty _ q) = q -reduceAB (Beside Empty _ q) = q -reduceAB doc = doc +reduceAB = snd . reduceAB' + +data IsEmpty = IsEmpty | NotEmpty + +reduceAB' :: Doc -> (IsEmpty, Doc) +reduceAB' (Above p g q) = eliminateEmpty Above (reduceAB p) g (reduceAB' q) +reduceAB' (Beside p g q) = eliminateEmpty Beside (reduceAB p) g (reduceAB' q) +reduceAB' doc = (NotEmpty, doc) + +-- Left-arg-strict +eliminateEmpty :: + (Doc -> Bool -> Doc -> Doc) -> + Doc -> Bool -> (IsEmpty, Doc) -> (IsEmpty, Doc) +eliminateEmpty _ Empty _ q = q +eliminateEmpty cons p g q = + (NotEmpty, + -- We're not empty whether or not q is empty, so for laziness-sake, + -- after checking that p isn't empty, we put the NotEmpty result + -- outside independent of q. This allows reduceAB to immediately + -- return the appropriate constructor (Above or Beside) without + -- forcing the entire nested Doc. This allows the foldr in vcat, + -- hsep, and hcat to be lazy on its second argument, avoiding a + -- stack overflow. + case q of + (NotEmpty, q') -> cons p g q' + (IsEmpty, _) -> p) nilAbove_ :: RDoc -> RDoc nilAbove_ = NilAbove From git at git.haskell.org Sat Aug 15 13:56:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Aug 2015 13:56:10 +0000 (UTC) Subject: [commit: ghc] wip/pretty: Special-case reduce for horiz/vert (8e62060) Message-ID: <20150815135610.747963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/pretty Link : http://ghc.haskell.org/trac/ghc/changeset/8e62060a28f041b267a004967ad8efa3cb465500/ghc >--------------------------------------------------------------- commit 8e62060a28f041b267a004967ad8efa3cb465500 Author: Eyal Lotem Date: Tue Jul 2 02:36:31 2013 +0300 Special-case reduce for horiz/vert This is a backport of c57c7a9dfc49617ba8d6e4fcdb019a3f29f1044c from libraries/pretty. >--------------------------------------------------------------- 8e62060a28f041b267a004967ad8efa3cb465500 compiler/utils/Pretty.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 49be9ee..ba717f3 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -529,15 +529,15 @@ reduceDoc p = p -- | List version of '<>'. hcat :: [Doc] -> Doc -hcat = reduceAB . foldr (\p q -> Beside p False q) empty +hcat = snd . reduceHoriz . foldr (\p q -> Beside p False q) empty -- | List version of '<+>'. hsep :: [Doc] -> Doc -hsep = reduceAB . foldr (\p q -> Beside p True q) empty +hsep = snd . reduceHoriz . foldr (\p q -> Beside p True q) empty -- | List version of '$$'. vcat :: [Doc] -> Doc -vcat = reduceAB . foldr (\p q -> Above p False q) empty +vcat = snd . reduceVert . foldr (\p q -> Above p False q) empty -- | Nest (or indent) a document by a given number of positions -- (which may also be negative). 'nest' satisfies the laws: @@ -584,17 +584,17 @@ mkUnion :: Doc -> Doc -> Doc mkUnion Empty _ = Empty mkUnion p q = p `union_` q -reduceAB :: Doc -> Doc -reduceAB = snd . reduceAB' - data IsEmpty = IsEmpty | NotEmpty -reduceAB' :: Doc -> (IsEmpty, Doc) -reduceAB' (Above p g q) = eliminateEmpty Above (reduceAB p) g (reduceAB' q) -reduceAB' (Beside p g q) = eliminateEmpty Beside (reduceAB p) g (reduceAB' q) -reduceAB' doc = (NotEmpty, doc) +reduceHoriz :: Doc -> (IsEmpty, Doc) +reduceHoriz (Beside p g q) = eliminateEmpty Beside (snd (reduceHoriz p)) g (reduceHoriz q) +reduceHoriz doc = (NotEmpty, doc) + +reduceVert :: Doc -> (IsEmpty, Doc) +reduceVert (Above p g q) = eliminateEmpty Above (snd (reduceVert p)) g (reduceVert q) +reduceVert doc = (NotEmpty, doc) --- Left-arg-strict +{-# INLINE eliminateEmpty #-} eliminateEmpty :: (Doc -> Bool -> Doc -> Doc) -> Doc -> Bool -> (IsEmpty, Doc) -> (IsEmpty, Doc) From git at git.haskell.org Sat Aug 15 15:27:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Aug 2015 15:27:23 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: mark encoding005 expect_broken(#10623) on Windows (8906037) Message-ID: <20150815152723.191D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89060374ea0242bc2d38425ba63f33b5189325b4/ghc >--------------------------------------------------------------- commit 89060374ea0242bc2d38425ba63f33b5189325b4 Author: Thomas Miedema Date: Sat Aug 15 16:55:26 2015 +0200 Testsuite: mark encoding005 expect_broken(#10623) on Windows >--------------------------------------------------------------- 89060374ea0242bc2d38425ba63f33b5189325b4 libraries/base/tests/IO/all.T | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T index 2977945..396e9b7 100644 --- a/libraries/base/tests/IO/all.T +++ b/libraries/base/tests/IO/all.T @@ -138,7 +138,8 @@ test('encoding001', test('encoding002', normal, compile_and_run, ['']) test('encoding003', normal, compile_and_run, ['']) test('encoding004', normal, compile_and_run, ['']) -test('encoding005', normal, compile_and_run, ['']) +test('encoding005', when(opsys('mingw32'), expect_broken(10623)), + compile_and_run, ['']) test('environment001', [extra_clean(['environment001'])], From git at git.haskell.org Sat Aug 15 15:27:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Aug 2015 15:27:25 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: mark T8089 expect_broken(#7325) on Windows (1857191) Message-ID: <20150815152725.C67243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/185719158137b0cdba32b32e8a8fda8eb6321215/ghc >--------------------------------------------------------------- commit 185719158137b0cdba32b32e8a8fda8eb6321215 Author: Thomas Miedema Date: Sat Aug 15 16:33:33 2015 +0200 Testsuite: mark T8089 expect_broken(#7325) on Windows >--------------------------------------------------------------- 185719158137b0cdba32b32e8a8fda8eb6321215 libraries/base/tests/all.T | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 1b065a3..d77db30 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -188,7 +188,11 @@ test('T9681', normal, compile_fail, ['']) # Probably something like 1s is already enough, but I don't know enough to # make an educated guess how long it needs to be guaranteed to reach the C # call." -test('T8089', [exit_code(99), run_timeout_multiplier(0.01)], +test('T8089', [exit_code(99), + run_timeout_multiplier(0.01), + when(opsys('mingw32'), + expect_broken_for(7325, ['normal', 'hpc', 'optasm'])), + ], compile_and_run, ['']) test('T9826',normal, compile_and_run,['']) test('T9848', From git at git.haskell.org Sat Aug 15 15:27:28 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 15 Aug 2015 15:27:28 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: recenter 2 performance tests on Windows (ca85442) Message-ID: <20150815152728.846243A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ca8544206ab723e21f55452f77aa1c5709074fe5/ghc >--------------------------------------------------------------- commit ca8544206ab723e21f55452f77aa1c5709074fe5 Author: Thomas Miedema Date: Fri Aug 14 12:05:20 2015 +0200 Testsuite: recenter 2 performance tests on Windows No major deviations. Also fixup T7861. >--------------------------------------------------------------- ca8544206ab723e21f55452f77aa1c5709074fe5 testsuite/tests/perf/should_run/all.T | 6 ++++-- testsuite/tests/typecheck/should_run/T7861.stderr | 4 +++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 0fa09f4..262f4e1 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -53,11 +53,12 @@ test('lazy-bs-alloc', [stats_num_field('peak_megabytes_allocated', (2, 1)), # expected value: 2 (amd64/Linux) stats_num_field('bytes allocated', - [(wordsize(64), 425400, 3), + [(wordsize(64), 431500, 3), # 489776 (amd64/Linux) # 2013-02-07: 429744 (amd64/Linux) # 2013-12-12: 425400 (amd64/Linux) # 2015-04-04: Widen 1->3% (amd64/Windows was failing) + # 2015-08-15: 431500 (Windows not good enough. avg of Windows&Linux) (wordsize(32), 411500, 2)]), # 2013-02-10: 421296 (x86/Windows) # 2013-02-10: 414180 (x86/OSX) @@ -183,10 +184,11 @@ test('T5205', [stats_num_field('bytes allocated', [(wordsize(32), 47088, 5), # expected value: 47088 (x86/Darwin) - (wordsize(64), 52600, 7)]), + (wordsize(64), 50648, 7)]), # expected value: 51320 (amd64/Linux) # 2014-07-17: 52600 (amd64/Linux) general round of updates # 2015-04-03: Widen 5->7% (amd64/Windows was doing better) + # 2015-08-15: 50648 (Windows too good. avg of Windows&Linux) only_ways(['normal', 'optasm']) ], compile_and_run, diff --git a/testsuite/tests/typecheck/should_run/T7861.stderr b/testsuite/tests/typecheck/should_run/T7861.stderr index 62b0dcd..8ed4be2 100644 --- a/testsuite/tests/typecheck/should_run/T7861.stderr +++ b/testsuite/tests/typecheck/should_run/T7861.stderr @@ -1,7 +1,9 @@ T7861: T7861.hs:10:5: error: Couldn't match type ?a? with ?[a]? ?a? is a rigid type variable bound by - the type signature for: f :: (forall b. a) -> a at T7861.hs:9:6 + the type signature for: + f :: (forall b. a) -> a + at T7861.hs:9:6 Expected type: (forall b. a) -> a Actual type: (forall b. a) -> [a] Relevant bindings include From git at git.haskell.org Sun Aug 16 12:31:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 16 Aug 2015 12:31:05 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Ensure DynFlags are consistent (5af80e7) Message-ID: <20150816123105.AB4F83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/5af80e79b0b679565ffcfae8ed34188561ef1452/ghc >--------------------------------------------------------------- commit 5af80e79b0b679565ffcfae8ed34188561ef1452 Author: Ben Gamari Date: Thu Aug 6 17:25:46 2015 +0200 Ensure DynFlags are consistent While we have always had makeDynFlagsConsistent to enforce a variety of consistency invariants on DynFlags, it hasn't been widely used. GHC.Main, for instance, ignored it entirely. This leads to issues like Trac #10549, where an OPTIONS_GHC pragma introduced an inconsistency, leading to a perplexing crash later in compilation. Here I add consistency checks in GHC.Main.set{Session,Program}DynFlags, closing this hole. Fixes #10549. Test Plan: Validate with T10549 Reviewers: austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1128 GHC Trac Issues: #10549 Cherry-Picked-From: eca9a1a17c12d01636417fb88bda5ee5fe34577f >--------------------------------------------------------------- 5af80e79b0b679565ffcfae8ed34188561ef1452 compiler/main/DynFlags.hs | 36 ++++++++++++++++++++-- compiler/main/GHC.hs | 27 +++------------- testsuite/tests/ghc-api/T10052/T10052.stderr | 2 +- .../tests/ghci.debugger/scripts/print007.stderr | 5 +-- .../should_compile => ghci/should_fail}/Makefile | 0 testsuite/tests/ghci/should_fail/T10549.hs | 15 +++++++++ testsuite/tests/ghci/should_fail/T10549.script | 1 + .../should_fail/T10549.stderr} | 2 +- testsuite/tests/ghci/should_fail/all.T | 3 ++ 9 files changed, 61 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 5af80e79b0b679565ffcfae8ed34188561ef1452 From git at git.haskell.org Sun Aug 16 12:37:06 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 16 Aug 2015 12:37:06 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Fix tests for "Ensure DynFlags are consistent" (75fd874) Message-ID: <20150816123706.7CEA73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/75fd8747c128c3f946769510ce8cfe089821116d/ghc >--------------------------------------------------------------- commit 75fd8747c128c3f946769510ce8cfe089821116d Author: Ben Gamari Date: Sun Aug 16 08:36:55 2015 -0400 Fix tests for "Ensure DynFlags are consistent" These slipped through the cracks. This fixes #10549. >--------------------------------------------------------------- 75fd8747c128c3f946769510ce8cfe089821116d testsuite/tests/ghc-api/T10052/T10052.stderr | 2 +- testsuite/tests/ghci.debugger/scripts/print007.stderr | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testsuite/tests/ghc-api/T10052/T10052.stderr b/testsuite/tests/ghc-api/T10052/T10052.stderr index 62f0b6d..1f49f8e 100644 --- a/testsuite/tests/ghc-api/T10052/T10052.stderr +++ b/testsuite/tests/ghc-api/T10052/T10052.stderr @@ -1,3 +1,3 @@ -when making flags consistent: warning: +when making flags consistent: Warning: -O conflicts with --interactive; -O ignored. diff --git a/testsuite/tests/ghci.debugger/scripts/print007.stderr b/testsuite/tests/ghci.debugger/scripts/print007.stderr index 62f0b6d..1f49f8e 100644 --- a/testsuite/tests/ghci.debugger/scripts/print007.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print007.stderr @@ -1,3 +1,3 @@ -when making flags consistent: warning: +when making flags consistent: Warning: -O conflicts with --interactive; -O ignored. From git at git.haskell.org Mon Aug 17 14:21:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Aug 2015 14:21:31 +0000 (UTC) Subject: [commit: ghc] master: Testsuite: speedup running a single test (744ff88) Message-ID: <20150817142131.056333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/744ff88537fa26bd4826ea35679fce04c65eee97/ghc >--------------------------------------------------------------- commit 744ff88537fa26bd4826ea35679fce04c65eee97 Author: Thomas Miedema Date: Sat Aug 15 21:10:32 2015 +0200 Testsuite: speedup running a single test Benchmark: in rootdirectory, run `time make test TEST=dummy VERBOSE=0` Before this commit: 2.6s After this commit: 0.7s >--------------------------------------------------------------- 744ff88537fa26bd4826ea35679fce04c65eee97 testsuite/driver/testlib.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 4e419f4..3311f00 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -591,6 +591,9 @@ def runTest (opts, name, func, args): # name :: String # setup :: TestOpts -> IO () def test (name, setup, func, args): + if config.only and name not in config.only: + return + global aloneTests global parallelTests global allTestNames @@ -663,7 +666,6 @@ def test_common_work (name, opts, func, args): ok_way = lambda way: \ not getTestOpts().skip \ - and (config.only == [] or name in config.only) \ and (getTestOpts().only_ways == None or way in getTestOpts().only_ways) \ and (config.cmdline_ways == [] or way in config.cmdline_ways) \ and (not (config.skip_perf_tests and isStatsTest())) \ From git at git.haskell.org Mon Aug 17 14:21:33 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Aug 2015 14:21:33 +0000 (UTC) Subject: [commit: ghc] master: Travis: prevent 10' no output, by setting VERBOSE=2 (e367e27) Message-ID: <20150817142133.DE8D53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/e367e2729ecf2b66b81680fe1b60bf1ef21880ed/ghc >--------------------------------------------------------------- commit e367e2729ecf2b66b81680fe1b60bf1ef21880ed Author: Thomas Miedema Date: Mon Aug 17 14:31:07 2015 +0200 Travis: prevent 10' no output, by setting VERBOSE=2 >--------------------------------------------------------------- e367e2729ecf2b66b81680fe1b60bf1ef21880ed .travis.yml | 7 ++++++- testsuite/mk/test.mk | 4 ---- validate | 9 ++++++--- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/.travis.yml b/.travis.yml index 4527708..660d383 100644 --- a/.travis.yml +++ b/.travis.yml @@ -48,4 +48,9 @@ script: - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk - echo 'GhcLibWays = v' >> mk/validate.mk - if [ "$DEBUG_STAGE2" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi - - THREADS=3 SKIP_PERF_TESTS=YES ./validate --fast --quiet + # * Use --quiet, otherwise the build log might exceed the limit of 4 + # megabytes, causing Travis to kill our job. + # * But use VERBOSE=2 (the default, but not when using --quiet) otherwise + # the testsuite might not print output for over 10 minutes (more likely so + # when DEBUG_STAGE2=NO), causing Travis to again kill our job. + - THREADS=3 SKIP_PERF_TESTS=YES VERBOSE=2 ./validate --fast --quiet diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index 644de5a..7a4e4f1 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -255,10 +255,6 @@ else setaccept = endif -TESTS = -TEST = -WAY = - .PHONY: all boot test verbose accept fast list_broken all: test diff --git a/validate b/validate index ab1cc01..39e1f01 100755 --- a/validate +++ b/validate @@ -33,6 +33,11 @@ Flags: THREADS=1 ./validate + You can also use environment variables to pass extra options to the + testsuite. For example: + + TEST='read001 read002' ./validate --testsuite-only --fast + EOF } @@ -260,10 +265,8 @@ FAST) ;; esac -if [ $be_quiet -eq 1 ]; then +if [ $be_quiet -eq 1 ] && [ -z $VERBOSE ]; then TEST_VERBOSITY="VERBOSE=1 NO_PRINT_SUMMARY=YES" -else - TEST_VERBOSITY="VERBOSE=2" fi $make $MAKE_TEST_TARGET stage=2 $BINDIST $TEST_VERBOSITY THREADS=$threads 2>&1 | tee testlog From git at git.haskell.org Mon Aug 17 22:15:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 17 Aug 2015 22:15:02 +0000 (UTC) Subject: [commit: ghc] master: Make rts/ThreadLabels.c threadsafe for debug runtime. (74897de) Message-ID: <20150817221502.636D43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/74897dece3ea92139b552bd711903ce630956df3/ghc >--------------------------------------------------------------- commit 74897dece3ea92139b552bd711903ce630956df3 Author: Sergei Trofimovich Date: Mon Aug 17 23:14:42 2015 +0100 Make rts/ThreadLabels.c threadsafe for debug runtime. rts/ThreadLabels.c has a global hashtable for each running haskell thread. It's not synchronized across OS threads. Was discovered when ran -debug build of ghc itself as: $ ghc-stage2 -j8 +RTS -A256M -l and glibc detected double-free corruption: #2 in __libc_message (do_abort=do_abort at entry=2, fmt=fmt at entry=0x7fe0bcebf368 "*** Error in `%s': %s: 0x%s ***\n") #3 in malloc_printerr (action=3, str=0x7fe0bcebf4c0 "double free or corruption (fasttop)", ptr=) #4 in _int_free (av=, p=, have_lock=0) #5 in stgFree (p=0x7fe060001820) at rts/RtsUtils.c:108 #6 in freeHashTable (table=0x5929320, freeDataFun=0x36374df ) at rts/Hash.c:360 #7 in freeThreadLabelTable () at rts/ThreadLabels.c:37 #8 in hs_exit_ (wait_foreign=rtsFalse) at rts/RtsStartup.c:403 #9 in shutdownHaskellAndExit (n=0, fastExit=0) at rts/RtsStartup.c:481 #10 in hs_main (...) at rts/RtsMain.c:91 #11 in main (...) at ghc/hschooks.c:63 Exposed itself after commit: > commit f6866824ce5cdf5359f0cad78c49d65f6d43af12 > Author: Sergei Trofimovich > Date: Mon Aug 4 08:10:33 2014 -0500 > > ghc --make: add nicer names to RTS threads (threaded IO manager, make workers) Signed-off-by: Sergei Trofimovich Reviewers: austin, simonmar, ezyang, bgamari Reviewed By: ezyang, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1146 >--------------------------------------------------------------- 74897dece3ea92139b552bd711903ce630956df3 rts/ThreadLabels.c | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/rts/ThreadLabels.c b/rts/ThreadLabels.c index 981a5d9..7a06580 100644 --- a/rts/ThreadLabels.c +++ b/rts/ThreadLabels.c @@ -20,11 +20,19 @@ #if defined(DEBUG) +#if defined(THREADED_RTS) +static Mutex threadLabels_mutex; +#endif /* THREADED_RTS */ + static HashTable * threadLabels = NULL; void initThreadLabelTable(void) { +#if defined(THREADED_RTS) + initMutex(&threadLabels_mutex); +#endif /* THREADED_RTS */ + if (threadLabels == NULL) { threadLabels = allocHashTable(); } @@ -33,33 +41,53 @@ initThreadLabelTable(void) void freeThreadLabelTable(void) { + ACQUIRE_LOCK(&threadLabels_mutex); + if (threadLabels != NULL) { freeHashTable(threadLabels, stgFree); threadLabels = NULL; } + + RELEASE_LOCK(&threadLabels_mutex); } static void updateThreadLabel(StgWord key, void *data) { removeThreadLabel(key); + + ACQUIRE_LOCK(&threadLabels_mutex); + insertHashTable(threadLabels,key,data); + + RELEASE_LOCK(&threadLabels_mutex); } void * lookupThreadLabel(StgWord key) { - return lookupHashTable(threadLabels,key); + void * result; + ACQUIRE_LOCK(&threadLabels_mutex); + + result = lookupHashTable(threadLabels,key); + + RELEASE_LOCK(&threadLabels_mutex); + + return result; } void removeThreadLabel(StgWord key) { + ACQUIRE_LOCK(&threadLabels_mutex); + void * old = NULL; if ((old = lookupHashTable(threadLabels,key))) { removeHashTable(threadLabels,key,old); stgFree(old); } + + RELEASE_LOCK(&threadLabels_mutex); } #endif /* DEBUG */ From git at git.haskell.org Tue Aug 18 16:33:10 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:33:10 +0000 (UTC) Subject: [commit: ghc] master: Dump files always use UTF8 encoding #10762 (ab9403d) Message-ID: <20150818163310.8EB773A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ab9403d5e6eb4f0a2e917d7edcd5821262432b26/ghc >--------------------------------------------------------------- commit ab9403d5e6eb4f0a2e917d7edcd5821262432b26 Author: Michael Snoyman Date: Tue Aug 18 17:58:36 2015 +0200 Dump files always use UTF8 encoding #10762 When the Windows codepage or *nix LANG variable is something besides UTF-8, dumping to file can cause GHC to exit currently. This changes the output encoding for files to match the defined input encoding for Haskell source code (UTF-8), making it easier for users and build tools to capture this output. Test Plan: Create a Haskell source file with non-Latin characters for identifier names and compile with: LANG=C ghc -ddump-to-file -ddump-hi filename.hs -fforce-recomp Without this patch, it will fail. With this patch, it succeeds Reviewers: austin, rwbarton, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1151 GHC Trac Issues: #10762 >--------------------------------------------------------------- ab9403d5e6eb4f0a2e917d7edcd5821262432b26 compiler/main/ErrUtils.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 3a7d9ec..fd10694 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -290,6 +290,13 @@ dumpSDoc dflags print_unqual flag hdr doc writeIORef gdref (Set.insert fileName gd) createDirectoryIfMissing True (takeDirectory fileName) handle <- openFile fileName mode + + -- We do not want the dump file to be affected by + -- environment variables, but instead to always use + -- UTF8. See: + -- https://ghc.haskell.org/trac/ghc/ticket/10762 + hSetEncoding handle utf8 + doc' <- if null hdr then return doc else do t <- getCurrentTime From git at git.haskell.org Tue Aug 18 16:33:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:33:13 +0000 (UTC) Subject: [commit: ghc] master: Comments reformating/corrections (d97e60f) Message-ID: <20150818163313.7760D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/d97e60f5dfab102127b6fa4a5277084815136fc7/ghc >--------------------------------------------------------------- commit d97e60f5dfab102127b6fa4a5277084815136fc7 Author: Divam Date: Tue Aug 18 18:08:26 2015 +0200 Comments reformating/corrections Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1145 >--------------------------------------------------------------- d97e60f5dfab102127b6fa4a5277084815136fc7 compiler/deSugar/Check.hs | 47 ++++++++++++++++++++-------------------- compiler/hsSyn/HsBinds.hs | 2 +- compiler/parser/ApiAnnotation.hs | 2 +- 3 files changed, 26 insertions(+), 25 deletions(-) diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index d03e367..2835189 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -36,7 +36,7 @@ This module performs checks about if one list of equations are: \item Overlapped \item Non exhaustive \end{itemize} -To discover that we go through the list of equations in a tree-like fashion. +To discover this we go through the list of equations in a tree-like fashion. If you like theory, a similar algorithm is described in: \begin{quotation} @@ -55,10 +55,10 @@ The algorithm is based on the first technique, but there are some differences: (By the way the second technique is really similar to the one used in @Match.hs@ to generate code) -This function takes the equations of a pattern and returns: +The @check@ function takes the equations of a pattern and returns: \begin{itemize} \item The patterns that are not recognized -\item The equations that are not overlapped +\item The equations that are shadowed or overlapped \end{itemize} It simplify the patterns and then call @check'@ (the same semantics), and it needs to reconstruct the patterns again .... @@ -74,7 +74,7 @@ then all the constructors are equal: f (: x (: y [])) = .... f (: x xs) = ..... \end{verbatim} -(more about that in @tidy_eqns@) +(more about this in @tidy_eqns@) We would prefer to have a @WarningPat@ of type @String@, but Strings and the Pretty Printer are not friends. @@ -175,26 +175,26 @@ untidy_lit (HsCharPrim src c) = HsChar src c untidy_lit lit = lit {- -This equation is the same that check, the only difference is that the -boring work is done, that work needs to be done only once, this is -the reason top have two functions, check is the external interface, - at check'@ is called recursively. + at check@ is the external interface, boring work (tidy, untidy) is done +in this as it needs to be done only once. + at check'@ is called recursively, this is the reason to have two functions. -There are several cases: +These are the several cases handled in @check'@: \begin{itemize} \item There are no equations: Everything is OK. -\item There are only one equation, that can fail, and all the patterns are + +\item If all the patterns are variables and the match can't fail + then this equation is used and it doesn't generate non-exhaustive cases. + +\item There is only one equation that can fail, and all the patterns are variables. Then that equation is used and the same equation is non-exhaustive. + \item All the patterns are variables, and the match can fail, there are more equations then the results is the result of the rest of equations and this equation is used also. -\item The general case, if all the patterns are variables (here the match - can't fail) then the result is that this equation is used and this - equation doesn't generate non-exhaustive cases. - \item In the general case, there can exist literals ,constructors or only vars in the first column, we actuate in consequence. @@ -330,7 +330,7 @@ This equation takes a matrix of patterns and split the equations by constructor, using all the constructors that appears in the first column of the pattern matching. -We can need a default clause or not ...., it depends if we used all the +Whether we need a default clause or not depends if we used all the constructors or not explicitly. The reasoning is similar to @process_literals@, the difference is that here the default case is not always needed. -} @@ -363,7 +363,7 @@ construct_matrix con qs = (pats,indexs) = (check' (remove_first_column con qs)) {- -Here remove first column is more difficult that with literals due to the fact +Here removing the first column is more difficult (than literals) due to the fact that constructors can have arguments. For instance, the matrix @@ -531,8 +531,8 @@ is_var_lit lit pat {- The difference beteewn @make_con@ and @make_whole_con@ is that - at make_wole_con@ creates a new constructor with all their arguments, and - at make_con@ takes a list of argumntes, creates the contructor getting their + at make_whole_con@ creates a new constructor with all their arguments, and + at make_con@ takes a list of arguments, creates the constructor getting their arguments from the list. See where \fbox{\ ???\ } are used for details. We need to reconstruct the patterns (make the constructors infix and @@ -563,7 +563,7 @@ In particular: \\ @(x:(...:[])@ & returns to be & @[x,...]@ \end{tabular} -The difficult case is the third one becouse we need to follow all the +The difficult case is the third one because we need to follow all the contructors until the @[]@ to know that we need to use the second case, not the second. \fbox{\ ???\ } -} @@ -648,8 +648,8 @@ tidy_eqn eqn = eqn { eqn_pats = map tidy_pat (eqn_pats eqn), -------------- might_fail_pat :: Pat Id -> Bool --- Returns True of patterns that might fail (i.e. fall through) in a way --- that is not covered by the checking algorithm. Specifically: +-- Returns True for patterns that might fail +-- (that are not covered by the checking algorithm) Specifically: -- NPlusKPat -- ViewPat (if refutable) -- ConPatOut of a PatSynCon @@ -670,7 +670,8 @@ might_fail_pat (BangPat p) = might_fail_lpat p might_fail_pat (ConPatOut { pat_con = con, pat_args = ps }) = case unLoc con of RealDataCon _dcon -> any might_fail_lpat (hsConPatArgs ps) - PatSynCon _psyn -> True + PatSynCon _psyn -> True -- This is considered 'might fail', as pattern synonym + -- is not supported by checking algorithm -- Finally the ones that are sure to succeed, or which are covered by the checking algorithm might_fail_pat (LazyPat _) = False -- Always succeeds @@ -696,7 +697,7 @@ tidy_pat (AsPat _ p) = tidy_pat (unLoc p) tidy_pat (SigPatOut p _) = tidy_pat (unLoc p) tidy_pat (CoPat _ pat _) = tidy_pat pat --- These two are might_fail patterns, so we map them to +-- These are might_fail patterns, so we map them to -- WildPats. The might_fail_pat stuff arranges that the -- guard says "this equation might fall through". tidy_pat (NPlusKPat id _ _ _) = WildPat (idType (unLoc id)) diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index d934418..4b661ff 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -289,7 +289,7 @@ That's where AbsBinds comes in. It looks like this: AbsBinds { abs_tvs = [a] , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a], - , abe_mono = reverse :: a -> a}] + , abe_mono = reverse :: [a] -> [a]}] , abs_binds = { reverse :: [a] -> [a] = \xs -> case xs of [] -> [] diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/parser/ApiAnnotation.hs index 0c80ec7..5ae1d04 100644 --- a/compiler/parser/ApiAnnotation.hs +++ b/compiler/parser/ApiAnnotation.hs @@ -38,7 +38,7 @@ identifying the specific keyword being captured. So -> let X = 1 in 2 *x +> let x = 1 in 2 *x would result in the AST element From git at git.haskell.org Tue Aug 18 16:33:16 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:33:16 +0000 (UTC) Subject: [commit: ghc] master: Add selectors for common fields (DataCon/PatSyn) to ConLike (18a1567) Message-ID: <20150818163316.3987C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/18a15679ad6727c36b799da7c3b2a38be2001c4a/ghc >--------------------------------------------------------------- commit 18a15679ad6727c36b799da7c3b2a38be2001c4a Author: Matthew Pickering Date: Tue Aug 18 18:07:18 2015 +0200 Add selectors for common fields (DataCon/PatSyn) to ConLike When pattern synonyms were introduced a new sum type was used in places where DataCon used to be used. PatSyn and DataCon share many of the same fields, this patch adds selectors to ConLike for these fields. Reviewers: austin, goldfire, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1154 >--------------------------------------------------------------- 18a15679ad6727c36b799da7c3b2a38be2001c4a compiler/basicTypes/ConLike.hs | 43 ++++++++++++++++++++++++++++++++++--- compiler/basicTypes/DataCon.hs-boot | 8 ++++++- compiler/basicTypes/PatSyn.hs-boot | 11 ++++++++++ compiler/deSugar/Check.hs | 4 +--- compiler/deSugar/MatchCon.hs | 14 +++--------- compiler/typecheck/TcPat.hs | 8 +------ compiler/types/TyCon.hs-boot | 1 + compiler/types/TypeRep.hs-boot | 1 + 8 files changed, 65 insertions(+), 25 deletions(-) diff --git a/compiler/basicTypes/ConLike.hs b/compiler/basicTypes/ConLike.hs index 7b8f70d..b770183 100644 --- a/compiler/basicTypes/ConLike.hs +++ b/compiler/basicTypes/ConLike.hs @@ -8,17 +8,27 @@ {-# LANGUAGE CPP, DeriveDataTypeable #-} module ConLike ( - ConLike(..) + ConLike(..) + , conLikeArity + , conLikeFieldLabels + , conLikeInstOrigArgTys + , conLikeExTyVars + , conLikeName + , conLikeStupidTheta ) where #include "HsVersions.h" -import {-# SOURCE #-} DataCon (DataCon) -import {-# SOURCE #-} PatSyn (PatSyn) +import {-# SOURCE #-} DataCon +import {-# SOURCE #-} PatSyn import Outputable import Unique import Util import Name +import TyCon +import BasicTypes +import {-# SOURCE #-} TypeRep (Type, ThetaType) +import Var import Data.Function (on) import qualified Data.Data as Data @@ -79,3 +89,30 @@ instance Data.Data ConLike where toConstr _ = abstractConstr "ConLike" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "ConLike" + + +conLikeArity :: ConLike -> Arity +conLikeArity (RealDataCon data_con) = dataConSourceArity data_con +conLikeArity (PatSynCon pat_syn) = patSynArity pat_syn + +conLikeFieldLabels :: ConLike -> [FieldLabel] +conLikeFieldLabels (RealDataCon data_con) = dataConFieldLabels data_con +conLikeFieldLabels (PatSynCon _) = [] + +conLikeInstOrigArgTys :: ConLike -> [Type] -> [Type] +conLikeInstOrigArgTys (RealDataCon data_con) tys = + dataConInstOrigArgTys data_con tys +conLikeInstOrigArgTys (PatSynCon pat_syn) tys = + patSynInstArgTys pat_syn tys + +conLikeExTyVars :: ConLike -> [TyVar] +conLikeExTyVars (RealDataCon dcon1) = dataConExTyVars dcon1 +conLikeExTyVars (PatSynCon psyn1) = patSynExTyVars psyn1 + +conLikeName :: ConLike -> Name +conLikeName (RealDataCon data_con) = dataConName data_con +conLikeName (PatSynCon pat_syn) = patSynName pat_syn + +conLikeStupidTheta :: ConLike -> ThetaType +conLikeStupidTheta (RealDataCon data_con) = dataConStupidTheta data_con +conLikeStupidTheta (PatSynCon {}) = [] diff --git a/compiler/basicTypes/DataCon.hs-boot b/compiler/basicTypes/DataCon.hs-boot index 4f19ffc..0d53fdd 100644 --- a/compiler/basicTypes/DataCon.hs-boot +++ b/compiler/basicTypes/DataCon.hs-boot @@ -1,15 +1,21 @@ module DataCon where import Var( TyVar ) import Name( Name, NamedThing ) -import {-# SOURCE #-} TyCon( TyCon ) +import {-# SOURCE #-} TyCon( TyCon, FieldLabel ) import Unique ( Uniquable ) import Outputable ( Outputable, OutputableBndr ) +import BasicTypes (Arity) +import {-# SOURCE #-} TypeRep (Type, ThetaType) data DataCon data DataConRep dataConName :: DataCon -> Name dataConTyCon :: DataCon -> TyCon dataConExTyVars :: DataCon -> [TyVar] +dataConSourceArity :: DataCon -> Arity +dataConFieldLabels :: DataCon -> [FieldLabel] +dataConInstOrigArgTys :: DataCon -> [Type] -> [Type] +dataConStupidTheta :: DataCon -> ThetaType instance Eq DataCon instance Ord DataCon diff --git a/compiler/basicTypes/PatSyn.hs-boot b/compiler/basicTypes/PatSyn.hs-boot index 733c51b..0ac4b7a 100644 --- a/compiler/basicTypes/PatSyn.hs-boot +++ b/compiler/basicTypes/PatSyn.hs-boot @@ -4,9 +4,20 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data ) import Outputable ( Outputable, OutputableBndr ) import Unique ( Uniquable ) +import BasicTypes (Arity) +import {-# SOURCE #-} TypeRep (Type) +import Var (TyVar) +import Name (Name) data PatSyn +patSynArity :: PatSyn -> Arity +patSynInstArgTys :: PatSyn -> [Type] -> [Type] +patSynExTyVars :: PatSyn -> [TyVar] +patSynName :: PatSyn -> Name + + + instance Eq PatSyn instance Ord PatSyn instance NamedThing PatSyn diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index af72f74..d03e367 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -754,9 +754,7 @@ tidy_con con (RecCon (HsRecFields fs _)) -- Special case for null patterns; maybe not a record at all | otherwise = PrefixCon (map (tidy_lpat.snd) all_pats) where - arity = case con of - RealDataCon dcon -> dataConSourceArity dcon - PatSynCon psyn -> patSynArity psyn + arity = conLikeArity con -- pad out all the missing fields with WildPats. field_pats = case con of diff --git a/compiler/deSugar/MatchCon.hs b/compiler/deSugar/MatchCon.hs index b42522c..4ea523a 100644 --- a/compiler/deSugar/MatchCon.hs +++ b/compiler/deSugar/MatchCon.hs @@ -17,8 +17,6 @@ import {-# SOURCE #-} Match ( match ) import HsSyn import DsBinds import ConLike -import DataCon -import PatSyn import TcType import DsMonad import DsUtils @@ -139,21 +137,15 @@ matchOneConLike vars ty (eqn1 : eqns) -- All eqns for a single constructor ConPatOut { pat_con = L _ con1, pat_arg_tys = arg_tys, pat_wrap = wrapper1, pat_tvs = tvs1, pat_dicts = dicts1, pat_args = args1 } = firstPat eqn1 - fields1 = case con1 of - RealDataCon dcon1 -> dataConFieldLabels dcon1 - PatSynCon{} -> [] + fields1 = conLikeFieldLabels con1 - val_arg_tys = case con1 of - RealDataCon dcon1 -> dataConInstOrigArgTys dcon1 inst_tys - PatSynCon psyn1 -> patSynInstArgTys psyn1 inst_tys + val_arg_tys = conLikeInstOrigArgTys con1 inst_tys inst_tys = ASSERT( tvs1 `equalLength` ex_tvs ) arg_tys ++ mkTyVarTys tvs1 -- dataConInstOrigArgTys takes the univ and existential tyvars -- and returns the types of the *value* args, which is what we want - ex_tvs = case con1 of - RealDataCon dcon1 -> dataConExTyVars dcon1 - PatSynCon psyn1 -> patSynExTyVars psyn1 + ex_tvs = conLikeExTyVars con1 match_group :: [Id] -> [(ConArgPats, EquationInfo)] -> DsM MatchResult -- All members of the group have compatible ConArgPats diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 17d0441..8e05cb3 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -1073,16 +1073,10 @@ tcConArgs con_like arg_tys (RecCon (HsRecFields rpats dd)) penv thing_inside ; return (sel_id, pat_ty) } field_tys :: [(FieldLabel, TcType)] - field_tys = case con_like of - RealDataCon data_con -> zip (dataConFieldLabels data_con) arg_tys + field_tys = zip (conLikeFieldLabels con_like) arg_tys -- Don't use zipEqual! If the constructor isn't really a record, then -- dataConFieldLabels will be empty (and each field in the pattern -- will generate an error below). - PatSynCon{} -> [] - -conLikeArity :: ConLike -> Arity -conLikeArity (RealDataCon data_con) = dataConSourceArity data_con -conLikeArity (PatSynCon pat_syn) = patSynArity pat_syn tcConArg :: Checker (LPat Name, TcSigmaType) (LPat Id) tcConArg (arg_pat, arg_ty) penv thing_inside diff --git a/compiler/types/TyCon.hs-boot b/compiler/types/TyCon.hs-boot index 5d27fa0..c2855ad 100644 --- a/compiler/types/TyCon.hs-boot +++ b/compiler/types/TyCon.hs-boot @@ -4,6 +4,7 @@ import Name (Name) import Unique (Unique) data TyCon +type FieldLabel = Name tyConName :: TyCon -> Name tyConUnique :: TyCon -> Unique diff --git a/compiler/types/TypeRep.hs-boot b/compiler/types/TypeRep.hs-boot index 94832b1..e4117de 100644 --- a/compiler/types/TypeRep.hs-boot +++ b/compiler/types/TypeRep.hs-boot @@ -8,5 +8,6 @@ data TyThing type PredType = Type type Kind = Type type SuperKind = Type +type ThetaType = [PredType] instance Outputable Type From git at git.haskell.org Tue Aug 18 16:33:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:33:18 +0000 (UTC) Subject: [commit: ghc] master: Transliterate unknown characters at output (22aca53) Message-ID: <20150818163318.EAF503A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/22aca5368864070bbed3b44dca3ce57e243bf415/ghc >--------------------------------------------------------------- commit 22aca5368864070bbed3b44dca3ce57e243bf415 Author: Michael Snoyman Date: Tue Aug 18 17:58:02 2015 +0200 Transliterate unknown characters at output This avoids the compiler from crashing when, for example, a warning contains a non-Latin identifier and the LANG variable is set to C. Fixes #6037. Test Plan: Create a Haskell source file containing an identifier with non-Latin characters and no type signature. Compile with `LANG=C ghc -Wall foo.hs`, and it should fail. With this patch, it will succeed. Reviewers: austin, rwbarton, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1153 GHC Trac Issues: #6037, #10762 >--------------------------------------------------------------- 22aca5368864070bbed3b44dca3ce57e243bf415 compiler/utils/Util.hs | 16 ++++++++++++++++ ghc/Main.hs | 3 +++ testsuite/tests/driver/all.T | 2 +- 3 files changed, 20 insertions(+), 1 deletion(-) diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index 96cd752..96e911e 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -83,6 +83,7 @@ module Util ( doesDirNameExist, getModificationUTCTime, modificationTimeIfExists, + hSetTranslit, global, consIORef, globalM, @@ -122,6 +123,8 @@ import Control.Applicative (Applicative) #endif import Control.Applicative ( liftA2 ) import Control.Monad ( liftM ) +import GHC.IO.Encoding (mkTextEncoding, textEncodingName) +import System.IO (Handle, hGetEncoding, hSetEncoding) import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, getModificationTime ) import System.FilePath @@ -978,6 +981,19 @@ modificationTimeIfExists f = do then return Nothing else ioError e +-- -------------------------------------------------------------- +-- Change the character encoding of the given Handle to transliterate +-- on unsupported characters instead of throwing an exception + +hSetTranslit :: Handle -> IO () +hSetTranslit h = do + menc <- hGetEncoding h + case fmap textEncodingName menc of + Just name | '/' `notElem` name -> do + enc' <- mkTextEncoding $ name ++ "//TRANSLIT" + hSetEncoding h enc' + _ -> return () + -- split a string at the last character where 'pred' is True, -- returning a pair of strings. The first component holds the string -- up (but not including) the last character for which 'pred' returned diff --git a/ghc/Main.hs b/ghc/Main.hs index 201ee5d..ed2ac67 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -80,6 +80,9 @@ main = do initGCStatistics -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering + hSetTranslit stdout + hSetTranslit stderr + GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do -- 1. extract the -B flag from the args argv0 <- getArgs diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index b79f166..a11c0f1 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -382,7 +382,7 @@ test('T7060', test('T7130', normal, compile_fail, ['-fflul-laziness']) test('T7563', when(unregisterised(), skip), run_command, ['$MAKE -s --no-print-directory T7563']) -test('T6037', expect_broken(6037), run_command, +test('T6037', normal, run_command, ['$MAKE -s --no-print-directory T6037']) test('T2507', # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X From git at git.haskell.org Tue Aug 18 16:33:21 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:33:21 +0000 (UTC) Subject: [commit: ghc] master: rts/Printer.c: speed up '-Da' printer for 'LIBBFD' build (ebca3f8) Message-ID: <20150818163321.A6E233A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ebca3f80b9deb50bda1e3913b969785b27d92b4e/ghc >--------------------------------------------------------------- commit ebca3f80b9deb50bda1e3913b969785b27d92b4e Author: Sergei Trofimovich Date: Tue Aug 18 18:06:41 2015 +0200 rts/Printer.c: speed up '-Da' printer for 'LIBBFD' build Patch switches from linear lookup in unordered array to a hash table lookup. When debugging GHC array contains 658_445 elements. Found performance gap when tried to debug blackholes. Signed-off-by: Sergei Trofimovich Reviewers: simonmar, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1150 >--------------------------------------------------------------- ebca3f80b9deb50bda1e3913b969785b27d92b4e rts/Printer.c | 92 +++++++---------------------------------------------------- 1 file changed, 11 insertions(+), 81 deletions(-) diff --git a/rts/Printer.c b/rts/Printer.c index 9bc2984..2396707 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -13,6 +13,7 @@ #include "rts/Bytecodes.h" /* for InstrPtr */ #include "sm/Storage.h" +#include "Hash.h" #include "Printer.h" #include "RtsUtils.h" @@ -28,14 +29,6 @@ * ------------------------------------------------------------------------*/ static void printStdObjPayload( StgClosure *obj ); -#ifdef USING_LIBBFD -static void reset_table ( int size ); -static void prepare_table ( void ); -static void insert ( StgWord value, const char *name ); -#endif -#if 0 /* unused but might be useful sometime */ -static rtsBool lookup_name ( char *name, StgWord *result ); -#endif /* -------------------------------------------------------------------------- * Printer @@ -593,69 +586,17 @@ void printTSO( StgTSO *tso ) /* -------------------------------------------------------------------------- * Simple lookup table - * - * Current implementation is pretty dumb! + * address -> function name * ------------------------------------------------------------------------*/ -struct entry { - StgWord value; - const char *name; -}; - -static nat table_size; -static struct entry* table; - -#ifdef USING_LIBBFD -static nat max_table_size; - -static void reset_table( int size ) -{ - max_table_size = size; - table_size = 0; - table = (struct entry *)stgMallocBytes(size * sizeof(struct entry), "Printer.c:reset_table()"); -} - -static void prepare_table( void ) -{ - /* Could sort it... */ -} - -static void insert( StgWord value, const char *name ) -{ - if ( table_size >= max_table_size ) { - barf( "Symbol table overflow\n" ); - } - table[table_size].value = value; - table[table_size].name = name; - table_size = table_size + 1; -} -#endif - -#if 0 -static rtsBool lookup_name( char *name, StgWord *result ) -{ - nat i; - for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) { - } - if (i < table_size) { - *result = table[i].value; - return rtsTrue; - } else { - return rtsFalse; - } -} -#endif +static HashTable * add_to_fname_table = NULL; const char *lookupGHCName( void *addr ) { - nat i; - for( i = 0; i < table_size && table[i].value != (StgWord) addr; ++i ) { - } - if (i < table_size) { - return table[i].name; - } else { + if (add_to_fname_table == NULL) return NULL; - } + + return lookupHashTable(add_to_fname_table, (StgWord)addr); } /* -------------------------------------------------------------------------- @@ -727,11 +668,6 @@ extern void DEBUG_LoadSymbols( char *name ) if (storage_needed < 0) { barf("can't read symbol table"); } -#if 0 - if (storage_needed == 0) { - debugBelch("no storage needed"); - } -#endif symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols"); number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table); @@ -740,10 +676,15 @@ extern void DEBUG_LoadSymbols( char *name ) barf("can't canonicalise symbol table"); } + if (add_to_fname_table == NULL) + add_to_fname_table = allocHashTable(); + for( i = 0; i != number_of_symbols; ++i ) { symbol_info info; bfd_get_symbol_info(abfd,symbol_table[i],&info); if (isReal(info.type, info.name)) { + insertHashTable(add_to_fname_table, + info.value, (void*)info.name); num_real_syms += 1; } } @@ -753,19 +694,8 @@ extern void DEBUG_LoadSymbols( char *name ) number_of_symbols, num_real_syms) ); - reset_table( num_real_syms ); - - for( i = 0; i != number_of_symbols; ++i ) { - symbol_info info; - bfd_get_symbol_info(abfd,symbol_table[i],&info); - if (isReal(info.type, info.name)) { - insert( info.value, info.name ); - } - } - stgFree(symbol_table); } - prepare_table(); } #else /* USING_LIBBFD */ From git at git.haskell.org Tue Aug 18 16:33:24 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:33:24 +0000 (UTC) Subject: [commit: ghc] master: Fix rdynamic flag and test on Windows (b17ec56) Message-ID: <20150818163324.8A1EF3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b17ec5674f26b0b65dda4ec446e0b9b5336b7562/ghc >--------------------------------------------------------------- commit b17ec5674f26b0b65dda4ec446e0b9b5336b7562 Author: Tamar Christina Date: Tue Aug 18 17:59:04 2015 +0200 Fix rdynamic flag and test on Windows The rdynamic tests and feature are marked broken on windows. This is because the flag used doesn't exist and the symbol lookup in the test did not account for platform differences in name mangling. This commit fixes the flag and tests for rdynamic on windows. Test Plan: make TEST="rdynamic" on both x86 and x86_64 Reviewers: austin, thomie, bgamari Reviewed By: thomie, bgamari Subscribers: #ghc_windows_task_force Differential Revision: https://phabricator.haskell.org/D1149 GHC Trac Issues: #9381 >--------------------------------------------------------------- b17ec5674f26b0b65dda4ec446e0b9b5336b7562 compiler/main/DynFlags.hs | 2 +- testsuite/tests/rts/all.T | 1 - testsuite/tests/rts/rdynamic.hs | 10 ++++++++-- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5fa62b4..0423e78 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2292,7 +2292,7 @@ dynamic_flags = [ #ifdef linux_HOST_OS addOptl "-rdynamic" #elif defined (mingw32_HOST_OS) - addOptl "-export-all-symbols" + addOptl "-Wl,--export-all-symbols" #else -- ignored for compat w/ gcc: id diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 72566d1..c9ad12b 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -261,7 +261,6 @@ test('T10017', [ when(opsys('mingw32'), skip) , only_ways(threaded_ways), extra_run_opts('+RTS -N2 -RTS') ], compile_and_run, ['']) test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) - , when(opsys('mingw32'), expect_broken(9381)) # this needs runtime infrastructure to do in ghci: # '-rdynamic' ghc, load modules only via dlopen(RTLD_BLOBAL) and more. , omit_ways(['ghci']) diff --git a/testsuite/tests/rts/rdynamic.hs b/testsuite/tests/rts/rdynamic.hs index 17f8df7..bbbe9e8 100644 --- a/testsuite/tests/rts/rdynamic.hs +++ b/testsuite/tests/rts/rdynamic.hs @@ -11,7 +11,7 @@ module Main(main, f) where import Foreign.C.String ( withCString, CString ) import GHC.Exts ( addrToAny# ) import GHC.Ptr ( Ptr(..), nullPtr ) -import System.Info ( os ) +import System.Info ( os, arch ) import Encoding main = (loadFunction Nothing "Main" "f" :: IO (Maybe String)) >>= print @@ -37,7 +37,13 @@ loadFunction mpkg m valsym = do else case addrToAny# addr of (# hval #) -> return ( Just hval ) where - prefixUnderscore = if elem os ["darwin","mingw32","cygwin"] then "_" else "" + prefixUnderscore = case (os, arch) of + ("mingw32", "x86_64") -> "" + ("cygwin" , "x86_64") -> "" + ("mingw32", _ ) -> "_" + ("darwin" , _ ) -> "_" + ("cygwin" , _ ) -> "_" + _ -> "" foreign import ccall safe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a) foreign import ccall safe "initLinker" c_initLinker :: IO () From git at git.haskell.org Tue Aug 18 16:42:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:42:12 +0000 (UTC) Subject: [commit: ghc] branch 'wip/d1141' created Message-ID: <20150818164212.AE2B13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/d1141 Referencing: 3849dac59209cc2608636ae120eac54237d882c5 From git at git.haskell.org Tue Aug 18 16:42:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:42:15 +0000 (UTC) Subject: [commit: ghc] wip/d1141: Delete FastBool (e433505) Message-ID: <20150818164215.CDFFE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/d1141 Link : http://ghc.haskell.org/trac/ghc/changeset/e43350573b7a6f233bc7ef2a8badaeb15fb46f34/ghc >--------------------------------------------------------------- commit e43350573b7a6f233bc7ef2a8badaeb15fb46f34 Author: Thomas Miedema Date: Tue Aug 18 18:38:12 2015 +0200 Delete FastBool This reverses some of the work done in Trac #1405, and assumes GHC is smart enough to do its own unboxing of booleans now. I would like to do some more performance measurements, but the code changes can be reviewed already. Test Plan: With a perf build: ./inplace/bin/ghc-stage2 nofib/spectral/simple/Main.hs -fforce-recomp +RTS -t --machine-readable before: [("bytes allocated", "1300744864") ,("num_GCs", "302") ,("average_bytes_used", "8811118") ,("max_bytes_used", "24477464") ,("num_byte_usage_samples", "9") ,("peak_megabytes_allocated", "64") ,("init_cpu_seconds", "0.001") ,("init_wall_seconds", "0.001") ,("mutator_cpu_seconds", "2.833") ,("mutator_wall_seconds", "4.283") ,("GC_cpu_seconds", "0.960") ,("GC_wall_seconds", "0.961") after: [("bytes allocated", "1301088064") ,("num_GCs", "310") ,("average_bytes_used", "8820253") ,("max_bytes_used", "24539904") ,("num_byte_usage_samples", "9") ,("peak_megabytes_allocated", "64") ,("init_cpu_seconds", "0.001") ,("init_wall_seconds", "0.001") ,("mutator_cpu_seconds", "2.876") ,("mutator_wall_seconds", "4.474") ,("GC_cpu_seconds", "0.965") ,("GC_wall_seconds", "0.979") ] CPU time seems to be up a bit, but I'm not sure. Unfortunately CPU time measurements are rather noisy. Reviewers: austin, bgamari, rwbarton Differential Revision: https://phabricator.haskell.org/D1143 GHC Trac Issues: #1405 >--------------------------------------------------------------- e43350573b7a6f233bc7ef2a8badaeb15fb46f34 compiler/codeGen/CodeGen/Platform.hs | 3 +- compiler/ghc.cabal.in | 1 - compiler/ghc.mk | 1 - compiler/main/TidyPgm.hs | 37 ++-- compiler/nativeGen/PPC/Instr.hs | 5 +- compiler/nativeGen/PPC/Regs.hs | 3 +- compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 2 +- .../nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs | 5 +- compiler/nativeGen/SPARC/Instr.hs | 5 +- compiler/nativeGen/SPARC/Regs.hs | 10 +- compiler/nativeGen/X86/CodeGen.hs | 3 +- compiler/nativeGen/X86/Instr.hs | 3 +- compiler/nativeGen/X86/Regs.hs | 3 +- compiler/utils/FastBool.hs | 70 -------- includes/CodeGen.Platform.hs | 187 ++++++++++----------- 15 files changed, 122 insertions(+), 216 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 e43350573b7a6f233bc7ef2a8badaeb15fb46f34 From git at git.haskell.org Tue Aug 18 16:42:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 18 Aug 2015 16:42:18 +0000 (UTC) Subject: [commit: ghc] wip/d1141: Refactor: delete most of the module FastTypes (3849dac) Message-ID: <20150818164218.B5EB43A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/d1141 Link : http://ghc.haskell.org/trac/ghc/changeset/3849dac59209cc2608636ae120eac54237d882c5/ghc >--------------------------------------------------------------- commit 3849dac59209cc2608636ae120eac54237d882c5 Author: Thomas Miedema Date: Tue Aug 18 18:38:28 2015 +0200 Refactor: delete most of the module FastTypes This reverses some of the work done in #1405, and goes back to the assumption that the bootstrap compiler understands GHC-haskell. In particular: * use MagicHash instead of _ILIT and _CLIT * pattern matching on I# if possible, instead of using iUnbox unnecessarily * use Int#/Char#/Addr# instead of the following type synonyms: - type FastInt = Int# - type FastChar = Char# - type FastPtr a = Addr# * inline the following functions: - iBox = I# - cBox = C# - fastChr = chr# - fastOrd = ord# - eqFastChar = eqChar# - shiftLFastInt = uncheckedIShiftL# - shiftR_FastInt = uncheckedIShiftRL# - shiftRLFastInt = uncheckedIShiftRL# * delete the following unused functions: - minFastInt - maxFastInt - uncheckedIShiftRA# - castFastPtr - panicDocFastInt and pprPanicFastInt * rename panicFastInt back to panic# These functions remain, since they actually do something: * iUnbox * bitAndFastInt * bitOrFastInt Test Plan: validate Reviewers: austin, bgamari Subscribers: rwbarton Differential Revision: https://phabricator.haskell.org/D1141 GHC Trac Issues: #1405 >--------------------------------------------------------------- 3849dac59209cc2608636ae120eac54237d882c5 compiler/basicTypes/Literal.hs | 33 +++-- compiler/basicTypes/Name.hs | 24 ++-- compiler/basicTypes/UniqSupply.hs | 19 +-- compiler/basicTypes/Unique.hs | 72 +++++------ compiler/basicTypes/Var.hs | 32 ++--- compiler/basicTypes/VarEnv.hs | 29 +++-- compiler/cmm/CmmOpt.hs | 24 +--- compiler/coreSyn/CoreUnfold.hs | 66 +++++----- compiler/ghc.cabal.in | 1 - compiler/ghc.mk | 1 - compiler/hsSyn/HsExpr.hs | 2 - compiler/main/GhcPlugins.hs | 3 +- compiler/nativeGen/PPC/Regs.hs | 33 +++-- compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 52 ++++---- compiler/nativeGen/SPARC/Regs.hs | 45 ++++--- compiler/nativeGen/TargetReg.hs | 5 +- compiler/nativeGen/X86/Regs.hs | 42 +++---- compiler/prelude/PrimOp.hs | 20 ++- compiler/profiling/CostCentre.hs | 14 +-- compiler/utils/FastFunctions.hs | 31 +---- compiler/utils/FastString.hs | 41 +----- compiler/utils/FastTypes.hs | 138 --------------------- compiler/utils/Outputable.hs | 9 +- compiler/utils/Panic.hs | 15 +-- compiler/utils/StringBuffer.hs | 23 +--- compiler/utils/Util.hs | 25 ++-- utils/genprimopcode/Main.hs | 4 +- 27 files changed, 266 insertions(+), 537 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 3849dac59209cc2608636ae120eac54237d882c5 From git at git.haskell.org Thu Aug 20 10:34:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Aug 2015 10:34:55 +0000 (UTC) Subject: [commit: ghc] master: Build system: delete half-baked Cygwin support (b6be81b) Message-ID: <20150820103455.AA1563A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b6be81b841e34ca45b3549c4c79e886a8761e59a/ghc >--------------------------------------------------------------- commit b6be81b841e34ca45b3549c4c79e886a8761e59a Author: Thomas Miedema Date: Sat Aug 15 11:36:44 2015 +0200 Build system: delete half-baked Cygwin support We only support building GHC on mys2 nowadays, see https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Windows. This (partially) reverts various commits from a few years ago, among which: * 5775d5142da227d65fb86994d363eb16841ee642 "Add OSTYPE build-system variable, and use it" * 3fb8c431824aa2f3bd979e35d1a283546fcfbe74 "Fix building libgmp on cygwin" * cdbb4720c424500adb57cbbef69721d0b039fa46 "Fix cmd invocation by libffi cuild system on Windows 7 cygwin" * e8121501ee3549a35e954726ccfd871ac9d51f83 "Fix dblatex and xml* tool detection on Windows" Reviewed by: austin, Phyx Differential Revision: https://phabricator.haskell.org/D1155 >--------------------------------------------------------------- b6be81b841e34ca45b3549c4c79e886a8761e59a aclocal.m4 | 48 +++++++++------------------------------- libffi/ghc.mk | 10 --------- libraries/integer-gmp/gmp/ghc.mk | 5 ----- mk/config.mk.in | 7 ++---- mk/install.mk.in | 21 ------------------ mk/project.mk.in | 9 ++------ rules/distdir-opts.mk | 18 +-------------- validate | 4 ---- 8 files changed, 15 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 b6be81b841e34ca45b3549c4c79e886a8761e59a From git at git.haskell.org Thu Aug 20 22:47:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 20 Aug 2015 22:47:25 +0000 (UTC) Subject: [commit: ghc] master: Delete sync-all (98f8c9e) Message-ID: <20150820224725.6A28D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/98f8c9e597bc54b16f588a4641d8fe3bad36c7bb/ghc >--------------------------------------------------------------- commit 98f8c9e597bc54b16f588a4641d8fe3bad36c7bb Author: Thomas Miedema Date: Fri Aug 21 00:47:16 2015 +0200 Delete sync-all >--------------------------------------------------------------- 98f8c9e597bc54b16f588a4641d8fe3bad36c7bb sync-all | 1023 -------------------------------------------------------------- 1 file changed, 1023 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 98f8c9e597bc54b16f588a4641d8fe3bad36c7bb From git at git.haskell.org Fri Aug 21 08:15:05 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 08:15:05 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Some cleanup (b2da169) Message-ID: <20150821081505.53C523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/b2da1693c4a8875a0a4a2788cd3d349713902157/ghc >--------------------------------------------------------------- commit b2da1693c4a8875a0a4a2788cd3d349713902157 Author: George Karachalias Date: Tue Aug 18 12:55:03 2015 +0200 Some cleanup >--------------------------------------------------------------- b2da1693c4a8875a0a4a2788cd3d349713902157 compiler/deSugar/Check.hs | 352 +++++++++++++++++++------------------------ compiler/deSugar/Match.hs | 9 +- compiler/deSugar/TmOracle.hs | 44 +++--- 3 files changed, 174 insertions(+), 231 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 b2da1693c4a8875a0a4a2788cd3d349713902157 From git at git.haskell.org Fri Aug 21 08:15:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 08:15:08 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Some more cleanup (3d07017) Message-ID: <20150821081508.182753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/3d07017cf2b674262a329470ca76f1115899a5e9/ghc >--------------------------------------------------------------- commit 3d07017cf2b674262a329470ca76f1115899a5e9 Author: George Karachalias Date: Tue Aug 18 16:06:24 2015 +0200 Some more cleanup >--------------------------------------------------------------- 3d07017cf2b674262a329470ca76f1115899a5e9 compiler/deSugar/Check.hs | 358 ++++++++++++++++++++----------------------- compiler/deSugar/TmOracle.hs | 8 +- 2 files changed, 169 insertions(+), 197 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 3d07017cf2b674262a329470ca76f1115899a5e9 From git at git.haskell.org Fri Aug 21 14:24:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 14:24:49 +0000 (UTC) Subject: [commit: ghc] master: Bag: Add Foldable instance (0d0e651) Message-ID: <20150821142449.DD2F03A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0d0e651d789a9a1b62139a210f4b013fa5453cfa/ghc >--------------------------------------------------------------- commit 0d0e651d789a9a1b62139a210f4b013fa5453cfa Author: Ben Gamari Date: Tue Aug 18 19:17:50 2015 +0200 Bag: Add Foldable instance >--------------------------------------------------------------- 0d0e651d789a9a1b62139a210f4b013fa5453cfa compiler/utils/Bag.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/compiler/utils/Bag.hs b/compiler/utils/Bag.hs index 8fbfa13..09fc00a 100644 --- a/compiler/utils/Bag.hs +++ b/compiler/utils/Bag.hs @@ -29,6 +29,7 @@ import Util import MonadUtils import Data.Data import Data.List ( partition ) +import qualified Data.Foldable as Foldable infixr 3 `consBag` infixl 3 `snocBag` @@ -269,3 +270,6 @@ instance Data a => Data (Bag a) where gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Bag" dataCast1 x = gcast1 x + +instance Foldable.Foldable Bag where + foldr = foldrBag From git at git.haskell.org Fri Aug 21 14:24:52 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 14:24:52 +0000 (UTC) Subject: [commit: ghc] master: GhcMake: Fix spelling in comment (a146b28) Message-ID: <20150821142452.ABBCE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a146b282fe9019ab0d3b0eea6c54dbe628ff5cc8/ghc >--------------------------------------------------------------- commit a146b282fe9019ab0d3b0eea6c54dbe628ff5cc8 Author: Ben Gamari Date: Tue Aug 18 19:17:22 2015 +0200 GhcMake: Fix spelling in comment >--------------------------------------------------------------- a146b282fe9019ab0d3b0eea6c54dbe628ff5cc8 compiler/main/GhcMake.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index fbeb631..7c3f95b 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -137,7 +137,7 @@ data LoadHowMuch -- -- This function implements the core of GHC's @--make@ mode. It preprocesses, -- compiles and loads the specified modules, avoiding re-compilation wherever --- possible. Depending on the target (see 'DynFlags.hscTarget') compilating +-- possible. Depending on the target (see 'DynFlags.hscTarget') compiling -- and loading may result in files being created on disk. -- -- Calls the 'defaultWarnErrLogger' after each compiling each module, whether From git at git.haskell.org Fri Aug 21 14:24:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 14:24:55 +0000 (UTC) Subject: [commit: ghc] master: Implement getSizeofMutableByteArrayOp primop (9e8562a) Message-ID: <20150821142455.8B2EB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/9e8562ae02701270e2c1dfcee3279d862dc5b7b6/ghc >--------------------------------------------------------------- commit 9e8562ae02701270e2c1dfcee3279d862dc5b7b6 Author: Ben Gamari Date: Fri Aug 21 10:37:39 2015 +0200 Implement getSizeofMutableByteArrayOp primop Now since ByteArrays are mutable we need to be more explicit about when the size is queried. Test Plan: Add testcase and validate Reviewers: goldfire, hvr, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1139 GHC Trac Issues: #9447 >--------------------------------------------------------------- 9e8562ae02701270e2c1dfcee3279d862dc5b7b6 compiler/codeGen/StgCmmPrim.hs | 5 +++ compiler/main/BreakArray.hs | 12 ++++- compiler/prelude/primops.txt.pp | 8 +++- libraries/integer-gmp/src/GHC/Integer/Type.hs | 63 +++++++++++++++------------ 4 files changed, 58 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 9e8562ae02701270e2c1dfcee3279d862dc5b7b6 From git at git.haskell.org Fri Aug 21 14:24:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 14:24:58 +0000 (UTC) Subject: [commit: ghc] master: Delete FastBool (3452473) Message-ID: <20150821142458.6C2723A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/3452473b4bb180ba327520067b8c6f2a8d6c4f4b/ghc >--------------------------------------------------------------- commit 3452473b4bb180ba327520067b8c6f2a8d6c4f4b Author: Thomas Miedema Date: Fri Aug 21 10:38:06 2015 +0200 Delete FastBool This reverses some of the work done in Trac #1405, and assumes GHC is smart enough to do its own unboxing of booleans now. I would like to do some more performance measurements, but the code changes can be reviewed already. Test Plan: With a perf build: ./inplace/bin/ghc-stage2 nofib/spectral/simple/Main.hs -fforce-recomp +RTS -t --machine-readable before: ``` [("bytes allocated", "1300744864") ,("num_GCs", "302") ,("average_bytes_used", "8811118") ,("max_bytes_used", "24477464") ,("num_byte_usage_samples", "9") ,("peak_megabytes_allocated", "64") ,("init_cpu_seconds", "0.001") ,("init_wall_seconds", "0.001") ,("mutator_cpu_seconds", "2.833") ,("mutator_wall_seconds", "4.283") ,("GC_cpu_seconds", "0.960") ,("GC_wall_seconds", "0.961") ] ``` after: ``` [("bytes allocated", "1301088064") ,("num_GCs", "310") ,("average_bytes_used", "8820253") ,("max_bytes_used", "24539904") ,("num_byte_usage_samples", "9") ,("peak_megabytes_allocated", "64") ,("init_cpu_seconds", "0.001") ,("init_wall_seconds", "0.001") ,("mutator_cpu_seconds", "2.876") ,("mutator_wall_seconds", "4.474") ,("GC_cpu_seconds", "0.965") ,("GC_wall_seconds", "0.979") ] ``` CPU time seems to be up a bit, but I'm not sure. Unfortunately CPU time measurements are rather noisy. Reviewers: austin, bgamari, rwbarton Subscribers: nomeata Differential Revision: https://phabricator.haskell.org/D1143 GHC Trac Issues: #1405 >--------------------------------------------------------------- 3452473b4bb180ba327520067b8c6f2a8d6c4f4b compiler/codeGen/CodeGen/Platform.hs | 3 +- compiler/ghc.cabal.in | 1 - compiler/ghc.mk | 1 - compiler/main/TidyPgm.hs | 37 ++-- compiler/nativeGen/PPC/Instr.hs | 5 +- compiler/nativeGen/PPC/Regs.hs | 3 +- compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 2 +- .../nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs | 5 +- compiler/nativeGen/SPARC/Instr.hs | 5 +- compiler/nativeGen/SPARC/Regs.hs | 10 +- compiler/nativeGen/X86/CodeGen.hs | 3 +- compiler/nativeGen/X86/Instr.hs | 3 +- compiler/nativeGen/X86/Regs.hs | 3 +- compiler/utils/FastBool.hs | 70 -------- includes/CodeGen.Platform.hs | 187 ++++++++++----------- 15 files changed, 122 insertions(+), 216 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 3452473b4bb180ba327520067b8c6f2a8d6c4f4b From git at git.haskell.org Fri Aug 21 14:25:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 14:25:01 +0000 (UTC) Subject: [commit: ghc] master: Refactor: delete most of the module FastTypes (2f29ebb) Message-ID: <20150821142501.433D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/2f29ebbb6f8c914f2bba624f3edcc259274df8af/ghc >--------------------------------------------------------------- commit 2f29ebbb6f8c914f2bba624f3edcc259274df8af Author: Thomas Miedema Date: Fri Aug 21 10:44:54 2015 +0200 Refactor: delete most of the module FastTypes This reverses some of the work done in #1405, and goes back to the assumption that the bootstrap compiler understands GHC-haskell. In particular: * use MagicHash instead of _ILIT and _CLIT * pattern matching on I# if possible, instead of using iUnbox unnecessarily * use Int#/Char#/Addr# instead of the following type synonyms: - type FastInt = Int# - type FastChar = Char# - type FastPtr a = Addr# * inline the following functions: - iBox = I# - cBox = C# - fastChr = chr# - fastOrd = ord# - eqFastChar = eqChar# - shiftLFastInt = uncheckedIShiftL# - shiftR_FastInt = uncheckedIShiftRL# - shiftRLFastInt = uncheckedIShiftRL# * delete the following unused functions: - minFastInt - maxFastInt - uncheckedIShiftRA# - castFastPtr - panicDocFastInt and pprPanicFastInt * rename panicFastInt back to panic# These functions remain, since they actually do something: * iUnbox * bitAndFastInt * bitOrFastInt Test Plan: validate Reviewers: austin, bgamari Subscribers: rwbarton Differential Revision: https://phabricator.haskell.org/D1141 GHC Trac Issues: #1405 >--------------------------------------------------------------- 2f29ebbb6f8c914f2bba624f3edcc259274df8af compiler/basicTypes/Literal.hs | 33 +++-- compiler/basicTypes/Name.hs | 24 ++-- compiler/basicTypes/UniqSupply.hs | 19 +-- compiler/basicTypes/Unique.hs | 72 +++++------ compiler/basicTypes/Var.hs | 32 ++--- compiler/basicTypes/VarEnv.hs | 29 +++-- compiler/cmm/CmmOpt.hs | 24 +--- compiler/coreSyn/CoreUnfold.hs | 68 +++++----- compiler/ghc.cabal.in | 1 - compiler/ghc.mk | 1 - compiler/hsSyn/HsExpr.hs | 2 - compiler/main/GhcPlugins.hs | 3 +- compiler/nativeGen/PPC/Regs.hs | 33 +++-- compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 52 ++++---- compiler/nativeGen/SPARC/Regs.hs | 45 ++++--- compiler/nativeGen/TargetReg.hs | 5 +- compiler/nativeGen/X86/Regs.hs | 42 +++---- compiler/prelude/PrimOp.hs | 20 ++- compiler/profiling/CostCentre.hs | 14 +-- compiler/utils/FastFunctions.hs | 31 +---- compiler/utils/FastString.hs | 41 +----- compiler/utils/FastTypes.hs | 138 --------------------- compiler/utils/Outputable.hs | 9 +- compiler/utils/Panic.hs | 15 +-- compiler/utils/StringBuffer.hs | 23 +--- compiler/utils/Util.hs | 25 ++-- utils/genprimopcode/Main.hs | 4 +- 27 files changed, 268 insertions(+), 537 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 2f29ebbb6f8c914f2bba624f3edcc259274df8af From git at git.haskell.org Fri Aug 21 17:18:01 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 17:18:01 +0000 (UTC) Subject: [commit: hsc2hs] master: Follow changes in GHC build system (293f41c) Message-ID: <20150821171801.C81383A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hsc2hs On branch : master Link : http://git.haskell.org/hsc2hs.git/commitdiff/293f41c78e956b78363ede463e7ff52eb6bc997d >--------------------------------------------------------------- commit 293f41c78e956b78363ede463e7ff52eb6bc997d Author: Thomas Miedema Date: Sat Aug 15 14:51:57 2015 +0200 Follow changes in GHC build system >--------------------------------------------------------------- 293f41c78e956b78363ede463e7ff52eb6bc997d ghc.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghc.mk b/ghc.mk index 68b348e..f12aea5 100644 --- a/ghc.mk +++ b/ghc.mk @@ -48,7 +48,7 @@ install: install_utils/hsc2hs_dist_install .PHONY: install_utils/hsc2hs_dist_install install_utils/hsc2hs_dist_install: utils/hsc2hs/template-hsc.h - $(call INSTALL_HEADER,$(INSTALL_OPTS),$<,"$(DESTDIR)$(topdir)") + $(INSTALL_HEADER) $(INSTALL_OPTS) $< "$(DESTDIR)$(topdir)" BINDIST_EXTRAS += utils/hsc2hs/template-hsc.h From git at git.haskell.org Fri Aug 21 17:23:11 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 17:23:11 +0000 (UTC) Subject: [commit: ghc] master: Build system: simplify install.mk.in (47493e6) Message-ID: <20150821172311.29CE83A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/47493e60fa2f8f520297969472dde01931530707/ghc >--------------------------------------------------------------- commit 47493e60fa2f8f520297969472dde01931530707 Author: Thomas Miedema Date: Sat Aug 15 14:18:07 2015 +0200 Build system: simplify install.mk.in This will allow fixing #1851 more easily ("make install-strip" should work). This reverts 57e2a81c589103b50da80a9e378b1a11285bd521: "On Cygwin, use a Cygwin-style path for /bin/install's destination" Update submodule haddock and hsc2hs. >--------------------------------------------------------------- 47493e60fa2f8f520297969472dde01931530707 docs/man/ghc.mk | 6 +++--- driver/ghci/ghc.mk | 4 ++-- ghc.mk | 50 +++++++++++++++++++++++++------------------------- includes/ghc.mk | 8 ++++---- mk/install.mk.in | 24 +++++++++--------------- rts/ghc.mk | 4 ++-- rules/shell-wrapper.mk | 2 +- utils/ghc-pkg/ghc.mk | 2 +- utils/haddock | 2 +- utils/hsc2hs | 2 +- 10 files changed, 49 insertions(+), 55 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 47493e60fa2f8f520297969472dde01931530707 From git at git.haskell.org Fri Aug 21 17:23:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 17:23:14 +0000 (UTC) Subject: [commit: ghc] master: Build system: delete unused distrib/Makefile (a1c008b) Message-ID: <20150821172314.077333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a1c008b30fc60a327afe098cf16bd14ca1e5e381/ghc >--------------------------------------------------------------- commit a1c008b30fc60a327afe098cf16bd14ca1e5e381 Author: Thomas Miedema Date: Sat Aug 15 19:07:52 2015 +0200 Build system: delete unused distrib/Makefile >--------------------------------------------------------------- a1c008b30fc60a327afe098cf16bd14ca1e5e381 distrib/Makefile | 73 -------------------------------------------------------- 1 file changed, 73 deletions(-) diff --git a/distrib/Makefile b/distrib/Makefile deleted file mode 100644 index 7f8add1..0000000 --- a/distrib/Makefile +++ /dev/null @@ -1,73 +0,0 @@ - -include Makefile-vars - -.PHONY: install-strip install postinstall denounce show-install-setup - -#.PHONY: in-place -# This has bitrotted: -#in-place :: -# @if test -x "./post-inplace-script" ; then \ -# echo "Running project-specific post-inplace script ..." ; \ -# ./post-inplace-script $(platform) `pwd` \ -# $(package)-$(version); \ -# echo "Done" ; \ -# fi -# @echo "Finished configuring..to use, add `pwd`/bin/$(platform) to your PATH." - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install - -install :: - $(INSTALL_DIR) $(bindir) - $(INSTALL_DIR) $(datadir) - echo "[]" > $(datadir)/package.conf - -install:: - $(MAKE) -C includes install DOING_BIN_DIST=YES - $(MAKE) -C utils install DOING_BIN_DIST=YES - $(MAKE) -C rts install DOING_BIN_DIST=YES - $(MAKE) -C libraries install DOING_BIN_DIST=YES - $(MAKE) -C libffi install DOING_BIN_DIST=YES - $(MAKE) -C compiler install DOING_BIN_DIST=YES - $(MAKE) -C ghc install DOING_BIN_DIST=YES - $(MAKE) -C driver install DOING_BIN_DIST=YES - $(MAKE) -C gmp install DOING_BIN_DIST=YES - $(MAKE) -C docs install-docs DOING_BIN_DIST=YES - $(MAKE) -C libraries/Cabal/doc install-docs DOING_BIN_DIST=YES - $(INSTALL_DATA) $(INSTALL_OPTS) settings $(libdir) - -install :: postinstall denounce - -# Look to see if $(bindir) is in $(PATH). Assumes there are no funky -# characters. -GREPPED_PATH=$(shell echo ":$(PATH):" | grep ":$(bindir):") - -denounce: - @echo - @echo ======================================================================= - @echo Installation of $(package)-$(version) was successful. - @echo -ifeq "$(GREPPED_PATH)" "" - @echo To use, add $(bindir) to your PATH. - @echo -endif - @if test -f $(htmldir)/index.html; then \ - echo For documentation, see $(htmldir)/index.html ; \ - else \ - echo "Warning: this binary distribution does NOT contain documentation!" ; \ - fi - @echo ======================================================================= - -postinstall: - @if test -x "./post-install-script" ; then \ - echo "Running project-specific post-install script ..." ; \ - ./post-install-script $(platform) $(libdir) ; \ - echo "Done" ; \ - fi - -show-install-setup: - @echo "Install setup..." - @echo "bindir = $(bindir)" - @echo "libdir = $(libdir) (libdir = $(libdir))" - @echo "datadir = $(datadir) (datadir = $(datadir))" - From git at git.haskell.org Fri Aug 21 22:01:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 21 Aug 2015 22:01:51 +0000 (UTC) Subject: [commit: ghc] master: Check options before warning about source imports. (a5061a9) Message-ID: <20150821220151.6CD823A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a5061a96724922097e4181d452a64618e35fa297/ghc >--------------------------------------------------------------- commit a5061a96724922097e4181d452a64618e35fa297 Author: Alex Rozenshteyn Date: Fri Aug 21 21:42:16 2015 +0200 Check options before warning about source imports. Summary: Fixes T10637 Reviewers: austin, bgamari, thomie Subscribers: dfordivam, simonpj, thomie Differential Revision: https://phabricator.haskell.org/D1157 GHC Trac Issues: #10637 >--------------------------------------------------------------- a5061a96724922097e4181d452a64618e35fa297 compiler/main/GhcMake.hs | 3 ++- testsuite/tests/programs/hs-boot/hs-boot.stderr | 2 -- testsuite/tests/rename/should_compile/T3103/T3103.stderr | 3 --- .../tests/{ghci/prog009/A1.hs => warnings/should_compile/T10637/A.hs} | 2 +- .../tests/{th/T2014 => warnings/should_compile/T10637}/A.hs-boot | 0 .../scripts/break022 => warnings/should_compile/T10637}/Makefile | 0 testsuite/tests/warnings/should_compile/T10637/T10637.hs | 4 ++++ testsuite/tests/warnings/should_compile/T10637/T10637.stderr | 3 +++ testsuite/tests/warnings/should_compile/T10637/all.T | 2 ++ 9 files changed, 12 insertions(+), 7 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 7c3f95b..ba21e5b 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1544,7 +1544,8 @@ nodeMapElts = Map.elems warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m () warnUnnecessarySourceImports sccs = do dflags <- getDynFlags - logWarnings (listToBag (concatMap (check dflags . flattenSCC) sccs)) + when (wopt Opt_WarnUnusedImports dflags) + (logWarnings (listToBag (concatMap (check dflags . flattenSCC) sccs))) where check dflags ms = let mods_in_this_cycle = map ms_mod_name ms in [ warn dflags i | m <- ms, i <- ms_home_srcimps m, diff --git a/testsuite/tests/programs/hs-boot/hs-boot.stderr b/testsuite/tests/programs/hs-boot/hs-boot.stderr index 42ca073..e69de29 100644 --- a/testsuite/tests/programs/hs-boot/hs-boot.stderr +++ b/testsuite/tests/programs/hs-boot/hs-boot.stderr @@ -1,2 +0,0 @@ - -B.hs:5:23: Warning: {-# SOURCE #-} unnecessary in import of ?A? diff --git a/testsuite/tests/rename/should_compile/T3103/T3103.stderr b/testsuite/tests/rename/should_compile/T3103/T3103.stderr index f1d4c53..e69de29 100644 --- a/testsuite/tests/rename/should_compile/T3103/T3103.stderr +++ b/testsuite/tests/rename/should_compile/T3103/T3103.stderr @@ -1,3 +0,0 @@ - -GHC/Word.hs:10:23: - Warning: {-# SOURCE #-} unnecessary in import of ?GHC.Unicode? diff --git a/testsuite/tests/ghci/prog009/A1.hs b/testsuite/tests/warnings/should_compile/T10637/A.hs similarity index 59% copy from testsuite/tests/ghci/prog009/A1.hs copy to testsuite/tests/warnings/should_compile/T10637/A.hs index 41644a1..a5369fc 100644 --- a/testsuite/tests/ghci/prog009/A1.hs +++ b/testsuite/tests/warnings/should_compile/T10637/A.hs @@ -1,3 +1,3 @@ module A where -import B +data A = A diff --git a/testsuite/tests/th/T2014/A.hs-boot b/testsuite/tests/warnings/should_compile/T10637/A.hs-boot similarity index 100% copy from testsuite/tests/th/T2014/A.hs-boot copy to testsuite/tests/warnings/should_compile/T10637/A.hs-boot diff --git a/testsuite/tests/ghci.debugger/scripts/break022/Makefile b/testsuite/tests/warnings/should_compile/T10637/Makefile similarity index 100% copy from testsuite/tests/ghci.debugger/scripts/break022/Makefile copy to testsuite/tests/warnings/should_compile/T10637/Makefile diff --git a/testsuite/tests/warnings/should_compile/T10637/T10637.hs b/testsuite/tests/warnings/should_compile/T10637/T10637.hs new file mode 100644 index 0000000..03a1e78 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T10637/T10637.hs @@ -0,0 +1,4 @@ +module T10637 where + +import {-# SOURCE #-} A () +data B = B diff --git a/testsuite/tests/warnings/should_compile/T10637/T10637.stderr b/testsuite/tests/warnings/should_compile/T10637/T10637.stderr new file mode 100644 index 0000000..0778bed --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T10637/T10637.stderr @@ -0,0 +1,3 @@ + +T10637.hs:3:23: + warning: {-# SOURCE #-} unnecessary in import of ?A? diff --git a/testsuite/tests/warnings/should_compile/T10637/all.T b/testsuite/tests/warnings/should_compile/T10637/all.T new file mode 100644 index 0000000..2be9756 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T10637/all.T @@ -0,0 +1,2 @@ +test('T10637', extra_clean(['T10637.o','T10637.hi', 'A.hi', 'A.o', 'A.hi-boot', 'A.o-boot']), + multimod_compile, ['T10637', '-v0 -fwarn-unused-imports']) From git at git.haskell.org Sat Aug 22 13:54:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Aug 2015 13:54:23 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Dump files always use UTF8 encoding #10762 (307e0a5) Message-ID: <20150822135423.166BD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/307e0a58838403c6a609b493d042eca5967035c9/ghc >--------------------------------------------------------------- commit 307e0a58838403c6a609b493d042eca5967035c9 Author: Michael Snoyman Date: Tue Aug 18 17:58:36 2015 +0200 Dump files always use UTF8 encoding #10762 When the Windows codepage or *nix LANG variable is something besides UTF-8, dumping to file can cause GHC to exit currently. This changes the output encoding for files to match the defined input encoding for Haskell source code (UTF-8), making it easier for users and build tools to capture this output. Test Plan: Create a Haskell source file with non-Latin characters for identifier names and compile with: LANG=C ghc -ddump-to-file -ddump-hi filename.hs -fforce-recomp Without this patch, it will fail. With this patch, it succeeds Reviewers: austin, rwbarton, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1151 GHC Trac Issues: #10762 >--------------------------------------------------------------- 307e0a58838403c6a609b493d042eca5967035c9 compiler/main/ErrUtils.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs index 6dbf60a..2a3b4c7 100644 --- a/compiler/main/ErrUtils.hs +++ b/compiler/main/ErrUtils.hs @@ -291,6 +291,13 @@ dumpSDoc dflags print_unqual flag hdr doc writeIORef gdref (Set.insert fileName gd) createDirectoryIfMissing True (takeDirectory fileName) handle <- openFile fileName mode + + -- We do not want the dump file to be affected by + -- environment variables, but instead to always use + -- UTF8. See: + -- https://ghc.haskell.org/trac/ghc/ticket/10762 + hSetEncoding handle utf8 + doc' <- if null hdr then return doc else do t <- getCurrentTime From git at git.haskell.org Sat Aug 22 13:54:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 22 Aug 2015 13:54:25 +0000 (UTC) Subject: [commit: ghc] ghc-7.10: Transliterate unknown characters at output (bbd6730) Message-ID: <20150822135425.ED1A13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : ghc-7.10 Link : http://ghc.haskell.org/trac/ghc/changeset/bbd6730f64a47d6fd4c831b78a3bbcd7a929ce4a/ghc >--------------------------------------------------------------- commit bbd6730f64a47d6fd4c831b78a3bbcd7a929ce4a Author: Michael Snoyman Date: Tue Aug 18 17:58:02 2015 +0200 Transliterate unknown characters at output This avoids the compiler from crashing when, for example, a warning contains a non-Latin identifier and the LANG variable is set to C. Fixes #6037. Test Plan: Create a Haskell source file containing an identifier with non-Latin characters and no type signature. Compile with `LANG=C ghc -Wall foo.hs`, and it should fail. With this patch, it will succeed. Reviewers: austin, rwbarton, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1153 GHC Trac Issues: #6037, #10762 >--------------------------------------------------------------- bbd6730f64a47d6fd4c831b78a3bbcd7a929ce4a compiler/utils/Util.hs | 16 ++++++++++++++++ ghc/Main.hs | 3 +++ testsuite/tests/driver/all.T | 7 +------ 3 files changed, 20 insertions(+), 6 deletions(-) diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index b2492f1..2e357c1 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -82,6 +82,7 @@ module Util ( doesDirNameExist, getModificationUTCTime, modificationTimeIfExists, + hSetTranslit, global, consIORef, globalM, @@ -121,6 +122,8 @@ import Control.Applicative (Applicative) #endif import Control.Applicative ( liftA2 ) import Control.Monad ( liftM ) +import GHC.IO.Encoding (mkTextEncoding, textEncodingName) +import System.IO (Handle, hGetEncoding, hSetEncoding) import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, getModificationTime ) import System.FilePath @@ -970,6 +973,19 @@ modificationTimeIfExists f = do then return Nothing else ioError e +-- -------------------------------------------------------------- +-- Change the character encoding of the given Handle to transliterate +-- on unsupported characters instead of throwing an exception + +hSetTranslit :: Handle -> IO () +hSetTranslit h = do + menc <- hGetEncoding h + case fmap textEncodingName menc of + Just name | '/' `notElem` name -> do + enc' <- mkTextEncoding $ name ++ "//TRANSLIT" + hSetEncoding h enc' + _ -> return () + -- split a string at the last character where 'pred' is True, -- returning a pair of strings. The first component holds the string -- up (but not including) the last character for which 'pred' returned diff --git a/ghc/Main.hs b/ghc/Main.hs index d30a50b..7b1c244 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -80,6 +80,9 @@ main = do initGCStatistics -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering + hSetTranslit stdout + hSetTranslit stderr + GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do -- 1. extract the -B flag from the args argv0 <- getArgs diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index a260a17..6b07d47 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -384,12 +384,7 @@ test('T7060', test('T7130', normal, compile_fail, ['-fflul-laziness']) test('T7563', when(unregisterised(), skip), run_command, ['$MAKE -s --no-print-directory T7563']) - -test('T6037', - # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X - [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail), - expect_broken(6037)], - run_command, +test('T6037', normal, run_command, ['$MAKE -s --no-print-directory T6037']) test('T2507', From git at git.haskell.org Sun Aug 23 00:28:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Aug 2015 00:28:39 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: Pretty printing (a0be473) Message-ID: <20150823002839.04CAC3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/a0be473e12944b77712c2e05687ca1ccd154ea1c/ghc >--------------------------------------------------------------- commit a0be473e12944b77712c2e05687ca1ccd154ea1c Author: George Karachalias Date: Sun Aug 23 02:29:58 2015 +0200 Pretty printing >--------------------------------------------------------------- a0be473e12944b77712c2e05687ca1ccd154ea1c compiler/deSugar/Check.hs | 125 +++++++++++++++++----------------- compiler/deSugar/Match.hs | 5 +- compiler/deSugar/TmOracle.hs | 157 ++++++++++++++++++++++++++++++++++++++----- 3 files changed, 206 insertions(+), 81 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc a0be473e12944b77712c2e05687ca1ccd154ea1c From git at git.haskell.org Sun Aug 23 18:11:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Aug 2015 18:11:51 +0000 (UTC) Subject: [commit: ghc] branch 'wip/D1159' created Message-ID: <20150823181151.50B953A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/D1159 Referencing: 4e9a41e1ba29afc231f61cee53fce1b04ed52370 From git at git.haskell.org Sun Aug 23 18:11:55 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 23 Aug 2015 18:11:55 +0000 (UTC) Subject: [commit: ghc] wip/D1159: compiler/iface: compress .hi files (4e9a41e) Message-ID: <20150823181155.A8F333A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/D1159 Link : http://ghc.haskell.org/trac/ghc/changeset/4e9a41e1ba29afc231f61cee53fce1b04ed52370/ghc >--------------------------------------------------------------- commit 4e9a41e1ba29afc231f61cee53fce1b04ed52370 Author: Austin Seipp Date: Sun Aug 23 20:08:04 2015 +0200 compiler/iface: compress .hi files Summary: Compress all interface files generated by the compiler with LZ4. While having an extremely small amount of code, LZ4 is both very fast at compression and decompression while having quite good space saving properties. Non-scientific size test: size of stage2 compiler .hi files: `find ./compiler/stage2 -type f -iname '*.hi' -exec du -ch {} + | grep total$` Without this patch: 22MB of .hi files for stage2. With this patch: 9.2MB of .hi files for stage2. Signed-off-by: Austin Seipp Test Plan: I ran `./validate` Reviewers: hvr, bgamari, thomie Subscribers: duncan Differential Revision: https://phabricator.haskell.org/D1159 >--------------------------------------------------------------- 4e9a41e1ba29afc231f61cee53fce1b04ed52370 compiler/cbits/lz4.c | 1520 ++++++++++++++++++++++++++++++++++++++++++++++ compiler/cbits/lz4.h | 364 +++++++++++ compiler/ghc.cabal.in | 2 + compiler/ghc.mk | 1 + compiler/utils/Binary.hs | 37 +- compiler/utils/LZ4.hs | 141 +++++ 6 files changed, 2046 insertions(+), 19 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 4e9a41e1ba29afc231f61cee53fce1b04ed52370 From git at git.haskell.org Mon Aug 24 08:49:48 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Aug 2015 08:49:48 +0000 (UTC) Subject: [commit: ghc] wip/gadtpm: tiny changes (b718578) Message-ID: <20150824084948.B9AC93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/gadtpm Link : http://ghc.haskell.org/trac/ghc/changeset/b718578ac8daa4ff4324fc4fa6c837d5ef899101/ghc >--------------------------------------------------------------- commit b718578ac8daa4ff4324fc4fa6c837d5ef899101 Author: George Karachalias Date: Mon Aug 24 10:50:32 2015 +0200 tiny changes >--------------------------------------------------------------- b718578ac8daa4ff4324fc4fa6c837d5ef899101 compiler/deSugar/Check.hs | 52 +++++-------- compiler/deSugar/TmOracle.hs | 180 ++++++++++++++++--------------------------- 2 files changed, 87 insertions(+), 145 deletions(-) Diff suppressed because of size. To see it, use: git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc b718578ac8daa4ff4324fc4fa6c837d5ef899101 From git at git.haskell.org Mon Aug 24 17:05:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 24 Aug 2015 17:05:58 +0000 (UTC) Subject: [commit: ghc] master: Delete ExtsCompat46 (#8330) (37a0b50) Message-ID: <20150824170558.DFEF73A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/37a0b50b5e28a326159bb464effb499c1d9de775/ghc >--------------------------------------------------------------- commit 37a0b50b5e28a326159bb464effb499c1d9de775 Author: Thomas Miedema Date: Tue Jul 21 14:59:55 2015 +0200 Delete ExtsCompat46 (#8330) We require ghc-7.8 to build HEAD (ghc-7.11). Differential Revision: https://phabricator.haskell.org/D1165 >--------------------------------------------------------------- 37a0b50b5e28a326159bb464effb499c1d9de775 compiler/ghc.cabal.in | 2 - compiler/ghc.mk | 1 - compiler/main/BreakArray.hs | 4 +- compiler/utils/Binary.hs | 21 +-- compiler/utils/Encoding.hs | 22 ++-- compiler/utils/ExtsCompat46.hs | 293 ----------------------------------------- compiler/utils/FastString.hs | 8 +- 7 files changed, 24 insertions(+), 327 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 37a0b50b5e28a326159bb464effb499c1d9de775 From git at git.haskell.org Tue Aug 25 19:50:02 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Aug 2015 19:50:02 +0000 (UTC) Subject: [commit: ghc] master: fix 64bit two-stage allocator on Solaris/AMD64 platform (#10790) (b78494e) Message-ID: <20150825195002.7155B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/b78494eee787bdc0f9cc263b773638dc7db3482f/ghc >--------------------------------------------------------------- commit b78494eee787bdc0f9cc263b773638dc7db3482f Author: Karel Gardas Date: Tue Aug 25 14:06:29 2015 +0200 fix 64bit two-stage allocator on Solaris/AMD64 platform (#10790) Test Plan: tested on Solaris 11/AMD64 when previous build failed Reviewers: bgamari, austin, simonmar, gcampax, ezyang Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1169 >--------------------------------------------------------------- b78494eee787bdc0f9cc263b773638dc7db3482f rts/posix/OSMem.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c index 976b5f5..aa3f3a1 100644 --- a/rts/posix/OSMem.c +++ b/rts/posix/OSMem.c @@ -156,7 +156,7 @@ my_mmap (void *addr, W_ size, int operation) else flags = 0; -#if defined(solaris2_HOST_OS) || defined(irix_HOST_OS) +#if defined(irix_HOST_OS) { if (operation & MEM_RESERVE) { From git at git.haskell.org Tue Aug 25 22:21:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Tue, 25 Aug 2015 22:21:54 +0000 (UTC) Subject: [commit: ghc] master: configure.ac: Allow disabling of large-address-space (fba724c) Message-ID: <20150825222154.E9B543A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/fba724ccabd295fc37e71ba6c4f892822a831d19/ghc >--------------------------------------------------------------- commit fba724ccabd295fc37e71ba6c4f892822a831d19 Author: Erik de Castro Lopo Date: Tue Aug 25 11:33:32 2015 +1000 configure.ac: Allow disabling of large-address-space Recent changes (commit 0d1a8d09f4) for 64 bit platforms allowed GHC to mmap one huge (currently 1 terrabyte) memory region from which to do its own allocations. This is enabled by default, but it would be nice (even just from the point of view of testing) to be able to disable this at configure time. Test Plan: configure and grep mk/config.h for USE_LARGE_ADDRESS_SPACE Reviewers: austin, ezyang, bgamari, rwbarton Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1170 GHC Trac Issues: #10791 >--------------------------------------------------------------- fba724ccabd295fc37e71ba6c4f892822a831d19 configure.ac | 42 ++++++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 16 deletions(-) diff --git a/configure.ac b/configure.ac index e7f9144..793ec0f 100644 --- a/configure.ac +++ b/configure.ac @@ -1066,24 +1066,34 @@ dnl runs out of paging file when we have multiple processes reserving dnl 1TB of address space, we get the following error: dnl VirtualAlloc MEM_RESERVE 1099512676352 bytes failed: The paging file is too small for this operation to complete. dnl + +AC_ARG_ENABLE(large-address-space, + [AC_HELP_STRING([--enable-large-address-space], + [Use a single large address space on 64 bit systems (enabled by default on 64 bit platforms)])], + EnableLargeAddressSpace=$enableval, + EnableLargeAddressSpace=yes +) + use_large_address_space=no if test "$ac_cv_sizeof_void_p" -eq 8 ; then - if test "$ghc_host_os" = "darwin" ; then - use_large_address_space=yes - else - AC_CHECK_DECLS([MAP_NORESERVE, MADV_FREE, MADV_DONTNEED],[],[], -[ -#include -#include -#include -#include -]) - if test "$ac_cv_have_decl_MAP_NORESERVE" = "yes" && - test "$ac_cv_have_decl_MADV_FREE" = "yes" || - test "$ac_cv_have_decl_MADV_DONTNEED" = "yes" ; then - use_large_address_space=yes - fi - fi + if test "x$EnableLargeAddressSpace" = "xyes" ; then + if test "$ghc_host_os" = "darwin" ; then + use_large_address_space=yes + else + AC_CHECK_DECLS([MAP_NORESERVE, MADV_FREE, MADV_DONTNEED],[],[], + [ + #include + #include + #include + #include + ]) + if test "$ac_cv_have_decl_MAP_NORESERVE" = "yes" && + test "$ac_cv_have_decl_MADV_FREE" = "yes" || + test "$ac_cv_have_decl_MADV_DONTNEED" = "yes" ; then + use_large_address_space=yes + fi + fi + fi fi if test "$use_large_address_space" = "yes" ; then AC_DEFINE([USE_LARGE_ADDRESS_SPACE], [1], [Enable single heap address space support]) From git at git.haskell.org Wed Aug 26 14:12:23 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:23 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T9858-typeable-ben' created Message-ID: <20150826141223.90CE13A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T9858-typeable-ben Referencing: 6d7fb0460466de2d8bdf38c3a98e66a368607551 From git at git.haskell.org Wed Aug 26 14:12:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:26 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Improve the error messages for class instance errors (e8259ab) Message-ID: <20150826141226.8F9933A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/e8259abfd1f57610bac99ae893aa7cbb60fa973f/ghc >--------------------------------------------------------------- commit e8259abfd1f57610bac99ae893aa7cbb60fa973f Author: Simon Peyton Jones Date: Fri Mar 20 12:27:59 2015 +0000 Improve the error messages for class instance errors See Note [Displaying potential instances]. >--------------------------------------------------------------- e8259abfd1f57610bac99ae893aa7cbb60fa973f compiler/main/DynFlags.hs | 2 + compiler/typecheck/TcErrors.hs | 106 ++++++++++++++++++++----- docs/users_guide/flags.xml | 6 ++ docs/users_guide/using.xml | 176 +++++++++-------------------------------- utils/haddock | 2 +- utils/hsc2hs | 2 +- 6 files changed, 137 insertions(+), 157 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 e8259abfd1f57610bac99ae893aa7cbb60fa973f From git at git.haskell.org Wed Aug 26 14:12:29 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:29 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Comments and white space (725ad45) Message-ID: <20150826141229.6DF183A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/725ad45f30d476f510c491673ffa38d906e4f6bc/ghc >--------------------------------------------------------------- commit 725ad45f30d476f510c491673ffa38d906e4f6bc Author: Simon Peyton Jones Date: Fri Mar 20 12:36:22 2015 +0000 Comments and white space >--------------------------------------------------------------- 725ad45f30d476f510c491673ffa38d906e4f6bc compiler/basicTypes/Id.hs | 7 +++---- compiler/coreSyn/MkCore.hs | 1 + compiler/iface/LoadIface.hs | 3 ++- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 968b541..45a4aa7 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -308,9 +308,8 @@ mkTemplateLocals = mkTemplateLocalsNum 1 mkTemplateLocalsNum :: Int -> [Type] -> [Id] mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys -{- -Note [Exported LocalIds] -~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Exported LocalIds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ We use mkExportedLocalId for things like - Dictionary functions (DFunId) - Wrapper and matcher Ids for pattern synonyms @@ -324,7 +323,7 @@ code by the occurrence analyser. (But "exported" here does not mean "brought into lexical scope by an import declaration". Indeed these things are always internal Ids that the user never sees.) -It's very important that they are *LocalIds*, not GlobalIs, for lots +It's very important that they are *LocalIds*, not GlobalIds, for lots of reasons: * We want to treat them as free variables for the purpose of diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 4d310c9..8bdee4a 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -274,6 +274,7 @@ mkCharExpr c = mkConApp charDataCon [mkCharLit c] -- | Create a 'CoreExpr' which will evaluate to the given @String@ mkStringExpr :: MonadThings m => String -> m CoreExpr -- Result :: String + -- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@ mkStringExprFS :: MonadThings m => FastString -> m CoreExpr -- Result :: String diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 9da1175..60e3a8a 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -191,6 +191,7 @@ checkWiredInTyCon tc = return () | otherwise = do { mod <- getModule + ; traceIf (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod) ; ASSERT( isExternalName tc_name ) when (mod /= nameModule tc_name) (initIfaceTcRn (loadWiredInHomeIface tc_name)) @@ -360,7 +361,7 @@ loadInterfaceForModule doc m -- | An 'IfM' function to load the home interface for a wired-in thing, -- so that we're sure that we see its instance declarations and rules --- See Note [Loading instances for wired-in things] in TcIface +-- See Note [Loading instances for wired-in things] loadWiredInHomeIface :: Name -> IfM lcl () loadWiredInHomeIface name = ASSERT( isWiredInName name ) From git at git.haskell.org Wed Aug 26 14:12:32 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:32 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Implement lookupGlobal in TcEnv, and use it (9d3aee5) Message-ID: <20150826141232.65D433A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/9d3aee5723b6fb1d7c7f093838ac890f202033f4/ghc >--------------------------------------------------------------- commit 9d3aee5723b6fb1d7c7f093838ac890f202033f4 Author: Simon Peyton Jones Date: Fri Mar 20 12:38:42 2015 +0000 Implement lookupGlobal in TcEnv, and use it This localises the (revolting) initTcForLookup function, exposing instead the more civilised interface for lookupGlobal >--------------------------------------------------------------- 9d3aee5723b6fb1d7c7f093838ac890f202033f4 compiler/coreSyn/CorePrep.hs | 16 ++++++++++------ compiler/simplCore/CoreMonad.hs | 9 ++++----- compiler/typecheck/TcEnv.hs | 20 +++++++++++++++++++- 3 files changed, 33 insertions(+), 12 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 9f6bb05..2b8ac02 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -30,7 +30,6 @@ import Type import Literal import Coercion import TcEnv -import TcRnMonad import TyCon import Demand import Var @@ -57,9 +56,14 @@ import Config import Name ( NamedThing(..), nameSrcSpan ) import SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) import Data.Bits +import MonadUtils ( mapAccumLM ) import Data.List ( mapAccumL ) import Control.Monad +#if __GLASGOW_HASKELL__ < 711 +import Control.Applicative +#endif + {- -- --------------------------------------------------------------------------- -- Overview @@ -1153,21 +1157,21 @@ data CorePrepEnv = CPE { lookupMkIntegerName :: DynFlags -> HscEnv -> IO Id lookupMkIntegerName dflags hsc_env = guardIntegerUse dflags $ liftM tyThingId $ - initTcForLookup hsc_env (tcLookupGlobal mkIntegerName) + lookupGlobal hsc_env mkIntegerName lookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon) lookupIntegerSDataConName dflags hsc_env = case cIntegerLibraryType of - IntegerGMP -> guardIntegerUse dflags $ liftM Just $ - initTcForLookup hsc_env (tcLookupDataCon integerSDataConName) + IntegerGMP -> guardIntegerUse dflags $ liftM (Just . tyThingDataCon) $ + lookupGlobal hsc_env integerSDataConName IntegerSimple -> return Nothing -- | Helper for 'lookupMkIntegerName' and 'lookupIntegerSDataConName' guardIntegerUse :: DynFlags -> IO a -> IO a guardIntegerUse dflags act | thisPackage dflags == primPackageKey - = return $ panic "Can't use Integer in ghc-prim" + = return $ panic "Can't use Integer in ghc-prim" | thisPackage dflags == integerPackageKey - = return $ panic "Can't use Integer in integer-*" + = return $ panic "Can't use Integer in integer-*" | otherwise = act mkInitialCorePrepEnv :: DynFlags -> HscEnv -> IO CorePrepEnv diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 68b613b..0a1c782 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -57,6 +57,7 @@ module CoreMonad ( #ifdef GHCI import Name( Name ) +import TcRnMonad ( initTcForLookup ) #endif import CoreSyn import HscTypes @@ -68,8 +69,7 @@ import Annotations import IOEnv hiding ( liftIO, failM, failWithM ) import qualified IOEnv ( liftIO ) -import TcEnv ( tcLookupGlobal ) -import TcRnMonad ( initTcForLookup ) +import TcEnv ( lookupGlobal ) import Var import Outputable import FastString @@ -886,9 +886,8 @@ dumpIfSet_dyn flag str doc -} instance MonadThings CoreM where - lookupThing name = do - hsc_env <- getHscEnv - liftIO $ initTcForLookup hsc_env (tcLookupGlobal name) + lookupThing name = do { hsc_env <- getHscEnv + ; liftIO $ lookupGlobal hsc_env name } {- ************************************************************************ diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 8db9f26..e39fbf9 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -1,5 +1,4 @@ -- (c) The University of Glasgow 2006 - {-# LANGUAGE CPP, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan @@ -19,6 +18,7 @@ module TcEnv( tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupAxiom, + lookupGlobal, -- Local environment tcExtendKindEnv, tcExtendKindEnv2, @@ -98,6 +98,23 @@ import Maybes( MaybeErr(..) ) import Data.IORef import Data.List + +{- ********************************************************************* +* * + An IO interface to looking up globals +* * +********************************************************************* -} + +lookupGlobal :: HscEnv -> Name -> IO TyThing +-- An IO version, used outside the typechecker +-- It's more complicated than it looks, because it may +-- need to suck in an interface file +lookupGlobal hsc_env name + = initTcForLookup hsc_env (tcLookupGlobal name) + -- This initTcForLookup stuff is massive overkill + -- but that's how it is right now, and at least + -- this function localises it + {- ************************************************************************ * * @@ -110,6 +127,7 @@ unless you know that the SrcSpan in the monad is already set to the span of the Name. -} + tcLookupLocatedGlobal :: Located Name -> TcM TyThing -- c.f. IfaceEnvEnv.tcIfaceGlobal tcLookupLocatedGlobal name From git at git.haskell.org Wed Aug 26 14:12:35 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:35 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: tcRnDeclsi can use tcRnSrcDecls (bd0ad08) Message-ID: <20150826141235.61B703A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/bd0ad08d6c2a9d563ee9c0e904e1e672ebb0b255/ghc >--------------------------------------------------------------- commit bd0ad08d6c2a9d563ee9c0e904e1e672ebb0b255 Author: Simon Peyton Jones Date: Mon Mar 23 14:32:31 2015 +0000 tcRnDeclsi can use tcRnSrcDecls I'm not sure why tcRnDeclsi didn't call tcRnSrcDecls before, but now it does. About 20 lines of code vanish. Hooray. >--------------------------------------------------------------- bd0ad08d6c2a9d563ee9c0e904e1e672ebb0b255 compiler/typecheck/TcRnDriver.hs | 41 +++------------------------------------- 1 file changed, 3 insertions(+), 38 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index e361dcb..6e3fd81 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1900,44 +1900,9 @@ tcRnDeclsi exists to allow class, data, and other declarations in GHCi. tcRnDeclsi :: HscEnv -> [LHsDecl RdrName] -> IO (Messages, Maybe TcGblEnv) - -tcRnDeclsi hsc_env local_decls = - runTcInteractive hsc_env $ do - - ((tcg_env, tclcl_env), lie) <- captureConstraints $ - tc_rn_src_decls local_decls - setEnvs (tcg_env, tclcl_env) $ do - - -- wanted constraints from static forms - stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef - - new_ev_binds <- simplifyTop (andWC stWC lie) - - failIfErrsM - let TcGblEnv { tcg_type_env = type_env, - tcg_binds = binds, - tcg_sigs = sig_ns, - tcg_ev_binds = cur_ev_binds, - tcg_imp_specs = imp_specs, - tcg_rules = rules, - tcg_vects = vects, - tcg_fords = fords } = tcg_env - all_ev_binds = cur_ev_binds `unionBags` new_ev_binds - - (bind_ids, ev_binds', binds', fords', imp_specs', rules', vects') - <- zonkTopDecls all_ev_binds binds Nothing sig_ns rules vects - imp_specs fords - - let final_type_env = extendTypeEnvWithIds type_env bind_ids - tcg_env' = tcg_env { tcg_binds = binds', - tcg_ev_binds = ev_binds', - tcg_imp_specs = imp_specs', - tcg_rules = rules', - tcg_vects = vects', - tcg_fords = fords' } - - setGlobalTypeEnv tcg_env' final_type_env - +tcRnDeclsi hsc_env local_decls + = runTcInteractive hsc_env $ + tcRnSrcDecls False Nothing local_decls externaliseAndTidyId :: Module -> Id -> TcM Id externaliseAndTidyId this_mod id From git at git.haskell.org Wed Aug 26 14:12:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:39 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Generate Typeble info at definition sites (fc903bf) Message-ID: <20150826141239.B00903A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/fc903bf85d1b79b12b974707fc8c2b5ed16651cd/ghc >--------------------------------------------------------------- commit fc903bf85d1b79b12b974707fc8c2b5ed16651cd Author: Simon Peyton Jones Date: Mon Mar 23 14:50:23 2015 +0000 Generate Typeble info at definition sites This patch implements the idea floated in #9858, namely that we should generate type-representation information at the data type declaration site, rather than when solving a Typeable constraint. However, this turned out quite a bit harder than I expected. I still think it's the right thing to do, and it's done now, but it was quite a struggle. See particularly * Note [Grand plan for Typeable] in TcTypeable (which is a new module) * Note [The overall promotion story] in DataCon (clarifies existing stuff) The most painful bit was that to generate Typeable instances (ie TyConRepName bindings) for every TyCon is tricky for types in ghc-prim etc: - we need to have enough data types around to *define* a TyCon - many of these types are wired-in Also, to minimise the code generated for each data type, I wanted to generate pure data, not CAFs with unpackCString# stuff floating about. Performance ~~~~~~~~~~~ Three perf/compiler tests start to allocate quite a bit more. This isn't surprising, because they all allocate zillions of data types, with practically no other code, esp T1969 T1969: GHC allocates 30% more T5642: GHC allocates 14% more T9872d: GHC allocates 5% more I'm treating this as acceptable. The payoff comes in Typeable-heavy code. Remaining to do ~~~~~~~~~~~~~~~ * I think that "TyCon" and "Module" are over-generic names to use for the runtime type representations used in GHC.Typeable. Better might be "TrTyCon" and "TrModule". But I have not yet done this * Add more info the the "TyCon" e.g. source location where it was defined * Use the new "Module" type to help with Trac #10068 * It would be possible to generate TyConRepName (ie Typeable instances) selectively rather than all the time. We'd need to persist the information in interface files. Lacking a motivating reason I have not done this, but it would not be difficult. Refactoring ~~~~~~~~~~~ As is so often the case, I ended up refactoring more than I intended. In particular * In TyCon, - a type *family* (whether type or data) is repesented by a FamilyTyCon - a algebraic data type (including data/newtype instances) is represented by AlgTyCon This wasn't true before; a data family was represented as an AlgTyCon. There are some corresponding changes in IfaceSyn. Also get rid of the (unhelpfully named) tyConParent. * In TyCon define 'Promoted', isomorphic to Maybe, used when things are optionally promoted; and use it elsewhere in GHC. * Each TyCon, including promoted TyCons, contains its TyConRepName, if it has one. This is, in effect, the name of its Typeable instance. * I added PatSynId, DefMethId, and ReflectionId to the IdInfo.IdDetails type. They are used for debugging only, namely to suppress excessive output in -ddump-types. * Tidy up the generation of PrelInfo.knownKeyNames * Move newImplicitBinder from IfaceEnv to BuildTyCl * PrelNames.conName renamed to dcQual for consistency with varQual, tcQual * Move mkDefaultMethodIds, mkRecSelBinds from TcTyClsDecls to TcTyDecls Conflicts: compiler/basicTypes/DataCon.hs compiler/basicTypes/Unique.hs compiler/deSugar/DsBinds.hs compiler/iface/BinIface.hs compiler/iface/BuildTyCl.hs compiler/iface/IfaceEnv.hs compiler/iface/IfaceSyn.hs compiler/iface/MkIface.hs compiler/iface/TcIface.hs compiler/main/HscMain.hs compiler/prelude/PrelInfo.hs compiler/prelude/PrelNames.hs compiler/prelude/TysPrim.hs compiler/prelude/TysWiredIn.hs compiler/typecheck/TcBinds.hs compiler/typecheck/TcEvidence.hs compiler/typecheck/TcHsSyn.hs compiler/typecheck/TcInstDcls.hs compiler/typecheck/TcInteract.hs compiler/typecheck/TcRnDriver.hs compiler/typecheck/TcRnTypes.hs compiler/typecheck/TcTyClsDecls.hs compiler/typecheck/TcTyDecls.hs compiler/types/TyCon.hs compiler/vectorise/Vectorise/Generic/PData.hs compiler/vectorise/Vectorise/Type/TyConDecl.hs libraries/base/Data/Typeable/Internal.hs libraries/ghc-prim/GHC/Classes.hs libraries/ghc-prim/GHC/Types.hs >--------------------------------------------------------------- fc903bf85d1b79b12b974707fc8c2b5ed16651cd compiler/basicTypes/DataCon.hs | 225 ++++++++++---- compiler/basicTypes/IdInfo.hs | 19 +- compiler/basicTypes/OccName.hs | 19 +- compiler/basicTypes/Unique.hs | 51 +++- compiler/deSugar/DsBinds.hs | 277 +++++++++-------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsUtils.hs | 6 +- compiler/iface/BinIface.hs | 5 +- compiler/iface/BuildTyCl.hs | 72 +++-- compiler/iface/IfaceEnv.hs | 41 +-- compiler/iface/IfaceSyn.hs | 91 +++--- compiler/iface/MkIface.hs | 24 +- compiler/iface/TcIface.hs | 93 +++--- compiler/main/HscMain.hs | 12 +- compiler/main/HscTypes.hs | 20 +- compiler/prelude/PrelInfo.hs | 100 +++--- compiler/prelude/PrelNames.hs | 112 ++++--- compiler/prelude/TysPrim.hs | 46 +-- compiler/prelude/TysWiredIn.hs | 177 ++++++----- compiler/typecheck/TcBinds.hs | 35 ++- compiler/typecheck/TcDeriv.hs | 86 +----- compiler/typecheck/TcEvidence.hs | 39 +-- compiler/typecheck/TcGenGenerics.hs | 38 ++- compiler/typecheck/TcHsSyn.hs | 28 +- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 19 +- compiler/typecheck/TcInteract.hs | 111 ++++--- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 40 +-- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcTyClsDecls.hs | 329 ++++---------------- compiler/typecheck/TcTyDecls.hs | 330 +++++++++++++++----- compiler/typecheck/TcType.hs | 0 compiler/typecheck/TcTypeNats.hs | 10 +- compiler/typecheck/TcTypeable.hs | 202 ++++++++++++ compiler/types/TyCon.hs | 406 ++++++++++++++----------- compiler/types/Type.hs | 12 + compiler/utils/Binary.hs | 11 +- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/Env.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 +- libraries/base/Data/Typeable.hs | 3 +- libraries/base/Data/Typeable/Internal.hs | 322 +++++++++++++------- libraries/base/GHC/Show.hs | 10 + libraries/ghc-prim/GHC/Classes.hs | 36 ++- libraries/ghc-prim/GHC/IntWord64.hs | 3 + libraries/ghc-prim/GHC/Magic.hs | 2 + libraries/ghc-prim/GHC/Tuple.hs | 3 + libraries/ghc-prim/GHC/TyCon.hs | 15 + libraries/ghc-prim/GHC/Types.hs | 52 +++- 51 files changed, 2122 insertions(+), 1447 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 fc903bf85d1b79b12b974707fc8c2b5ed16651cd From git at git.haskell.org Wed Aug 26 14:12:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:42 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Try another approach for type-level literals (b831888) Message-ID: <20150826141242.A71083A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/b8318884315d1c03936168e05d40e3fce731eb47/ghc >--------------------------------------------------------------- commit b8318884315d1c03936168e05d40e3fce731eb47 Author: Ben Gamari Date: Wed Aug 26 14:59:32 2015 +0200 Try another approach for type-level literals >--------------------------------------------------------------- b8318884315d1c03936168e05d40e3fce731eb47 compiler/deSugar/DsBinds.hs | 19 ++++++++++--------- compiler/prelude/PrelNames.hs | 15 +++++---------- libraries/base/Data/Typeable/Internal.hs | 14 +------------- 3 files changed, 16 insertions(+), 32 deletions(-) diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 316e276..f80e369 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -940,17 +940,18 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2) ; ctr <- dsLookupGlobalId mkAppTyName ; return ( mkApps (Var ctr) [ e1, e2 ] ) } -ds_ev_typeable ty (EvTypeableTyLit ev) - = do { dict <- dsEvTerm ev - ; ctr <- dsLookupGlobalId repConName - -- typeLitTypeRep :: Known{Nat,Symbol} a => Proxy# a -> TypeRep - ; let finst = mkTyApps (Var ctr) [ty] - proxy = mkTyApps (Var proxyHashId) [typeKind ty, ty] - ; return (mkApps finst [dict, proxy]) } +ds_ev_typeable ty (EvTypeableTyLit _) + = do { -- dict <- dsEvTerm ev + ; ctr <- dsLookupGlobalId typeLitTypeRepName + -- typeLitTypeRep :: String -> TypeRep + -- ; let finst = mkTyApps (Var ctr) [ty] + -- proxy = mkTyApps (Var proxyHashId) [typeKind ty, ty] + ; tag <- mkStringExpr str + ; return (mkApps (Var ctr) [tag]) } where str - | Just _ <- isNumLitTy ty = typeNatTypeRepName - | Just _ <- isStrLitTy ty = typeSymbolTypeRepName + | Just n <- isNumLitTy ty = show n + | Just s <- isStrLitTy ty = show s | otherwise = panic "ds_ev_typeable: malformed TyLit evidence" ds_ev_typeable ty ev diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 8dc79bc..49137b6 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -209,8 +209,7 @@ basicKnownKeyNames mkPolyTyConAppName, mkAppTyName, typeRepIdName, - typeNatTypeRepName, - typeSymbolTypeRepName, + typeLitTypeRepName, trTyConDataConName, trModuleDataConName, trNameSDataConName, -- Dynamic @@ -1048,8 +1047,7 @@ typeableClassName , mkPolyTyConAppName , mkAppTyName , typeRepIdName - , typeNatTypeRepName - , typeSymbolTypeRepName + , typeLitTypeRepName :: Name typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey @@ -1059,8 +1057,7 @@ trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNam typeRepIdName = varQual tYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey mkPolyTyConAppName = varQual tYPEABLE_INTERNAL (fsLit "mkPolyTyConApp") mkPolyTyConAppKey mkAppTyName = varQual tYPEABLE_INTERNAL (fsLit "mkAppTy") mkAppTyKey -typeNatTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey -typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey +typeLitTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeLitTypeRep") typeLitTypeRepKey -- Dynamic @@ -1909,15 +1906,13 @@ proxyHashKey = mkPreludeMiscIdUnique 502 mkTyConKey , mkPolyTyConAppKey , mkAppTyKey - , typeNatTypeRepKey - , typeSymbolTypeRepKey + , typeLitTypeRepKey , typeRepIdKey :: Unique mkTyConKey = mkPreludeMiscIdUnique 503 mkPolyTyConAppKey = mkPreludeMiscIdUnique 504 mkAppTyKey = mkPreludeMiscIdUnique 505 -typeNatTypeRepKey = mkPreludeMiscIdUnique 506 -typeSymbolTypeRepKey = mkPreludeMiscIdUnique 507 +typeLitTypeRepKey = mkPreludeMiscIdUnique 506 typeRepIdKey = mkPreludeMiscIdUnique 508 -- Dynamic diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 564f295..27063c1 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -67,14 +67,12 @@ module Data.Typeable.Internal ( rnfTypeRep, showsTypeRep, typeRepKinds, - typeNatTypeRep, - typeSymbolTypeRep + typeLitTypeRep, ) where import GHC.Base import GHC.Word import GHC.Show -import GHC.TypeLits import Data.Proxy import GHC.Fingerprint.Type @@ -446,13 +444,3 @@ tcConstraint = mkGhcTypesTyCon "Constraint"# funTc :: TyCon funTc = tcFun -- Legacy - --- | Used to make `'Typeable' instance for things of kind Nat -typeNatTypeRep :: KnownNat a => Proxy# a -> TypeRep -typeNatTypeRep p = typeLitTypeRep (show (natVal' p)) - --- | Used to make `'Typeable' instance for things of kind Symbol -typeSymbolTypeRep :: KnownSymbol a => Proxy# a -> TypeRep -typeSymbolTypeRep p = typeLitTypeRep (show (symbolVal' p)) - --- TODO: what to put here? From git at git.haskell.org Wed Aug 26 14:12:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 14:12:45 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Debugging (6d7fb04) Message-ID: <20150826141245.89D073A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/6d7fb0460466de2d8bdf38c3a98e66a368607551/ghc >--------------------------------------------------------------- commit 6d7fb0460466de2d8bdf38c3a98e66a368607551 Author: Ben Gamari Date: Wed Aug 26 15:29:23 2015 +0200 Debugging >--------------------------------------------------------------- 6d7fb0460466de2d8bdf38c3a98e66a368607551 compiler/typecheck/TcTyClsDecls.hs | 2 +- compiler/typecheck/TcValidity.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 446e461..cdf9c54 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -833,7 +833,7 @@ tcClassATs :: Name -- The class name (not knot-tied) -> TcM [ClassATItem] tcClassATs class_name cls ats at_defs = do { -- Complain about associated type defaults for non associated-types - sequence_ [ failWithTc (badATErr class_name n) + sequence_ [ failWithTc (badATErr class_name n <> ppr n <> ppr at_names) | n <- map at_def_tycon at_defs , not (n `elemNameSet` at_names) ] ; mapM tc_at ats } diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 122b286..6594610 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1155,7 +1155,7 @@ checkConsistentFamInst Nothing _ _ _ = return () checkConsistentFamInst (Just (clas, mini_env)) fam_tc at_tvs at_tys = do { -- Check that the associated type indeed comes from this class checkTc (Just clas == tyConAssoc_maybe fam_tc) - (badATErr (className clas) (tyConName fam_tc)) + (badATErr (className clas) (tyConName fam_tc) <> ppr (tyConAssoc_maybe fam_tc)) -- See Note [Checking consistent instantiation] in TcTyClsDecls -- Check right to left, so that we spot type variable From git at git.haskell.org Wed Aug 26 17:14:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 17:14:42 +0000 (UTC) Subject: [commit: ghc] master: Fix algorithm.tex build and update with some new info. (1c643ba) Message-ID: <20150826171442.3CB1D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1c643bad99f7afb485ec9998b1bb5afd49edafb7/ghc >--------------------------------------------------------------- commit 1c643bad99f7afb485ec9998b1bb5afd49edafb7 Author: Edward Z. Yang Date: Wed Aug 26 10:16:05 2015 -0700 Fix algorithm.tex build and update with some new info. Signed-off-by: Edward Z. Yang >--------------------------------------------------------------- 1c643bad99f7afb485ec9998b1bb5afd49edafb7 docs/backpack/algorithm.tex | 85 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 77 insertions(+), 8 deletions(-) diff --git a/docs/backpack/algorithm.tex b/docs/backpack/algorithm.tex index 6cb3169..a5cf2b6 100644 --- a/docs/backpack/algorithm.tex +++ b/docs/backpack/algorithm.tex @@ -11,7 +11,6 @@ \usepackage{color} \usepackage{footnote} \usepackage{float} -\usepackage{algorithm} \usepackage{algpseudocode} \usepackage{bigfoot} \usepackage{amssymb} @@ -127,7 +126,7 @@ $$ \begin{array}{rcll} \multicolumn{3}{l}{\mbox{\bf Identifiers}} \\ \I{InstalledPackageId} & & \mbox{Opaque unique identifier} \\ - \I{IndefUnitId} & ::= & \I{InstalledPackageId}\, \verb|-|\, p \\ + \I{IndefUnitId} & ::= & \I{InstalledPackageId}\, \verb|/|\, p \\ \I{UnitKey} & ::= & \I{IndefUnitId} \verb|(|\, \I{HoleMap}\, \verb|)| \\ & | & \verb|HOLE| \\ \I{HoleMap} & ::= & \I{ModuleName}\; \verb|->|\; \I{Module}\; \verb|,|\, \ldots \\ @@ -570,10 +569,10 @@ EPT, we type check and load into the EPT the \I{ModDetails} of the \I{Module} in the \I{Name}, and then check the EPT again. (\verb|importDecl|) -\subsection{\textit{ModName} to \textit{ModIface}} +\subsection{\textit{ModuleName} to \textit{ModIface}} In all cases, the \I{mi\_exports} can be calculated directly from the -shaping process, which specifies exactly for each \I{ModName} in scope +shaping process, which specifies exactly for each \I{ModuleName} in scope what will be brought into scope. \paragraph{Modules} Modules are straightforward, as for any @@ -582,7 +581,7 @@ with it (the \I{ModIface} for when we type-checked the (unique) \verb|module| declaration.) \paragraph{Signatures} For signatures, there may be multiple \I{ModIface}s -associated with a \I{ModName} in scope, e.g. in this situation: +associated with a \I{ModuleName} in scope, e.g. in this situation: \begin{verbatim} unit p where @@ -721,6 +720,76 @@ Specifically, the correctness condition for a signature is this: \emph{Any \I{Na mentioned in the \I{ModIface} of a signature must either be from an external module, or be exported by the signature}. +\newpage +\section{Installation} + +This section defines the syntax for the file-system format of the \I{IndefUnitDb}. +Like entries in the installed unit database, an entry is a sequence of fields +with values. + +Indefinite unit entries share some entries in common with entries in the installed +unit database: + +\begin{description} + \item[\texttt{id:}] \I{InstalledPackageId} \newline + The unique identifier of an installed package. This combined + with \texttt{unit-name} uniquely identifies an entry in the + installed unit database. + \item[\texttt{unit-name:}] \I{UnitName} \newline + The unit name of the installed unit. This is unique per a package. + Unlike for the installed unit database, this entry is mandatory for + indefinite units. + \item[\texttt{exposed:}] \verb|True| or \verb|False| \newline + Whether or not this package is exposed, i.e. it is available for + \verb|include| under its \verb|unit-name| (this is used to compute + the default \I{UnitNameMap} when GHC is called by itself). + \item[\texttt{import-dirs:}] \I{FilePath} \newline + Where interface files for this unit can be found. + \item[\texttt{exposed-modules:}] \I{ModuleName} or \I{ModuleName} \texttt{from} \I{Module} \newline + The set of exposed modules from this unit, including reexports from + other units. +\end{description} +% +As well as all non-essential, Cabal-specific metadata; e.g. \texttt{name}, \texttt{version}, \ldots (\texttt{data-dir} and \texttt{haddock} probably) +Here are new entries for indefinite units: + +\begin{description} + \item[\texttt{requires:}] \I{ModuleName} \ldots \newline + The set of module names which are requirements of this unit. + (Installed units instead record \texttt{instantiated-with}, which + specifies how each requirement was instantiated.) + \item[\texttt{source-dir:}] \I{FilePath} \newline + The path to the original source of the package. + \item[\texttt{setup-executable:}] \I{FilePath} \newline + The path to the \texttt{Setup} executable as described by the Cabal + specification which is capable of building and installing the package + using \texttt{./Setup instantiate} (new), + \texttt{./Setup build}, \texttt{./Setup copy} and + \texttt{./Setup register}. + \item[\texttt{package-config:}] \I{FilePath} \newline + The path to the package configuration saved when the indefinite + unit was installed. This should contain all of the relevant configuration + information necessary to build a package, except how its requirements + are instantiated. +\end{description} +% +The string representation of \I{Module} is worth remarking upon. In +this specification, \I{Module} is a recursive data structure. For +installed packages, it is acceptable to flatten \I{Module} into a +hash representing the \I{UnitKey} and the \I{ModuleName}, as the \I{UnitKey} +is an \I{InstalledUnitId} which has an entry in the database. However, +this is unacceptable for indefinite units, because we don't have an +entry per \I{UnitKey}. So, for \I{UnitKey}s in the indefinite unit database, +the full tree is written out, subject to this syntax: + +\begin{verbatim} +Module ::= UnitKey ":" ModuleName +UnitKey ::= InstalledPackageId + [ "/" UnitName "(" HoleMap ")" ] + | "HOLE" +HoleMap ::= ModuleName "->" Module "," ... +\end{verbatim} + \section{Appendix: Shaping} This section clarifies some subtle aspects about shaping. @@ -738,8 +807,8 @@ in such a world, we need a different definition of shape: \begin{verbatim} Shape ::= - provided: ModName -> Module { OccName -> Name } - required: ModName -> { OccName -> Name } + provided: ModuleName -> Module { OccName -> Name } + required: ModuleName -> { OccName -> Name } \end{verbatim} Presently, however, such an \I{OccName} annotation would be redundant: it can be inferred from the \I{Name}. @@ -775,7 +844,7 @@ indistinguishable. \subsection{Signatures can require a specific entity.} With requirements like \verb|A -> { HOLE:A.T, HOLE:A.foo }|, why not specify it as \verb|A -> { T, foo }|, -e.g., \verb|required: { ModName -> { OccName } }|? Consider: +e.g., \verb|required: { ModuleName -> { OccName } }|? Consider: \begin{verbatim} unit p () requires (A, B) where From git at git.haskell.org Wed Aug 26 20:25:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 20:25:36 +0000 (UTC) Subject: [commit: ghc] master: Comments and white space (0f3335f) Message-ID: <20150826202536.BAFDA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0f3335fe45229c5790529e5fc7484c77bdae7668/ghc >--------------------------------------------------------------- commit 0f3335fe45229c5790529e5fc7484c77bdae7668 Author: Simon Peyton Jones Date: Fri Mar 20 12:36:22 2015 +0000 Comments and white space >--------------------------------------------------------------- 0f3335fe45229c5790529e5fc7484c77bdae7668 compiler/basicTypes/Id.hs | 7 +++---- compiler/coreSyn/MkCore.hs | 1 + compiler/iface/LoadIface.hs | 3 ++- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index 968b541..45a4aa7 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -308,9 +308,8 @@ mkTemplateLocals = mkTemplateLocalsNum 1 mkTemplateLocalsNum :: Int -> [Type] -> [Id] mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys -{- -Note [Exported LocalIds] -~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Exported LocalIds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ We use mkExportedLocalId for things like - Dictionary functions (DFunId) - Wrapper and matcher Ids for pattern synonyms @@ -324,7 +323,7 @@ code by the occurrence analyser. (But "exported" here does not mean "brought into lexical scope by an import declaration". Indeed these things are always internal Ids that the user never sees.) -It's very important that they are *LocalIds*, not GlobalIs, for lots +It's very important that they are *LocalIds*, not GlobalIds, for lots of reasons: * We want to treat them as free variables for the purpose of diff --git a/compiler/coreSyn/MkCore.hs b/compiler/coreSyn/MkCore.hs index 4d310c9..8bdee4a 100644 --- a/compiler/coreSyn/MkCore.hs +++ b/compiler/coreSyn/MkCore.hs @@ -274,6 +274,7 @@ mkCharExpr c = mkConApp charDataCon [mkCharLit c] -- | Create a 'CoreExpr' which will evaluate to the given @String@ mkStringExpr :: MonadThings m => String -> m CoreExpr -- Result :: String + -- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@ mkStringExprFS :: MonadThings m => FastString -> m CoreExpr -- Result :: String diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 9da1175..60e3a8a 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -191,6 +191,7 @@ checkWiredInTyCon tc = return () | otherwise = do { mod <- getModule + ; traceIf (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod) ; ASSERT( isExternalName tc_name ) when (mod /= nameModule tc_name) (initIfaceTcRn (loadWiredInHomeIface tc_name)) @@ -360,7 +361,7 @@ loadInterfaceForModule doc m -- | An 'IfM' function to load the home interface for a wired-in thing, -- so that we're sure that we see its instance declarations and rules --- See Note [Loading instances for wired-in things] in TcIface +-- See Note [Loading instances for wired-in things] loadWiredInHomeIface :: Name -> IfM lcl () loadWiredInHomeIface name = ASSERT( isWiredInName name ) From git at git.haskell.org Wed Aug 26 20:25:39 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 20:25:39 +0000 (UTC) Subject: [commit: ghc] master: Implement lookupGlobal in TcEnv, and use it (816d48a) Message-ID: <20150826202539.85E783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/816d48a9b4d1607d1eaf6dfa396d64f2d6c1599c/ghc >--------------------------------------------------------------- commit 816d48a9b4d1607d1eaf6dfa396d64f2d6c1599c Author: Simon Peyton Jones Date: Fri Mar 20 12:38:42 2015 +0000 Implement lookupGlobal in TcEnv, and use it This localises the (revolting) initTcForLookup function, exposing instead the more civilised interface for lookupGlobal >--------------------------------------------------------------- 816d48a9b4d1607d1eaf6dfa396d64f2d6c1599c compiler/coreSyn/CorePrep.hs | 16 ++++++++++------ compiler/simplCore/CoreMonad.hs | 9 ++++----- compiler/typecheck/TcEnv.hs | 20 +++++++++++++++++++- 3 files changed, 33 insertions(+), 12 deletions(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 9f6bb05..2b8ac02 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -30,7 +30,6 @@ import Type import Literal import Coercion import TcEnv -import TcRnMonad import TyCon import Demand import Var @@ -57,9 +56,14 @@ import Config import Name ( NamedThing(..), nameSrcSpan ) import SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) import Data.Bits +import MonadUtils ( mapAccumLM ) import Data.List ( mapAccumL ) import Control.Monad +#if __GLASGOW_HASKELL__ < 711 +import Control.Applicative +#endif + {- -- --------------------------------------------------------------------------- -- Overview @@ -1153,21 +1157,21 @@ data CorePrepEnv = CPE { lookupMkIntegerName :: DynFlags -> HscEnv -> IO Id lookupMkIntegerName dflags hsc_env = guardIntegerUse dflags $ liftM tyThingId $ - initTcForLookup hsc_env (tcLookupGlobal mkIntegerName) + lookupGlobal hsc_env mkIntegerName lookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon) lookupIntegerSDataConName dflags hsc_env = case cIntegerLibraryType of - IntegerGMP -> guardIntegerUse dflags $ liftM Just $ - initTcForLookup hsc_env (tcLookupDataCon integerSDataConName) + IntegerGMP -> guardIntegerUse dflags $ liftM (Just . tyThingDataCon) $ + lookupGlobal hsc_env integerSDataConName IntegerSimple -> return Nothing -- | Helper for 'lookupMkIntegerName' and 'lookupIntegerSDataConName' guardIntegerUse :: DynFlags -> IO a -> IO a guardIntegerUse dflags act | thisPackage dflags == primPackageKey - = return $ panic "Can't use Integer in ghc-prim" + = return $ panic "Can't use Integer in ghc-prim" | thisPackage dflags == integerPackageKey - = return $ panic "Can't use Integer in integer-*" + = return $ panic "Can't use Integer in integer-*" | otherwise = act mkInitialCorePrepEnv :: DynFlags -> HscEnv -> IO CorePrepEnv diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index 68b613b..0a1c782 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -57,6 +57,7 @@ module CoreMonad ( #ifdef GHCI import Name( Name ) +import TcRnMonad ( initTcForLookup ) #endif import CoreSyn import HscTypes @@ -68,8 +69,7 @@ import Annotations import IOEnv hiding ( liftIO, failM, failWithM ) import qualified IOEnv ( liftIO ) -import TcEnv ( tcLookupGlobal ) -import TcRnMonad ( initTcForLookup ) +import TcEnv ( lookupGlobal ) import Var import Outputable import FastString @@ -886,9 +886,8 @@ dumpIfSet_dyn flag str doc -} instance MonadThings CoreM where - lookupThing name = do - hsc_env <- getHscEnv - liftIO $ initTcForLookup hsc_env (tcLookupGlobal name) + lookupThing name = do { hsc_env <- getHscEnv + ; liftIO $ lookupGlobal hsc_env name } {- ************************************************************************ diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 8db9f26..e39fbf9 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -1,5 +1,4 @@ -- (c) The University of Glasgow 2006 - {-# LANGUAGE CPP, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan @@ -19,6 +18,7 @@ module TcEnv( tcLookupDataCon, tcLookupPatSyn, tcLookupConLike, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupAxiom, + lookupGlobal, -- Local environment tcExtendKindEnv, tcExtendKindEnv2, @@ -98,6 +98,23 @@ import Maybes( MaybeErr(..) ) import Data.IORef import Data.List + +{- ********************************************************************* +* * + An IO interface to looking up globals +* * +********************************************************************* -} + +lookupGlobal :: HscEnv -> Name -> IO TyThing +-- An IO version, used outside the typechecker +-- It's more complicated than it looks, because it may +-- need to suck in an interface file +lookupGlobal hsc_env name + = initTcForLookup hsc_env (tcLookupGlobal name) + -- This initTcForLookup stuff is massive overkill + -- but that's how it is right now, and at least + -- this function localises it + {- ************************************************************************ * * @@ -110,6 +127,7 @@ unless you know that the SrcSpan in the monad is already set to the span of the Name. -} + tcLookupLocatedGlobal :: Located Name -> TcM TyThing -- c.f. IfaceEnvEnv.tcIfaceGlobal tcLookupLocatedGlobal name From git at git.haskell.org Wed Aug 26 20:25:42 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 20:25:42 +0000 (UTC) Subject: [commit: ghc] master: tcRnDeclsi can use tcRnSrcDecls (711e0bf) Message-ID: <20150826202542.4610A3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/711e0bf21184c3aead05a47d3237a9ed42054e6c/ghc >--------------------------------------------------------------- commit 711e0bf21184c3aead05a47d3237a9ed42054e6c Author: Simon Peyton Jones Date: Mon Mar 23 14:32:31 2015 +0000 tcRnDeclsi can use tcRnSrcDecls I'm not sure why tcRnDeclsi didn't call tcRnSrcDecls before, but now it does. About 20 lines of code vanish. Hooray. >--------------------------------------------------------------- 711e0bf21184c3aead05a47d3237a9ed42054e6c compiler/typecheck/TcRnDriver.hs | 41 +++------------------------------------- 1 file changed, 3 insertions(+), 38 deletions(-) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index e361dcb..6e3fd81 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1900,44 +1900,9 @@ tcRnDeclsi exists to allow class, data, and other declarations in GHCi. tcRnDeclsi :: HscEnv -> [LHsDecl RdrName] -> IO (Messages, Maybe TcGblEnv) - -tcRnDeclsi hsc_env local_decls = - runTcInteractive hsc_env $ do - - ((tcg_env, tclcl_env), lie) <- captureConstraints $ - tc_rn_src_decls local_decls - setEnvs (tcg_env, tclcl_env) $ do - - -- wanted constraints from static forms - stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef - - new_ev_binds <- simplifyTop (andWC stWC lie) - - failIfErrsM - let TcGblEnv { tcg_type_env = type_env, - tcg_binds = binds, - tcg_sigs = sig_ns, - tcg_ev_binds = cur_ev_binds, - tcg_imp_specs = imp_specs, - tcg_rules = rules, - tcg_vects = vects, - tcg_fords = fords } = tcg_env - all_ev_binds = cur_ev_binds `unionBags` new_ev_binds - - (bind_ids, ev_binds', binds', fords', imp_specs', rules', vects') - <- zonkTopDecls all_ev_binds binds Nothing sig_ns rules vects - imp_specs fords - - let final_type_env = extendTypeEnvWithIds type_env bind_ids - tcg_env' = tcg_env { tcg_binds = binds', - tcg_ev_binds = ev_binds', - tcg_imp_specs = imp_specs', - tcg_rules = rules', - tcg_vects = vects', - tcg_fords = fords' } - - setGlobalTypeEnv tcg_env' final_type_env - +tcRnDeclsi hsc_env local_decls + = runTcInteractive hsc_env $ + tcRnSrcDecls False Nothing local_decls externaliseAndTidyId :: Module -> Id -> TcM Id externaliseAndTidyId this_mod id From git at git.haskell.org Wed Aug 26 20:25:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 20:25:45 +0000 (UTC) Subject: [commit: ghc] master: TcDeriv: Kill dead code (ac0d052) Message-ID: <20150826202545.18FA93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/ac0d052f724510f3f007c4869f87a202ee83bd16/ghc >--------------------------------------------------------------- commit ac0d052f724510f3f007c4869f87a202ee83bd16 Author: Ben Gamari Date: Wed Aug 26 17:46:22 2015 +0200 TcDeriv: Kill dead code >--------------------------------------------------------------- ac0d052f724510f3f007c4869f87a202ee83bd16 compiler/typecheck/TcDeriv.hs | 86 +++++-------------------------------------- 1 file changed, 10 insertions(+), 76 deletions(-) diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 6395ddf..0a20155 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -406,73 +406,6 @@ tcDeriving tycl_decls inst_decls deriv_decls hangP s x = text "" $$ hang (ptext (sLit s)) 2 x -{- -genTypeableTyConReps :: DynFlags -> - [LTyClDecl Name] -> - [LInstDecl Name] -> - TcM (Bag (LHsBind RdrName, LSig RdrName)) -genTypeableTyConReps dflags decls insts = - do tcs1 <- mapM tyConsFromDecl decls - tcs2 <- mapM tyConsFromInst insts - return $ listToBag [ genTypeableTyConRep dflags loc tc - | (loc,tc) <- concat (tcs1 ++ tcs2) ] - where - - tyConFromDataCon (L l n) = do dc <- tcLookupDataCon n - return (do tc <- promoteDataCon_maybe dc - return (l,tc)) - - -- Promoted data constructors from a data declaration, or - -- a data-family instance. - tyConsFromDataRHS = fmap catMaybes - . mapM tyConFromDataCon - . concatMap (con_names . unLoc) - . dd_cons - - -- Tycons from a data-family declaration; not promotable. - tyConFromDataFamDecl FamilyDecl { fdLName = L loc name } = - do tc <- tcLookupTyCon name - return (loc,tc) - - - -- tycons from a type-level declaration - tyConsFromDecl (L _ d) - - -- data or newtype declaration: promoted tycon, tycon, promoted ctrs. - | isDataDecl d = - do let L loc name = tcdLName d - tc <- tcLookupTyCon name - promotedCtrs <- tyConsFromDataRHS (tcdDataDefn d) - let tyCons = (loc,tc) : promotedCtrs - - return (case promotableTyCon_maybe tc of - Nothing -> tyCons - Just kc -> (loc,kc) : tyCons) - - -- data family: just the type constructor; these are not promotable. - | isDataFamilyDecl d = - do res <- tyConFromDataFamDecl (tcdFam d) - return [res] - - -- class: the type constructors of associated data families - | isClassDecl d = - let isData FamilyDecl { fdInfo = DataFamily } = True - isData _ = False - - in mapM tyConFromDataFamDecl (filter isData (map unLoc (tcdATs d))) - - | otherwise = return [] - - - tyConsFromInst (L _ d) = - case d of - ClsInstD ci -> fmap concat - $ mapM (tyConsFromDataRHS . dfid_defn . unLoc) - $ cid_datafam_insts ci - DataFamInstD dfi -> tyConsFromDataRHS (dfid_defn dfi) - TyFamInstD {} -> return [] --} - -- Prints the representable type family instance pprRepTy :: FamInst -> SDoc pprRepTy fi@(FamInst { fi_tys = lhs }) @@ -685,13 +618,10 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode)) ; case tcSplitTyConApp_maybe inst_ty of Just (tc, tc_args) | className cls == typeableClassName - -> do warn <- woptM Opt_WarnDerivingTypeable - when warn - $ addWarnTc - $ text "Standalone deriving `Typeable` has no effect." + -> do warnUselessTypeable return [] - | isAlgTyCon tc -- All other classes + | isAlgTyCon tc || isDataFamilyTyCon tc -- All other classes -> do { spec <- mkEqnHelp (fmap unLoc overlap_mode) tvs cls cls_tys tc tc_args (Just theta) ; return [spec] } @@ -702,6 +632,13 @@ deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode)) } +warnUselessTypeable :: TcM () +warnUselessTypeable + = do { warn <- woptM Opt_WarnDerivingTypeable + ; when warn $ addWarnTc + $ ptext (sLit "Deriving") <+> quotes (ppr typeableClassName) <+> + ptext (sLit "has no effect: all types now auto-derive Typeable") } + ------------------------------------------------------------------ deriveTyData :: [TyVar] -> TyCon -> [Type] -- LHS of data or data instance -- Can be a data instance, hence [Type] args @@ -723,10 +660,7 @@ deriveTyData tvs tc tc_args (L loc deriv_pred) -- so the argument kind 'k' is not decomposable by splitKindFunTys -- as is the case for all other derivable type classes ; if className cls == typeableClassName - then do warn <- woptM Opt_WarnDerivingTypeable - when warn - $ addWarnTc - $ text "Deriving `Typeable` has no effect." + then do warnUselessTypeable return [] else From git at git.haskell.org Wed Aug 26 20:25:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 20:25:47 +0000 (UTC) Subject: [commit: ghc] master: PrelNames: Clean up list a bit (de476e9) Message-ID: <20150826202547.D8F9D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/de476e93dd6d3c43724a2c1d1b72f0b6e01578bc/ghc >--------------------------------------------------------------- commit de476e93dd6d3c43724a2c1d1b72f0b6e01578bc Author: Ben Gamari Date: Wed Aug 26 17:50:33 2015 +0200 PrelNames: Clean up list a bit >--------------------------------------------------------------- de476e93dd6d3c43724a2c1d1b72f0b6e01578bc compiler/prelude/PrelNames.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 23d5000..ddccf90 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -175,15 +175,7 @@ wired in ones are defined in TysWiredIn etc. basicKnownKeyNames :: [Name] basicKnownKeyNames = genericTyConNames - ++ [ -- Type constructors (synonyms especially) - ioTyConName, ioDataConName, - runMainIOName, - rationalTyConName, - stringTyConName, - ratioDataConName, - ratioTyConName, - - -- Classes. *Must* include: + ++ [ -- Classes. *Must* include: -- classes that are grabbed by key (e.g., eqClassKey) -- classes in "Class.standardClassKeys" (quite a few) eqClassName, -- mentioned, derivable @@ -206,6 +198,11 @@ basicKnownKeyNames foldableClassName, traversableClassName, + -- The IO type + -- See Note [TyConRepNames for non-wired-in TyCons] + ioTyConName, ioDataConName, + runMainIOName, + -- Typeable typeableClassName, typeRepTyConName, @@ -222,11 +219,14 @@ basicKnownKeyNames negateName, minusName, geName, eqName, -- Conversion functions + rationalTyConName, + ratioTyConName, ratioDataConName, fromRationalName, fromIntegerName, toIntegerName, toRationalName, fromIntegralName, realToFracName, -- String stuff + stringTyConName, fromStringName, -- Enum stuff @@ -331,7 +331,8 @@ basicKnownKeyNames toAnnotationWrapperName -- The Ordering type - , orderingTyConName, ltDataConName, eqDataConName, gtDataConName + , orderingTyConName + , ltDataConName, eqDataConName, gtDataConName -- The SPEC type for SpecConstr , specTyConName From git at git.haskell.org Wed Aug 26 20:25:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 20:25:50 +0000 (UTC) Subject: [commit: ghc] master: Clean up handling of knownKeyNames (7924469) Message-ID: <20150826202550.A4EDA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/792446906c718a08f0870b58acbdf2cfdeb77770/ghc >--------------------------------------------------------------- commit 792446906c718a08f0870b58acbdf2cfdeb77770 Author: Ben Gamari Date: Wed Aug 26 17:58:25 2015 +0200 Clean up handling of knownKeyNames >--------------------------------------------------------------- 792446906c718a08f0870b58acbdf2cfdeb77770 compiler/main/HscMain.hs | 12 +++++- compiler/prelude/PrelInfo.hs | 100 ++++++++++++++++++++----------------------- 2 files changed, 56 insertions(+), 56 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index c7cabe6..41418fa 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -91,7 +91,8 @@ import BasicTypes ( HValue ) import ByteCodeGen ( byteCodeGen, coreExprToBCOs ) import Linker import CoreTidy ( tidyExpr ) -import Type ( Type, Kind ) +import Type ( Type ) +import {- Kind parts of -} Type ( Kind ) import CoreLint ( lintInteractiveExpr ) import VarEnv ( emptyTidyEnv ) import Panic @@ -177,7 +178,7 @@ newHscEnv :: DynFlags -> IO HscEnv newHscEnv dflags = do eps_var <- newIORef initExternalPackageState us <- mkSplitUniqSupply 'r' - nc_var <- newIORef (initNameCache us knownKeyNames) + nc_var <- newIORef (initNameCache us allKnownKeyNames) fc_var <- newIORef emptyModuleEnv return HscEnv { hsc_dflags = dflags, hsc_targets = [], @@ -190,6 +191,13 @@ newHscEnv dflags = do hsc_type_env_var = Nothing } +allKnownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta, +allKnownKeyNames = -- where templateHaskellNames are defined + knownKeyNames +#ifdef GHCI + ++ templateHaskellNames +#endif + -- ----------------------------------------------------------------------------- getWarnings :: Hsc WarningMessages diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 5ab060e..9cfa78b 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -10,7 +10,7 @@ module PrelInfo ( primOpRules, builtinRules, ghcPrimExports, - wiredInThings, knownKeyNames, + knownKeyNames, primOpId, -- Random other things @@ -23,56 +23,31 @@ module PrelInfo ( #include "HsVersions.h" +import Constants ( mAX_TUPLE_SIZE ) +import BasicTypes ( Boxity(..) ) +import ConLike ( ConLike(..) ) import PrelNames import PrelRules import Avail import PrimOp import DataCon import Id +import Name import MkId -import Name( Name, getName ) import TysPrim import TysWiredIn import HscTypes import Class import TyCon -import Outputable -import UniqFM import Util import {-# SOURCE #-} TcTypeNats ( typeNatTyCons ) -#ifdef GHCI -import THNames -#endif - import Data.Array - -{- ********************************************************************* -* * - Known key things -* * -********************************************************************* -} - -knownKeyNames :: [Name] -knownKeyNames = - ASSERT2( isNullUFM badNamesUFM, text "badknownKeyNames" <+> ppr badNamesUFM ) - names - where - badNamesUFM = filterUFM (\ns -> length ns > 1) namesUFM - namesUFM = foldl (\m n -> addToUFM_Acc (:) singleton m n n) emptyUFM names - names = concat - [ map getName wiredInThings - , cTupleTyConNames - , basicKnownKeyNames -#ifdef GHCI - , templateHaskellNames -#endif - ] - -{- ********************************************************************* +{- +************************************************************************ * * - Wired in things +\subsection[builtinNameInfo]{Lookup built-in names} * * ************************************************************************ @@ -87,33 +62,50 @@ Notes about wired in things * The name cache is initialised with (the names of) all wired-in things -* The type checker sees if the Name is wired in before looking up - the name in the type environment. So the type envt itself contains - no wired in things. +* The type environment itself contains no wired in things. The type + checker sees if the Name is wired in before looking up the name in + the type environment. * MkIface prunes out wired-in things before putting them in an interface file. So interface files never contain wired-in things. -} -wiredInThings :: [TyThing] --- This list is used only to initialise HscMain.knownKeyNames --- to ensure that when you say "Prelude.map" in your source code, you --- get a Name with the correct known key (See Note [Known-key names]) -wiredInThings - = concat - [ -- Wired in TyCons and their implicit Ids - tycon_things - , concatMap implicitTyThings tycon_things - - -- Wired in Ids - , map AnId wiredInIds - - -- PrimOps - , map (AnId . primOpId) allThePrimOps - ] + +knownKeyNames :: [Name] +-- This list is used to ensure that when you say "Prelude.map" in your +-- source code, you get a Name with the correct known key +-- (See Note [Known-key names] in PrelNames) +knownKeyNames + = concat [ tycon_kk_names funTyCon + , concatMap tycon_kk_names primTyCons + , concatMap tycon_kk_names wiredInTyCons + , concatMap tycon_kk_names typeNatTyCons + , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk + , map idName wiredInIds + , map (idName . primOpId) allThePrimOps + , basicKnownKeyNames ] where - tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons - ++ typeNatTyCons) + -- "kk" short for "known-key" + tycon_kk_names :: TyCon -> [Name] + tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc)) + + datacon_kk_names dc + | Promoted tc <- promoteDataCon_maybe dc = dataConName dc : rep_names tc + | otherwise = [dataConName dc] + + thing_kk_names :: TyThing -> [Name] + thing_kk_names (ATyCon tc) = tycon_kk_names tc + thing_kk_names (AConLike (RealDataCon dc)) = datacon_kk_names dc + thing_kk_names thing = [getName thing] + + -- The TyConRepName for a known-key TyCon has a known key, + -- but isn't itself an implicit thing. Yurgh. + -- NB: if any of the wired-in TyCons had record fields, the record + -- field names would be in a similar situation. Ditto class ops. + -- But it happens that there aren't any + rep_names tc = case tyConRepName_maybe tc of + Just n -> [n] + Nothing -> [] {- We let a lot of "non-standard" values be visible, so that we can make From git at git.haskell.org Wed Aug 26 20:25:53 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 20:25:53 +0000 (UTC) Subject: [commit: ghc] master: BinIface: Clean up whitespace (89d25b9) Message-ID: <20150826202553.6F0F63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/89d25b9e7f8b3a40c58916700cd8adfbd9dd4f19/ghc >--------------------------------------------------------------- commit 89d25b9e7f8b3a40c58916700cd8adfbd9dd4f19 Author: Ben Gamari Date: Wed Aug 26 17:56:06 2015 +0200 BinIface: Clean up whitespace >--------------------------------------------------------------- 89d25b9e7f8b3a40c58916700cd8adfbd9dd4f19 compiler/iface/BinIface.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 9d3ef75..3c1633d 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -23,9 +23,9 @@ module BinIface ( import TcRnMonad import TyCon import ConLike -import DataCon (dataConName, dataConWorkId, dataConTyCon) +import DataCon ( dataConName, dataConWorkId, dataConTyCon ) import PrelInfo ( knownKeyNames ) -import Id (idName, isDataConWorkId_maybe) +import Id ( idName, isDataConWorkId_maybe ) import TysWiredIn import IfaceEnv import HscTypes @@ -304,7 +304,6 @@ serialiseName bh name _ = do knownKeyNamesMap :: UniqFM Name knownKeyNamesMap = listToUFM_Directly [(nameUnique n, n) | n <- knownKeyNames] - -- See Note [Symbol table representation of names] putName :: BinDictionary -> BinSymbolTable -> BinHandle -> Name -> IO () putName _dict BinSymbolTable{ From git at git.haskell.org Wed Aug 26 23:05:34 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Wed, 26 Aug 2015 23:05:34 +0000 (UTC) Subject: [commit: ghc] master: Revert "Clean up handling of knownKeyNames" (a8601a8) Message-ID: <20150826230534.913753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a8601a839f6f0d2bcd841aa46ebab00298f1c464/ghc >--------------------------------------------------------------- commit a8601a839f6f0d2bcd841aa46ebab00298f1c464 Author: Ben Gamari Date: Thu Aug 27 01:00:52 2015 +0200 Revert "Clean up handling of knownKeyNames" This reverts commit 792446906c718a08f0870b58acbdf2cfdeb77770. This commit was a failed part of an effort to split up D757. I'll need to try again and make sure I build-test next time. >--------------------------------------------------------------- a8601a839f6f0d2bcd841aa46ebab00298f1c464 compiler/main/HscMain.hs | 12 +----- compiler/prelude/PrelInfo.hs | 100 +++++++++++++++++++++++-------------------- 2 files changed, 56 insertions(+), 56 deletions(-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 41418fa..c7cabe6 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -91,8 +91,7 @@ import BasicTypes ( HValue ) import ByteCodeGen ( byteCodeGen, coreExprToBCOs ) import Linker import CoreTidy ( tidyExpr ) -import Type ( Type ) -import {- Kind parts of -} Type ( Kind ) +import Type ( Type, Kind ) import CoreLint ( lintInteractiveExpr ) import VarEnv ( emptyTidyEnv ) import Panic @@ -178,7 +177,7 @@ newHscEnv :: DynFlags -> IO HscEnv newHscEnv dflags = do eps_var <- newIORef initExternalPackageState us <- mkSplitUniqSupply 'r' - nc_var <- newIORef (initNameCache us allKnownKeyNames) + nc_var <- newIORef (initNameCache us knownKeyNames) fc_var <- newIORef emptyModuleEnv return HscEnv { hsc_dflags = dflags, hsc_targets = [], @@ -191,13 +190,6 @@ newHscEnv dflags = do hsc_type_env_var = Nothing } -allKnownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta, -allKnownKeyNames = -- where templateHaskellNames are defined - knownKeyNames -#ifdef GHCI - ++ templateHaskellNames -#endif - -- ----------------------------------------------------------------------------- getWarnings :: Hsc WarningMessages diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 9cfa78b..5ab060e 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -10,7 +10,7 @@ module PrelInfo ( primOpRules, builtinRules, ghcPrimExports, - knownKeyNames, + wiredInThings, knownKeyNames, primOpId, -- Random other things @@ -23,31 +23,56 @@ module PrelInfo ( #include "HsVersions.h" -import Constants ( mAX_TUPLE_SIZE ) -import BasicTypes ( Boxity(..) ) -import ConLike ( ConLike(..) ) import PrelNames import PrelRules import Avail import PrimOp import DataCon import Id -import Name import MkId +import Name( Name, getName ) import TysPrim import TysWiredIn import HscTypes import Class import TyCon +import Outputable +import UniqFM import Util import {-# SOURCE #-} TcTypeNats ( typeNatTyCons ) +#ifdef GHCI +import THNames +#endif + import Data.Array -{- -************************************************************************ + +{- ********************************************************************* * * -\subsection[builtinNameInfo]{Lookup built-in names} + Known key things +* * +********************************************************************* -} + +knownKeyNames :: [Name] +knownKeyNames = + ASSERT2( isNullUFM badNamesUFM, text "badknownKeyNames" <+> ppr badNamesUFM ) + names + where + badNamesUFM = filterUFM (\ns -> length ns > 1) namesUFM + namesUFM = foldl (\m n -> addToUFM_Acc (:) singleton m n n) emptyUFM names + names = concat + [ map getName wiredInThings + , cTupleTyConNames + , basicKnownKeyNames +#ifdef GHCI + , templateHaskellNames +#endif + ] + +{- ********************************************************************* +* * + Wired in things * * ************************************************************************ @@ -62,50 +87,33 @@ Notes about wired in things * The name cache is initialised with (the names of) all wired-in things -* The type environment itself contains no wired in things. The type - checker sees if the Name is wired in before looking up the name in - the type environment. +* The type checker sees if the Name is wired in before looking up + the name in the type environment. So the type envt itself contains + no wired in things. * MkIface prunes out wired-in things before putting them in an interface file. So interface files never contain wired-in things. -} - -knownKeyNames :: [Name] --- This list is used to ensure that when you say "Prelude.map" in your --- source code, you get a Name with the correct known key --- (See Note [Known-key names] in PrelNames) -knownKeyNames - = concat [ tycon_kk_names funTyCon - , concatMap tycon_kk_names primTyCons - , concatMap tycon_kk_names wiredInTyCons - , concatMap tycon_kk_names typeNatTyCons - , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk - , map idName wiredInIds - , map (idName . primOpId) allThePrimOps - , basicKnownKeyNames ] +wiredInThings :: [TyThing] +-- This list is used only to initialise HscMain.knownKeyNames +-- to ensure that when you say "Prelude.map" in your source code, you +-- get a Name with the correct known key (See Note [Known-key names]) +wiredInThings + = concat + [ -- Wired in TyCons and their implicit Ids + tycon_things + , concatMap implicitTyThings tycon_things + + -- Wired in Ids + , map AnId wiredInIds + + -- PrimOps + , map (AnId . primOpId) allThePrimOps + ] where - -- "kk" short for "known-key" - tycon_kk_names :: TyCon -> [Name] - tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc)) - - datacon_kk_names dc - | Promoted tc <- promoteDataCon_maybe dc = dataConName dc : rep_names tc - | otherwise = [dataConName dc] - - thing_kk_names :: TyThing -> [Name] - thing_kk_names (ATyCon tc) = tycon_kk_names tc - thing_kk_names (AConLike (RealDataCon dc)) = datacon_kk_names dc - thing_kk_names thing = [getName thing] - - -- The TyConRepName for a known-key TyCon has a known key, - -- but isn't itself an implicit thing. Yurgh. - -- NB: if any of the wired-in TyCons had record fields, the record - -- field names would be in a similar situation. Ditto class ops. - -- But it happens that there aren't any - rep_names tc = case tyConRepName_maybe tc of - Just n -> [n] - Nothing -> [] + tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons + ++ typeNatTyCons) {- We let a lot of "non-standard" values be visible, so that we can make From git at git.haskell.org Thu Aug 27 07:13:38 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 07:13:38 +0000 (UTC) Subject: [commit: ghc] master: PrelNames: introduce dcQual in place of conName (28ad98e) Message-ID: <20150827071338.EF7D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/28ad98e7384cd128ddba17620ed6a8345c0d7850/ghc >--------------------------------------------------------------- commit 28ad98e7384cd128ddba17620ed6a8345c0d7850 Author: Ben Gamari Date: Wed Aug 26 18:03:00 2015 +0200 PrelNames: introduce dcQual in place of conName >--------------------------------------------------------------- 28ad98e7384cd128ddba17620ed6a8345c0d7850 compiler/prelude/PrelNames.hs | 38 ++++++++++++++++++-------------------- 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index ddccf90..12a1543 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -767,18 +767,18 @@ runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey orderingTyConName, ltDataConName, eqDataConName, gtDataConName :: Name -orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey -ltDataConName = conName gHC_TYPES (fsLit "LT") ltDataConKey -eqDataConName = conName gHC_TYPES (fsLit "EQ") eqDataConKey -gtDataConName = conName gHC_TYPES (fsLit "GT") gtDataConKey +orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey +ltDataConName = dcQual gHC_TYPES (fsLit "LT") ltDataConKey +eqDataConName = dcQual gHC_TYPES (fsLit "EQ") eqDataConKey +gtDataConName = dcQual gHC_TYPES (fsLit "GT") gtDataConKey specTyConName :: Name specTyConName = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey eitherTyConName, leftDataConName, rightDataConName :: Name eitherTyConName = tcQual dATA_EITHER (fsLit "Either") eitherTyConKey -leftDataConName = conName dATA_EITHER (fsLit "Left") leftDataConKey -rightDataConName = conName dATA_EITHER (fsLit "Right") rightDataConKey +leftDataConName = dcQual dATA_EITHER (fsLit "Left") leftDataConKey +rightDataConName = dcQual dATA_EITHER (fsLit "Right") rightDataConKey -- Generics (types) v1TyConName, u1TyConName, par1TyConName, rec1TyConName, @@ -939,7 +939,7 @@ integerTyConName, mkIntegerName, integerSDataConName, andIntegerName, orIntegerName, xorIntegerName, complementIntegerName, shiftLIntegerName, shiftRIntegerName :: Name integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey -integerSDataConName = conName gHC_INTEGER_TYPE (fsLit n) integerSDataConKey +integerSDataConName = dcQual gHC_INTEGER_TYPE (fsLit n) integerSDataConKey where n = case cIntegerLibraryType of IntegerGMP -> "S#" IntegerSimple -> panic "integerSDataConName evaluated for integer-simple" @@ -992,7 +992,7 @@ rationalTyConName, ratioTyConName, ratioDataConName, realClassName, realToFracName :: Name rationalTyConName = tcQual gHC_REAL (fsLit "Rational") rationalTyConKey ratioTyConName = tcQual gHC_REAL (fsLit "Ratio") ratioTyConKey -ratioDataConName = conName gHC_REAL (fsLit ":%") ratioDataConKey +ratioDataConName = dcQual gHC_REAL (fsLit ":%") ratioDataConKey realClassName = clsQual gHC_REAL (fsLit "Real") realClassKey integralClassName = clsQual gHC_REAL (fsLit "Integral") integralClassKey realFracClassName = clsQual gHC_REAL (fsLit "RealFrac") realFracClassKey @@ -1097,10 +1097,10 @@ ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey ghciStepIoMName = varQual gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey -- IO things -ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName, - failIOName :: Name +ioTyConName, ioDataConName, + thenIOName, bindIOName, returnIOName, failIOName :: Name ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey -ioDataConName = conName gHC_TYPES (fsLit "IO") ioDataConKey +ioDataConName = dcQual gHC_TYPES (fsLit "IO") ioDataConKey thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey @@ -1179,11 +1179,11 @@ ipClassName = clsQual gHC_CLASSES (fsLit "IP") ipClassNameKey -- Source Locations callStackDataConName, callStackTyConName, srcLocDataConName :: Name callStackDataConName - = conName gHC_STACK (fsLit "CallStack") callStackDataConKey + = dcQual gHC_STACK (fsLit "CallStack") callStackDataConKey callStackTyConName = tcQual gHC_STACK (fsLit "CallStack") callStackTyConKey srcLocDataConName - = conName gHC_SRCLOC (fsLit "SrcLoc") srcLocDataConKey + = dcQual gHC_SRCLOC (fsLit "SrcLoc") srcLocDataConKey -- plugins pLUGINS :: Module @@ -1198,7 +1198,7 @@ staticPtrInfoTyConName = staticPtrInfoDataConName :: Name staticPtrInfoDataConName = - conName gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey + dcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey staticPtrTyConName :: Name staticPtrTyConName = @@ -1206,11 +1206,11 @@ staticPtrTyConName = staticPtrDataConName :: Name staticPtrDataConName = - conName gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey + dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey fingerprintDataConName :: Name fingerprintDataConName = - conName gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey + dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey {- ************************************************************************ @@ -1222,18 +1222,16 @@ fingerprintDataConName = All these are original names; hence mkOrig -} -varQual, tcQual, clsQual :: Module -> FastString -> Unique -> Name +varQual, tcQual, clsQual, dcQual :: Module -> FastString -> Unique -> Name varQual = mk_known_key_name varName tcQual = mk_known_key_name tcName clsQual = mk_known_key_name clsName +dcQual = mk_known_key_name dataName mk_known_key_name :: NameSpace -> Module -> FastString -> Unique -> Name mk_known_key_name space modu str unique = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan -conName :: Module -> FastString -> Unique -> Name -conName modu occ unique - = mkExternalName unique modu (mkOccNameFS dataName occ) noSrcSpan {- ************************************************************************ From git at git.haskell.org Thu Aug 27 07:13:41 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 07:13:41 +0000 (UTC) Subject: [commit: ghc] master: Move newImplicitBinder to from IfaceEnv to BuildTyCl (211b349) Message-ID: <20150827071341.D4A9E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/211b3497f19510f94c00d4c234f59da48695b563/ghc >--------------------------------------------------------------- commit 211b3497f19510f94c00d4c234f59da48695b563 Author: Ben Gamari Date: Thu Aug 27 08:01:21 2015 +0200 Move newImplicitBinder to from IfaceEnv to BuildTyCl >--------------------------------------------------------------- 211b3497f19510f94c00d4c234f59da48695b563 compiler/iface/BuildTyCl.hs | 18 ++++++++++++++++++ compiler/iface/IfaceEnv.hs | 20 +------------------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs index 0a922e8..640ad9b 100644 --- a/compiler/iface/BuildTyCl.hs +++ b/compiler/iface/BuildTyCl.hs @@ -341,3 +341,21 @@ Here we can't use a newtype either, even though there is only one field, because equality predicates are unboxed, and classes are boxed. -} + +newImplicitBinder :: Name -- Base name + -> (OccName -> OccName) -- Occurrence name modifier + -> TcRnIf m n Name -- Implicit name +-- Called in BuildTyCl to allocate the implicit binders of type/class decls +-- For source type/class decls, this is the first occurrence +-- For iface ones, the LoadIface has alrady allocated a suitable name in the cache +newImplicitBinder base_name mk_sys_occ + | Just mod <- nameModule_maybe base_name + = newGlobalBinder mod occ loc + | otherwise -- When typechecking a [d| decl bracket |], + -- TH generates types, classes etc with Internal names, + -- so we follow suit for the implicit binders + = do { uniq <- newUnique + ; return (mkInternalName uniq occ loc) } + where + occ = mk_sys_occ (nameOccName base_name) + loc = nameSrcSpan base_name diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs index a822b10..2981550 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/iface/IfaceEnv.hs @@ -3,7 +3,7 @@ {-# LANGUAGE CPP, RankNTypes #-} module IfaceEnv ( - newGlobalBinder, newImplicitBinder, newInteractiveBinder, + newGlobalBinder, newInteractiveBinder, externaliseName, lookupIfaceTop, lookupOrig, lookupOrigNameCache, extendNameCache, @@ -130,24 +130,6 @@ allocateGlobalBinder name_supply mod occ loc new_cache = extendNameCache (nsNames name_supply) mod occ name new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache} -newImplicitBinder :: Name -- Base name - -> (OccName -> OccName) -- Occurrence name modifier - -> TcRnIf m n Name -- Implicit name --- Called in BuildTyCl to allocate the implicit binders of type/class decls --- For source type/class decls, this is the first occurrence --- For iface ones, the LoadIface has alrady allocated a suitable name in the cache -newImplicitBinder base_name mk_sys_occ - | Just mod <- nameModule_maybe base_name - = newGlobalBinder mod occ loc - | otherwise -- When typechecking a [d| decl bracket |], - -- TH generates types, classes etc with Internal names, - -- so we follow suit for the implicit binders - = do { uniq <- newUnique - ; return (mkInternalName uniq occ loc) } - where - occ = mk_sys_occ (nameOccName base_name) - loc = nameSrcSpan base_name - ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo] ifaceExportNames exports = return exports From git at git.haskell.org Thu Aug 27 07:13:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 07:13:44 +0000 (UTC) Subject: [commit: ghc] master: IfaceEnv: Clean up updNameCache a bit (70ea94c) Message-ID: <20150827071344.BBC313A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/70ea94cb5e51701b44c9e3e598b0898fd87f8d31/ghc >--------------------------------------------------------------- commit 70ea94cb5e51701b44c9e3e598b0898fd87f8d31 Author: Ben Gamari Date: Wed Aug 26 18:10:21 2015 +0200 IfaceEnv: Clean up updNameCache a bit >--------------------------------------------------------------- 70ea94cb5e51701b44c9e3e598b0898fd87f8d31 compiler/iface/IfaceEnv.hs | 21 ++++++++------------- compiler/main/HscTypes.hs | 8 +++++++- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs index 2981550..645ceda 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/iface/IfaceEnv.hs @@ -37,8 +37,6 @@ import Util import Outputable -import Data.IORef ( atomicModifyIORef' ) - {- ********************************************************* * * @@ -73,7 +71,7 @@ newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name newGlobalBinder mod occ loc = do { mod `seq` occ `seq` return () -- See notes with lookupOrig - ; name <- updNameCacheTcRn $ \name_cache -> + ; name <- updNameCache $ \name_cache -> allocateGlobalBinder name_cache mod occ loc ; traceIf (text "newGlobalBinder" <+> (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name])) @@ -84,7 +82,7 @@ newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name -- from the interactive context newInteractiveBinder hsc_env occ loc = do { let mod = icInteractiveModule (hsc_IC hsc_env) - ; updNameCache hsc_env $ \name_cache -> + ; updNameCacheIO hsc_env $ \name_cache -> allocateGlobalBinder name_cache mod occ loc } allocateGlobalBinder @@ -147,7 +145,7 @@ lookupOrig mod occ mod `seq` occ `seq` return () -- ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ) - ; updNameCacheTcRn $ \name_cache -> + ; updNameCache $ \name_cache -> case lookupOrigNameCache (nsNames name_cache) mod occ of { Just name -> (name_cache, name); Nothing -> @@ -167,7 +165,7 @@ externaliseName mod name loc = nameSrcSpan name uniq = nameUnique name ; occ `seq` return () -- c.f. seq in newGlobalBinder - ; updNameCacheTcRn $ \ ns -> + ; updNameCache $ \ ns -> let name' = mkExternalName uniq mod occ loc ns' = ns { nsNames = extendNameCache (nsNames ns) mod occ name' } in (ns', name') } @@ -224,12 +222,9 @@ extendNameCache nc mod occ name where combine _ occ_env = extendOccEnv occ_env occ name -updNameCacheTcRn :: (NameCache -> (NameCache, c)) -> TcRnIf a b c -updNameCacheTcRn upd_fn = do { hsc_env <- getTopEnv - ; liftIO (updNameCache hsc_env upd_fn) } - -updNameCache :: HscEnv -> (NameCache -> (NameCache, c)) -> IO c -updNameCache hsc_env upd_fn = atomicModifyIORef' (hsc_NC hsc_env) upd_fn +updNameCache :: (NameCache -> (NameCache, c)) -> TcRnIf a b c +updNameCache upd_fn = do { hsc_env <- getTopEnv + ; liftIO $ updNameCacheIO hsc_env upd_fn } -- | A function that atomically updates the name cache given a modifier -- function. The second result of the modifier function will be the result @@ -240,7 +235,7 @@ newtype NameCacheUpdater -- | Return a function to atomically update the name cache. mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater mkNameCacheUpdater = do { hsc_env <- getTopEnv - ; return (NCU (updNameCache hsc_env)) } + ; return (NCU (updNameCacheIO hsc_env)) } initNameCache :: UniqSupply -> [Name] -> NameCache initNameCache us names diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index b3ae671..3b47e4c 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -93,7 +93,7 @@ module HscTypes ( -- * Information on imports and exports WhetherHasOrphans, IsBootInterface, Usage(..), Dependencies(..), noDependencies, - NameCache(..), OrigNameCache, + NameCache(..), OrigNameCache, updNameCacheIO, IfaceExport, -- * Warnings @@ -2361,6 +2361,12 @@ data NameCache -- ^ Ensures that one original name gets one unique } +updNameCacheIO :: HscEnv + -> (NameCache -> (NameCache, c)) -- The updating function + -> IO c +updNameCacheIO hsc_env upd_fn + = atomicModifyIORef' (hsc_NC hsc_env) upd_fn + -- | Per-module cache of original 'OccName's given 'Name's type OrigNameCache = ModuleEnv (OccEnv Name) From git at git.haskell.org Thu Aug 27 07:13:47 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 07:13:47 +0000 (UTC) Subject: [commit: ghc] master: MkIface: Introduce PatSynId, ReflectionId, DefMethId (f6035bc) Message-ID: <20150827071347.A312E3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/f6035bc004fd004e421355bb88ec1e601c3c0c0c/ghc >--------------------------------------------------------------- commit f6035bc004fd004e421355bb88ec1e601c3c0c0c Author: Ben Gamari Date: Wed Aug 26 18:14:31 2015 +0200 MkIface: Introduce PatSynId, ReflectionId, DefMethId Currently we don't persist these three "advisory" IdInfos through interface files. We easily could if needed. >--------------------------------------------------------------- f6035bc004fd004e421355bb88ec1e601c3c0c0c compiler/basicTypes/IdInfo.hs | 19 ++++++++++++++++++- compiler/iface/MkIface.hs | 13 +++++++++++-- 2 files changed, 29 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index e9fccbe..0291005 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -122,7 +122,8 @@ data IdDetails -- b) when desugaring a RecordCon we can get -- from the Id back to the data con] - | ClassOpId Class -- ^ The 'Id' is a superclass selector or class operation of a class + | ClassOpId Class -- ^ The 'Id' is a superclass selector, + -- or class operation of a class | PrimOpId PrimOp -- ^ The 'Id' is for a primitive operator | FCallId ForeignCall -- ^ The 'Id' is for a foreign call @@ -134,6 +135,19 @@ data IdDetails -- implemented with a newtype, so it might be bad -- to be strict on this dictionary + -- The rest are distinguished only for debugging reasons + -- e.g. to suppress them in -ddump-types + -- Currently we don't persist these through interface file + -- (see MkIface.toIfaceIdDetails), but we easily could if it mattered + + | DefMethId -- ^ A default-method Id, either polymorphic or generic + + | ReflectionId -- ^ A top-level Id to support runtime reflection + -- e.g. $trModule, or $tcT + + | PatSynId -- ^ A top-level Id to support pattern synonyms; + -- the builder or matcher for the patern synonym + coVarDetails :: IdDetails coVarDetails = VanillaId @@ -145,6 +159,9 @@ pprIdDetails VanillaId = empty pprIdDetails other = brackets (pp other) where pp VanillaId = panic "pprIdDetails" + pp DefMethId = ptext (sLit "DefMethId") + pp ReflectionId = ptext (sLit "ReflectionId") + pp PatSynId = ptext (sLit "PatSynId") pp (DataConWorkId _) = ptext (sLit "DataCon") pp (DataConWrapId _) = ptext (sLit "DataConWrapper") pp (ClassOpId {}) = ptext (sLit "ClassOp") diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 714777a..697972a 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1875,8 +1875,17 @@ toIfaceIdDetails VanillaId = IfVanillaId toIfaceIdDetails (DFunId {}) = IfDFunId toIfaceIdDetails (RecSelId { sel_naughty = n , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n -toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other) - IfVanillaId -- Unexpected + + -- Currently we don't persist these three "advisory" IdInfos + -- through interface files. We easily could if it mattered +toIfaceIdDetails PatSynId = IfVanillaId +toIfaceIdDetails ReflectionId = IfVanillaId +toIfaceIdDetails DefMethId = IfVanillaId + + -- The remaining cases are all "implicit Ids" which don't + -- appear in interface files at all +toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other) + IfVanillaId -- Unexpected; the other toIfaceIdInfo :: IdInfo -> IfaceIdInfo toIfaceIdInfo id_info From git at git.haskell.org Thu Aug 27 07:13:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 07:13:50 +0000 (UTC) Subject: [commit: ghc] master: TysWiredIn: Shuffle code around (7bd8f8f) Message-ID: <20150827071350.837973A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/7bd8f8f820ab647a4acd1d8c9e30ef254324b4d9/ghc >--------------------------------------------------------------- commit 7bd8f8f820ab647a4acd1d8c9e30ef254324b4d9 Author: Ben Gamari Date: Wed Aug 26 18:19:31 2015 +0200 TysWiredIn: Shuffle code around >--------------------------------------------------------------- 7bd8f8f820ab647a4acd1d8c9e30ef254324b4d9 compiler/prelude/TysWiredIn.hs | 144 ++++++++++++++++++++--------------------- 1 file changed, 71 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 7bd8f8f820ab647a4acd1d8c9e30ef254324b4d9 From git at git.haskell.org Thu Aug 27 08:01:45 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 08:01:45 +0000 (UTC) Subject: [commit: ghc] master: base: Remove a redundant 'return' (15c63d2) Message-ID: <20150827080145.ABB443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15c63d2ac1983a72de20ec83b7263bf12b79ae49/ghc >--------------------------------------------------------------- commit 15c63d2ac1983a72de20ec83b7263bf12b79ae49 Author: Simon Peyton Jones Date: Thu Mar 26 11:06:12 2015 +0000 base: Remove a redundant 'return' >--------------------------------------------------------------- 15c63d2ac1983a72de20ec83b7263bf12b79ae49 libraries/base/Foreign/Marshal/Array.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/libraries/base/Foreign/Marshal/Array.hs b/libraries/base/Foreign/Marshal/Array.hs index 0aea67b..5e10341 100644 --- a/libraries/base/Foreign/Marshal/Array.hs +++ b/libraries/base/Foreign/Marshal/Array.hs @@ -211,8 +211,7 @@ withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b withArrayLen vals f = allocaArray len $ \ptr -> do pokeArray ptr vals - res <- f len ptr - return res + f len ptr where len = length vals From git at git.haskell.org Thu Aug 27 11:48:09 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 11:48:09 +0000 (UTC) Subject: [commit: ghc] branch 'wip/origin/wip/T9858-typeable-ben' created Message-ID: <20150827114809.401443A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/origin/wip/T9858-typeable-ben Referencing: c103116de68fd9f76be3fee20a927bbe729dbdbd From git at git.haskell.org Thu Aug 27 11:48:13 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 11:48:13 +0000 (UTC) Subject: [commit: ghc] wip/origin/wip/T9858-typeable-ben: Generate Typeable info at definition sites (c103116) Message-ID: <20150827114813.1FACD3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/origin/wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/c103116de68fd9f76be3fee20a927bbe729dbdbd/ghc >--------------------------------------------------------------- commit c103116de68fd9f76be3fee20a927bbe729dbdbd Author: Ben Gamari Date: Wed Aug 26 18:24:34 2015 +0200 Generate Typeable info at definition sites This patch implements the idea floated in Trac #9858, namely that we should generate type-representation information at the data type declaration site, rather than when solving a Typeable constraint. However, this turned out quite a bit harder than I expected. I still think it's the right thing to do, and it's done now, but it was quite a struggle. See particularly * Note [Grand plan for Typeable] in TcTypeable (which is a new module) * Note [The overall promotion story] in DataCon (clarifies existing stuff) The most painful bit was that to generate Typeable instances (ie TyConRepName bindings) for every TyCon is tricky for types in ghc-prim etc: * We need to have enough data types around to *define* a TyCon * Many of these types are wired-in Also, to minimise the code generated for each data type, I wanted to generate pure data, not CAFs with unpackCString# stuff floating about. Performance ~~~~~~~~~~~ Three perf/compiler tests start to allocate quite a bit more. This isn't surprising, because they all allocate zillions of data types, with practically no other code, esp. T1969 * T1969: GHC allocates 30% more * T5642: GHC allocates 14% more * T9872d: GHC allocates 5% more I'm treating this as acceptable. The payoff comes in Typeable-heavy code. Remaining to do ~~~~~~~~~~~~~~~ * I think that "TyCon" and "Module" are over-generic names to use for the runtime type representations used in GHC.Typeable. Better might be "TrTyCon" and "TrModule". But I have not yet done this * Add more info the the "TyCon" e.g. source location where it was defined * Use the new "Module" type to help with Trac Trac #10068 * It would be possible to generate TyConRepName (ie Typeable instances) selectively rather than all the time. We'd need to persist the information in interface files. Lacking a motivating reason I have not done this, but it would not be difficult. Refactoring ~~~~~~~~~~~ As is so often the case, I ended up refactoring more than I intended. In particular * In TyCon, a type *family* (whether type or data) is repesented by a FamilyTyCon * a algebraic data type (including data/newtype instances) is represented by AlgTyCon This wasn't true before; a data family was represented as an AlgTyCon. There are some corresponding changes in IfaceSyn. * Also get rid of the (unhelpfully named) tyConParent. * In TyCon define 'Promoted', isomorphic to Maybe, used when things are optionally promoted; and use it elsewhere in GHC. * Cleanup handling of knownKeyNames * Each TyCon, including promoted TyCons, contains its TyConRepName, if it has one. This is, in effect, the name of its Typeable instance. * Move mkDefaultMethodIds, mkRecSelBinds from TcTyClsDecls to TcTyDecls >--------------------------------------------------------------- c103116de68fd9f76be3fee20a927bbe729dbdbd compiler/basicTypes/DataCon.hs | 225 ++++++++++---- compiler/basicTypes/OccName.hs | 19 +- compiler/basicTypes/Unique.hs | 51 +++- compiler/coreSyn/CorePrep.hs | 2 +- compiler/deSugar/DsBinds.hs | 277 +++++++++-------- compiler/ghc.cabal.in | 1 + compiler/hsSyn/HsUtils.hs | 6 +- compiler/iface/BuildTyCl.hs | 54 ++-- compiler/iface/IfaceSyn.hs | 91 +++--- compiler/iface/MkIface.hs | 11 +- compiler/iface/TcIface.hs | 93 +++--- compiler/main/HscMain.hs | 12 +- compiler/main/HscTypes.hs | 12 +- compiler/prelude/PrelInfo.hs | 100 +++--- compiler/prelude/PrelNames.hs | 79 +++-- compiler/prelude/TysPrim.hs | 51 ++-- compiler/prelude/TysWiredIn.hs | 54 ++-- compiler/typecheck/TcBinds.hs | 35 ++- compiler/typecheck/TcEvidence.hs | 53 ++-- compiler/typecheck/TcGenGenerics.hs | 38 ++- compiler/typecheck/TcHsSyn.hs | 28 +- compiler/typecheck/TcHsType.hs | 8 +- compiler/typecheck/TcInstDcls.hs | 19 +- compiler/typecheck/TcInteract.hs | 172 ++++++----- compiler/typecheck/TcPatSyn.hs | 4 +- compiler/typecheck/TcRnDriver.hs | 40 +-- compiler/typecheck/TcRnMonad.hs | 2 +- compiler/typecheck/TcRnTypes.hs | 7 +- compiler/typecheck/TcTyClsDecls.hs | 329 ++++---------------- compiler/typecheck/TcTyDecls.hs | 330 +++++++++++++++----- compiler/typecheck/TcTypeNats.hs | 12 +- compiler/typecheck/TcTypeable.hs | 206 +++++++++++++ compiler/types/TyCon.hs | 406 ++++++++++++++----------- compiler/types/Type.hs | 9 + compiler/utils/Binary.hs | 11 +- compiler/vectorise/Vectorise/Generic/PData.hs | 4 +- compiler/vectorise/Vectorise/Type/Env.hs | 4 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 7 +- libraries/base/Data/Typeable.hs | 3 +- libraries/base/Data/Typeable/Internal.hs | 336 ++++++++++++-------- libraries/base/GHC/Show.hs | 10 + libraries/ghc-prim/GHC/Classes.hs | 36 ++- libraries/ghc-prim/GHC/IntWord64.hs | 3 + libraries/ghc-prim/GHC/Magic.hs | 2 + libraries/ghc-prim/GHC/Tuple.hs | 3 + libraries/ghc-prim/GHC/Types.hs | 52 +++- 46 files changed, 2010 insertions(+), 1297 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 c103116de68fd9f76be3fee20a927bbe729dbdbd From git at git.haskell.org Thu Aug 27 11:48:31 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 11:48:31 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben's head updated: Generate Typeable info at definition sites (c103116) Message-ID: <20150827114831.6BA6B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Branch 'wip/T9858-typeable-ben' now includes: b78494e fix 64bit two-stage allocator on Solaris/AMD64 platform (#10790) fba724c configure.ac: Allow disabling of large-address-space 1c643ba Fix algorithm.tex build and update with some new info. 0f3335f Comments and white space 816d48a Implement lookupGlobal in TcEnv, and use it 711e0bf tcRnDeclsi can use tcRnSrcDecls ac0d052 TcDeriv: Kill dead code de476e9 PrelNames: Clean up list a bit 89d25b9 BinIface: Clean up whitespace 7924469 Clean up handling of knownKeyNames a8601a8 Revert "Clean up handling of knownKeyNames" 28ad98e PrelNames: introduce dcQual in place of conName 211b349 Move newImplicitBinder to from IfaceEnv to BuildTyCl 70ea94c IfaceEnv: Clean up updNameCache a bit f6035bc MkIface: Introduce PatSynId, ReflectionId, DefMethId 7bd8f8f TysWiredIn: Shuffle code around c103116 Generate Typeable info at definition sites From git at git.haskell.org Thu Aug 27 11:52:14 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 11:52:14 +0000 (UTC) Subject: [commit: ghc] branch 'wip/origin/wip/T9858-typeable-ben' deleted Message-ID: <20150827115214.57E983A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: wip/origin/wip/T9858-typeable-ben From git at git.haskell.org Thu Aug 27 16:47:22 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 16:47:22 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Include constraint tuples in the known-key names (df730ca) Message-ID: <20150827164722.E9AFA3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/df730ca7185b6e140965d99aa29c89687a279bf3/ghc >--------------------------------------------------------------- commit df730ca7185b6e140965d99aa29c89687a279bf3 Author: Simon Peyton Jones Date: Thu Aug 27 17:48:38 2015 +0100 Include constraint tuples in the known-key names >--------------------------------------------------------------- df730ca7185b6e140965d99aa29c89687a279bf3 compiler/prelude/PrelInfo.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 9cfa78b..16f72e1 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -72,15 +72,26 @@ Notes about wired in things knownKeyNames :: [Name] --- This list is used to ensure that when you say "Prelude.map" in your --- source code, you get a Name with the correct known key +-- This list is used to ensure that when you say "Prelude.map" +-- in your source code, or in an interface file, +-- you get a Name with the correct known key -- (See Note [Known-key names] in PrelNames) knownKeyNames = concat [ tycon_kk_names funTyCon , concatMap tycon_kk_names primTyCons + , concatMap tycon_kk_names wiredInTyCons + -- Does not include tuples + , concatMap tycon_kk_names typeNatTyCons + , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk + + , cTupleTyConNames + -- Constraint tuples are known-key but not wired-in + -- They can't show up in source code, but can appear + -- in intreface files + , map idName wiredInIds , map (idName . primOpId) allThePrimOps , basicKnownKeyNames ] From git at git.haskell.org Thu Aug 27 16:47:25 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Thu, 27 Aug 2015 16:47:25 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Missing import (938b861) Message-ID: <20150827164725.B71203A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/938b86100f895584597feebae41bc50df4862232/ghc >--------------------------------------------------------------- commit 938b86100f895584597feebae41bc50df4862232 Author: Simon Peyton Jones Date: Thu Aug 27 17:48:56 2015 +0100 Missing import >--------------------------------------------------------------- 938b86100f895584597feebae41bc50df4862232 compiler/main/HscMain.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 41418fa..a3db501 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -95,6 +95,7 @@ import Type ( Type ) import {- Kind parts of -} Type ( Kind ) import CoreLint ( lintInteractiveExpr ) import VarEnv ( emptyTidyEnv ) +import THNames ( templateHaskellNames ) import Panic import ConLike From git at git.haskell.org Fri Aug 28 09:47:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Aug 2015 09:47:12 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Fix data family constructor (49a2c9d) Message-ID: <20150828094712.E65A33A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/49a2c9d753fd79e709e69fdbffd803d1f6a8ba84/ghc >--------------------------------------------------------------- commit 49a2c9d753fd79e709e69fdbffd803d1f6a8ba84 Author: Simon Peyton Jones Date: Fri Aug 28 10:47:40 2015 +0100 Fix data family constructor >--------------------------------------------------------------- 49a2c9d753fd79e709e69fdbffd803d1f6a8ba84 compiler/typecheck/TcSplice.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 7c9882b..961da3c 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1336,10 +1336,9 @@ reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys) reifyFamFlavour :: TyCon -> TcM (Either TH.FamFlavour [TH.TySynEqn]) reifyFamFlavour tc - | isOpenTypeFamilyTyCon tc = return $ Left TH.TypeFam - | isDataFamilyTyCon tc = return $ Left TH.DataFam | Just flav <- famTyConFlav_maybe tc = case flav of OpenSynFamilyTyCon -> return $ Left TH.TypeFam + DataFamilyTyCon {} -> return $ Left TH.TypeFam AbstractClosedSynFamilyTyCon -> return $ Right [] BuiltInSynFamTyCon _ -> return $ Right [] ClosedSynFamilyTyCon Nothing -> return $ Right [] @@ -1347,7 +1346,7 @@ reifyFamFlavour tc -> do { eqns <- brListMapM reifyAxBranch $ coAxiomBranches ax ; return $ Right eqns } | otherwise - = panic "TcSplice.reifyFamFlavour: not a type family" + = pprPanic "TcSplice.reifyFamFlavour: not a type family" (ppr tc) reifyTyVars :: [TyVar] -> TcM [TH.TyVarBndr] From git at git.haskell.org Fri Aug 28 09:47:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Aug 2015 09:47:15 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: More refactoring in matchClass (c69f421) Message-ID: <20150828094715.D34B53A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/c69f42122a3fd1c728ae31c77ce0feabdd7fac77/ghc >--------------------------------------------------------------- commit c69f42122a3fd1c728ae31c77ce0feabdd7fac77 Author: Simon Peyton Jones Date: Fri Aug 28 10:48:32 2015 +0100 More refactoring in matchClass This refactoring was unforced, but tidies up the structure so I can see what is happening. >--------------------------------------------------------------- c69f42122a3fd1c728ae31c77ce0feabdd7fac77 compiler/typecheck/TcInteract.hs | 305 +++++++++++++++++++++------------------ 1 file changed, 168 insertions(+), 137 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 c69f42122a3fd1c728ae31c77ce0feabdd7fac77 From git at git.haskell.org Fri Aug 28 11:08:12 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Aug 2015 11:08:12 +0000 (UTC) Subject: [commit: ghc] branch 'wip/T10803' created Message-ID: <20150828110812.401943A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : wip/T10803 Referencing: 4c57c8a9ccb98704e4ff26d734960b8f07c78c58 From git at git.haskell.org Fri Aug 28 11:08:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Aug 2015 11:08:15 +0000 (UTC) Subject: [commit: ghc] wip/T10803: First part of implementing TypeSignatureSections (4c57c8a) Message-ID: <20150828110815.0D40B3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10803 Link : http://ghc.haskell.org/trac/ghc/changeset/4c57c8a9ccb98704e4ff26d734960b8f07c78c58/ghc >--------------------------------------------------------------- commit 4c57c8a9ccb98704e4ff26d734960b8f07c78c58 Author: Herbert Valerio Riedel Date: Fri Aug 28 13:09:26 2015 +0200 First part of implementing TypeSignatureSections See #10803 >--------------------------------------------------------------- 4c57c8a9ccb98704e4ff26d734960b8f07c78c58 compiler/hsSyn/HsExpr.hs | 7 +++++++ compiler/parser/Parser.y | 1 + compiler/rename/RnExpr.hs | 13 +++++++++++++ compiler/typecheck/TcExpr.hs | 3 +++ 4 files changed, 24 insertions(+) diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 8b8b9df..1acc31a 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -187,6 +187,10 @@ data HsExpr id | SectionR (LHsExpr id) -- operator; see Note [Sections in HsSyn] (LHsExpr id) -- operand + + | TySigSection (LHsType id) (PostRn id [Name]) + + -- | Used for explicit tuples and sections thereof -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', @@ -643,6 +647,9 @@ ppr_expr (SectionR op expr) 4 (pp_expr <> rparen) pp_infixly v = sep [pprInfixOcc v, pp_expr] +ppr_expr (TySigSection sig _) + = hang dcolon 4 (ppr sig) + ppr_expr (ExplicitTuple exprs boxity) = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs)) where diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 1b4df16..e8716b0 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2327,6 +2327,7 @@ texp :: { LHsExpr RdrName } -- inside parens. | infixexp qop { sLL $1 $> $ SectionL $1 $2 } | qopm infixexp { sLL $1 $> $ SectionR $1 $2 } + | '::' sigtype { sLL $1 $> $ TySigSection $2 PlaceHolder } -- View patterns get parenthesized above | exp '->' texp {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] } diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index da0d387..9b36b06 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -176,6 +176,10 @@ rnExpr (HsPar (L loc (section@(SectionR {})))) = do { (section', fvs) <- rnSection section ; return (HsPar (L loc section'), fvs) } +rnExpr (HsPar (L loc (section@(TySigSection {})))) + = do { (section', fvs) <- rnSection section + ; return (HsPar (L loc section'), fvs) } + rnExpr (HsPar e) = do { (e', fvs_e) <- rnLExpr e ; return (HsPar e', fvs_e) } @@ -184,6 +188,9 @@ rnExpr expr@(SectionL {}) = do { addErr (sectionErr expr); rnSection expr } rnExpr expr@(SectionR {}) = do { addErr (sectionErr expr); rnSection expr } +rnExpr expr@(TySigSection {}) + = do { addErr (sectionErr expr); rnSection expr } + --------------------------------------------- rnExpr (HsCoreAnn src ann expr) @@ -400,6 +407,12 @@ rnSection section@(SectionL expr op) ; checkSectionPrec InfixL section op' expr' ; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) } +rnSection (TySigSection pty PlaceHolder) + = do { (wcs, pty') <- extractWildcards pty + ; bindLocatedLocalsFV wcs $ \wcs_new -> do { + (pty'', fvTy) <- rnLHsType ExprWithTySigCtx pty' + ; return (TySigSection pty'' wcs_new, fvTy) } } + rnSection other = pprPanic "rnSection" (ppr other) {- diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index d2b0c59..02b500d 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -373,6 +373,9 @@ tcExpr (SectionL arg1 op) res_ty ; return $ mkHsWrapCo co_res $ SectionL arg1' (mkLHsWrapCo co_fn op') } +tcExpr (TySigSection sig_ty wcs) res_ty + = error "NOT IMPLEMENTED YET" -- TODO + tcExpr (ExplicitTuple tup_args boxity) res_ty | all tupArgPresent tup_args = do { let tup_tc = tupleTyCon boxity (length tup_args) From git at git.haskell.org Fri Aug 28 14:22:26 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Aug 2015 14:22:26 +0000 (UTC) Subject: [commit: ghc] wip/T9858-typeable-ben: Make the generated GHC.Prim module import GHC.Tuple (108faf9) Message-ID: <20150828142226.E8E743A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T9858-typeable-ben Link : http://ghc.haskell.org/trac/ghc/changeset/108faf9fdc0225aedde4af7fecd1df432220fee5/ghc >--------------------------------------------------------------- commit 108faf9fdc0225aedde4af7fecd1df432220fee5 Author: Simon Peyton Jones Date: Fri Aug 28 15:24:02 2015 +0100 Make the generated GHC.Prim module import GHC.Tuple See Note [Import GHC.Tuple into GHC.Prim] in genprimopcode/Main.hs I think this has been a lurking bug for ages. Lacking it, Haddock's invocation of GHC for the ghc-prim library says Checking module GHC.Prim... attempting to use module ?GHC.Tuple? (libraries/ghc-prim/./GHC/Tuple.hs) which is not loaded >--------------------------------------------------------------- 108faf9fdc0225aedde4af7fecd1df432220fee5 utils/genprimopcode/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 2a5218e..3ab8ff8 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -262,6 +262,16 @@ gen_hs_source (Info defaults entries) = ++ "-}\n" ++ "import GHC.Types (Coercible)\n" + ++ "import GHC.Tuple ()\n" + -- Note [Import GHC.Tuple into GHC.Prim] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- This expresses a dependency on GHC.Tuple, which we need + -- to ensure that GHC.Tuple is compiled first. The generated + -- code in this module mentions '()', and that in turn tries + -- to ensure that its home module is loaded (for instances I think) + -- So it had better be there, when compiling with --make or Haddock. + -- It's more kosher anyway to be explicit about the dependency. + ++ "default ()" -- If we don't say this then the default type include Integer -- so that runs off and loads modules that are not part of -- pacakge ghc-prim at all. And that in turn somehow ends up From git at git.haskell.org Fri Aug 28 15:35:08 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Aug 2015 15:35:08 +0000 (UTC) Subject: [commit: ghc] wip/T10803: First part of implementing TypeSignatureSections (75cf1ef) Message-ID: <20150828153508.5D91C3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : wip/T10803 Link : http://ghc.haskell.org/trac/ghc/changeset/75cf1ef06c1c7b47bd543d3acab003938b51ae5c/ghc >--------------------------------------------------------------- commit 75cf1ef06c1c7b47bd543d3acab003938b51ae5c Author: Herbert Valerio Riedel Date: Fri Aug 28 13:09:26 2015 +0200 First part of implementing TypeSignatureSections See #10803 >--------------------------------------------------------------- 75cf1ef06c1c7b47bd543d3acab003938b51ae5c compiler/deSugar/DsExpr.hs | 6 ++++++ compiler/hsSyn/HsExpr.hs | 16 ++++++++++++++++ compiler/parser/Parser.y | 1 + compiler/rename/RnExpr.hs | 11 +++++++++++ compiler/typecheck/TcExpr.hs | 9 +++++++++ compiler/typecheck/TcHsSyn.hs | 4 ++++ 6 files changed, 47 insertions(+) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 433a13e..f4d92e1 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -276,6 +276,11 @@ dsExpr (SectionR op expr) = do return (bindNonRec y_id y_core $ Lam x_id (mkCoreAppsDs core_op [Var x_id, Var y_id])) +dsExpr (TySigSectionOut _ ty co) = do + -- (\(x:ty) -> x) |> co + arg_var <- newSysLocalDs ty + return $ Lam arg_var (Var arg_var) + dsExpr (ExplicitTuple tup_args boxity) = do { let go (lam_vars, args) (L _ (Missing ty)) -- For every missing expression, we need @@ -673,6 +678,7 @@ dsExpr (HsTickPragma _ _ expr) = do -- HsSyn constructs that just shouldn't be here: dsExpr (ExprWithTySig {}) = panic "dsExpr:ExprWithTySig" +dsExpr (TySigSection {}) = panic "dsExpr:TySigSection" dsExpr (HsBracket {}) = panic "dsExpr:HsBracket" dsExpr (HsArrApp {}) = panic "dsExpr:HsArrApp" dsExpr (HsArrForm {}) = panic "dsExpr:HsArrForm" diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 8b8b9df..79d7611 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -36,6 +36,7 @@ import StaticFlags( opt_PprStyle_Debug ) import Outputable import FastString import Type +import Coercion -- libraries: import Data.Data hiding (Fixity) @@ -187,6 +188,15 @@ data HsExpr id | SectionR (LHsExpr id) -- operator; see Note [Sections in HsSyn] (LHsExpr id) -- operand + -- | Type-signature operator sections + + | TySigSection (LHsType id) + (PostRn id [Name]) -- wildcards + + | TySigSectionOut (LHsType Name) + (PostTc id Type) + (PostTc id Coercion) + -- | Used for explicit tuples and sections thereof -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', @@ -643,6 +653,12 @@ ppr_expr (SectionR op expr) 4 (pp_expr <> rparen) pp_infixly v = sep [pprInfixOcc v, pp_expr] +ppr_expr (TySigSection sig _) + = hang dcolon 4 (ppr sig) + +ppr_expr (TySigSectionOut sig _ _) + = hang dcolon 4 (ppr sig) + ppr_expr (ExplicitTuple exprs boxity) = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs)) where diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 1b4df16..e8716b0 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2327,6 +2327,7 @@ texp :: { LHsExpr RdrName } -- inside parens. | infixexp qop { sLL $1 $> $ SectionL $1 $2 } | qopm infixexp { sLL $1 $> $ SectionR $1 $2 } + | '::' sigtype { sLL $1 $> $ TySigSection $2 PlaceHolder } -- View patterns get parenthesized above | exp '->' texp {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] } diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index da0d387..85ef82d 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -176,6 +176,10 @@ rnExpr (HsPar (L loc (section@(SectionR {})))) = do { (section', fvs) <- rnSection section ; return (HsPar (L loc section'), fvs) } +rnExpr (HsPar (L loc (section@(TySigSection {})))) + = do { (section', fvs) <- rnSection section + ; return (HsPar (L loc section'), fvs) } + rnExpr (HsPar e) = do { (e', fvs_e) <- rnLExpr e ; return (HsPar e', fvs_e) } @@ -184,6 +188,9 @@ rnExpr expr@(SectionL {}) = do { addErr (sectionErr expr); rnSection expr } rnExpr expr@(SectionR {}) = do { addErr (sectionErr expr); rnSection expr } +rnExpr expr@(TySigSection {}) + = do { addErr (sectionErr expr); rnSection expr } + --------------------------------------------- rnExpr (HsCoreAnn src ann expr) @@ -400,6 +407,10 @@ rnSection section@(SectionL expr op) ; checkSectionPrec InfixL section op' expr' ; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) } +rnSection (TySigSection pty PlaceHolder) + = do { (pty', fvTy, wcs) <- rnLHsTypeWithWildCards ExprWithTySigCtx pty + ; return (TySigSection pty' wcs, fvTy) } + rnSection other = pprPanic "rnSection" (ppr other) {- diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index d2b0c59..a71b493 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -373,6 +373,15 @@ tcExpr (SectionL arg1 op) res_ty ; return $ mkHsWrapCo co_res $ SectionL arg1' (mkLHsWrapCo co_fn op') } +tcExpr (TySigSection sig_ty wcs) res_ty + = tcWildcardBinders wcs $ \ wc_prs -> + do { addErrCtxt (pprSigCtxt ExprSigCtxt empty (ppr sig_ty)) $ + emitWildcardHoleConstraints wc_prs + ; sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty + ; co <- unifyType (mkFunTy sig_tc_ty sig_tc_ty) res_ty -- TcM TcCoercion + ; return $ mkHsWrapCo co (TySigSectionOut sig_ty res_ty (panic "FIXME")) + } + tcExpr (ExplicitTuple tup_args boxity) res_ty | all tupArgPresent tup_args = do { let tup_tc = tupleTyCon boxity (length tup_args) diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index c461d51..b7e1fae 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -651,6 +651,10 @@ zonkExpr env (SectionR op expr) new_expr <- zonkLExpr env expr return (SectionR new_op new_expr) +-- FIXME: is this really right? +zonkExpr env (tysig at TySigSectionOut {}) = pure tysig +zonkExpr env (tysig at TySigSection {}) = panic "zonkExpr TySigSection" + zonkExpr env (ExplicitTuple tup_args boxed) = do { new_tup_args <- mapM zonk_tup_arg tup_args ; return (ExplicitTuple new_tup_args boxed) } From git at git.haskell.org Fri Aug 28 16:51:44 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Fri, 28 Aug 2015 16:51:44 +0000 (UTC) Subject: [commit: ghc] master: RTS: Reduce MBLOCK_SPACE_SIZE on AArch64 (38c98e4) Message-ID: <20150828165144.E97E23A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/38c98e4f61a48084995a5347d76ddd024ce1a09c/ghc >--------------------------------------------------------------- commit 38c98e4f61a48084995a5347d76ddd024ce1a09c Author: Erik de Castro Lopo Date: Tue Aug 25 02:07:45 2015 +0000 RTS: Reduce MBLOCK_SPACE_SIZE on AArch64 Commit 0d1a8d09f4 added a two step allocator for 64 bit systems. This allocator mmaps a huge (1 TB) chunk of memory out of which it does smaller allocations. On AArch64/Arm64 linux, this mmap was failing due to the Arm64 Linux kernel parameter CONFIG_ARM64_VA_BITS defaulting to 39 bits. Therefore reducing the AArch64 value for MBLOCK_SPACE_SIZE to make this allocation 1/4 TB while remaining 1 TB for other archs. Reviewers: ezyang, austin, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1171 GHC Trac Issues: #10682 >--------------------------------------------------------------- 38c98e4f61a48084995a5347d76ddd024ce1a09c rts/sm/HeapAlloc.h | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/rts/sm/HeapAlloc.h b/rts/sm/HeapAlloc.h index c914b5d..f2760bd 100644 --- a/rts/sm/HeapAlloc.h +++ b/rts/sm/HeapAlloc.h @@ -52,7 +52,12 @@ #ifdef USE_LARGE_ADDRESS_SPACE extern W_ mblock_address_space_begin; +#if aarch64_HOST_ARCH +# define MBLOCK_SPACE_SIZE ((StgWord)1 << 38) /* 1/4 TB */ +#else # define MBLOCK_SPACE_SIZE ((StgWord)1 << 40) /* 1 TB */ +#endif + # define HEAP_ALLOCED(p) ((W_)(p) >= mblock_address_space_begin && \ (W_)(p) < (mblock_address_space_begin + \ MBLOCK_SPACE_SIZE)) From git at git.haskell.org Sat Aug 29 11:25:36 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:36 +0000 (UTC) Subject: [commit: ghc] master: Respect GHC_CHARENC environment variable #10762 (1b56c40) Message-ID: <20150829112536.D1F0D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/1b56c40578374a15b4a2593895710c68b0e2a717/ghc >--------------------------------------------------------------- commit 1b56c40578374a15b4a2593895710c68b0e2a717 Author: Michael Snoyman Date: Sat Aug 29 12:23:48 2015 +0200 Respect GHC_CHARENC environment variable #10762 Only supports UTF-8 as a value right now. I expect some discussion to go on around the naming of this variable and whether it's valid to backport it to GHC 7.10 (which would be my preference). The motivation here is that, when capturing the output of GHC to a file, we often want to ensure that the output is UTF-8, regardless of the actual character encoding of the terminal/console. On the other hand, we don't want to necessary change the terminal/console encoding. The reason being: * On Windows, this requires a global-esque change to the console codepage, which adversely affects other processes in the same console * On all OSes, this can break features like smart quote auto-detection. Test Plan: Set LANG to C, GHC_CHARENC to UTF-8, and compile a Haskell source file with a non-ASCII warning produced. The output who include the UTF-8 sequence instead of replacing it with ?. Reviewers: austin, rwbarton, bgamari Reviewed By: bgamari Subscribers: hsyl20, thomie Differential Revision: https://phabricator.haskell.org/D1167 GHC Trac Issues: #10762 >--------------------------------------------------------------- 1b56c40578374a15b4a2593895710c68b0e2a717 ghc/Main.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/ghc/Main.hs b/ghc/Main.hs index ed2ac67..a1a4ecc 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -80,8 +80,18 @@ main = do initGCStatistics -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering - hSetTranslit stdout - hSetTranslit stderr + + -- Handle GHC-specific character encoding flags, allowing us to control how + -- GHC produces output regardless of OS. + env <- getEnvironment + case lookup "GHC_CHARENC" env of + Just "UTF-8" -> do + hSetEncoding stdout utf8 + hSetEncoding stderr utf8 + _ -> do + -- Avoid GHC erroring out when trying to display unhandled characters + hSetTranslit stdout + hSetTranslit stderr GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do -- 1. extract the -B flag from the args From git at git.haskell.org Sat Aug 29 11:25:40 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:40 +0000 (UTC) Subject: [commit: ghc] master: Add testcase for #7411 (15cb83d) Message-ID: <20150829112540.787753A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/15cb83d4e98c2c356bf0e3eb0df6d322755337bd/ghc >--------------------------------------------------------------- commit 15cb83d4e98c2c356bf0e3eb0df6d322755337bd Author: Ben Gamari Date: Thu Aug 27 15:04:29 2015 +0200 Add testcase for #7411 >--------------------------------------------------------------- 15cb83d4e98c2c356bf0e3eb0df6d322755337bd testsuite/tests/simplCore/should_fail/T7411.hs | 3 +++ testsuite/tests/simplCore/should_fail/T7411.stderr | 2 ++ testsuite/tests/simplCore/should_fail/all.T | 3 +++ 3 files changed, 8 insertions(+) diff --git a/testsuite/tests/simplCore/should_fail/T7411.hs b/testsuite/tests/simplCore/should_fail/T7411.hs new file mode 100644 index 0000000..10bc0b3 --- /dev/null +++ b/testsuite/tests/simplCore/should_fail/T7411.hs @@ -0,0 +1,3 @@ +import Control.Exception +import Control.DeepSeq +main = evaluate (('a' : undefined) `deepseq` return () :: IO ()) diff --git a/testsuite/tests/simplCore/should_fail/T7411.stderr b/testsuite/tests/simplCore/should_fail/T7411.stderr new file mode 100644 index 0000000..c02ad80 --- /dev/null +++ b/testsuite/tests/simplCore/should_fail/T7411.stderr @@ -0,0 +1,2 @@ +T7411: Prelude.undefined + diff --git a/testsuite/tests/simplCore/should_fail/all.T b/testsuite/tests/simplCore/should_fail/all.T new file mode 100644 index 0000000..8e9e45a --- /dev/null +++ b/testsuite/tests/simplCore/should_fail/all.T @@ -0,0 +1,3 @@ +test('T7411', [expect_broken_for(7411, ['optasm', 'optllvm', + 'hpc', 'threaded2', 'dyn']), + exit_code(1)], compile_and_run, ['']) \ No newline at end of file From git at git.haskell.org Sat Aug 29 11:25:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:43 +0000 (UTC) Subject: [commit: ghc] master: Dwarf: Fix DW_AT_use_UTF8 attribute (81ae26d) Message-ID: <20150829112543.57C963A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/81ae26d3d18803ac87cf5f72b7c313793df8312c/ghc >--------------------------------------------------------------- commit 81ae26d3d18803ac87cf5f72b7c313793df8312c Author: Ben Gamari Date: Sat Aug 29 12:24:14 2015 +0200 Dwarf: Fix DW_AT_use_UTF8 attribute Previously this was given in the body but not in the abbreviation table. Who knows what sort of havoc this was wrecking. Test Plan: Verify against DWARF4 specification Reviewers: scpmw, austin Subscribers: Tarrasch, thomie Differential Revision: https://phabricator.haskell.org/D1172 >--------------------------------------------------------------- 81ae26d3d18803ac87cf5f72b7c313793df8312c compiler/nativeGen/Dwarf/Constants.hs | 3 ++- compiler/nativeGen/Dwarf/Types.hs | 8 ++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/compiler/nativeGen/Dwarf/Constants.hs b/compiler/nativeGen/Dwarf/Constants.hs index 4b334fc..333d670 100644 --- a/compiler/nativeGen/Dwarf/Constants.hs +++ b/compiler/nativeGen/Dwarf/Constants.hs @@ -60,13 +60,14 @@ dW_CHILDREN_no = 0 dW_CHILDREN_yes = 1 dW_FORM_addr, dW_FORM_data4, dW_FORM_string, dW_FORM_flag, - dW_FORM_block1, dW_FORM_ref4 :: Word + dW_FORM_block1, dW_FORM_ref4, dW_FORM_flag_present :: Word dW_FORM_addr = 0x01 dW_FORM_data4 = 0x06 dW_FORM_string = 0x08 dW_FORM_flag = 0x0c dW_FORM_block1 = 0x0a dW_FORM_ref4 = 0x13 +dW_FORM_flag_present = 0x19 -- | Dwarf native types dW_ATE_address, dW_ATE_boolean, dW_ATE_float, dW_ATE_signed, diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs index 00d0535..f9262b4 100644 --- a/compiler/nativeGen/Dwarf/Types.hs +++ b/compiler/nativeGen/Dwarf/Types.hs @@ -66,7 +66,8 @@ pprAbbrev :: DwarfAbbrev -> SDoc pprAbbrev = pprLEBWord . fromIntegral . fromEnum -- | Abbreviation declaration. This explains the binary encoding we --- use for representing @DwarfInfo at . +-- use for representing 'DwarfInfo'. Be aware that this must be updated +-- along with 'pprDwarfInfo'. pprAbbrevDecls :: Bool -> SDoc pprAbbrevDecls haveDebugLine = let mkAbbrev abbr tag chld flds = @@ -76,11 +77,11 @@ pprAbbrevDecls haveDebugLine = in dwarfAbbrevSection $$ ptext dwarfAbbrevLabel <> colon $$ mkAbbrev DwAbbrCompileUnit dW_TAG_compile_unit dW_CHILDREN_yes - ([ (dW_AT_name, dW_FORM_string) + ([(dW_AT_name, dW_FORM_string) , (dW_AT_producer, dW_FORM_string) , (dW_AT_language, dW_FORM_data4) , (dW_AT_comp_dir, dW_FORM_string) - , (dW_AT_use_UTF8, dW_FORM_flag) + , (dW_AT_use_UTF8, dW_FORM_flag_present) -- not represented in body ] ++ (if haveDebugLine then [ (dW_AT_stmt_list, dW_FORM_data4) ] @@ -117,7 +118,6 @@ pprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lineLbl) = $$ pprString producer $$ pprData4 dW_LANG_Haskell $$ pprString compDir - $$ pprFlag True -- use UTF8 $$ if haveSrc then sectionOffset lineLbl dwarfLineLabel else empty From git at git.haskell.org Sat Aug 29 11:25:46 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:46 +0000 (UTC) Subject: [commit: ghc] master: Make Generic (Proxy t) instance poly-kinded (fixes #10775) (a6826c5) Message-ID: <20150829112546.212193A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/a6826c5d18675a783acce39352eea283e462bf8b/ghc >--------------------------------------------------------------- commit a6826c5d18675a783acce39352eea283e462bf8b Author: RyanGlScott Date: Sat Aug 29 12:23:31 2015 +0200 Make Generic (Proxy t) instance poly-kinded (fixes #10775) This amounts to enabling PolyKinds in GHC.Generics. However, explicit kind signatures must be applied to the datatypes and typeclasses in GHC.Generics to ensure that the Core which TcGenGenerics generates is properly kinded. Several of the typeclasses in GHC.Generics could be poly-kinded, but this differential does not attempt to address this, since D493 already addresses this. Test Plan: ./validate Reviewers: hvr, austin, dreixel, bgamari Reviewed By: austin, dreixel, bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D1166 GHC Trac Issues: #10775 >--------------------------------------------------------------- a6826c5d18675a783acce39352eea283e462bf8b libraries/base/GHC/Generics.hs | 39 ++++++++++++++++++++------------------- libraries/base/changelog.md | 2 ++ 2 files changed, 22 insertions(+), 19 deletions(-) diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 0b4ebc6..d98533b 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -7,6 +7,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE PolyKinds #-} ----------------------------------------------------------------------------- -- | @@ -576,10 +577,10 @@ import Data.Proxy -------------------------------------------------------------------------------- -- | Void: used for datatypes without constructors -data V1 p +data V1 (p :: *) -- | Unit: used for constructors without arguments -data U1 p = U1 +data U1 (p :: *) = U1 deriving (Eq, Ord, Read, Show, Generic) -- | Used for marking occurrences of the parameter @@ -587,30 +588,30 @@ newtype Par1 p = Par1 { unPar1 :: p } deriving (Eq, Ord, Read, Show, Generic) -- | Recursive calls of kind * -> * -newtype Rec1 f p = Rec1 { unRec1 :: f p } +newtype Rec1 f (p :: *) = Rec1 { unRec1 :: f p } deriving (Eq, Ord, Read, Show, Generic) -- | Constants, additional parameters and recursion of kind * -newtype K1 i c p = K1 { unK1 :: c } +newtype K1 (i :: *) c (p :: *) = K1 { unK1 :: c } deriving (Eq, Ord, Read, Show, Generic) -- | Meta-information (constructor names, etc.) -newtype M1 i c f p = M1 { unM1 :: f p } +newtype M1 (i :: *) (c :: *) f (p :: *) = M1 { unM1 :: f p } deriving (Eq, Ord, Read, Show, Generic) -- | Sums: encode choice between constructors infixr 5 :+: -data (:+:) f g p = L1 (f p) | R1 (g p) +data (:+:) f g (p :: *) = L1 (f p) | R1 (g p) deriving (Eq, Ord, Read, Show, Generic) -- | Products: encode multiple arguments to constructors infixr 6 :*: -data (:*:) f g p = f p :*: g p +data (:*:) f g (p :: *) = f p :*: g p deriving (Eq, Ord, Read, Show, Generic) -- | Composition of functors infixr 7 :.: -newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) } +newtype (:.:) f (g :: * -> *) (p :: *) = Comp1 { unComp1 :: f (g p) } deriving (Eq, Ord, Read, Show, Generic) -- | Tag for K1: recursion (of kind *) @@ -643,22 +644,22 @@ type S1 = M1 S -- | Class for datatypes that represent datatypes -class Datatype d where +class Datatype (d :: *) where -- | The name of the datatype (unqualified) - datatypeName :: t d (f :: * -> *) a -> [Char] + datatypeName :: t d (f :: * -> *) (a :: *) -> [Char] -- | The fully-qualified name of the module where the type is declared - moduleName :: t d (f :: * -> *) a -> [Char] + moduleName :: t d (f :: * -> *) (a :: *) -> [Char] -- | The package name of the module where the type is declared - packageName :: t d (f :: * -> *) a -> [Char] + packageName :: t d (f :: * -> *) (a :: *) -> [Char] -- | Marks if the datatype is actually a newtype - isNewtype :: t d (f :: * -> *) a -> Bool + isNewtype :: t d (f :: * -> *) (a :: *) -> Bool isNewtype _ = False -- | Class for datatypes that represent records -class Selector s where +class Selector (s :: *) where -- | The name of the selector - selName :: t s (f :: * -> *) a -> [Char] + selName :: t s (f :: * -> *) (a :: *) -> [Char] -- | Used for constructor fields without a name data NoSelector @@ -666,16 +667,16 @@ data NoSelector instance Selector NoSelector where selName _ = "" -- | Class for datatypes that represent data constructors -class Constructor c where +class Constructor (c :: *) where -- | The name of the constructor - conName :: t c (f :: * -> *) a -> [Char] + conName :: t c (f :: * -> *) (a :: *) -> [Char] -- | The fixity of the constructor - conFixity :: t c (f :: * -> *) a -> Fixity + conFixity :: t c (f :: * -> *) (a :: *) -> Fixity conFixity _ = Prefix -- | Marks if this constructor is a record - conIsRecord :: t c (f :: * -> *) a -> Bool + conIsRecord :: t c (f :: * -> *) (a :: *) -> Bool conIsRecord _ = False diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 9ceef87..51a1de9 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -56,6 +56,8 @@ * Made `PatternMatchFail`, `RecSelError`, `RecConError`, `RecUpdError`, `NoMethodError`, and `AssertionFailed` newtypes (#10738) + * The `Generic` instance for `Proxy` is now poly-kinded (#10775) + ## 4.8.1.0 *Jul 2015* * Bundled with GHC 7.10.2 From git at git.haskell.org Sat Aug 29 11:25:49 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:49 +0000 (UTC) Subject: [commit: ghc] master: Dwarf: Produce {low, high}_pc attributes for compilation units (cbf58a2) Message-ID: <20150829112549.0605D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cbf58a217785acf519a3129916a5e9bb98a7b268/ghc >--------------------------------------------------------------- commit cbf58a217785acf519a3129916a5e9bb98a7b268 Author: Ben Gamari Date: Sat Aug 29 12:24:54 2015 +0200 Dwarf: Produce {low,high}_pc attributes for compilation units Some libraries (e.g. elfutils) need these otherwise they ignore our DWARF annotations. Test Plan: Test with elfutils' `readelf --debug-dump=cu_index` Reviewers: scpmw, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1173 >--------------------------------------------------------------- cbf58a217785acf519a3129916a5e9bb98a7b268 compiler/nativeGen/Dwarf.hs | 6 +++++- compiler/nativeGen/Dwarf/Types.hs | 9 ++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs index 34f1ed6..273949e 100644 --- a/compiler/nativeGen/Dwarf.hs +++ b/compiler/nativeGen/Dwarf.hs @@ -30,6 +30,7 @@ import qualified Compiler.Hoopl as H -- | Generate DWARF/debug information dwarfGen :: DynFlags -> ModLocation -> UniqSupply -> [DebugBlock] -> IO (SDoc, UniqSupply) +dwarfGen _ _ us [] = return (empty, us) dwarfGen df modLoc us blocks = do -- Convert debug data structures to DWARF info records @@ -43,6 +44,8 @@ dwarfGen df modLoc us blocks = do , dwName = fromMaybe "" (ml_hs_file modLoc) , dwCompDir = addTrailingPathSeparator compPath , dwProducer = cProjectName ++ " " ++ cProjectVersion + , dwLowLabel = dblCLabel $ head procs + , dwHighLabel = mkAsmTempEndLabel $ dblCLabel $ last procs , dwLineLabel = dwarfLineLabel } @@ -57,7 +60,8 @@ dwarfGen df modLoc us blocks = do let abbrevSct = pprAbbrevDecls haveSrc -- .debug_info section: Information records on procedures and blocks - let (unitU, us') = takeUniqFromSupply us + let -- unique to identify start and end compilation unit .debug_inf + (unitU, us') = takeUniqFromSupply us infoSct = vcat [ dwarfInfoSection , compileUnitHeader unitU , pprDwarfInfo haveSrc dwarfUnit diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs index f9262b4..9a600bd 100644 --- a/compiler/nativeGen/Dwarf/Types.hs +++ b/compiler/nativeGen/Dwarf/Types.hs @@ -44,6 +44,8 @@ data DwarfInfo , dwName :: String , dwProducer :: String , dwCompDir :: String + , dwLowLabel :: CLabel + , dwHighLabel :: CLabel , dwLineLabel :: LitString } | DwarfSubprogram { dwChildren :: [DwarfInfo] , dwName :: String @@ -82,6 +84,8 @@ pprAbbrevDecls haveDebugLine = , (dW_AT_language, dW_FORM_data4) , (dW_AT_comp_dir, dW_FORM_string) , (dW_AT_use_UTF8, dW_FORM_flag_present) -- not represented in body + , (dW_AT_low_pc, dW_FORM_addr) + , (dW_AT_high_pc, dW_FORM_addr) ] ++ (if haveDebugLine then [ (dW_AT_stmt_list, dW_FORM_data4) ] @@ -112,12 +116,15 @@ pprDwarfInfo haveSrc d -- that the binary format of this is paramterized in @abbrevDecls@ and -- has to be kept in synch. pprDwarfInfoOpen :: Bool -> DwarfInfo -> SDoc -pprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lineLbl) = +pprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lowLabel + highLabel lineLbl) = pprAbbrev DwAbbrCompileUnit $$ pprString name $$ pprString producer $$ pprData4 dW_LANG_Haskell $$ pprString compDir + $$ pprWord (ppr lowLabel) + $$ pprWord (ppr highLabel) $$ if haveSrc then sectionOffset lineLbl dwarfLineLabel else empty From git at git.haskell.org Sat Aug 29 11:25:51 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:51 +0000 (UTC) Subject: [commit: ghc] master: Dwarf: Produce .dwarf_aranges section (8476ce2) Message-ID: <20150829112551.D46FB3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/8476ce24c77f4323bd4e03552d3d1513318589f4/ghc >--------------------------------------------------------------- commit 8476ce24c77f4323bd4e03552d3d1513318589f4 Author: Ben Gamari Date: Sat Aug 29 12:25:04 2015 +0200 Dwarf: Produce .dwarf_aranges section Test Plan: Check with `readelf --debug-dump=ranges` Reviewers: scpmw, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1174 >--------------------------------------------------------------- 8476ce24c77f4323bd4e03552d3d1513318589f4 compiler/nativeGen/Dwarf.hs | 28 +++++++++++------ compiler/nativeGen/Dwarf/Constants.hs | 13 ++++---- compiler/nativeGen/Dwarf/Types.hs | 57 ++++++++++++++++++++++++++++++++--- 3 files changed, 77 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 8476ce24c77f4323bd4e03552d3d1513318589f4 From git at git.haskell.org Sat Aug 29 11:25:54 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:54 +0000 (UTC) Subject: [commit: ghc] master: integer-gmp: optimise bitBigNat (c7f0626) Message-ID: <20150829112554.9FCFE3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c7f0626699998fe16871fd442e4199b48cbefb35/ghc >--------------------------------------------------------------- commit c7f0626699998fe16871fd442e4199b48cbefb35 Author: Herbert Valerio Riedel Date: Sat Aug 29 12:25:45 2015 +0200 integer-gmp: optimise bitBigNat This is a somewhat minor optimisation exploiting the static knowledge of the operands involved allowing to save a few allocations. Reviewers: austin, rwbarton, goldfire, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1179 >--------------------------------------------------------------- c7f0626699998fe16871fd442e4199b48cbefb35 libraries/integer-gmp/src/GHC/Integer/Type.hs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index a04d9ad..fd7901a 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -1014,8 +1014,25 @@ timesBigNatWord x@(BN# x#) y# where nx# = sizeofBigNat# x +-- | Specialised version of +-- +-- > bitBigNat = shiftLBigNat (wordToBigNat 1##) +-- +-- avoiding a few redundant allocations bitBigNat :: Int# -> BigNat -bitBigNat i# = shiftLBigNat (wordToBigNat 1##) i# -- FIXME +bitBigNat i# + | isTrue# (i# <# 0#) = zeroBigNat -- or maybe 'nullBigNat'? + | isTrue# (i# ==# 0#) = oneBigNat + | True = runS $ do + mbn@(MBN# mba#) <- newBigNat# (li# +# 1#) + -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'? + -- clear all limbs (except for the most-significant limb) + _ <- svoid (setByteArray# mba# 0# (li# `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#) + -- set single bit in most-significant limb + _ <- svoid (writeBigNat# mbn li# (uncheckedShiftL# 1## bi#)) + unsafeFreezeBigNat# mbn + where + (# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS# testBitBigNat :: BigNat -> Int# -> Bool testBitBigNat bn i# From git at git.haskell.org Sat Aug 29 11:25:57 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:25:57 +0000 (UTC) Subject: [commit: ghc] master: StgCmmHeap: Re-add check for large static allocations (c1d7b4b) Message-ID: <20150829112557.6A7D93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/c1d7b4b43bbc4c7a590a8b942adc09e654d0659d/ghc >--------------------------------------------------------------- commit c1d7b4b43bbc4c7a590a8b942adc09e654d0659d Author: Ben Gamari Date: Thu Aug 27 14:08:01 2015 +0200 StgCmmHeap: Re-add check for large static allocations This should at least help alleviate the annoyance of #4505. This reintroduces a compile-time check originally added in a278f3f02d09bc32b0a75d4a04d710090cde250f but dropped with the new code generator. >--------------------------------------------------------------- c1d7b4b43bbc4c7a590a8b942adc09e654d0659d compiler/codeGen/StgCmmHeap.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 4b2bd96..6aaa100 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -46,6 +46,7 @@ import Id ( Id ) import Module import DynFlags import FastString( mkFastString, fsLit ) +import Panic( sorry ) #if __GLASGOW_HASKELL__ >= 709 import Prelude hiding ((<*>)) @@ -532,8 +533,16 @@ heapCheck checkStack checkYield do_gc code -- that the conditionals on hpHw don't cause a black hole do { dflags <- getDynFlags ; let mb_alloc_bytes + | hpHw > mBLOCK_SIZE = sorry $ unlines + [" Trying to allocate more than "++show mBLOCK_SIZE++" bytes.", + "", + "This is currently not possible due to a limitation of GHC's code generator.", + "See http://hackage.haskell.org/trac/ghc/ticket/4505 for details.", + "Suggestion: read data from a file instead of having large static data", + "structures in code."] | hpHw > 0 = Just (mkIntExpr dflags (hpHw * (wORD_SIZE dflags))) | otherwise = Nothing + where mBLOCK_SIZE = bLOCKS_PER_MBLOCK dflags * bLOCK_SIZE_W dflags stk_hwm | checkStack = Just (CmmLit CmmHighStackMark) | otherwise = Nothing ; codeOnly $ do_checks stk_hwm checkYield mb_alloc_bytes do_gc From git at git.haskell.org Sat Aug 29 11:26:00 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:26:00 +0000 (UTC) Subject: [commit: ghc] master: ghc-pkg --enable-multi-instance should not complain about case sensitivity. (cd2dc9e) Message-ID: <20150829112600.417D63A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/cd2dc9e2cf80881e96b98d025c2848edeca11ba4/ghc >--------------------------------------------------------------- commit cd2dc9e2cf80881e96b98d025c2848edeca11ba4 Author: Edward Z. Yang Date: Sat Aug 29 12:25:28 2015 +0200 ghc-pkg --enable-multi-instance should not complain about case sensitivity. Test Plan: validate Reviewers: simonmar, bgamari, austin Reviewed By: bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1177 >--------------------------------------------------------------- cd2dc9e2cf80881e96b98d025c2848edeca11ba4 utils/ghc-pkg/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 1d80e97..fbd7dae 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1665,7 +1665,8 @@ checkDuplicates db_stack pkg multi_instance update = do uncasep = map toLower . display dups = filter ((== uncasep pkgid) . uncasep) (map sourcePackageId pkgs) - when (not update && not (null dups)) $ verror ForceAll $ + when (not update && not multi_instance + && not (null dups)) $ verror ForceAll $ "Package names may be treated case-insensitively in the future.\n"++ "Package " ++ display pkgid ++ " overlaps with: " ++ unwords (map display dups) From git at git.haskell.org Sat Aug 29 11:26:03 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 11:26:03 +0000 (UTC) Subject: [commit: ghc] master: Fix identifier parsing in hp2ps (0c823af) Message-ID: <20150829112603.3378D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/0c823af84d80ac103528e54eda8e1c6bdf2bea69/ghc >--------------------------------------------------------------- commit 0c823af84d80ac103528e54eda8e1c6bdf2bea69 Author: Yuras Shumovich Date: Sat Aug 29 12:25:14 2015 +0200 Fix identifier parsing in hp2ps Now identifiers can start with a package key, which is a hash, so they may also start with a digit. Identifiers always appear at the beginning of a line, and numbers never appear here, soit's safe to allow identifiers to start with a digit. Test Plan: `concprog002` passes under `threaded2_hT` way Reviewers: austin, bgamari, thomie Reviewed By: austin, bgamari, thomie Differential Revision: https://phabricator.haskell.org/D1175 GHC Trac Issues: #10661 >--------------------------------------------------------------- 0c823af84d80ac103528e54eda8e1c6bdf2bea69 testsuite/tests/concurrent/prog002/all.T | 1 - utils/hp2ps/HpFile.c | 44 +++++++++++++++++--------------- 2 files changed, 23 insertions(+), 22 deletions(-) diff --git a/testsuite/tests/concurrent/prog002/all.T b/testsuite/tests/concurrent/prog002/all.T index 5eb6238..54613a7 100644 --- a/testsuite/tests/concurrent/prog002/all.T +++ b/testsuite/tests/concurrent/prog002/all.T @@ -11,7 +11,6 @@ else: test('concprog002', [only_ways(['threaded2','threaded2_hT']), - expect_broken_for(10661, ['threaded2_hT']), extra_ways(ways), exit_code(1), when(fast(), skip), diff --git a/utils/hp2ps/HpFile.c b/utils/hp2ps/HpFile.c index 9459247..12ef8d6 100644 --- a/utils/hp2ps/HpFile.c +++ b/utils/hp2ps/HpFile.c @@ -35,7 +35,7 @@ static boolish insample = 0; /* true when in sample */ static floatish lastsample; /* the last sample time */ static void GetHpLine PROTO((FILE *)); /* forward */ -static void GetHpTok PROTO((FILE *)); /* forward */ +static void GetHpTok PROTO((FILE *, int)); /* forward */ static struct entry *GetEntry PROTO((char *)); /* forward */ @@ -77,7 +77,7 @@ GetHpFile(FILE *infp) linenum = 1; lastsample = 0.0; - GetHpTok(infp); + GetHpTok(infp, 1); while (endfile == 0) { GetHpLine(infp); @@ -122,49 +122,49 @@ GetHpLine(FILE *infp) switch (thetok) { case JOB_TOK: - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != STRING_TOK) { Error("%s, line %d: string must follow JOB", hpfile, linenum); } jobstring = thestring; gotjob = 1; - GetHpTok(infp); + GetHpTok(infp, 1); break; case DATE_TOK: - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != STRING_TOK) { Error("%s, line %d: string must follow DATE", hpfile, linenum); } datestring = thestring; gotdate = 1; - GetHpTok(infp); + GetHpTok(infp, 1); break; case SAMPLE_UNIT_TOK: - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != STRING_TOK) { Error("%s, line %d: string must follow SAMPLE_UNIT", hpfile, linenum); } sampleunitstring = thestring; gotsampleunit = 1; - GetHpTok(infp); + GetHpTok(infp, 1); break; case VALUE_UNIT_TOK: - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != STRING_TOK) { Error("%s, line %d: string must follow VALUE_UNIT", hpfile, linenum); } valueunitstring = thestring; gotvalueunit = 1; - GetHpTok(infp); + GetHpTok(infp, 1); break; case MARK_TOK: - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != FLOAT_TOK) { Error("%s, line %d, floating point number must follow MARK", hpfile, linenum); @@ -182,12 +182,12 @@ GetHpLine(FILE *infp) } } markmap[ nmarks++ ] = thefloatish; - GetHpTok(infp); + GetHpTok(infp, 1); break; case BEGIN_SAMPLE_TOK: insample = 1; - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != FLOAT_TOK) { Error("%s, line %d, floating point number must follow BEGIN_SAMPLE", hpfile, linenum); } @@ -207,28 +207,28 @@ GetHpLine(FILE *infp) } } samplemap[ nsamples ] = thefloatish; - GetHpTok(infp); + GetHpTok(infp, 1); break; case END_SAMPLE_TOK: insample = 0; - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != FLOAT_TOK) { Error("%s, line %d: floating point number must follow END_SAMPLE", hpfile, linenum); } nsamples++; - GetHpTok(infp); + GetHpTok(infp, 1); break; case IDENTIFIER_TOK: - GetHpTok(infp); + GetHpTok(infp, 0); if (thetok != INTEGER_TOK) { Error("%s, line %d: integer must follow identifier", hpfile, linenum); } StoreSample(GetEntry(theident), nsamples, thefloatish); - GetHpTok(infp); + GetHpTok(infp, 1); break; case EOF_TOK: @@ -274,10 +274,12 @@ TokenToString(token t) * the corresponding value is also assigned to "theinteger" * or "thefloatish" as appropriate; in the case of identifiers * it is assigned to "theident". + * + * startline argument should be true for the first token on a line */ static void -GetHpTok(FILE *infp) +GetHpTok(FILE *infp, int startline) { while (isspace(ch)) { /* skip whitespace */ @@ -290,7 +292,8 @@ GetHpTok(FILE *infp) return; } - if (isdigit(ch)) { + if (isdigit(ch) && !startline) { + /* there should not be numbers at start of line */ thetok = GetNumber(infp); return; } else if (ch == '\"') { @@ -298,7 +301,6 @@ GetHpTok(FILE *infp) thetok = STRING_TOK; return; } else if (IsIdChar(ch)) { - ASSERT(! (isdigit(ch))); /* ch can't be a digit here */ GetIdent(infp); if (!isupper((int)theident[0])) { thetok = IDENTIFIER_TOK; From git at git.haskell.org Sat Aug 29 12:55:58 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sat, 29 Aug 2015 12:55:58 +0000 (UTC) Subject: [commit: packages/hpc] master: Tests: don't write to the same file from multiple tests (5ae4275) Message-ID: <20150829125558.417523A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/hpc On branch : master Link : http://git.haskell.org/packages/hpc.git/commitdiff/5ae4275dd8e6c2242c299cc0b8c396564389f2c2 >--------------------------------------------------------------- commit 5ae4275dd8e6c2242c299cc0b8c396564389f2c2 Author: Thomas Miedema Date: Thu Aug 27 09:26:52 2015 +0200 Tests: don't write to the same file from multiple tests >--------------------------------------------------------------- 5ae4275dd8e6c2242c299cc0b8c396564389f2c2 tests/raytrace/tixs/test.T | 19 +++++++++---------- tests/simple/tixs/test.T | 10 ++++++---- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/tests/raytrace/tixs/test.T b/tests/raytrace/tixs/test.T index f558741..0a9428e 100644 --- a/tests/raytrace/tixs/test.T +++ b/tests/raytrace/tixs/test.T @@ -9,18 +9,17 @@ test('hpc_report_multi_002', normal, run_command, test('hpc_report_multi_003', normal, run_command, ["{hpc} report hpc_sample --include=Geometry --per-module --decl-list"]) -test('hpc_markup_multi_001', normal, run_command, - ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc hpc_sample --include=Geometry"]) -test('hpc_markup_multi_002', normal, run_command, - ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc hpc_sample --exclude=Geometry"]) -test('hpc_markup_multi_003', normal, run_command, - ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc hpc_sample --fun-entry-count"]) +test('hpc_markup_multi_001', extra_clean(['markup_multi_001/*']), run_command, + ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc --destdir=markup_multi_001" + " hpc_sample --include=Geometry"]) +test('hpc_markup_multi_002', extra_clean(['markup_multi_002/*']), run_command, + ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc --destdir=markup_multi_002" + " hpc_sample --exclude=Geometry"]) +test('hpc_markup_multi_003', extra_clean(['markup_multi_003/*']), run_command, + ["{hpc} markup --srcdir=.. --hpcdir=tixs/.hpc --destdir=markup_multi_003" + " hpc_sample --fun-entry-count"]) test('hpc_show_multi_001', normal, run_command, ["{hpc} show hpc_sample"]) test('hpc_show_multi_002', normal, run_command, ["{hpc} show hpc_sample --include=Geometry"]) - -# XXX We used to do clean_o_hi(), but that doesn't work any more -# Fix cleaning properly - diff --git a/tests/simple/tixs/test.T b/tests/simple/tixs/test.T index f1e82ef..71c9ad5 100644 --- a/tests/simple/tixs/test.T +++ b/tests/simple/tixs/test.T @@ -22,10 +22,12 @@ test('hpc_markup_error_001', exit_code(1), run_command, ["{hpc} markup"]) # no .tix file test('hpc_markup_error_002', exit_code(1), run_command, ["{hpc} markup hpc001.hs"]) # bad .tix file -test('hpc_markup_001', normal, run_command, - ["{hpc} markup --verbosity=0 hpc_sample.tix --highlight-covered; cat Main.hs.html"]) -test('hpc_markup_002', normal, run_command, - ["{hpc} markup --verbosity=0 hpc_sample.tix --fun-entry-count; cat Main.hs.html"]) +test('hpc_markup_001', extra_clean(['markup_001/*']), run_command, + ["{hpc} markup --verbosity=0 --destdir=markup_001" + " hpc_sample.tix --highlight-covered; cat markup_001/Main.hs.html"]) +test('hpc_markup_002', extra_clean(['markup_002/*']), run_command, + ["{hpc} markup --verbosity=0 --destdir=markup_002" + " hpc_sample.tix --fun-entry-count; cat markup_002/Main.hs.html"]) test('hpc_help_show', normal, run_command, ["{hpc} help show"]) test('hpc_show', normal, run_command, ["{hpc} show hpc_sample.tix"]) From git at git.haskell.org Sun Aug 30 16:46:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 30 Aug 2015 16:46:15 +0000 (UTC) Subject: [commit: ghc] master: Fix 7.10 validate (60120d2) Message-ID: <20150830164615.DF4803A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/60120d2848ce05de6cb152429cf7d4116c6b4528/ghc >--------------------------------------------------------------- commit 60120d2848ce05de6cb152429cf7d4116c6b4528 Author: Matthew Pickering Date: Sun Aug 30 18:30:51 2015 +0200 Fix 7.10 validate Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1190 >--------------------------------------------------------------- 60120d2848ce05de6cb152429cf7d4116c6b4528 compiler/coreSyn/CorePrep.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 2b8ac02..7b256a4 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -60,7 +60,7 @@ import MonadUtils ( mapAccumLM ) import Data.List ( mapAccumL ) import Control.Monad -#if __GLASGOW_HASKELL__ < 711 +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif From git at git.haskell.org Sun Aug 30 16:46:18 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Sun, 30 Aug 2015 16:46:18 +0000 (UTC) Subject: [commit: ghc] master: Fix typo in pattern synonym documentation. (12098c2) Message-ID: <20150830164618.C9F8D3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/12098c2e70b2a432f4ed675ed72b53a396cb2842/ghc >--------------------------------------------------------------- commit 12098c2e70b2a432f4ed675ed72b53a396cb2842 Author: Matthew Pickering Date: Sun Aug 30 18:31:01 2015 +0200 Fix typo in pattern synonym documentation. `MkT` is the name of the constructor whilst `T` is the name of the type. Reviewers: bgamari, austin Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1191 GHC Trac Issues: #10787 >--------------------------------------------------------------- 12098c2e70b2a432f4ed675ed72b53a396cb2842 docs/users_guide/glasgow_exts.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 909d841..92cbdc0 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -1095,13 +1095,13 @@ For example, consider data T a where MkT :: (Show b) => a -> b -> T a -f1 :: (Eq a, Num a) => MkT a -> String +f1 :: (Eq a, Num a) => T a -> String f1 (MkT 42 x) = show x pattern ExNumPat :: (Show b) => (Num a, Eq a) => b -> T a pattern ExNumPat x = MkT 42 x -f2 :: (Eq a, Num a) => MkT a -> String +f2 :: (Eq a, Num a) => T a -> String f2 (ExNumPat x) = show x Here f1 does not use pattern synonyms. To match against the From git at git.haskell.org Mon Aug 31 15:09:15 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 31 Aug 2015 15:09:15 +0000 (UTC) Subject: [commit: ghc] branch 'HEAD' created Message-ID: <20150831150915.882E93A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc New branch : HEAD Referencing: 12098c2e70b2a432f4ed675ed72b53a396cb2842 From git at git.haskell.org Mon Aug 31 15:11:43 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 31 Aug 2015 15:11:43 +0000 (UTC) Subject: [commit: ghc] master: Anchor type family instances deterministically (10a0775) Message-ID: <20150831151143.5389F3A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc On branch : master Link : http://ghc.haskell.org/trac/ghc/changeset/10a07753ff4ac0c1285454567c926d580d0f0470/ghc >--------------------------------------------------------------- commit 10a07753ff4ac0c1285454567c926d580d0f0470 Author: Bartosz Nitka Date: Mon Aug 31 16:10:34 2015 +0100 Anchor type family instances deterministically Summary: This is very similar to D1073. It makes type family instances to be attached to a binding with a least `OccName`, therefore not depending on `Unique` ordering. Test Plan: * this makes `Language.Haskell.Exts.SrcLoc` deterministic * ./validate Reviewers: simonmar, austin, bgamari, simonpj Reviewed By: simonpj Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1192 GHC Trac Issues: #4012 >--------------------------------------------------------------- 10a07753ff4ac0c1285454567c926d580d0f0470 compiler/iface/MkIface.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 697972a..f594181 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1853,13 +1853,8 @@ famInstToIfaceFamInst (FamInst { fi_axiom = axiom, orph | is_local fam_decl = NotOrphan (nameOccName fam_decl) - - | not (isEmptyNameSet lhs_names) - = NotOrphan (nameOccName (head (nameSetElems lhs_names))) - - | otherwise - = IsOrphan + = chooseOrphanAnchor $ nameSetElems lhs_names -------------------------- toIfaceLetBndr :: Id -> IfaceLetBndr From git at git.haskell.org Mon Aug 31 20:29:50 2015 From: git at git.haskell.org (git at git.haskell.org) Date: Mon, 31 Aug 2015 20:29:50 +0000 (UTC) Subject: [commit: ghc] branch 'HEAD' deleted Message-ID: <20150831202950.180783A300@ghc.haskell.org> Repository : ssh://git at git.haskell.org/ghc Deleted branch: HEAD