1 Glues lots of things together for ugen-generated
5 #include "HsVersions.h"
8 -- re-exported Prelude stuff
9 returnPrimIO, thenPrimIO,
19 import Name ( RdrName(..) )
20 import SrcLoc ( mkSrcLoc2, mkUnknownSrcLoc )
25 = (FAST_STRING,Module,SrcLoc) -- file, module and src_loc carried down
28 {-# INLINE returnUgn #-}
29 {-# INLINE thenUgn #-}
31 returnUgn x stuff = returnPrimIO x
34 = x stuff `thenPrimIO` \ z ->
37 initUgn :: UgnM a -> IO a
39 = action (SLIT(""),SLIT(""),mkUnknownSrcLoc) `thenPrimIO` \ result ->
42 ioToUgnM :: PrimIO a -> UgnM a
47 type ParseTree = _Addr
49 type U_VOID_STAR = _Addr
50 rdU_VOID_STAR :: _Addr -> UgnM U_VOID_STAR
51 rdU_VOID_STAR x = returnUgn x
54 rdU_long :: Int -> UgnM U_long
55 rdU_long x = returnUgn x
57 type U_stringId = FAST_STRING
58 rdU_stringId :: _Addr -> UgnM U_stringId
59 {-# INLINE rdU_stringId #-}
60 rdU_stringId s = returnUgn (_packCString s)
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)
66 type U_hstring = FAST_STRING
67 rdU_hstring :: _Addr -> UgnM U_hstring
69 = ioToUgnM (_ccall_ get_hstring_len x) `thenUgn` \ len ->
70 ioToUgnM (_ccall_ get_hstring_bytes x) `thenUgn` \ bytes ->
71 returnUgn (_packCBytes len bytes)
75 setSrcFileUgn :: FAST_STRING -> UgnM a -> UgnM a
76 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
78 getSrcFileUgn :: UgnM FAST_STRING
79 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
81 setSrcModUgn :: Module -> UgnM a -> UgnM a
82 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
84 getSrcModUgn :: UgnM Module
85 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
87 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
88 mkSrcLocUgn ln action (file,mod,_)
89 = action loc (file,mod,loc)
91 loc = mkSrcLoc2 file ln
93 getSrcLocUgn :: UgnM SrcLoc
94 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff