-newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name
- -- newTopBinder puts into the cache the binder with the
- -- module information set correctly. When the decl is later renamed,
- -- the binding site will thereby get the correct module.
- -- There maybe occurrences that don't have the correct Module, but
- -- by the typechecker will propagate the binding definition to all
- -- the occurrences, so that doesn't matter
-
-newTopBinder mod rdr_name loc
- = -- First check the cache
-
- -- There should never be a qualified name in a binding position (except in instance decls)
- -- The parser doesn't check this because the same parser parses instance decls
- (if isQual rdr_name then
- qualNameErr (text "its declaration") (rdr_name,loc)
- else
- returnRn ()
- ) `thenRn_`
-
- getNameSupplyRn `thenRn` \ name_supply ->
- let
- occ = rdrNameOcc rdr_name
- key = (moduleName mod, occ)
- cache = nsNames name_supply
- in
- case lookupFM cache key of
-
- -- A hit in the cache! We are at the binding site of the name, and
- -- this is the moment when we know all about
- -- a) the Name's host Module (in particular, which
- -- package it comes from)
- -- b) its defining SrcLoc
- -- So we update this info
-
- Just name -> let
- new_name = setNameModuleAndLoc name mod loc
- new_cache = addToFM cache key new_name
- in
- setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_`
--- traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
- returnRn new_name
-
- -- Miss in the cache!
- -- Build a completely new Name, and put it in the cache
- -- Even for locally-defined names we use implicitImportProvenance;
- -- updateProvenances will set it to rights
- Nothing -> let
- (us', us1) = splitUniqSupply (nsUniqs name_supply)
- uniq = uniqFromSupply us1
- new_name = mkGlobalName uniq mod occ loc
- new_cache = addToFM cache key new_name
- in
- setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
--- traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
- returnRn new_name
-
-
-newGlobalName :: ModuleName -> OccName -> RnM d Name
- -- Used for *occurrences*. We make a place-holder Name, really just
- -- to agree on its unique, which gets overwritten when we read in
- -- the binding occurence later (newTopBinder)
- -- The place-holder Name doesn't have the right SrcLoc, and its
- -- Module won't have the right Package either.
- --
- -- (We have to pass a ModuleName, not a Module, because we may be
- -- simply looking at an occurrence M.x in an interface file.)
- --
- -- This means that a renamed program may have incorrect info
- -- on implicitly-imported occurrences, but the correct info on the
- -- *binding* declaration. It's the type checker that propagates the
- -- correct information to all the occurrences.
- -- Since implicitly-imported names never occur in error messages,
- -- it doesn't matter that we get the correct info in place till later,
- -- (but since it affects DLL-ery it does matter that we get it right
- -- in the end).
-newGlobalName mod_name occ
- = getNameSupplyRn `thenRn` \ name_supply ->
- let
- key = (mod_name, occ)
- cache = nsNames name_supply
- in
- case lookupFM cache key of
- Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
- returnRn name
-
- Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_`
- -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_`
- returnRn name
- where
- (us', us1) = splitUniqSupply (nsUniqs name_supply)
- uniq = uniqFromSupply us1
- mod = mkVanillaModule mod_name
- name = mkGlobalName uniq mod occ noSrcLoc
- new_cache = addToFM cache key name
-
-newIPName rdr_name
- = getNameSupplyRn `thenRn` \ name_supply ->
- let
- ipcache = nsIPs name_supply
- in
- case lookupFM ipcache key of
- Just name -> returnRn name
- Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_`
- returnRn name
- where
- (us', us1) = splitUniqSupply (nsUniqs name_supply)
- uniq = uniqFromSupply us1
- name = mkIPName uniq key
- new_ipcache = addToFM ipcache key name
- where key = (rdrNameOcc rdr_name)
+newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
+newTopSrcBinder this_mod mb_parent (L loc rdr_name)
+ | Just name <- isExact_maybe rdr_name
+ = -- This is here to catch
+ -- (a) Exact-name binders created by Template Haskell
+ -- (b) The PrelBase defn of (say) [] and similar, for which
+ -- the parser reads the special syntax and returns an Exact RdrName
+ -- We are at a binding site for the name, so check first that it
+ -- the current module is the correct one; otherwise GHC can get
+ -- very confused indeed. This test rejects code like
+ -- data T = (,) Int Int
+ -- unless we are in GHC.Tup
+ ASSERT2( isExternalName name, ppr name )
+ do checkErr (this_mod == nameModule name)
+ (badOrigBinding rdr_name)
+ returnM name
+
+
+ | isOrig rdr_name
+ = do checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
+ (badOrigBinding rdr_name)
+ -- When reading External Core we get Orig names as binders,
+ -- but they should agree with the module gotten from the monad
+ --
+ -- We can get built-in syntax showing up here too, sadly. If you type
+ -- data T = (,,,)
+ -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon
+ -- uses setRdrNameSpace to make it into a data constructors. At that point
+ -- the nice Exact name for the TyCon gets swizzled to an Orig name.
+ -- Hence the badOrigBinding error message.
+ --
+ -- Except for the ":Main.main = ..." definition inserted into
+ -- the Main module; ugh!
+
+ -- Because of this latter case, we call newGlobalBinder with a module from
+ -- the RdrName, not from the environment. In principle, it'd be fine to
+ -- have an arbitrary mixture of external core definitions in a single module,
+ -- (apart from module-initialisation issues, perhaps).
+ newGlobalBinder rdr_mod (rdrNameOcc rdr_name) mb_parent
+ (srcSpanStart loc) --TODO, should pass the whole span
+
+ | otherwise
+ = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
+ where
+ rdr_mod = rdrNameModule rdr_name