[project @ 2004-12-21 17:08:59 by simonpj]

---------------------------------
     Template Haskell: dynamically scoped qualified names
	---------------------------------

This commit adds a constructor to TH.Name, so that

	nameBase (mkName "Foo.baz")    == "baz"
	nameModule (MkName "Foo.baz") == "Foo"

We always did parse the module name off the front, but it used to
be done in hsSyn/Convert, but now it's done in TH.Syntax, which is
a better place.

diff --git a/ghc/compiler/hsSyn/Convert.lhs b/ghc/compiler/hsSyn/Convert.lhs
index 9a7d0b6..08d0cc6 100644 (file)
--- a/ghc/compiler/hsSyn/Convert.lhs
+++ b/ghc/compiler/hsSyn/Convert.lhs
@@ -403,8 +403,9 @@ tconName = thRdrName OccName.tcName
 thRdrName :: OccName.NameSpace -> TH.Name -> RdrName
 -- This turns a Name into a RdrName
 
-thRdrName ns (TH.Name occ (TH.NameG ns' mod)) = mkOrig (mk_mod mod) (mk_occ ns occ)
-thRdrName ns (TH.Name occ TH.NameS)           = mkDynName ns occ
+thRdrName ns (TH.Name occ TH.NameS)           = mkRdrUnqual (mk_occ ns occ)
+thRdrName ns (TH.Name occ (TH.NameQ mod))     = mkRdrQual (mk_mod mod) (mk_occ ns occ)
+thRdrName ns (TH.Name occ (TH.NameG ns' mod)) = mkOrig    (mk_mod mod) (mk_occ ns occ)
 thRdrName ns (TH.Name occ (TH.NameU uniq))    
   = mkRdrUnqual (OccName.mkOccName ns uniq_str)
   where
@@ -424,22 +425,5 @@ mk_occ ns occ = OccName.mkOccFS ns (mkFastString (TH.occString occ))
 
 mk_mod :: TH.ModName -> Module
 mk_mod mod = mkModule (TH.modString mod)
-
-mkDynName :: OccName.NameSpace -> TH.OccName -> RdrName
--- Parse the string to see if it has a "." in it
--- so we know whether to generate a qualified or unqualified name
--- It's a bit tricky because we need to parse 
---     Foo.Baz.x as Qual Foo.Baz x
--- So we parse it from back to front
-
-mkDynName ns th_occ
-  = split [] (reverse (TH.occString th_occ))
-  where
-    split occ []        = mkRdrUnqual (mk_occ occ)
-    split occ ('.':rev)        = mkRdrQual (mk_mod (reverse rev)) (mk_occ occ)
-    split occ (c:rev)   = split (c:occ) rev
-
-    mk_occ occ = OccName.mkOccFS ns (mkFastString occ)
-    mk_mod mod = mkModule mod
 \end{code}
 

diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs
index b5e13f7..dcd4195 100644 (file)
--- a/ghc/compiler/typecheck/TcSplice.lhs
+++ b/ghc/compiler/typecheck/TcSplice.lhs
@@ -22,7 +22,7 @@ import HsSyn          ( HsBracket(..), HsExpr(..), HsSplice(..), LHsExpr, LHsDecl,
 import Convert         ( convertToHsExpr, convertToHsDecls, convertToHsType )
 import RnExpr          ( rnLExpr )
 import RnEnv           ( lookupFixityRn, lookupSrcOcc_maybe )
-import RdrName         ( RdrName, mkRdrUnqual, lookupLocalRdrEnv )
+import RdrName         ( RdrName, mkRdrQual, mkRdrUnqual, lookupLocalRdrEnv )
 import RnTypes         ( rnLHsType )
 import TcExpr          ( tcCheckRho, tcMonoExpr )
 import TcHsSyn         ( mkHsLet, zonkTopLExpr )
@@ -465,8 +465,18 @@ lookupThName (TH.Name occ (TH.NameG th_ns mod))
                TH.TcClsName -> tcClsName
                TH.VarName   -> varName
 
-lookupThName th_name@(TH.Name occ TH.NameS) 
-  =  do { let rdr_name = mkRdrUnqual (OccName.mkOccFS ns occ_fs)
+lookupThName (TH.Name occ (TH.NameU uniq)) 
+  = return (mkInternalName (mk_uniq uniq) (OccName.mkOccFS bogus_ns occ_fs) noSrcLoc)
+  where
+    occ_fs = mkFastString (TH.occString occ)
+    bogus_ns = OccName.varName -- Not yet recorded in the TH name
+                               -- but only the unique matters
+
+lookupThName th_name@(TH.Name occ flavour)     -- NameS or NameQ
+  =  do { let occ = OccName.mkOccFS ns occ_fs
+             rdr_name = case flavour of
+                           TH.NameS   -> mkRdrUnqual occ
+                           TH.NameQ m -> mkRdrQual (mkModule (TH.modString m)) occ
        ; rdr_env <- getLocalRdrEnv
        ; case lookupLocalRdrEnv rdr_env rdr_name of
                Just name -> return name
@@ -481,13 +491,6 @@ lookupThName th_name@(TH.Name occ TH.NameS)
        | otherwise      = OccName.varName
     occ_fs = mkFastString (TH.occString occ)
 
-lookupThName (TH.Name occ (TH.NameU uniq)) 
-  = return (mkInternalName (mk_uniq uniq) (OccName.mkOccFS bogus_ns occ_fs) noSrcLoc)
-  where
-    occ_fs = mkFastString (TH.occString occ)
-    bogus_ns = OccName.varName -- Not yet recorded in the TH name
-                               -- but only the unique matters
-
 tcLookupTh :: Name -> TcM TcTyThing
 -- This is a specialised version of TcEnv.tcLookup; specialised mainly in that
 -- it gives a reify-related error message on failure, whereas in the normal