ghc/compiler/yaccParser/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         UgenUtil..,
  13
  14         -- complete interface
  15         ProtoName
  16     ) where
  17
  18 #if __GLASGOW_HASKELL__ < 26
  19 import PreludePrimIO
  20 #else
  21 import PreludeGlaST
  22 #endif
  23 import MainMonad
  24
  25 import ProtoName
  26 import Outputable
  27 import SrcLoc           ( mkSrcLoc2 )
  28 import Util
  29 \end{code}
  30
  31 \begin{code}
  32 type UgnM a
  33   = FAST_STRING            -- source file name; carried down
  34   -> PrimIO a
  35
  36 {-# INLINE returnUgn #-}
  37 {-# INLINE thenUgn #-}
  38
  39 returnUgn x mod = returnPrimIO x
  40
  41 thenUgn x y mod
  42   = x mod       `thenPrimIO` \ z ->
  43     y z mod
  44
  45 initUgn :: FAST_STRING -> UgnM a -> MainIO a
  46 initUgn srcfile action
  47   = action srcfile
  48
  49 ioToUgnM :: PrimIO a -> UgnM a
  50 ioToUgnM x mod = x
  51 \end{code}
  52
  53 \begin{code}
  54 type ParseTree = _Addr
  55
  56 type U_VOID_STAR = _Addr
  57 rdU_VOID_STAR ::  _Addr -> UgnM U_VOID_STAR
  58 rdU_VOID_STAR x = returnUgn x
  59
  60 type U_long = Int
  61 rdU_long ::  Int -> UgnM U_long
  62 rdU_long x = returnUgn x -- (A# x) = returnUgn (I# (addr2Int# x))
  63
  64 type U_unkId = ProtoName
  65 rdU_unkId :: _Addr -> UgnM U_unkId
  66 rdU_unkId x
  67   = rdU_stringId x `thenUgn` \ y ->
  68     returnUgn (Unk y)
  69
  70 type U_stringId = FAST_STRING
  71 rdU_stringId :: _Addr -> UgnM U_stringId
  72 rdU_stringId s
  73   = ioToUgnM (_ccall_ hash_index s) `thenUgn` \ (I# i) ->
  74     returnUgn (_packCString s) -- ToDo: use the i!
  75
  76 type U_numId = Int -- ToDo: Int
  77 rdU_numId :: _Addr -> UgnM U_numId
  78 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  79
  80 type U_hstring = FAST_STRING
  81 rdU_hstring :: _Addr -> UgnM U_hstring
  82 rdU_hstring x
  83   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  84     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  85     returnUgn (_packCBytes len bytes)
  86 \end{code}
  87
  88 \begin{code}
  89 setSrcFileUgn :: FAST_STRING{-filename-} -> UgnM a -> UgnM a
  90 setSrcFileUgn file action _ = action file
  91
  92 getSrcFileUgn :: UgnM FAST_STRING{-filename-}
  93 getSrcFileUgn mod = returnUgn mod mod
  94
  95 mkSrcLocUgn :: U_long -> UgnM SrcLoc
  96 mkSrcLocUgn ln mod
  97   = returnUgn (mkSrcLoc2 mod ln) mod
  98 \end{code}