[commit: ghc] master: Refine fix for #7667. (ba6308e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/ba6308ece51fbd86f7a0281c223dc49c2f73531a/ghc

>---------------------------------------------------------------

commit ba6308ece51fbd86f7a0281c223dc49c2f73531a
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Oct 21 10:10:24 2013 -0400

    Refine fix for #7667.
    
    Now, we allow types that do not begin with ':', but we retain other
    checks on variable names.


>---------------------------------------------------------------

ba6308ece51fbd86f7a0281c223dc49c2f73531a
 compiler/hsSyn/Convert.lhs |   28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index e78296f..c4c28a9 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -1053,9 +1053,10 @@ tName n = cvtName OccName.tvName n
 tconNameL n = wrapL (tconName n)
 tconName n = cvtName OccName.tcClsName n
 
--- See Note [Checking name spaces]
 cvtName :: OccName.NameSpace -> TH.Name -> CvtM RdrName
 cvtName ctxt_ns (TH.Name occ flavour)
+  | not (okOcc ctxt_ns occ_str) = failWith (badOcc ctxt_ns occ_str)
+  | otherwise
   = do { loc <- getL
        ; let rdr_name = thRdrName loc ctxt_ns occ_str flavour
        ; force rdr_name
@@ -1063,6 +1064,15 @@ cvtName ctxt_ns (TH.Name occ flavour)
   where
     occ_str = TH.occString occ
 
+okOcc :: OccName.NameSpace -> String -> Bool
+okOcc _  []      = False
+okOcc ns str@(c:_)
+  | OccName.isVarNameSpace ns     = startsVarId c || startsVarSym c
+  | OccName.isDataConNameSpace ns = startsConId c || startsConSym c || str == "[]"
+  | otherwise                     = startsConId c || startsConSym c ||
+                                    startsVarSym c || str == "[]" || str == "->"
+                                     -- allow type operators like "+"
+
 -- Determine the name space of a name in a type
 --
 isVarName :: TH.Name -> Bool
@@ -1071,6 +1081,11 @@ isVarName (TH.Name occ _)
       ""    -> False
       (c:_) -> startsVarId c || startsVarSym c
 
+badOcc :: OccName.NameSpace -> String -> SDoc
+badOcc ctxt_ns occ
+  = ptext (sLit "Illegal") <+> pprNameSpace ctxt_ns
+        <+> ptext (sLit "name:") <+> quotes (text occ)
+
 thRdrName :: SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
 -- This turns a TH Name into a RdrName; used for both binders and occurrences
 -- See Note [Binders in Template Haskell]
@@ -1205,14 +1220,3 @@ the way System Names are printed.
 There's a small complication of course; see Note [Looking up Exact
 RdrNames] in RnEnv.
 
-Note [Checking name spaces]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In cvtName, it's possible that the name we are converting doesn't
-match the namespace requested. For example, we might have a data
-constructor "foo" or a variable "Bar". We could check for these cases,
-but it seems difficult to guarantee identical behavior to the parser.
-Furthermore, a TH user might (somewhat dirtily) want to violate Haskell's
-naming expectations, and to use a name that couldn't be used in source
-code. So, according to the discussion in #7667, we just don't check.
-If you're thinking of changing this behavior, also please do see #7484,
-which is closely related.