ghc/compiler/parser/UgenUtil.lhs

   1 Glues lots of things together for ugen-generated
   2 .hs files here
   3
   4 \begin{code}
   5 #include "HsVersions.h"
   6
   7 module UgenUtil (
   8         -- re-exported Prelude stuff
   9         returnPrimIO, thenPrimIO,
  10
  11         -- stuff defined here
  12         EXP_MODULE(UgenUtil)
  13     ) where
  14
  15 IMP_Ubiq()
  16
  17 import PreludeGlaST
  18
  19 #if __GLASGOW_HASKELL__ >= 200
  20 # define ADDR       GHCbase.Addr
  21 # define PACK_STR   packCString
  22 # define PACK_BYTES packCBytes
  23 #else
  24 # define ADDR       _Addr
  25 # define PACK_STR   mkFastCharString
  26 # define PACK_BYTES mkFastCharString2
  27 #endif
  28
  29 import RdrHsSyn         ( RdrName(..) )
  30 import SrcLoc           ( mkSrcLoc, noSrcLoc, SrcLoc )
  31 \end{code}
  32
  33 \begin{code}
  34 type UgnM a
  35   = (FAST_STRING,Module,SrcLoc)    -- file, module and src_loc carried down
  36   -> PrimIO a
  37
  38 {-# INLINE returnUgn #-}
  39 {-# INLINE thenUgn #-}
  40
  41 returnUgn x stuff = returnPrimIO x
  42
  43 thenUgn x y stuff
  44   = x stuff     `thenPrimIO` \ z ->
  45     y z stuff
  46
  47 initUgn :: UgnM a -> IO a
  48 initUgn action
  49   = let
  50         do_it = action (SLIT(""),SLIT(""),noSrcLoc)
  51     in
  52 #if __GLASGOW_HASKELL__ >= 200
  53     primIOToIO do_it
  54 #else
  55     do_it       `thenPrimIO` \ result ->
  56     return result
  57 #endif
  58
  59 ioToUgnM :: PrimIO a -> UgnM a
  60 ioToUgnM x stuff = x
  61 \end{code}
  62
  63 \begin{code}
  64 type ParseTree = ADDR
  65
  66 type U_VOID_STAR = ADDR
  67 rdU_VOID_STAR ::  ADDR -> UgnM U_VOID_STAR
  68 rdU_VOID_STAR x = returnUgn x
  69
  70 type U_long = Int
  71 rdU_long ::  Int -> UgnM U_long
  72 rdU_long x = returnUgn x
  73
  74 type U_stringId = FAST_STRING
  75 rdU_stringId :: ADDR -> UgnM U_stringId
  76 {-# INLINE rdU_stringId #-}
  77 rdU_stringId s = returnUgn (PACK_STR s)
  78
  79 type U_numId = Int -- ToDo: Int
  80 rdU_numId :: ADDR -> UgnM U_numId
  81 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  82
  83 type U_hstring = FAST_STRING
  84 rdU_hstring :: ADDR -> UgnM U_hstring
  85 rdU_hstring x
  86   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  87     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  88     returnUgn (PACK_BYTES bytes len)
  89 \end{code}
  90
  91 \begin{code}
  92 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
  93 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
  94
  95 getSrcFileUgn :: UgnM FAST_STRING
  96 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
  97
  98 setSrcModUgn :: Module -> UgnM a -> UgnM a
  99 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
 100
 101 getSrcModUgn :: UgnM Module
 102 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
 103
 104 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
 105 mkSrcLocUgn ln action (file,mod,_)
 106   = action loc (file,mod,loc)
 107   where
 108     loc = mkSrcLoc file ln
 109
 110 getSrcLocUgn :: UgnM SrcLoc
 111 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff
 112 \end{code}