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