ghc/compiler/rename/RnMonad3.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnMonad3]{The monad used by the third renamer pass}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnMonad3 (
  10         Rn3M(..),
  11         initRn3, thenRn3, andRn3, returnRn3, mapRn3, fixRn3,
  12
  13         putInfoDownM3,
  14
  15         newFullNameM3, newInvisibleNameM3
  16
  17         -- for completeness
  18     ) where
  19
  20 import Ubiq{-uitous-}
  21
  22 import FiniteMap        ( emptyFM,  isEmptyFM,  lookupFM,
  23                           emptySet, isEmptySet, elementOf
  24                         )
  25 import HsSyn            ( IE )
  26 import NameTypes        -- lots of stuff
  27 import Outputable       ( ExportFlag(..) )
  28 import ProtoName        ( ProtoName(..) )
  29 import RdrHsSyn         ( getExportees, ExportListInfo(..), ProtoNameIE(..) )
  30 import UniqSupply       ( getUnique, splitUniqSupply )
  31 import Util             ( panic )
  32
  33 infixr 9 `thenRn3`
  34 \end{code}
  35
  36 %************************************************************************
  37 %*                                                                      *
  38 \subsection{Plain @RnPass3@ monadery}
  39 %*                                                                      *
  40 %************************************************************************
  41
  42 \begin{code}
  43 type Rn3M result
  44   =  ExportListInfo -> FAST_STRING{-ModuleName-} -> UniqSupply
  45   -> result
  46
  47 {-# INLINE andRn3 #-}
  48 {-# INLINE thenRn3 #-}
  49 {-# INLINE returnRn3 #-}
  50
  51 initRn3 :: Rn3M a -> UniqSupply -> a
  52
  53 initRn3 m us = m Nothing{-no export list-} (panic "initRn3: uninitialised module name") us
  54
  55 thenRn3 :: Rn3M a -> (a -> Rn3M b) -> Rn3M b
  56 andRn3  :: (a -> a -> a) -> Rn3M a -> Rn3M a -> Rn3M a
  57
  58 thenRn3 expr continuation exps mod_name uniqs
  59   = case splitUniqSupply uniqs      of { (s1, s2) ->
  60     case (expr exps mod_name s1)    of { res1 ->
  61     continuation res1 exps mod_name s2 }}
  62
  63 andRn3 combiner m1 m2 exps mod_name uniqs
  64   = case splitUniqSupply uniqs      of { (s1, s2) ->
  65     case (m1 exps mod_name s1)      of { res1 ->
  66     case (m2 exps mod_name s2)      of { res2 ->
  67     combiner res1 res2 }}}
  68
  69 returnRn3 :: a -> Rn3M a
  70 returnRn3 result exps mod_name uniqs = result
  71
  72 mapRn3 :: (a -> Rn3M b) -> [a] -> Rn3M [b]
  73
  74 mapRn3 f []     = returnRn3 []
  75 mapRn3 f (x:xs)
  76   = f x         `thenRn3` \ r ->
  77     mapRn3 f xs `thenRn3` \ rs ->
  78     returnRn3 (r:rs)
  79
  80 fixRn3 :: (a -> Rn3M a) -> Rn3M a
  81
  82 fixRn3 m exps mod_name us
  83   = result
  84   where
  85     result = m result exps mod_name us
  86
  87 putInfoDownM3 :: FAST_STRING{-ModuleName-} -> Maybe [ProtoNameIE] -> Rn3M a -> Rn3M a
  88
  89 putInfoDownM3 mod_name exports cont _ _ uniqs
  90   = cont (getExportees exports) mod_name uniqs
  91 \end{code}
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection[RnMonad3-new-names]{Making new names}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 @newFullNameM3@ makes a new user-visible FullName (the usual);
 100 @newInvisibleNameM3@ is the odd case.  @new_name@ does all the work.
 101
 102 \begin{code}
 103 newFullNameM3, newInvisibleNameM3
 104         :: ProtoName            -- input
 105         -> SrcLoc               -- where it started life
 106         -> Bool                 -- if it is "TyCon"ish (rather than "val"ish)
 107         -> Maybe ExportFlag     -- Just flag => force the use of that exportness
 108         -> Rn3M (Unique, FullName)
 109
 110 newFullNameM3 pn src_loc is_tycon_ish frcd_exp exps mod_name uniqs
 111   = new_name pn src_loc is_tycon_ish frcd_exp False{-visible-} exps mod_name uniqs
 112
 113 newInvisibleNameM3 pn src_loc is_tycon_ish frcd_exp exps mod_name uniqs
 114   = new_name pn src_loc is_tycon_ish frcd_exp True{-invisible-} exps mod_name uniqs
 115 \end{code}
 116
 117 \begin{code}
 118 new_name pn src_loc is_tycon_ish frcd_export_flag want_invisible exps mod_name uniqs
 119   = (uniq, name)
 120   where
 121     uniq = getUnique uniqs
 122
 123     mk_name = if want_invisible then mkPrivateFullName else mkFullName
 124
 125     name = case pn of
 126
 127         Unk s -> mk_name mod_name s
 128                    (if fromPrelude mod_name
 129                       && is_tycon_ish then -- & tycon/clas/datacon => Core
 130                        HereInPreludeCore
 131                     else
 132                        ThisModule
 133                    )
 134                    (case frcd_export_flag of
 135                       Just fl -> fl
 136                       Nothing -> mk_export_flag True [mod_name] s exps)
 137                    src_loc
 138
 139         Qunk m s -> mk_name mod_name s
 140                       (if fromPrelude mod_name
 141                          && is_tycon_ish then -- & tycon/clas/datacon => Core
 142                           HereInPreludeCore
 143                        else
 144                           ThisModule
 145                       )
 146                       (case frcd_export_flag of
 147                          Just fl -> fl
 148                          Nothing -> mk_export_flag (_trace "mk_export_flag?" True) [m] s exps)
 149                       src_loc
 150
 151         -- note: the assigning of prelude-ness is most dubious (ToDo)
 152
 153         Imp m d informant_mods l
 154           -> mk_name m d
 155                (if fromPrelude m then   -- as above
 156                    if is_tycon_ish then
 157                        ExportedByPreludeCore
 158                    else
 159                        OtherPrelude l
 160                 else if m == mod_name then -- pretty dang weird... (ToDo: anything?)
 161                    ThisModule
 162                 else
 163                    OtherModule l informant_mods -- for Other*, we save its occurrence name
 164                )
 165                (case frcd_export_flag of
 166                   Just fl -> fl
 167                   Nothing -> mk_export_flag (m==mod_name) informant_mods l exps)
 168                src_loc
 169
 170         Prel n    -> panic "RnMonad3.new_name: prelude name"
 171 \end{code}
 172
 173 In deciding the ``exportness'' of something, there are these cases to
 174 consider:
 175 \begin{description}
 176 \item[No explicit export list:]
 177 Everything defined in this module goes out.
 178
 179 \item[Matches a non-\tr{M..} item in the export list:]
 180 Then it's exported as its @name_pr@ item suggests.
 181
 182 \item[Matches a \tr{M..} item in the export list:]
 183
 184 (Note: the module \tr{M} may be {\em this} module!)  It's exported if
 185 we got it from \tr{M}'s interface; {\em most emphatically not} the
 186 same thing as ``it originally came from \tr{M}''.
 187
 188 \item[Otherwise:]
 189 It isn't exported.
 190 \end{description}
 191
 192 \begin{code}
 193 mk_export_flag  :: Bool         -- True <=> originally from the module we're compiling
 194                 -> [FAST_STRING]-- modules that told us about this thing
 195                 -> FAST_STRING  -- name of the thing we're looking at
 196                 -> ExportListInfo
 197                 -> ExportFlag   -- result
 198
 199 mk_export_flag this_module informant_mods thing Nothing{-no export list-}
 200   = if this_module then ExportAll else NotExported
 201
 202 mk_export_flag this_module informant_mods thing (Just (exports_alist, dotdot_modules))
 203   | otherwise
 204   = case (lookupFM exports_alist thing) of
 205       Just how_to_export -> how_to_export
 206       Nothing            -> if (or [ im `elementOf` dotdot_modules | im <- informant_mods ])
 207                             then ExportAll
 208                             else NotExported
 209 \end{code}