1 Glues lots of things together for ugen-generated
5 #include "HsVersions.h"
8 -- re-exported Prelude stuff
9 returnPrimIO, thenPrimIO,
19 #if __GLASGOW_HASKELL__ >= 200
20 # define ADDR GHCbase.Addr
21 # define PACK_STR packCString
22 # define PACK_BYTES packCBytes
25 # define PACK_STR mkFastCharString
26 # define PACK_BYTES mkFastCharString2
29 import RdrHsSyn ( RdrName(..) )
30 import SrcLoc ( mkSrcLoc, noSrcLoc, SrcLoc )
35 = (FAST_STRING,Module,SrcLoc) -- file, module and src_loc carried down
38 {-# INLINE returnUgn #-}
39 {-# INLINE thenUgn #-}
41 returnUgn x stuff = returnPrimIO x
44 = x stuff `thenPrimIO` \ z ->
47 initUgn :: UgnM a -> IO a
50 do_it = action (SLIT(""),SLIT(""),noSrcLoc)
52 #if __GLASGOW_HASKELL__ >= 200
55 do_it `thenPrimIO` \ result ->
59 ioToUgnM :: PrimIO a -> UgnM a
66 type U_VOID_STAR = ADDR
67 rdU_VOID_STAR :: ADDR -> UgnM U_VOID_STAR
68 rdU_VOID_STAR x = returnUgn x
71 rdU_long :: Int -> UgnM U_long
72 rdU_long x = returnUgn x
74 type U_stringId = FAST_STRING
75 rdU_stringId :: ADDR -> UgnM U_stringId
76 {-# INLINE rdU_stringId #-}
77 rdU_stringId s = returnUgn (PACK_STR s)
79 type U_numId = Int -- ToDo: Int
80 rdU_numId :: ADDR -> UgnM U_numId
81 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
83 type U_hstring = FAST_STRING
84 rdU_hstring :: ADDR -> UgnM U_hstring
86 = ioToUgnM (_ccall_ get_hstring_len x) `thenUgn` \ len ->
87 ioToUgnM (_ccall_ get_hstring_bytes x) `thenUgn` \ bytes ->
88 returnUgn (PACK_BYTES bytes len)
92 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
93 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
95 getSrcFileUgn :: UgnM FAST_STRING
96 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
98 setSrcModUgn :: Module -> UgnM a -> UgnM a
99 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
101 getSrcModUgn :: UgnM Module
102 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
104 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
105 mkSrcLocUgn ln action (file,mod,_)
106 = action loc (file,mod,loc)
108 loc = mkSrcLoc file ln
110 getSrcLocUgn :: UgnM SrcLoc
111 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff