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 Module           ( Module, mkSrcModule )
  15 import SrcLoc           ( mkSrcLoc, noSrcLoc, SrcLoc )
  16 import FastString       ( FastString, mkFastCharString, mkFastCharString2 )
  17 \end{code}
  18
  19 \begin{code}
  20 type UgnM a
  21   = (FastString,SrcLoc)    -- file, and src_loc carried down
  22   -> IO a
  23
  24 {-# INLINE returnUgn #-}
  25 {-# INLINE thenUgn #-}
  26
  27 returnUgn x stuff = return x
  28
  29 thenUgn x y stuff
  30   = x stuff     >>= \ z ->
  31     y z stuff
  32
  33 initUgn :: UgnM a -> IO a
  34 initUgn action = action (SLIT(""),noSrcLoc)
  35
  36 ioToUgnM :: IO a -> UgnM a
  37 ioToUgnM x stuff = x
  38 \end{code}
  39
  40 \begin{code}
  41 type ParseTree = Addr
  42
  43 type U_VOID_STAR = Addr
  44 rdU_VOID_STAR ::  Addr -> UgnM U_VOID_STAR
  45 rdU_VOID_STAR x = returnUgn x
  46
  47 type U_long = Int
  48 rdU_long ::  Int -> UgnM U_long
  49 rdU_long x = returnUgn x
  50
  51 type U_stringId = FastString
  52 rdU_stringId :: Addr -> UgnM U_stringId
  53 {-# INLINE rdU_stringId #-}
  54 rdU_stringId s = returnUgn (mkFastCharString s)
  55
  56 type U_numId = Int -- ToDo: Int
  57 rdU_numId :: Addr -> UgnM U_numId
  58 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  59
  60 type U_hstring = FastString
  61 rdU_hstring :: Addr -> UgnM U_hstring
  62 rdU_hstring x
  63   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  64     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  65     returnUgn (mkFastCharString2 bytes len)
  66 \end{code}
  67
  68 \begin{code}
  69 setSrcFileUgn :: FastString -> UgnM a -> UgnM a
  70 setSrcFileUgn file action stuff@(_,loc) = action (file,loc)
  71
  72 getSrcFileUgn :: UgnM FastString
  73 getSrcFileUgn stuff@(file,loc) = returnUgn file stuff
  74
  75 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
  76 mkSrcLocUgn ln action (file,_)
  77   = action loc (file,loc)
  78   where
  79     loc = mkSrcLoc file ln
  80
  81 getSrcLocUgn :: UgnM SrcLoc
  82 getSrcLocUgn stuff@(file,loc) = returnUgn loc stuff
  83 \end{code}