1 Glues lots of things together for ugen-generated
5 #include "HsVersions.h"
8 -- re-exported Prelude stuff
9 returnPrimIO, thenPrimIO,
19 import MainMonad ( MainIO(..) )
20 import Name ( RdrName(..) )
21 import SrcLoc ( mkSrcLoc2, mkUnknownSrcLoc )
26 = (FAST_STRING,Module,SrcLoc) -- file, module and src_loc carried down
29 {-# INLINE returnUgn #-}
30 {-# INLINE thenUgn #-}
32 returnUgn x stuff = returnPrimIO x
35 = x stuff `thenPrimIO` \ z ->
38 initUgn :: UgnM a -> MainIO a
40 = action (SLIT(""),SLIT(""),mkUnknownSrcLoc) `thenPrimIO` \ result ->
43 ioToUgnM :: PrimIO a -> UgnM a
48 type ParseTree = _Addr
50 type U_VOID_STAR = _Addr
51 rdU_VOID_STAR :: _Addr -> UgnM U_VOID_STAR
52 rdU_VOID_STAR x = returnUgn x
55 rdU_long :: Int -> UgnM U_long
56 rdU_long x = returnUgn x
58 type U_stringId = FAST_STRING
59 rdU_stringId :: _Addr -> UgnM U_stringId
60 {-# INLINE rdU_stringId #-}
61 rdU_stringId s = returnUgn (_packCString s)
63 type U_numId = Int -- ToDo: Int
64 rdU_numId :: _Addr -> UgnM U_numId
65 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
67 type U_hstring = FAST_STRING
68 rdU_hstring :: _Addr -> UgnM U_hstring
70 = ioToUgnM (_ccall_ get_hstring_len x) `thenUgn` \ len ->
71 ioToUgnM (_ccall_ get_hstring_bytes x) `thenUgn` \ bytes ->
72 returnUgn (_packCBytes len bytes)
76 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
77 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
79 getSrcFileUgn :: UgnM FAST_STRING
80 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
82 setSrcModUgn :: Module -> UgnM a -> UgnM a
83 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
85 getSrcModUgn :: UgnM Module
86 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
88 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
89 mkSrcLocUgn ln action (file,mod,_)
90 = action loc (file,mod,loc)
92 loc = mkSrcLoc2 file ln
94 getSrcLocUgn :: UgnM SrcLoc
95 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff