Menu
▾
▴
[Gtk2hs-commit] (main branch): Add an option to c2hs to wrap each call in a locking operation.
|
From: Axel S. <si...@co...> - 2009-10-30 17:02:14
|
Tue May 12 17:35:27 EDT 2009 Axe...@en...
* Add an option to c2hs to wrap each call in a locking operation.
hunk ./tools/c2hs/chs/CHS.hs 57
--- | `call' [`pure'] [`unsafe'] idalias
--- | `fun' [`pure'] [`unsafe'] idalias parms
+-- | `call' [`pure'] [`unsafe'] [`nolock'] idalias
+-- | `fun' [`pure'] [`unsafe'] [`nolock'] idalias parms
hunk ./tools/c2hs/chs/CHS.hs 63
--- ctxt -> [`lib' `=' string] [prefix]
+-- ctxt -> [`lib' `=' string] [prefix] [lock]
hunk ./tools/c2hs/chs/CHS.hs 66
+-- lock -> `lock' `=' string
hunk ./tools/c2hs/chs/CHS.hs 77
--- ptrkind -> [`foreign' | `stable'] ['newtype' | '->' ident]
+-- ptrkind -> [`foreign' | `stable' ] ['newtype' | '->' ident]
hunk ./tools/c2hs/chs/CHS.hs 167
+ (Maybe String) -- lock function
hunk ./tools/c2hs/chs/CHS.hs 181
+ Bool -- is without lock?
hunk ./tools/c2hs/chs/CHS.hs 187
+ Bool -- is without lock?
hunk ./tools/c2hs/chs/CHS.hs 211
- posOf (CHSContext _ _ pos) = pos
+ posOf (CHSContext _ _ _ pos) = pos
hunk ./tools/c2hs/chs/CHS.hs 215
- posOf (CHSCall _ _ _ _ pos) = pos
- posOf (CHSFun _ _ _ _ _ _ _ pos) = pos
+ posOf (CHSCall _ _ _ _ _ pos) = pos
+ posOf (CHSFun _ _ _ _ _ _ _ _ pos) = pos
hunk ./tools/c2hs/chs/CHS.hs 227
- (CHSContext olib1 opref1 _ ) == (CHSContext olib2 opref2 _ ) = [_$_]
- olib1 == olib1 && opref1 == opref2
+ (CHSContext olib1 opref1 olock1 _ ) ==
+ (CHSContext olib2 opref2 olock2 _ ) = [_$_]
+ olib1 == olib1 && opref1 == opref2 && olock1 == olock2
hunk ./tools/c2hs/chs/CHS.hs 236
- (CHSCall _ _ ide1 oalias1 _) == (CHSCall _ _ ide2 oalias2 _) = [_$_]
+ (CHSCall _ _ _ ide1 oalias1 _) == (CHSCall _ _ _ ide2 oalias2 _) = [_$_]
hunk ./tools/c2hs/chs/CHS.hs 238
- (CHSFun _ _ ide1 oalias1 _ _ _ _) [_$_]
- == (CHSFun _ _ ide2 oalias2 _ _ _ _) = [_$_]
+ (CHSFun _ _ _ ide1 oalias1 _ _ _ _) [_$_]
+ == (CHSFun _ _ _ ide2 oalias2 _ _ _ _) = [_$_]
hunk ./tools/c2hs/chs/CHS.hs 452
-showCHSHook (CHSContext olib oprefix _) = [_$_]
+showCHSHook (CHSContext olib oprefix olock _) = [_$_]
hunk ./tools/c2hs/chs/CHS.hs 458
+ . (case olock of
+ Nothing -> showString ""
+ Just lock -> showString "lock = " . showString lock . showString " ")
hunk ./tools/c2hs/chs/CHS.hs 476
-showCHSHook (CHSCall isPure isUns ide oalias _) = [_$_]
+showCHSHook (CHSCall isPure isUns isNol ide oalias _) = [_$_]
hunk ./tools/c2hs/chs/CHS.hs 480
+ . (if isNol then showString "nolock " else id)
hunk ./tools/c2hs/chs/CHS.hs 482
-showCHSHook (CHSFun isPure isUns ide oalias octxt parms parm _) = [_$_]
+showCHSHook (CHSFun isPure isUns isNol ide oalias octxt parms parm _) = [_$_]
hunk ./tools/c2hs/chs/CHS.hs 486
+ . (if isNol then showString "nolock " else id)
hunk ./tools/c2hs/chs/CHS.hs 805
- (olib , toks'' ) <- parseOptLib toks
- (opref , toks''') <- parseOptPrefix False toks''
- toks'''' <- parseEndHook toks'''
- frags <- parseFrags toks''''
- let frag = CHSContext olib opref pos
+ (olib , toks ) <- parseOptLib toks
+ (opref , toks) <- parseOptPrefix False toks
+ (olock , toks) <- parseOptLock toks
+ toks <- parseEndHook toks
+ frags <- parseFrags toks
+ let frag = CHSContext olib opref olock pos
hunk ./tools/c2hs/chs/CHS.hs 848
- (isPure , toks' ) <- parseIsPure toks
- (isUnsafe, toks'' ) <- parseIsUnsafe toks'
- (ide , toks''' ) <- parseIdent toks''
- (oalias , toks'''') <- parseOptAs ide False toks'''
- toks''''' <- parseEndHook toks''''
- frags <- parseFrags toks'''''
+ (isPure , toks ) <- parseIsPure toks
+ (isUnsafe, toks ) <- parseIsUnsafe toks
+ (isNolock, toks ) <- parseIsNolock toks
+ (ide , toks ) <- parseIdent toks
+ (oalias , toks ) <- parseOptAs ide False toks
+ toks <- parseEndHook toks
+ frags <- parseFrags toks
hunk ./tools/c2hs/chs/CHS.hs 856
- CHSHook (CHSCall isPure isUnsafe ide (norm ide oalias) pos) : frags
+ CHSHook (CHSCall isPure isUnsafe isNolock ide (norm ide oalias) pos) : frags
hunk ./tools/c2hs/chs/CHS.hs 863
- (ide , toks'3) <- parseIdent toks'2
- (oalias , toks'4) <- parseOptAs ide False toks'3
- (octxt , toks'5) <- parseOptContext toks'4
- (parms , toks'6) <- parseParms toks'5
- (parm , toks'7) <- parseParm toks'6
- toks'8 <- parseEndHook toks'7
- frags <- parseFrags toks'8
+ (isNolock, toks'3) <- parseIsNolock toks'2
+ (ide , toks'4) <- parseIdent toks'3
+ (oalias , toks'5) <- parseOptAs ide False toks'4
+ (octxt , toks'6) <- parseOptContext toks'5
+ (parms , toks'7) <- parseParms toks'6
+ (parm , toks'8) <- parseParm toks'7
+ toks'9 <- parseEndHook toks'8
+ frags <- parseFrags toks'9
hunk ./tools/c2hs/chs/CHS.hs 873
- (CHSFun isPure isUnsafe ide (norm ide oalias) octxt parms parm pos) :
+ (CHSFun isPure isUnsafe isNolock ide (norm ide oalias) octxt parms parm pos) :
hunk ./tools/c2hs/chs/CHS.hs 907
+parseIsNolock :: [CHSToken] -> CST s (Bool, [CHSToken])
+parseIsNolock (CHSTokNolock _:toks) = return (True , toks)
+parseIsNolock toks = return (False, toks)
+
hunk ./tools/c2hs/chs/CHS.hs 1006
+parseOptLock :: [CHSToken] -> CST s (Maybe String, [CHSToken])
+parseOptLock (CHSTokLock _ :
+ CHSTokEqual _ :
+ CHSTokString _ str:
+ toks) = return (Just str, toks)
+parseOptLock (CHSTokLock _:toks ) = syntaxError toks
+parseOptLock toks = return (Nothing, toks)
+
hunk ./tools/c2hs/chs/CHSLexer.hs 97
--- | `unsafe' | `with'
+-- | `unsafe' | `with' | 'lock' | 'unlock'
hunk ./tools/c2hs/chs/CHSLexer.hs 230
+ | CHSTokLock Position -- `lock'
+ | CHSTokNolock Position -- `nolock'
hunk ./tools/c2hs/chs/CHSLexer.hs 279
+ posOf (CHSTokLock pos ) = pos
+ posOf (CHSTokNolock pos ) = pos
hunk ./tools/c2hs/chs/CHSLexer.hs 327
+ (CHSTokLock _ ) == (CHSTokLock _ ) = True
+ (CHSTokNolock _ ) == (CHSTokNolock _ ) = True
hunk ./tools/c2hs/chs/CHSLexer.hs 376
+ showsPrec _ (CHSTokLock _ ) = showString "lock"
+ showsPrec _ (CHSTokNolock _ ) = showString "nolock"
hunk ./tools/c2hs/chs/CHSLexer.hs 698
+ idkwtok pos "lock" _ = CHSTokLock pos
+ idkwtok pos "nolock" _ = CHSTokNolock pos
hunk ./tools/c2hs/gen/GBMonad.hs 70
- getPrefix, delayCode, getDelayedCode, ptrMapsTo, queryPtr, objIs,
+ getPrefix, getLock, delayCode, getDelayedCode, ptrMapsTo, queryPtr, objIs,
hunk ./tools/c2hs/gen/GBMonad.hs 226
+-- (3) an optional wrapper function that acquires a lock, this may also
+-- be specified on the command line
hunk ./tools/c2hs/gen/GBMonad.hs 240
+ mLock :: Maybe String, -- a lock function
hunk ./tools/c2hs/gen/GBMonad.hs 248
-initialGBState :: GBState
-initialGBState = GBState {
- lib = "",
- prefix = "",
- frags = [],
- ptrmap = Map.empty,
- objmap = Map.empty
- }
+initialGBState :: Maybe String -> GBState
+initialGBState mLock = GBState {
+ lib = "",
+ prefix = "",
+ mLock = mLock,
+ frags = [],
+ ptrmap = Map.empty,
+ objmap = Map.empty
+ }
hunk ./tools/c2hs/gen/GBMonad.hs 260
-setContext :: (Maybe String) -> (Maybe String) -> GB ()
-setContext lib prefix = [_$_]
+setContext :: (Maybe String) -> (Maybe String) -> (Maybe String) ->
+ GB ()
+setContext lib prefix newMLock = [_$_]
hunk ./tools/c2hs/gen/GBMonad.hs 264
- prefix = fromMaybe "" prefix},
+ prefix = fromMaybe "" prefix,
+ mLock = case newMLock of
+ Nothing -> mLock state
+ Just _ -> newMLock },
hunk ./tools/c2hs/gen/GBMonad.hs 280
+-- get the lock function
+getLock :: GB (Maybe String)
+getLock = readCT mLock
+
hunk ./tools/c2hs/gen/GBMonad.hs 301
- delay hook@(CHSCall isFun isUns ide oalias _) frags =
+ delay hook@(CHSCall isFun isUns _ ide oalias _) frags =
hunk ./tools/c2hs/gen/GBMonad.hs 303
- Just (CHSCall isFun' isUns' ide' _ _, _) [_$_]
+ Just (CHSCall isFun' isUns' _ ide' _ _, _) [_$_]
hunk ./tools/c2hs/gen/GBMonad.hs 305
- && isUns == isUns' [_$_]
+ && isUns == isUns'
hunk ./tools/c2hs/gen/GenBind.hs 101
--- * context hook must preceded all but the import hooks
+-- * context hook must precede all but the import hooks
hunk ./tools/c2hs/gen/GenBind.hs 158
- initialGBState, setContext, getPrefix, [_$_]
+ initialGBState, setContext, getPrefix, getLock,
hunk ./tools/c2hs/gen/GenBind.hs 162
-
hunk ./tools/c2hs/gen/GenBind.hs 297
- (_, res) <- runCT (expandModule mod) ac initialGBState
- return res
+ mLock <- getSwitch lockFunSB
+ (_, res) <- runCT (expandModule mod) ac (initialGBState mLock)
+ return res
hunk ./tools/c2hs/gen/GenBind.hs 383
-expandHook (CHSContext olib oprefix _) =
+expandHook (CHSContext olib oprefix olock _) =
hunk ./tools/c2hs/gen/GenBind.hs 385
- setContext olib oprefix -- enter context information
+ setContext olib oprefix olock -- enter context information
hunk ./tools/c2hs/gen/GenBind.hs 428
-expandHook hook@(CHSCall isPure isUns ide oalias pos) =
+expandHook hook@(CHSCall isPure isUns isNol ide oalias pos) =
hunk ./tools/c2hs/gen/GenBind.hs 436
+ mLock <- if isNol then return Nothing else getLock
hunk ./tools/c2hs/gen/GenBind.hs 440
- callImport hook isPure isUns ideLexeme hsLexeme cdecl' pos
+ callImport hook isPure isUns mLock ideLexeme hsLexeme cdecl' pos
hunk ./tools/c2hs/gen/GenBind.hs 444
-expandHook hook@(CHSFun isPure isUns ide oalias ctxt parms parm pos) =
+expandHook hook@(CHSFun isPure isUns isNol ide oalias ctxt parms parm pos) =
hunk ./tools/c2hs/gen/GenBind.hs 452
+ mLock <- if isNol then return Nothing else getLock
hunk ./tools/c2hs/gen/GenBind.hs 455
- fiLexeme = hsLexeme ++ "'_" -- *Urgh* - probably unqiue...
+ fiLexeme = hsLexeme ++ "'_" -- *Urgh* - probably unique...
hunk ./tools/c2hs/gen/GenBind.hs 458
- callHook = CHSCall isPure isUns cide (Just fiIde) pos
- callImport callHook isPure isUns (identToLexeme cide) fiLexeme cdecl' pos
- funDef isPure hsLexeme fiLexeme cdecl' ctxt parms parm pos
+ callHook = CHSCall isPure isUns isNol cide (Just fiIde) pos
+ callImport callHook isPure isUns mLock (identToLexeme cide) fiLexeme cdecl' pos
+ funDef isPure hsLexeme fiLexeme cdecl' ctxt mLock parms parm pos
hunk ./tools/c2hs/gen/GenBind.hs 690
-callImport :: CHSHook -> Bool -> Bool -> String -> String -> CDecl -> Position
- -> GB String
-callImport hook isPure isUns ideLexeme hsLexeme cdecl pos =
+callImport :: CHSHook -> Bool -> Bool -> Maybe String -> String -> String
+ -> CDecl -> Position -> GB String
+callImport hook isPure isUns mLock ideLexeme hsLexeme cdecl pos =
hunk ./tools/c2hs/gen/GenBind.hs 705
- else return hsLexeme
+ else return funStr
hunk ./tools/c2hs/gen/GenBind.hs 711
- concat (zipWith wrForPtr foreignVec [1..])++hsLexeme++" "++
+ concat (zipWith wrForPtr foreignVec [1..])++funStr++" "++
hunk ./tools/c2hs/gen/GenBind.hs 723
+ funStr = case mLock of Nothing -> hsLexeme
+ Just lockFun -> lockFun ++ " $ " ++ hsLexeme
hunk ./tools/c2hs/gen/GenBind.hs 744
+ -> Maybe String -- lock function
hunk ./tools/c2hs/gen/GenBind.hs 749
-funDef isPure hsLexeme fiLexeme cdecl octxt parms parm pos =
+funDef isPure hsLexeme fiLexeme cdecl octxt mLock parms parm pos =
hunk ./tools/c2hs/gen/GenBind.hs 763
+ lock = case mLock of Nothing -> ""
+ Just lock -> lock ++ " $"
hunk ./tools/c2hs/gen/GenBind.hs 767
- else " " ++ fiLexeme ++ join callArgs ++ " >>= \\res ->\n"
+ else " " ++ lock ++ fiLexeme ++ join callArgs ++ " >>= \\res ->\n"
hunk ./tools/c2hs/state/Switches.hs 84
- chiPathSB :: [FilePath] -- .chi file directories
+ chiPathSB :: [FilePath], -- .chi file directories
+ lockFunSB :: Maybe String -- a function to wrap each call
hunk ./tools/c2hs/state/Switches.hs 102
- chiPathSB = ["."]
+ chiPathSB = ["."],
+ lockFunSB = Nothing
hunk ./tools/c2hs/toplevel/Main.hs 127
+-- --lock=NAME
+-- Wrap each foreign function call in the function NAME. This
+-- function is usually a function that acquires a lock for
+-- the memory region that the called function is about to access.
+-- A wrap function can also be specificed within the file in the
+-- context hook, in which case it overrides the command line function.
+-- The wrapper function can be omitted on a call-by-call basis by
+-- using the nolock option in the call hook.
+--
hunk ./tools/c2hs/toplevel/Main.hs 212
+ | LockFun String -- wrap each function call in this function
hunk ./tools/c2hs/toplevel/Main.hs 263
+ Option ['l']
+ ["lock"]
+ (ReqArg LockFun "NAME")
+ "wrap each foreign call with the function NAME",
hunk ./tools/c2hs/toplevel/Main.hs 418
+processOpt (LockFun name ) = setLockFun name
hunk ./tools/c2hs/toplevel/Main.hs 538
+-- set the name of the wrapper function that acquires a lock
+--
+setLockFun :: String -> CST s ()
+setLockFun name = setSwitch $ \sb -> sb { lockFunSB = Just name }
|
