Commit 893d7df5 authored by simonpj's avatar simonpj
Browse files

[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.
parent 180484cb
......@@ -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}
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment