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     ) where
  14
  15 import PreludeGlaST
  16
  17 IMP_Ubiq()
  18
  19 import Name             ( RdrName(..) )
  20 import SrcLoc           ( mkSrcLoc2, mkUnknownSrcLoc )
  21 \end{code}
  22
  23 \begin{code}
  24 type UgnM a
  25   = (FAST_STRING,Module,SrcLoc)    -- file, module and src_loc carried down
  26   -> PrimIO a
  27
  28 {-# INLINE returnUgn #-}
  29 {-# INLINE thenUgn #-}
  30
  31 returnUgn x stuff = returnPrimIO x
  32
  33 thenUgn x y stuff
  34   = x stuff     `thenPrimIO` \ z ->
  35     y z stuff
  36
  37 initUgn :: UgnM a -> IO a
  38 initUgn action
  39   = action (SLIT(""),SLIT(""),mkUnknownSrcLoc) `thenPrimIO` \ result ->
  40     return result
  41
  42 ioToUgnM :: PrimIO a -> UgnM a
  43 ioToUgnM x stuff = x
  44 \end{code}
  45
  46 \begin{code}
  47 type ParseTree = _Addr
  48
  49 type U_VOID_STAR = _Addr
  50 rdU_VOID_STAR ::  _Addr -> UgnM U_VOID_STAR
  51 rdU_VOID_STAR x = returnUgn x
  52
  53 type U_long = Int
  54 rdU_long ::  Int -> UgnM U_long
  55 rdU_long x = returnUgn x
  56
  57 type U_stringId = FAST_STRING
  58 rdU_stringId :: _Addr -> UgnM U_stringId
  59 {-# INLINE rdU_stringId #-}
  60 rdU_stringId s = returnUgn (_packCString s)
  61
  62 type U_numId = Int -- ToDo: Int
  63 rdU_numId :: _Addr -> UgnM U_numId
  64 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
  65
  66 type U_hstring = FAST_STRING
  67 rdU_hstring :: _Addr -> UgnM U_hstring
  68 rdU_hstring x
  69   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
  70     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
  71     returnUgn (_packCBytes len bytes)
  72 \end{code}
  73
  74 \begin{code}
  75 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
  76 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
  77
  78 getSrcFileUgn :: UgnM FAST_STRING
  79 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
  80
  81 setSrcModUgn :: Module -> UgnM a -> UgnM a
  82 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
  83
  84 getSrcModUgn :: UgnM Module
  85 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
  86
  87 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
  88 mkSrcLocUgn ln action (file,mod,_)
  89   = action loc (file,mod,loc)
  90   where
  91     loc = mkSrcLoc2 file ln
  92
  93 getSrcLocUgn :: UgnM SrcLoc
  94 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff
  95 \end{code}