2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnMonad12]{The monad used by the renamer passes 1 and 2}
7 #include "HsVersions.h"
11 initRn12, thenRn12, returnRn12,
12 mapRn12, zipWithRn12, foldrRn12,
13 addErrRn12, getModuleNameRn12, recoverQuietlyRn12
15 -- and to make the interface self-sufficient...
20 import Bag ( emptyBag, isEmptyBag, snocBag, Bag )
21 import ErrUtils ( Error(..) )
22 import Pretty ( Pretty(..) )
27 In this monad, we pass down the name of the module we are working on,
28 and we thread the collected errors.
32 = FAST_STRING{-module name-}
34 -> (result, Bag Error)
36 {-# INLINE thenRn12 #-}
37 {-# INLINE returnRn12 #-}
39 initRn12 :: FAST_STRING{-module name-} -> Rn12M a -> (a, Bag Error)
40 initRn12 mod action = action mod emptyBag
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
47 returnRn12 :: a -> Rn12M a
48 returnRn12 x mod errs_so_far = (x, errs_so_far)
50 mapRn12 :: (a -> Rn12M b) -> [a] -> Rn12M [b]
52 mapRn12 f [] = returnRn12 []
54 = f x `thenRn12` \ r ->
55 mapRn12 f xs `thenRn12` \ rs ->
58 zipWithRn12 :: (a -> b -> Rn12M c) -> [a] -> [b] -> Rn12M [c]
60 zipWithRn12 f [] [] = returnRn12 []
61 zipWithRn12 f (x:xs) (y:ys)
62 = f x y `thenRn12` \ r ->
63 zipWithRn12 f xs ys `thenRn12` \ rs ->
65 -- NB: zipWithRn12 behaves like zipWithEqual
66 -- (requires equal-length lists)
68 foldrRn12 :: (a -> b -> Rn12M b) -> b -> [a] -> Rn12M b
70 foldrRn12 f z [] = returnRn12 z
72 = foldrRn12 f z xs `thenRn12` \ rest ->
75 addErrRn12 :: Error -> Rn12M ()
76 addErrRn12 err mod errs_so_far
77 = ( (), errs_so_far `snocBag` err )
79 getModuleNameRn12 :: Rn12M FAST_STRING
80 getModuleNameRn12 mod errs_so_far = (mod, errs_so_far)
84 recoverQuietlyRn12 :: a -> Rn12M a -> Rn12M a
86 recoverQuietlyRn12 use_this_if_err action mod errs_so_far
89 = case (action mod emptyBag{-no errors-}) of { (res, errs) ->
90 if isEmptyBag errs then
91 (res, errs_so_far) -- retain incoming errs
93 (use_this_if_err, errs_so_far)