ghc/compiler/main/MainMonad.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
   3 %
   4 \section[MainMonad]{I/O monad used in @Main@ module of the compiler}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module MainMonad (
  10         MainIO(..),
  11         returnMn,
  12         thenMn,
  13         thenMn_,
  14 --      foldlMn, INLINEd at its two (important) uses...
  15         readMn,
  16         writeMn,
  17         getArgsMn,
  18         getSplitUniqSupplyMn,
  19         exitMn,
  20         fopen, fclose, fwrite, _FILE(..),
  21
  22         UniqSupply
  23         IF_ATTACK_PRAGMAS(COMMA getArgsPrimIO)
  24         IF_ATTACK_PRAGMAS(COMMA appendFilePrimIO)
  25         IF_ATTACK_PRAGMAS(COMMA appendChanPrimIO)
  26         IF_ATTACK_PRAGMAS(COMMA readChanPrimIO)
  27         IF_ATTACK_PRAGMAS(COMMA mkSplitUniqSupply) -- profiling only, really
  28     ) where
  29
  30 #if __HASKELL1__ >= 3
  31 import LibSystem
  32 #endif
  33
  34 import PreludeGlaST
  35
  36 import Ubiq{-uitous-}
  37
  38 import UniqSupply       ( mkSplitUniqSupply, UniqSupply )
  39
  40 infixr 9 `thenMn`       -- right-associative, please
  41 infixr 9 `thenMn_`
  42 \end{code}
  43
  44 A value of type @MainIO a@ represents an I/O-performing computation
  45 returning a value of type @a@.  It is a function from the whole list
  46 of responses-to-the-rest-of-the-program, to a triple consisting of:
  47 \begin{enumerate}
  48 \item
  49 the value of type @a@;
  50 \item
  51 a function which prefixes the requests for the computation to
  52 the front of a supplied list of requests; using a function here
  53 avoids an expensive append operation in @thenMn@;
  54 \item
  55 the depleted list of responses.
  56 \end{enumerate}
  57
  58 \begin{code}
  59 returnMn    :: a -> MainIO a
  60 thenMn      :: MainIO a -> (a -> MainIO b) -> MainIO b
  61 thenMn_     :: MainIO a -> MainIO b -> MainIO b
  62
  63 #if __HASKELL1__ < 3
  64 readMn      :: String{-channel-} -> MainIO String
  65 writeMn     :: String{-channel-} -> String -> MainIO ()
  66 #else
  67 readMn      :: Handle -> MainIO String
  68 writeMn     :: Handle -> String -> MainIO ()
  69 #endif
  70
  71 getArgsMn   :: MainIO [String]
  72 getSplitUniqSupplyMn
  73             :: Char -> MainIO UniqSupply
  74 exitMn      :: Int -> MainIO ()
  75
  76 {-# INLINE returnMn #-}
  77 {-# INLINE thenMn   #-}
  78 {-# INLINE thenMn_  #-}
  79
  80 exitMn val
  81   = if val /= 0
  82     then error "Compilation had errors\n"
  83     else returnMn ()
  84
  85 #if __HASKELL1__ < 3
  86
  87 type MainIO a = PrimIO a
  88
  89 returnMn    = returnPrimIO
  90 thenMn      = thenPrimIO
  91 thenMn_     = seqPrimIO
  92
  93 readMn chan                 = readChanPrimIO chan
  94 writeMn chan str            = appendChanPrimIO chan str
  95 getArgsMn                   = getArgsPrimIO
  96
  97 getSplitUniqSupplyMn char = mkSplitUniqSupply char
  98
  99 #else {- 1.3 -}
 100
 101 type MainIO a = IO a
 102
 103 returnMn    = return
 104 thenMn      = (>>=)
 105 thenMn_     = (>>)
 106
 107 readMn chan                 = hGetContents chan
 108 writeMn chan str            = hPutStr chan str
 109 getArgsMn                   = getArgs
 110
 111 getSplitUniqSupplyMn char
 112   = mkSplitUniqSupply char `thenPrimIO` \ us ->
 113     return us
 114
 115 #endif {- 1.3 -}
 116 \end{code}