1 Glues lots of things together for ugen-generated
11 #include "HsVersions.h"
14 import Module ( Module, mkSrcModule )
15 import SrcLoc ( mkSrcLoc, noSrcLoc, SrcLoc )
16 import FastString ( FastString, mkFastCharString, mkFastCharString2 )
21 = (FastString,Module,SrcLoc) -- file, module and src_loc carried down
24 {-# INLINE returnUgn #-}
25 {-# INLINE thenUgn #-}
27 returnUgn x stuff = return x
33 initUgn :: UgnM a -> IO a
34 initUgn action = action (SLIT(""),mkSrcModule "",noSrcLoc)
36 ioToUgnM :: IO a -> UgnM a
43 type U_VOID_STAR = Addr
44 rdU_VOID_STAR :: Addr -> UgnM U_VOID_STAR
45 rdU_VOID_STAR x = returnUgn x
48 rdU_long :: Int -> UgnM U_long
49 rdU_long x = returnUgn x
51 type U_stringId = FastString
52 rdU_stringId :: Addr -> UgnM U_stringId
53 {-# INLINE rdU_stringId #-}
54 rdU_stringId s = returnUgn (mkFastCharString s)
56 type U_numId = Int -- ToDo: Int
57 rdU_numId :: Addr -> UgnM U_numId
58 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
60 type U_hstring = FastString
61 rdU_hstring :: Addr -> UgnM U_hstring
63 = ioToUgnM (_ccall_ get_hstring_len x) `thenUgn` \ len ->
64 ioToUgnM (_ccall_ get_hstring_bytes x) `thenUgn` \ bytes ->
65 returnUgn (mkFastCharString2 bytes len)
69 setSrcFileUgn :: FastString -> UgnM a -> UgnM a
70 setSrcFileUgn file action stuff@(_,mod,loc) = action (file,mod,loc)
72 getSrcFileUgn :: UgnM FastString
73 getSrcFileUgn stuff@(file,mod,loc) = returnUgn file stuff
75 setSrcModUgn :: Module -> UgnM a -> UgnM a
76 setSrcModUgn mod action stuff@(file,_,loc) = action (file,mod,loc)
78 getSrcModUgn :: UgnM Module
79 getSrcModUgn stuff@(file,mod,loc) = returnUgn mod stuff
81 mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
82 mkSrcLocUgn ln action (file,mod,_)
83 = action loc (file,mod,loc)
85 loc = mkSrcLoc file ln
87 getSrcLocUgn :: UgnM SrcLoc
88 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff