1 Glues lots of things together for ugen-generated
5 #include "HsVersions.h"
8 -- re-exported Prelude stuff
9 returnPrimIO, thenPrimIO,
17 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
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
34 # define PACK_STR mkFastCharString
35 # define PACK_BYTES mkFastCharString2
38 import RdrHsSyn ( RdrName(..) )
39 import SrcLoc ( mkSrcLoc, noSrcLoc, SrcLoc )
44 = (FAST_STRING,Module,SrcLoc) -- file, module and src_loc carried down
47 {-# INLINE returnUgn #-}
48 {-# INLINE thenUgn #-}
50 returnUgn x stuff = returnPrimIO x
53 = x stuff `thenPrimIO` \ z ->
56 initUgn :: UgnM a -> IO a
59 do_it = action (SLIT(""),SLIT(""),noSrcLoc)
61 #if __GLASGOW_HASKELL__ >= 200
64 do_it `thenPrimIO` \ result ->
68 ioToUgnM :: PrimIO a -> UgnM a
75 type U_VOID_STAR = ADDR
76 rdU_VOID_STAR :: ADDR -> UgnM U_VOID_STAR
77 rdU_VOID_STAR x = returnUgn x
80 rdU_long :: Int -> UgnM U_long
81 rdU_long x = returnUgn x
83 type U_stringId = FAST_STRING
84 rdU_stringId :: ADDR -> UgnM U_stringId
85 {-# INLINE rdU_stringId #-}
86 rdU_stringId s = returnUgn (PACK_STR s)
88 type U_numId = Int -- ToDo: Int
89 rdU_numId :: ADDR -> UgnM U_numId
90 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
92 type U_hstring = FAST_STRING
93 rdU_hstring :: ADDR -> UgnM U_hstring
95 = ioToUgnM (_ccall_ get_hstring_len x) `thenUgn` \ len ->
96 ioToUgnM (_ccall_ get_hstring_bytes x) `thenUgn` \ bytes ->
97 returnUgn (PACK_BYTES bytes len)
101 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
102 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
104 getSrcFileUgn :: UgnM FAST_STRING
105 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
107 setSrcModUgn :: Module -> UgnM a -> UgnM a
108 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
110 getSrcModUgn :: UgnM Module
111 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
113 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
114 mkSrcLocUgn ln action (file,mod,_)
115 = action loc (file,mod,loc)
117 loc = mkSrcLoc file ln
119 getSrcLocUgn :: UgnM SrcLoc
120 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff