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 BasicTypes       ( IfaceFlavour )
  40 import SrcLoc           ( mkSrcLoc, noSrcLoc, SrcLoc )
  41 \end{code}
  42
  43 \begin{code}
  44 type UgnM a
  45   = (FAST_STRING,Module,SrcLoc)    -- file, module and src_loc carried down
  46   -> PrimIO a
  47
  48 {-# INLINE returnUgn #-}
  49 {-# INLINE thenUgn #-}
  50
  51 returnUgn x stuff = returnPrimIO x
  52
  53 thenUgn x y stuff
  54   = x stuff     `thenPrimIO` \ z ->
  55     y z stuff
  56
  57 initUgn :: UgnM a -> IO a
  58 initUgn action
  59   = let
  60         do_it = action (SLIT(""),SLIT(""),noSrcLoc)
  61     in
  62 #if __GLASGOW_HASKELL__ >= 200
  63     primIOToIO do_it
  64 #else
  65     do_it       `thenPrimIO` \ result ->
  66     return result
  67 #endif
  68
  69 ioToUgnM :: PrimIO a -> UgnM a
  70 ioToUgnM x stuff = x
  71 \end{code}
  72
  73 \begin{code}
  74 type ParseTree = ADDR
  75
  76 type U_VOID_STAR = ADDR
  77 rdU_VOID_STAR ::  ADDR -> UgnM U_VOID_STAR
  78 rdU_VOID_STAR x = returnUgn x
  79
  80 type U_long = Int
  81 rdU_long ::  Int -> UgnM U_long
  82 rdU_long x = returnUgn x
  83
  84 type U_stringId = FAST_STRING
  85 rdU_stringId :: ADDR -> UgnM U_stringId
  86 {-# INLINE rdU_stringId #-}
  87 rdU_stringId s = returnUgn (PACK_STR s)
  88
  89 type U_numId = Int -- ToDo: Int
  90 rdU_numId :: ADDR -> UgnM U_numId
  91 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  92
  93 type U_hstring = FAST_STRING
  94 rdU_hstring :: ADDR -> UgnM U_hstring
  95 rdU_hstring x
  96   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  97     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  98     returnUgn (PACK_BYTES bytes len)
  99 \end{code}
 100
 101 \begin{code}
 102 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
 103 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
 104
 105 getSrcFileUgn :: UgnM FAST_STRING
 106 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
 107
 108 setSrcModUgn :: Module -> UgnM a -> UgnM a
 109 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
 110
 111 getSrcModUgn :: UgnM Module
 112 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
 113
 114 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
 115 mkSrcLocUgn ln action (file,mod,_)
 116   = action loc (file,mod,loc)
 117   where
 118     loc = mkSrcLoc file ln
 119
 120 getSrcLocUgn :: UgnM SrcLoc
 121 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff
 122 \end{code}