Make dataToQa aware of Data instances which use functions to implement toConstr
authorRyanGlScott <ryan.gl.scott@gmail.com>
Tue, 13 Oct 2015 05:43:32 +0000 (00:43 -0500)
committerAustin Seipp <austin@well-typed.com>
Tue, 13 Oct 2015 05:43:42 +0000 (00:43 -0500)
Trac #10796 exposes a way to make `template-haskell`'s `dataToQa` function
freak out if using a `Data` instance that produces a `Constr` (by means of
`toConstr`) using a function name instead of a data constructor name. While
such `Data` instances are somewhat questionable, they are nevertheless present
in popular libraries (e.g., `containers`), so we can at least make `dataToQa`
aware of their existence.

In order to properly distinguish strings which represent variables (as opposed
to data constructors), it was necessary to move functionality from `Lexeme` (in
`ghc`) to `GHC.Lexeme` in a new `ghc-boot` library (which was previously named
`bin-package-db`).

Reviewed By: goldfire, thomie

Differential Revision: https://phabricator.haskell.org/D1313

GHC Trac Issues: #10796

24 files changed:
.gitignore
compiler/basicTypes/Lexeme.hs
compiler/ghc.cabal.in
compiler/main/PackageConfig.hs
docs/users_guide/7.12.1-notes.rst
ghc.mk
libraries/ghc-boot/GHC/Lexeme.hs [new file with mode: 0644]
libraries/ghc-boot/GHC/PackageDb.hs [moved from libraries/bin-package-db/GHC/PackageDb.hs with 100% similarity]
libraries/ghc-boot/LICENSE [moved from libraries/bin-package-db/LICENSE with 100% similarity]
libraries/ghc-boot/ghc-boot.cabal [moved from libraries/bin-package-db/bin-package-db.cabal with 61% similarity]
libraries/template-haskell/Language/Haskell/TH.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
libraries/template-haskell/changelog.md
libraries/template-haskell/template-haskell.cabal
rules/foreachLibrary.mk
testsuite/tests/codeGen/should_compile/jmp_tbl.hs
testsuite/tests/th/T10796a.hs [new file with mode: 0644]
testsuite/tests/th/T10796b.hs [new file with mode: 0644]
testsuite/tests/th/T10796b.stderr [new file with mode: 0644]
testsuite/tests/th/TH_Roles2.stderr
testsuite/tests/th/TH_nameSpace.hs [new file with mode: 0644]
testsuite/tests/th/TH_nameSpace.stdout [new file with mode: 0644]
testsuite/tests/th/all.T
utils/ghc-pkg/ghc-pkg.cabal

index d710852..20fb883 100644 (file)
@@ -119,12 +119,12 @@ _darcs/
 /libffi/stamp*
 /libffi/package.conf.install
 /libffi/package.conf.install.raw
 /libffi/stamp*
 /libffi/package.conf.install
 /libffi/package.conf.install.raw
-/libraries/bin-package-db/GNUmakefile
-/libraries/bin-package-db/ghc.mk
 /libraries/bootstrapping.conf
 /libraries/prologue.txt
 /libraries/doc-index*.html
 /libraries/frames.html
 /libraries/bootstrapping.conf
 /libraries/prologue.txt
 /libraries/doc-index*.html
 /libraries/frames.html
+/libraries/ghc-boot/GNUmakefile
+/libraries/ghc-boot/ghc.mk
 /libraries/haddock-util.js
 /libraries/hslogo-16.png
 /libraries/index-frames.html
 /libraries/haddock-util.js
 /libraries/hslogo-16.png
 /libraries/index-frames.html
