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 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
  18 import PreludeGlaST
  19 #else
  20 import GlaExts
  21 import Name
  22 #endif
  23
  24 #if __GLASGOW_HASKELL__ == 201
  25 # define ADDR       GHCbase.Addr
  26 # define PACK_STR   packCString
  27 # define PACK_BYTES packCBytes
  28 #elif __GLASGOW_HASKELL >= 202
  29 # define ADDR       GHC.Addr
  30 # define PACK_STR   mkFastCharString
  31 # define PACK_BYTES mkFastCharString2
  32 #else
  33 # define ADDR       _Addr
  34 # define PACK_STR   mkFastCharString
  35 # define PACK_BYTES mkFastCharString2
  36 #endif
  37
  38 import RdrHsSyn         ( RdrName(..) )
  39 import SrcLoc           ( mkSrcLoc, noSrcLoc, SrcLoc )
  40 \end{code}
  41
  42 \begin{code}
  43 type UgnM a
  44   = (FAST_STRING,Module,SrcLoc)    -- file, module and src_loc carried down
  45   -> PrimIO a
  46
  47 {-# INLINE returnUgn #-}
  48 {-# INLINE thenUgn #-}
  49
  50 returnUgn x stuff = returnPrimIO x
  51
  52 thenUgn x y stuff
  53   = x stuff     `thenPrimIO` \ z ->
  54     y z stuff
  55
  56 initUgn :: UgnM a -> IO a
  57 initUgn action
  58   = let
  59         do_it = action (SLIT(""),SLIT(""),noSrcLoc)
  60     in
  61 #if __GLASGOW_HASKELL__ >= 200
  62     primIOToIO do_it
  63 #else
  64     do_it       `thenPrimIO` \ result ->
  65     return result
  66 #endif
  67
  68 ioToUgnM :: PrimIO a -> UgnM a
  69 ioToUgnM x stuff = x
  70 \end{code}
  71
  72 \begin{code}
  73 type ParseTree = ADDR
  74
  75 type U_VOID_STAR = ADDR
  76 rdU_VOID_STAR ::  ADDR -> UgnM U_VOID_STAR
  77 rdU_VOID_STAR x = returnUgn x
  78
  79 type U_long = Int
  80 rdU_long ::  Int -> UgnM U_long
  81 rdU_long x = returnUgn x
  82
  83 type U_stringId = FAST_STRING
  84 rdU_stringId :: ADDR -> UgnM U_stringId
  85 {-# INLINE rdU_stringId #-}
  86 rdU_stringId s = returnUgn (PACK_STR s)
  87
  88 type U_numId = Int -- ToDo: Int
  89 rdU_numId :: ADDR -> UgnM U_numId
  90 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  91
  92 type U_hstring = FAST_STRING
  93 rdU_hstring :: ADDR -> UgnM U_hstring
  94 rdU_hstring x
  95   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  96     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  97     returnUgn (PACK_BYTES bytes len)
  98 \end{code}
  99
 100 \begin{code}
 101 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
 102 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
 103
 104 getSrcFileUgn :: UgnM FAST_STRING
 105 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
 106
 107 setSrcModUgn :: Module -> UgnM a -> UgnM a
 108 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
 109
 110 getSrcModUgn :: UgnM Module
 111 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
 112
 113 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
 114 mkSrcLocUgn ln action (file,mod,_)
 115   = action loc (file,mod,loc)
 116   where
 117     loc = mkSrcLoc file ln
 118
 119 getSrcLocUgn :: UgnM SrcLoc
 120 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff
 121 \end{code}