ghc/compiler/rename/RenameMonad12.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[RenameMonad12]{The monad used by the renamer passes 1 and 2}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RenameMonad12 (
  10         Rn12M(..),
  11         initRn12, thenRn12, returnRn12,
  12         mapRn12, zipWithRn12, foldrRn12,
  13         addErrRn12, getModuleNameRn12, recoverQuietlyRn12,
  14
  15         -- and to make the interface self-sufficient...
  16         Bag, Pretty(..), PprStyle, PrettyRep
  17     ) where
  18
  19 import Bag
  20 import Errors
  21 import Outputable
  22 import Pretty           -- for type Pretty
  23 import Util             -- for pragmas only
  24
  25 infixr 9 `thenRn12`
  26 \end{code}
  27
  28 In this monad, we pass down the name of the module we are working on,
  29 and we thread the collected errors.
  30
  31 \begin{code}
  32 type Rn12M result
  33   =  FAST_STRING{-module name-}
  34   -> Bag Error
  35   -> (result, Bag Error)
  36
  37 #ifdef __GLASGOW_HASKELL__
  38 {-# INLINE thenRn12 #-}
  39 {-# INLINE returnRn12 #-}
  40 #endif
  41
  42 initRn12 :: FAST_STRING{-module name-} -> Rn12M a -> (a, Bag Error)
  43 initRn12 mod action = action mod emptyBag
  44
  45 thenRn12 :: Rn12M a -> (a -> Rn12M b) -> Rn12M b
  46 thenRn12 expr continuation mod errs_so_far
  47   = case (expr mod errs_so_far) of
  48      (res1, errs1) -> continuation res1 mod errs1
  49
  50 returnRn12 :: a -> Rn12M a
  51 returnRn12 x mod errs_so_far = (x, errs_so_far)
  52
  53 mapRn12 :: (a -> Rn12M b) -> [a] -> Rn12M [b]
  54
  55 mapRn12 f []     = returnRn12 []
  56 mapRn12 f (x:xs)
  57   = f x          `thenRn12` \ r ->
  58     mapRn12 f xs `thenRn12` \ rs ->
  59     returnRn12 (r:rs)
  60
  61 zipWithRn12 :: (a -> b -> Rn12M c) -> [a] -> [b] -> Rn12M [c]
  62
  63 zipWithRn12 f []     [] = returnRn12 []
  64 zipWithRn12 f (x:xs) (y:ys)
  65   = f x y               `thenRn12` \ r ->
  66     zipWithRn12 f xs ys `thenRn12` \ rs ->
  67     returnRn12 (r:rs)
  68
  69 foldrRn12 :: (a -> b -> Rn12M b) -> b -> [a] -> Rn12M b
  70
  71 foldrRn12 f z []     = returnRn12 z
  72 foldrRn12 f z (x:xs)
  73  = foldrRn12 f z xs  `thenRn12` \ rest ->
  74    f x rest
  75
  76 addErrRn12 :: Error -> Rn12M ()
  77 addErrRn12 err mod errs_so_far
  78  = ( (), errs_so_far `snocBag` err )
  79
  80 getModuleNameRn12 :: Rn12M FAST_STRING
  81 getModuleNameRn12 mod errs_so_far = (mod, errs_so_far)
  82 \end{code}
  83
  84 \begin{code}
  85 recoverQuietlyRn12 :: a -> Rn12M a -> Rn12M a
  86
  87 recoverQuietlyRn12 use_this_if_err action mod errs_so_far
  88   = let
  89         (result, errs_out)
  90           = case (action mod emptyBag{-no errors-}) of { (res, errs) ->
  91             if isEmptyBag errs then
  92                 (res, errs_so_far)  -- retain incoming errs
  93             else
  94                 (use_this_if_err, errs_so_far)
  95             }
  96     in
  97     (result, errs_out)
  98 \end{code}