--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+%
+\section[RenameMonad3]{The monad used by the third renamer pass}
+
+\begin{code}
+#include "HsVersions.h"
+
+module RenameMonad3 (
+ Rn3M(..),
+ initRn3, thenRn3, andRn3, returnRn3, mapRn3, fixRn3,
+
+ putInfoDownM3,
+
+ newFullNameM3, newInvisibleNameM3,
+
+ -- for completeness
+ IE, FullName, ExportFlag, ProtoName, Unique,
+ SplitUniqSupply
+ IF_ATTACK_PRAGMAS(COMMA splitUniqSupply)
+ ) where
+
+import AbsSyn -- including, IE, getIEStrings, ...
+import FiniteMap
+import Maybes ( Maybe(..), assocMaybe )
+import NameTypes
+import Outputable
+import ProtoName
+import RenameMonad4 ( GlobalNameFun(..) )
+import SplitUniq
+import Unique
+import Util
+
+infixr 9 `thenRn3`
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Plain @Rename3@ monadery}
+%* *
+%************************************************************************
+
+\begin{code}
+type Rn3M result
+ = ImExportListInfo -> FAST_STRING{-ModuleName-} -> SplitUniqSupply
+ -> result
+
+#ifdef __GLASGOW_HASKELL__
+{-# INLINE andRn3 #-}
+{-# INLINE thenRn3 #-}
+{-# INLINE returnRn3 #-}
+#endif
+
+initRn3 :: Rn3M a -> SplitUniqSupply -> a
+
+initRn3 m us = m (emptyFM,emptySet) (panic "initRn3: uninitialised module name") us
+
+thenRn3 :: Rn3M a -> (a -> Rn3M b) -> Rn3M b
+andRn3 :: (a -> a -> a) -> Rn3M a -> Rn3M a -> Rn3M a
+
+thenRn3 expr continuation exps mod_name uniqs
+ = case splitUniqSupply uniqs of { (s1, s2) ->
+ case (expr exps mod_name s1) of { res1 ->
+ continuation res1 exps mod_name s2 }}
+
+andRn3 combiner m1 m2 exps mod_name uniqs
+ = case splitUniqSupply uniqs of { (s1, s2) ->
+ case (m1 exps mod_name s1) of { res1 ->
+ case (m2 exps mod_name s2) of { res2 ->
+ combiner res1 res2 }}}
+
+returnRn3 :: a -> Rn3M a
+returnRn3 result exps mod_name uniqs = result
+
+mapRn3 :: (a -> Rn3M b) -> [a] -> Rn3M [b]
+
+mapRn3 f [] = returnRn3 []
+mapRn3 f (x:xs)
+ = f x `thenRn3` \ r ->
+ mapRn3 f xs `thenRn3` \ rs ->
+ returnRn3 (r:rs)
+
+fixRn3 :: (a -> Rn3M a) -> Rn3M a
+
+fixRn3 m exps mod_name us
+ = result
+ where
+ result = m result exps mod_name us
+
+putInfoDownM3 :: FAST_STRING{-ModuleName-} -> [IE] -> Rn3M a -> Rn3M a
+
+putInfoDownM3 mod_name exports cont _ _ uniqs
+ = cont (getIEStrings exports) mod_name uniqs
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[RenameMonad3-new-names]{Making new names}
+%* *
+%************************************************************************
+
+@newFullNameM3@ makes a new user-visible FullName (the usual);
+@newInvisibleNameM3@ is the odd case. @new_name@ does all the work.
+
+\begin{code}
+newFullNameM3, newInvisibleNameM3
+ :: ProtoName -- input
+ -> SrcLoc -- where it started life
+ -> Bool -- if it is "TyCon"ish (rather than "val"ish)
+ -> Maybe ExportFlag -- Just flag => force the use of that exportness
+ -> Rn3M (Unique, FullName)
+
+newFullNameM3 pn src_loc is_tycon_ish frcd_exp exps mod_name uniqs
+ = new_name pn src_loc is_tycon_ish frcd_exp False{-visible-} exps mod_name uniqs
+
+newInvisibleNameM3 pn src_loc is_tycon_ish frcd_exp exps mod_name uniqs
+ = new_name pn src_loc is_tycon_ish frcd_exp True{-invisible-} exps mod_name uniqs
+\end{code}
+
+\begin{code}
+new_name pn src_loc is_tycon_ish frcd_export_flag want_invisible exps mod_name uniqs
+ = (uniq, name)
+ where
+ uniq = getSUnique uniqs
+
+ mk_name = if want_invisible then mkPrivateFullName else mkFullName
+
+ name = case pn of
+
+ Unk s -> mk_name mod_name s
+ (if fromPrelude mod_name
+ && is_tycon_ish then -- & tycon/clas/datacon => Core
+ HereInPreludeCore
+ else
+ ThisModule
+ )
+ (case frcd_export_flag of
+ Just fl -> fl
+ Nothing -> mk_export_flag True [mod_name] s exps)
+ src_loc
+
+ -- note: the assigning of prelude-ness is most dubious (ToDo)
+
+ Imp m d informant_mods l
+ -> mk_name m d
+ (if fromPrelude m then -- as above
+ if is_tycon_ish then
+ ExportedByPreludeCore
+ else
+ OtherPrelude l
+ else if m == mod_name then -- pretty dang weird... (ToDo: anything?)
+ ThisModule
+ else
+ OtherModule l informant_mods -- for Other*, we save its occurrence name
+ )
+ (case frcd_export_flag of
+ Just fl -> fl
+ Nothing -> mk_export_flag (m==mod_name) informant_mods l exps)
+ src_loc
+
+ Prel n -> panic "RenameMonad3.new_name: prelude name"
+\end{code}
+
+In deciding the ``exportness'' of something, there are these cases to
+consider:
+\begin{description}
+\item[No explicit export list:]
+Everything defined in this module goes out.
+
+\item[Matches a non-\tr{M..} item in the export list:]
+Then it's exported as its @name_pr@ item suggests.
+
+\item[Matches a \tr{M..} item in the export list:]
+
+(Note: the module \tr{M} may be {\em this} module!) It's exported if
+we got it from \tr{M}'s interface; {\em most emphatically not} the
+same thing as ``it originally came from \tr{M}''.
+
+\item[Otherwise:]
+It isn't exported.
+\end{description}
+
+\begin{code}
+mk_export_flag :: Bool -- True <=> originally from the module we're compiling
+ -> [FAST_STRING] -- modules that told us about this thing
+ -> FAST_STRING -- name of the thing we're looking at
+ -> ImExportListInfo
+ -> ExportFlag -- result
+
+mk_export_flag this_module informant_mods thing (exports_alist, dotdot_modules)
+ | isEmptyFM exports_alist && isEmptySet dotdot_modules
+ = if this_module then ExportAll else NotExported
+
+ | otherwise
+ = case (lookupFM exports_alist thing) of
+ Just how_to_export -> how_to_export
+ Nothing -> if (or [ im `elementOf` dotdot_modules | im <- informant_mods ])
+ then ExportAll
+ else NotExported
+\end{code}
projects / ghc-hetmet.git / blobdiff