ghc/compiler/parser/UgenUtil.lhs

   1 Glues lots of things together for ugen-generated
   2 .hs files here
   3
   4 \begin{code}
   5 module UgenUtil (
   6         -- stuff defined here
   7         module UgenUtil,
   8         Addr
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import GlaExts
  14 import Name
  15 import RdrHsSyn         ( RdrName(..) )
  16 import BasicTypes       ( IfaceFlavour )
  17 import SrcLoc           ( mkSrcLoc, noSrcLoc, SrcLoc )
  18 import FastString       ( FastString, mkFastCharString, mkFastCharString2 )
  19 \end{code}
  20
  21 \begin{code}
  22 type UgnM a
  23   = (FastString,Module,SrcLoc)     -- file, module and src_loc carried down
  24   -> IO a
  25
  26 {-# INLINE returnUgn #-}
  27 {-# INLINE thenUgn #-}
  28
  29 returnUgn x stuff = return x
  30
  31 thenUgn x y stuff
  32   = x stuff     >>= \ z ->
  33     y z stuff
  34
  35 initUgn :: UgnM a -> IO a
  36 initUgn action = action (SLIT(""),SLIT(""),noSrcLoc)
  37
  38 ioToUgnM :: IO a -> UgnM a
  39 ioToUgnM x stuff = x
  40 \end{code}
  41
  42 \begin{code}
  43 type ParseTree = Addr
  44
  45 type U_VOID_STAR = Addr
  46 rdU_VOID_STAR ::  Addr -> UgnM U_VOID_STAR
  47 rdU_VOID_STAR x = returnUgn x
  48
  49 type U_long = Int
  50 rdU_long ::  Int -> UgnM U_long
  51 rdU_long x = returnUgn x
  52
  53 type U_stringId = FastString
  54 rdU_stringId :: Addr -> UgnM U_stringId
  55 {-# INLINE rdU_stringId #-}
  56 rdU_stringId s = returnUgn (mkFastCharString s)
  57
  58 type U_numId = Int -- ToDo: Int
  59 rdU_numId :: Addr -> UgnM U_numId
  60 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  61
  62 type U_hstring = FastString
  63 rdU_hstring :: Addr -> UgnM U_hstring
  64 rdU_hstring x
  65   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  66     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  67     returnUgn (mkFastCharString2 bytes len)
  68 \end{code}
  69
  70 \begin{code}
  71 setSrcFileUgn :: FastString -> UgnM a -> UgnM a
  72 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
  73
  74 getSrcFileUgn :: UgnM FastString
  75 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
  76
  77 setSrcModUgn :: Module -> UgnM a -> UgnM a
  78 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
  79
  80 getSrcModUgn :: UgnM Module
  81 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
  82
  83 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
  84 mkSrcLocUgn ln action (file,mod,_)
  85   = action loc (file,mod,loc)
  86   where
  87     loc = mkSrcLoc file ln
  88
  89 getSrcLocUgn :: UgnM SrcLoc
  90 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff
  91 \end{code}