ghc/compiler/rename/RnMonad12.lhs

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