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         UgenUtil..,
  13
  14         -- complete interface
  15         ProtoName
  16     ) where
  17
  18 import PreludeGlaST
  19
  20 import Ubiq{-uitous-}
  21
  22 import MainMonad        ( MainIO(..) )
  23 import ProtoName        ( ProtoName(..) )
  24 import SrcLoc           ( mkSrcLoc2 )
  25
  26 --import ProtoName
  27 --import Outputable
  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 `thenPrimIO` \ result ->
  48     return result
  49
  50 ioToUgnM :: PrimIO a -> UgnM a
  51 ioToUgnM x mod = x
  52 \end{code}
  53
  54 \begin{code}
  55 type ParseTree = _Addr
  56
  57 type U_VOID_STAR = _Addr
  58 rdU_VOID_STAR ::  _Addr -> UgnM U_VOID_STAR
  59 rdU_VOID_STAR x = returnUgn x
  60
  61 type U_long = Int
  62 rdU_long ::  Int -> UgnM U_long
  63 rdU_long x = returnUgn x -- (A# x) = returnUgn (I# (addr2Int# x))
  64
  65 type U_unkId = ProtoName
  66 rdU_unkId :: _Addr -> UgnM U_unkId
  67 rdU_unkId x
  68   = rdU_stringId x `thenUgn` \ y ->
  69     returnUgn (Unk y)
  70
  71 type U_stringId = FAST_STRING
  72 rdU_stringId :: _Addr -> UgnM U_stringId
  73 {-# INLINE rdU_stringId #-}
  74 rdU_stringId s
  75   = -- ToDo (sometime): ioToUgnM (_ccall_ hash_index s) `thenUgn` \ (I# i) ->
  76     returnUgn (_packCString s)
  77
  78 type U_numId = Int -- ToDo: Int
  79 rdU_numId :: _Addr -> UgnM U_numId
  80 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  81
  82 type U_hstring = FAST_STRING
  83 rdU_hstring :: _Addr -> UgnM U_hstring
  84 rdU_hstring x
  85   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  86     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  87     returnUgn (_packCBytes len bytes)
  88 \end{code}
  89
  90 \begin{code}
  91 setSrcFileUgn :: FAST_STRING{-filename-} -> UgnM a -> UgnM a
  92 setSrcFileUgn file action _ = action file
  93
  94 getSrcFileUgn :: UgnM FAST_STRING{-filename-}
  95 getSrcFileUgn mod = returnUgn mod mod
  96
  97 mkSrcLocUgn :: U_long -> UgnM SrcLoc
  98 mkSrcLocUgn ln mod
  99   = returnUgn (mkSrcLoc2 mod ln) mod
 100 \end{code}