index a240961..2049e00 100644 (file)
@@ -6,11 +6,11 @@
 
 module Lexeme (
           -- * Lexical characteristics of Haskell names
 
 module Lexeme (
           -- * Lexical characteristics of Haskell names
-  
+
           -- | Use these functions to figure what kind of name a 'FastString'
           -- represents; these functions do /not/ check that the identifier
           -- is valid.
           -- | Use these functions to figure what kind of name a 'FastString'
           -- represents; these functions do /not/ check that the identifier
           -- is valid.
-  
+
         isLexCon, isLexVar, isLexId, isLexSym,
         isLexConId, isLexConSym, isLexVarId, isLexVarSym,
         startsVarSym, startsVarId, startsConSym, startsConId,
         isLexCon, isLexVar, isLexId, isLexSym,
         isLexConId, isLexConSym, isLexVarId, isLexVarSym,
         startsVarSym, startsVarId, startsConSym, startsConId,
@@ -33,6 +33,8 @@ import Util ((<||>))
 import Data.Char
 import qualified Data.Set as Set
 
 import Data.Char
 import qualified Data.Set as Set
 
+import GHC.Lexeme
+
 {-
 
 ************************************************************************
 {-
 
 ************************************************************************
@@ -86,22 +88,6 @@ isLexVarSym fs                          -- Infix identifiers e.g. "+"
       (c:cs) -> startsVarSym c && all isVarSymChar cs
         -- See Note [Classification of generated names]
 
       (c:cs) -> startsVarSym c && all isVarSymChar cs
         -- See Note [Classification of generated names]
 
--------------
-startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
-startsVarSym c = startsVarSymASCII c || (ord c > 0x7f && isSymbol c)  -- Infix Ids
-startsConSym c = c == ':'               -- Infix data constructors
-startsVarId c  = c == '_' || case generalCategory c of  -- Ordinary Ids
-  LowercaseLetter -> True
-  OtherLetter     -> True   -- See #1103
-  _               -> False
-startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors
-
-startsVarSymASCII :: Char -> Bool
-startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
-
-isVarSymChar :: Char -> Bool
-isVarSymChar c = c == ':' || startsVarSym c
-
 {-
 
 ************************************************************************
 {-
 
 ************************************************************************
@@ -113,7 +99,7 @@ isVarSymChar c = c == ':' || startsVarSym c
 -}
 
 ----------------------
 -}
 
 ----------------------
--- External interface 
+-- External interface
 ----------------------
 
 -- | Is this an acceptable variable name?
 ----------------------
 
 -- | Is this an acceptable variable name?
@@ -237,7 +223,7 @@ okSymChar c
       ModifierSymbol       -> True
       OtherSymbol          -> True
       _                    -> False
       ModifierSymbol       -> True
       OtherSymbol          -> True
       _                    -> False
-    
+
 -- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.
 reservedIds :: Set.Set String
 reservedIds = Set.fromList [ "case", "class", "data", "default", "deriving"
 -- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.
 reservedIds :: Set.Set String
 reservedIds = Set.fromList [ "case", "class", "data", "default", "deriving"
index 37a4f28..f068eb2 100644 (file)
@@ -55,7 +55,7 @@ Library
                    template-haskell,
                    hpc,
                    transformers,
                    template-haskell,
                    hpc,
                    transformers,
-                   bin-package-db,
+                   ghc-boot,
                    hoopl
 
     if os(windows)
                    hoopl
 
     if os(windows)
index f3cdac7..9e9775b 100644 (file)
@@ -37,7 +37,7 @@ import Module
 import Unique
 
 -- -----------------------------------------------------------------------------
 import Unique
 
 -- -----------------------------------------------------------------------------
--- Our PackageConfig type is the InstalledPackageInfo from bin-package-db,
+-- Our PackageConfig type is the InstalledPackageInfo from ghc-boot,
 -- which is similar to a subset of the InstalledPackageInfo type from Cabal.
 
 type PackageConfig = InstalledPackageInfo
 -- which is similar to a subset of the InstalledPackageInfo type from Cabal.
 
 type PackageConfig = InstalledPackageInfo
index 0e1d0a2..14b0bef 100644 (file)
@@ -204,11 +204,6 @@ base
    this functionality was only available from ``GHC.Conc``.
 
 
    this functionality was only available from ``GHC.Conc``.
 
 
-bin-package-db
-~~~~~~~~~~~~~~
-
--  This is an internal package, and should not be used.
-
 binary
 ~~~~~~
 
 binary
 ~~~~~~
 
@@ -254,6 +249,24 @@ ghc
    strictness annotations as the user wrote them, whether from an
    imported module or not.
 
    strictness annotations as the user wrote them, whether from an
    imported module or not.
 
+-  Moved `startsVarSym`, `startsVarId`, `startsConSym`, `startsConId`,
+   `startsVarSymASCII`, and `isVarSymChar` from `Lexeme` to the `GHC.Lemexe`
+   module of the `ghc-boot` library.
+
+ghc-boot
+~~~~~~~~
+
+-  This is an internal package. Use with caution.
+
+-  This package was renamed from `bin-package-db` to reflect its new purpose
+   of containing intra-GHC functionality that needs to be shared across
+   multiple GHC boot libraries.
+
+-  Added `GHC.Lexeme`, which contains functions for determining if a
+   character can be the first letter of a variable or data constructor in
+   Haskell, as defined by GHC. (These functions were moved from `Lexeme`
+   in `ghc`.)
+
 ghc-prim
 ~~~~~~~~
 
 ghc-prim
 ~~~~~~~~
 
diff --git a/ghc.mk b/ghc.mk
index 6a294ac..47926c4 100644 (file)
--- a/ghc.mk
+++ b/ghc.mk
@@ -410,7 +410,7 @@ else # CLEANING
 # programs such as GHC and ghc-pkg, that we do not assume the stage0
 # compiler already has installed (or up-to-date enough).
 
 # programs such as GHC and ghc-pkg, that we do not assume the stage0
 # compiler already has installed (or up-to-date enough).
 
-PACKAGES_STAGE0 = binary Cabal/Cabal hpc bin-package-db hoopl transformers template-haskell
+PACKAGES_STAGE0 = binary Cabal/Cabal hpc ghc-boot hoopl transformers template-haskell
 ifeq "$(Windows_Host)" "NO"
 ifneq "$(HostOS_CPP)" "ios"
 PACKAGES_STAGE0 += terminfo
 ifeq "$(Windows_Host)" "NO"
 ifneq "$(HostOS_CPP)" "ios"
 PACKAGES_STAGE0 += terminfo
@@ -438,10 +438,10 @@ PACKAGES_STAGE1 += directory
 PACKAGES_STAGE1 += process
 PACKAGES_STAGE1 += hpc
 PACKAGES_STAGE1 += pretty
 PACKAGES_STAGE1 += process
 PACKAGES_STAGE1 += hpc
 PACKAGES_STAGE1 += pretty
-PACKAGES_STAGE1 += template-haskell
 PACKAGES_STAGE1 += binary
 PACKAGES_STAGE1 += Cabal/Cabal
 PACKAGES_STAGE1 += binary
 PACKAGES_STAGE1 += Cabal/Cabal
-PACKAGES_STAGE1 += bin-package-db
+PACKAGES_STAGE1 += ghc-boot
+PACKAGES_STAGE1 += template-haskell
 PACKAGES_STAGE1 += hoopl
 PACKAGES_STAGE1 += transformers
 
 PACKAGES_STAGE1 += hoopl
 PACKAGES_STAGE1 += transformers
 
@@ -752,7 +752,7 @@ fixed_pkg_prev=
 $(foreach pkg,$(PACKAGES_STAGE0),$(eval $(call fixed_pkg_dep,$(pkg),dist-boot)))
 # ghc-pkg, unlike other utils that we build with the stage0 compiler (TODO: is
 # this really true?), depends on several boot packages (e.g. Cabal and
 $(foreach pkg,$(PACKAGES_STAGE0),$(eval $(call fixed_pkg_dep,$(pkg),dist-boot)))
 # ghc-pkg, unlike other utils that we build with the stage0 compiler (TODO: is
 # this really true?), depends on several boot packages (e.g. Cabal and
-# bin-package-db). They need to be configured before ghc-pkg, so we add a
+# ghc-boot). They need to be configured before ghc-pkg, so we add a
 # dependency between their package-data.mk files. See also Note
 # [Dependencies between package-data.mk files].
 utils/ghc-pkg/dist/package-data.mk: $(fixed_pkg_prev)
 # dependency between their package-data.mk files. See also Note
 # [Dependencies between package-data.mk files].
 utils/ghc-pkg/dist/package-data.mk: $(fixed_pkg_prev)
diff --git a/libraries/ghc-boot/GHC/Lexeme.hs b/libraries/ghc-boot/GHC/Lexeme.hs
new file mode 100644 (file)
index 0000000..677c9a6
--- /dev/null
@@ -0,0 +1,32 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Lexeme
+-- Copyright   :  (c) The GHC Team
+--
+-- Maintainer  :  ghc-devs@haskell.org
+-- Portability :  portable
+--
+-- Functions to evaluate whether or not a string is a valid identifier.
+--
+module GHC.Lexeme (
+          -- * Lexical characteristics of Haskell names
+        startsVarSym, startsVarId, startsConSym, startsConId,
+        startsVarSymASCII, isVarSymChar
+  ) where
+
+import Data.Char
+
+startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
+startsVarSym c = startsVarSymASCII c || (ord c > 0x7f && isSymbol c)  -- Infix Ids
+startsConSym c = c == ':'               -- Infix data constructors
+startsVarId c  = c == '_' || case generalCategory c of  -- Ordinary Ids
+  LowercaseLetter -> True
+  OtherLetter     -> True   -- See #1103
+  _               -> False
+startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors
+
+startsVarSymASCII :: Char -> Bool
+startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+
+isVarSymChar :: Char -> Bool
+isVarSymChar c = c == ':' || startsVarSym c
similarity index 61%
rename from libraries/bin-package-db/bin-package-db.cabal
rename to libraries/ghc-boot/ghc-boot.cabal
index a54fe16..98929b7 100644 (file)
@@ -1,17 +1,17 @@
-name:           bin-package-db
+name:           ghc-boot
 version:        0.0.0.0
 license:        BSD3
 maintainer:     ghc-devs@haskell.org
 bug-reports:    glasgow-haskell-bugs@haskell.org
 version:        0.0.0.0
 license:        BSD3
 maintainer:     ghc-devs@haskell.org
 bug-reports:    glasgow-haskell-bugs@haskell.org
-synopsis:       The GHC compiler's view of the GHC package database format
-description:    This library is shared between GHC and ghc-pkg and is used by
-                GHC to read package databases.
+synopsis:       Shared functionality between GHC and its boot libraries
+description:    This library is shared between GHC, ghc-pkg, and other boot
+                libraries.
                 .
                 .
-                It only deals with the subset of the package database that the
-                compiler cares about: modules paths etc and not package
-                metadata like description, authors etc. It is thus not a
-                library interface to ghc-pkg and is *not* suitable for
-                modifying GHC package databases.
+                A note about "GHC.PackageDb": it only deals with the subset of
+                the package database that the compiler cares about: modules
+                paths etc and not package metadata like description, authors
+                etc. It is thus not a library interface to ghc-pkg and is *not*
+                suitable for modifying GHC package databases.
                 .
                 The package database format and this library are constructed in
                 such a way that while ghc-pkg depends on Cabal, the GHC library
                 .
                 The package database format and this library are constructed in
                 such a way that while ghc-pkg depends on Cabal, the GHC library
@@ -22,7 +22,7 @@ build-type:     Simple
 source-repository head
     type:     git
     location: http://git.haskell.org/ghc.git
 source-repository head
     type:     git
     location: http://git.haskell.org/ghc.git
-    subdir:   libraries/bin-package-db
+    subdir:   libraries/ghc-boot
 
 Library
     default-language: Haskell2010
 
 Library
     default-language: Haskell2010
@@ -34,6 +34,7 @@ Library
             TypeSynonymInstances
 
     exposed-modules:
             TypeSynonymInstances
 
     exposed-modules:
+            GHC.Lexeme
             GHC.PackageDb
 
     build-depends: base       >= 4   && < 5,
             GHC.PackageDb
 
     build-depends: base       >= 4   && < 5,
index bce8bf5..4903881 100644 (file)
@@ -51,6 +51,7 @@ module Language.Haskell.TH(
         nameBase,       -- :: Name -> String
         nameModule,     -- :: Name -> Maybe String
         namePackage,    -- :: Name -> Maybe String
         nameBase,       -- :: Name -> String
         nameModule,     -- :: Name -> Maybe String
         namePackage,    -- :: Name -> Maybe String
+        nameSpace,      -- :: Name -> Maybe NameSpace
         -- ** Built-in names
         tupleTypeName, tupleDataName,   -- Int -> Name
         unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name
         -- ** Built-in names
         tupleTypeName, tupleDataName,   -- Int -> Name
         unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name
index b64dfff..97c379d 100644 (file)
@@ -38,6 +38,7 @@ import Data.Int
 import Data.Word
 import Data.Ratio
 import GHC.Generics     ( Generic )
 import Data.Word
 import Data.Ratio
 import GHC.Generics     ( Generic )
+import GHC.Lexeme       ( startsVarSym, startsVarId )
 
 #ifdef HAS_NATURAL
 import Numeric.Natural
 
 #ifdef HAS_NATURAL
 import Numeric.Natural
@@ -645,10 +646,10 @@ dataToQa mkCon mkLit appCon antiQ t =
       Nothing ->
           case constrRep constr of
             AlgConstr _ ->
       Nothing ->
           case constrRep constr of
             AlgConstr _ ->
-                appCon (mkCon conName) conArgs
+                appCon (mkCon funOrConName) conArgs
               where
               where
-                conName :: Name
-                conName =
+                funOrConName :: Name
+                funOrConName =
                     case showConstr constr of
                       "(:)"       -> Name (mkOccName ":")
                                           (NameG DataName
                     case showConstr constr of
                       "(:)"       -> Name (mkOccName ":")
                                           (NameG DataName
@@ -662,13 +663,23 @@ dataToQa mkCon mkLit appCon antiQ t =
                                           (NameG DataName
                                                 (mkPkgName "ghc-prim")
                                                 (mkModName "GHC.Tuple"))
                                           (NameG DataName
                                                 (mkPkgName "ghc-prim")
                                                 (mkModName "GHC.Tuple"))
-                      con         -> mkNameG_d (tyConPackage tycon)
-                                               (tyConModule tycon)
-                                               con
+                      -- It is possible for a Data instance to be defined such
+                      -- that toConstr uses a Constr defined using a function,
+                      -- not a data constructor. In such a case, we must take
+                      -- care to build the Name using mkNameG_v (for values),
+                      -- not mkNameG_d (for data constructors).
+                      -- See Trac #10796.
+                      fun@(x:_)   | startsVarSym x || startsVarId x
+                                  -> mkNameG_v tyconPkg tyconMod fun
+                      con         -> mkNameG_d tyconPkg tyconMod con
                   where
                     tycon :: TyCon
                     tycon = (typeRepTyCon . typeOf) t
 
                   where
                     tycon :: TyCon
                     tycon = (typeRepTyCon . typeOf) t
 
+                    tyconPkg, tyconMod :: String
+                    tyconPkg = tyConPackage tycon
+                    tyconMod = tyConModule  tycon
+
                 conArgs :: [Q q]
                 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
             IntConstr n ->
                 conArgs :: [Q q]
                 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
             IntConstr n ->
@@ -691,8 +702,17 @@ dataToExpQ  ::  Data a
             =>  (forall b . Data b => b -> Maybe (Q Exp))
             ->  a
             ->  Q Exp
             =>  (forall b . Data b => b -> Maybe (Q Exp))
             ->  a
             ->  Q Exp
-dataToExpQ = dataToQa conE litE (foldl appE)
-    where conE s =  return (ConE s)
+dataToExpQ = dataToQa varOrConE litE (foldl appE)
+    where
+          -- Make sure that VarE is used if the Constr value relies on a
+          -- function underneath the surface (instead of a constructor).
+          -- See Trac #10796.
+          varOrConE s =
+            case nameSpace s of
+                 Just VarName  -> return (VarE s)
+                 Just DataName -> return (ConE s)
+                 _ -> fail $ "Can't construct an expression from name "
+                          ++ showName s
           appE x y = do { a <- x; b <- y; return (AppE a b)}
           litE c = return (LitE c)
 
           appE x y = do { a <- x; b <- y; return (AppE a b)}
           litE c = return (LitE c)
 
@@ -710,8 +730,13 @@ dataToPatQ  ::  Data a
             ->  Q Pat
 dataToPatQ = dataToQa id litP conP
     where litP l = return (LitP l)
             ->  Q Pat
 dataToPatQ = dataToQa id litP conP
     where litP l = return (LitP l)
-          conP n ps = do ps' <- sequence ps
-                         return (ConP n ps')
+          conP n ps =
+            case nameSpace n of
+                Just DataName -> do
+                    ps' <- sequence ps
+                    return (ConP n ps')
+                _ -> fail $ "Can't construct a pattern from name "
+                         ++ showName n
 
 -----------------------------------------------------
 --              Names and uniques
 
 -----------------------------------------------------
 --              Names and uniques
@@ -855,13 +880,13 @@ data NameFlavour
                 -- An original name (occurrences only, not binders)
                 -- Need the namespace too to be sure which
                 -- thing we are naming
                 -- An original name (occurrences only, not binders)
                 -- Need the namespace too to be sure which
                 -- thing we are naming
-  deriving ( Typeable, Data, Eq, Ord, Generic )
+  deriving ( Typeable, Data, Eq, Ord, Show, Generic )
 
 data NameSpace = VarName        -- ^ Variables
                | DataName       -- ^ Data constructors
                | TcClsName      -- ^ Type constructors and classes; Haskell has them
                                 -- in the same name space for now.
 
 data NameSpace = VarName        -- ^ Variables
                | DataName       -- ^ Data constructors
                | TcClsName      -- ^ Type constructors and classes; Haskell has them
                                 -- in the same name space for now.
-               deriving( Eq, Ord, Data, Typeable, Generic )
+               deriving( Eq, Ord, Show, Data, Typeable, Generic )
 
 type Uniq = Int
 
 
 type Uniq = Int
 
@@ -907,6 +932,26 @@ namePackage :: Name -> Maybe String
 namePackage (Name _ (NameG _ p _)) = Just (pkgString p)
 namePackage _                      = Nothing
 
 namePackage (Name _ (NameG _ p _)) = Just (pkgString p)
 namePackage _                      = Nothing
 
+-- | Returns whether a name represents an occurrence of a top-level variable
+-- ('VarName'), data constructor ('DataName'), type constructor, or type class
+-- ('TcClsName'). If we can't be sure, it returns 'Nothing'.
+--
+-- ==== __Examples__
+--
+-- >>> nameSpace 'Prelude.id
+-- Just VarName
+-- >>> nameSpace (mkName "id")
+-- Nothing -- only works for top-level variable names
+-- >>> nameSpace 'Data.Maybe.Just
+-- Just DataName
+-- >>> nameSpace ''Data.Maybe.Maybe
+-- Just TcClsName
+-- >>> nameSpace ''Data.Ord.Ord
+-- Just TcClsName
+nameSpace :: Name -> Maybe NameSpace
+nameSpace (Name _ (NameG ns _ _)) = Just ns
+nameSpace _                       = Nothing
+
 {- |
 Generate a capturable name. Occurrences of such names will be
 resolved according to the Haskell scoping rules at the occurrence
 {- |
 Generate a capturable name. Occurrences of such names will be
 resolved according to the Haskell scoping rules at the occurrence
index fb701ab..e4edf63 100644 (file)
     according to the fixities of the operators. The `ParensT` constructor can be
     used to explicitly group expressions.
 
     according to the fixities of the operators. The `ParensT` constructor can be
     used to explicitly group expressions.
 
-  * Add `namePackage`
+  * Add `namePackage` and `nameSpace`
+
+  * Make `dataToQa` and `dataToExpQ` able to handle `Data` instances whose
+    `toConstr` implementation relies on a function instead of a data
+    constructor (#10796)
+
+  * Add `Show` instances for `NameFlavour` and `NameSpace`
 
   * TODO: document API changes and important bugfixes
 
 
   * TODO: document API changes and important bugfixes
 
index 4bfd1a9..dd31604 100644 (file)
@@ -48,6 +48,7 @@ Library
 
     build-depends:
         base       >= 4.6 && < 4.9,
 
     build-depends:
         base       >= 4.6 && < 4.9,
+        ghc-boot,
         pretty     == 1.1.*
 
     -- We need to set the package key to template-haskell (without a
         pretty     == 1.1.*
 
     -- We need to set the package key to template-haskell (without a
index cdd5496..1a91cd9 100644 (file)
@@ -18,7 +18,7 @@
 # Except! If there's a libraries/foo/ghc-packages then it calls
 #     $(call $1,foo/bar,tag)
 # for each word 'bar' in libraries/foo/ghc-packages.
 # Except! If there's a libraries/foo/ghc-packages then it calls
 #     $(call $1,foo/bar,tag)
 # for each word 'bar' in libraries/foo/ghc-packages.
-# 
+#
 
 # We use an FEL_ prefix for the variable names, to avoid trampling on
 # other variables, as make has no concept of local variables.
 
 # We use an FEL_ prefix for the variable names, to avoid trampling on
 # other variables, as make has no concept of local variables.
@@ -28,7 +28,7 @@
 # repositories of their own:
 #
 #  - base
 # repositories of their own:
 #
 #  - base
-#  - bin-package-db
+#  - ghc-boot
 #  - ghc-prim
 #  - integer-gmp
 #  - integer-simple
 #  - ghc-prim
 #  - integer-gmp
 #  - integer-simple
@@ -37,7 +37,7 @@
 define foreachLibrary
 # $1 = function to call for each library
 # We will give it the package path and the tag as arguments
 define foreachLibrary
 # $1 = function to call for each library
 # We will give it the package path and the tag as arguments
-$$(foreach hashline,libraries/bin-package-db#-#no-remote-repo#no-vcs        \
+$$(foreach hashline,libraries/ghc-boot#-#no-remote-repo#no-vcs        \
                     libraries/base#-#no-remote-repo#no-vcs                  \
                     libraries/ghc-prim#-#no-remote-repo#no-vcs              \
                     libraries/integer-gmp#-#no-remote-repo#no-vcs           \
                     libraries/base#-#no-remote-repo#no-vcs                  \
                     libraries/ghc-prim#-#no-remote-repo#no-vcs              \
                     libraries/integer-gmp#-#no-remote-repo#no-vcs           \
index 2af97d1..05fabf6 100644 (file)
@@ -4,7 +4,7 @@
 This funny module was reduced from a failing build of stage2 using
 the new code generator and the linear register allocator, with this bug:
 
 This funny module was reduced from a failing build of stage2 using
 the new code generator and the linear register allocator, with this bug:
 
-"inplace/bin/ghc-stage1" -fPIC -dynamic  -H32m -O -Wall -H64m -O0    -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils   -optP-DGHCI -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package bin-package-db-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0  -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts     -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf  dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o  -fforce-recomp -dno-debug-output -fno-warn-unused-binds
+"inplace/bin/ghc-stage1" -fPIC -dynamic  -H32m -O -Wall -H64m -O0    -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils   -optP-DGHCI -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0  -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts     -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf  dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o  -fforce-recomp -dno-debug-output -fno-warn-unused-binds
 
 ghc-stage1: panic! (the 'impossible' happened)
   (GHC version 7.1.20110414 for x86_64-unknown-linux):
 
 ghc-stage1: panic! (the 'impossible' happened)
   (GHC version 7.1.20110414 for x86_64-unknown-linux):
diff --git a/testsuite/tests/th/T10796a.hs b/testsuite/tests/th/T10796a.hs
new file mode 100644 (file)
index 0000000..6c1ac8c
--- /dev/null
@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T10796a where
+
+import Data.Ratio
+import Data.Set (Set, fromList)
+import Language.Haskell.TH.Syntax (liftData)
+
+-- Data instance with toConstr implemented using a variable,
+-- not a data constructor
+splicedSet :: Set Char
+splicedSet = $(liftData (fromList "test"))
+
+-- Infix data constructor
+splicedRatio :: Ratio Int
+splicedRatio = $(liftData (1 % 2 :: Ratio Int))
diff --git a/testsuite/tests/th/T10796b.hs b/testsuite/tests/th/T10796b.hs
new file mode 100644 (file)
index 0000000..3da4063
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T10796b where
+
+import Data.Set (Set, fromList)
+import Language.Haskell.TH.Quote (dataToPatQ)
+
+badPattern :: Set Char -> Set Char
+badPattern s@($(dataToPatQ (const Nothing) (fromList "test"))) = s
diff --git a/testsuite/tests/th/T10796b.stderr b/testsuite/tests/th/T10796b.stderr
new file mode 100644 (file)
index 0000000..1dd5110
--- /dev/null
@@ -0,0 +1,5 @@
+
+T10796b.hs:8:17: error:
+    Can't construct a pattern from name Data.Set.Base.fromList
+    In the untyped splice:
+      $(dataToPatQ (const Nothing) (fromList "test"))
index 8611b92..891a792 100644 (file)
@@ -4,9 +4,9 @@ TYPE CONSTRUCTORS
   data T (a :: k)
 COERCION AXIOMS
 Dependent modules: []
   data T (a :: k)
 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.11.0.0]
+Dependent packages: [ghc-boot-0.0.0.0, pretty-<VERSION>,
+                     deepseq-<VERSION>, array-<VERSION>, base-<VERSION>, ghc-prim-<VERSION>,
+                     integer-<IMPL>-<VERSION>, template-haskell-<VERSION>]
 
 ==================== Typechecker ====================
 
 
 ==================== Typechecker ====================
 
diff --git a/testsuite/tests/th/TH_nameSpace.hs b/testsuite/tests/th/TH_nameSpace.hs
new file mode 100644 (file)
index 0000000..42e7503
--- /dev/null
@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Data.Maybe (Maybe(..))
+import Data.Ord (Ord)
+import Language.Haskell.TH (mkName, nameSpace)
+
+main :: IO ()
+main = mapM_ (print . nameSpace)
+             [ 'Prelude.id
+             , mkName "id"
+             , 'Data.Maybe.Just
+             , ''Data.Maybe.Maybe
+             , ''Data.Ord.Ord
+             ]
diff --git a/testsuite/tests/th/TH_nameSpace.stdout b/testsuite/tests/th/TH_nameSpace.stdout
new file mode 100644 (file)
index 0000000..a7b2cd7
--- /dev/null
@@ -0,0 +1,5 @@
+Just VarName
+Nothing
+Just DataName
+Just TcClsName
+Just TcClsName
index 8304737..9ded810 100644 (file)
@@ -357,6 +357,9 @@ test('T10704',
      ['T10704', '-v0'])
 test('T6018th', normal, compile_fail, ['-v0'])
 test('TH_namePackage', normal, compile_and_run, ['-v0'])
      ['T10704', '-v0'])
 test('T6018th', normal, compile_fail, ['-v0'])
 test('TH_namePackage', normal, compile_and_run, ['-v0'])
+test('TH_nameSpace', normal, compile_and_run, ['-v0'])
+test('T10796a', normal, compile, ['-v0'])
+test('T10796b', normal, compile_fail, ['-v0'])
 test('T10811', normal, compile, ['-v0'])
 test('T10810', normal, compile, ['-v0'])
 test('T10891', normal, compile, ['-v0'])
 test('T10811', normal, compile, ['-v0'])
 test('T10810', normal, compile, ['-v0'])
 test('T10891', normal, compile, ['-v0'])
index 317aab7..742e296 100644 (file)
@@ -25,7 +25,7 @@ Executable ghc-pkg
                    filepath,
                    Cabal,
                    binary,
                    filepath,
                    Cabal,
                    binary,
-                   bin-package-db,
+                   ghc-boot,
                    bytestring
     if !os(windows)
         Build-Depends: unix,
                    bytestring
     if !os(windows)
         Build-Depends: unix,