1 patch for repository http://code.haskell.org/c2hs: Sun Mar 24 16:21:29 CET 2013 p.balzarek@googlemail.com * add ptrto directive New patches: [add ptrto directive p.balzarek@googlemail.com**20130324152129 Ignore-this: 744f1a64e535ad6b76c98833a65152f ] { hunk ./src/C2HS/CHS.hs 299 -- data CHSAccess = CHSSet -- set structure field | CHSGet -- get structure field + | CHSGetPtr -- pointer to structure field deriving (Eq) -- | structure access path hunk ./src/C2HS/CHS.hs 529 showCHSHook (CHSField acc path _) = (case acc of CHSGet -> showString "get " - CHSSet -> showString "set ") + CHSSet -> showString "set " + CHSGetPtr -> showString "ptrto " + ) . showCHSAPath path showCHSHook (CHSPointer star ide oalias ptrType isNewtype oRefType emit _) = showString "pointer " hunk ./src/C2HS/CHS.hs 800 parseFrags0 (CHSTokFun pos :toks) = parseFun pos toks parseFrags0 (CHSTokGet pos :toks) = parseField pos CHSGet toks parseFrags0 (CHSTokSet pos :toks) = parseField pos CHSSet toks + parseFrags0 (CHSTokPtrTo pos :toks) = parseField pos CHSGetPtr toks parseFrags0 (CHSTokClass pos :toks) = parseClass pos toks parseFrags0 (CHSTokPointer pos :toks) = parsePointer pos toks parseFrags0 toks = syntaxError toks hunk ./src/C2HS/CHS/Lexer.hs 227 | CHSTokPure Position -- `pure' | CHSTokQualif Position -- `qualified' | CHSTokSet Position -- `set' + | CHSTokPtrTo Position -- `ptrto' | CHSTokSizeof Position -- `sizeof' | CHSTokAlignof Position -- `alignof' | CHSTokStable Position -- `stable' hunk ./src/C2HS/CHS/Lexer.hs 280 posOf (CHSTokPure pos ) = pos posOf (CHSTokQualif pos ) = pos posOf (CHSTokSet pos ) = pos + posOf (CHSTokPtrTo pos ) = pos posOf (CHSTokSizeof pos ) = pos posOf (CHSTokAlignof pos ) = pos posOf (CHSTokStable pos ) = pos hunk ./src/C2HS/CHS/Lexer.hs 333 (CHSTokPure _ ) == (CHSTokPure _ ) = True (CHSTokQualif _ ) == (CHSTokQualif _ ) = True (CHSTokSet _ ) == (CHSTokSet _ ) = True + (CHSTokPtrTo _ ) == (CHSTokPtrTo _ ) = True (CHSTokSizeof _ ) == (CHSTokSizeof _ ) = True (CHSTokAlignof _ ) == (CHSTokAlignof _ ) = True (CHSTokStable _ ) == (CHSTokStable _ ) = True hunk ./src/C2HS/CHS/Lexer.hs 387 showsPrec _ (CHSTokPure _ ) = showString "pure" showsPrec _ (CHSTokQualif _ ) = showString "qualified" showsPrec _ (CHSTokSet _ ) = showString "set" + showsPrec _ (CHSTokPtrTo _ ) = showString "ptrto" showsPrec _ (CHSTokSizeof _ ) = showString "sizeof" showsPrec _ (CHSTokAlignof _ ) = showString "alignof" showsPrec _ (CHSTokStable _ ) = showString "stable" hunk ./src/C2HS/CHS/Lexer.hs 710 idkwtok pos "pure" _ = CHSTokPure pos idkwtok pos "qualified" _ = CHSTokQualif pos idkwtok pos "set" _ = CHSTokSet pos + idkwtok pos "ptrto" _ = CHSTokPtrTo pos idkwtok pos "sizeof" _ = CHSTokSizeof pos idkwtok pos "alignof" _ = CHSTokAlignof pos idkwtok pos "stable" _ = CHSTokStable pos hunk ./src/C2HS/CHS/Lexer.hs 741 CHSTokNewtype pos -> mkid pos "newtype" CHSTokNocode pos -> mkid pos "nocode" CHSTokPointer pos -> mkid pos "pointer" + CHSTokPtrTo pos -> mkid pos "ptrto" CHSTokPrefix pos -> mkid pos "prefix" CHSTokPure pos -> mkid pos "pure" CHSTokQualif pos -> mkid pos "qualified" hunk ./src/C2HS/Gen/Bind.hs 545 "** Fun hook for `" ++ identToString (apathToIdent apath) ++ "':\n" traceValueType et = traceGenBind $ "Type of accessed value: " ++ showExtType et ++ "\n" +expandHook (CHSField CHSGetPtr path pos) = + do + traceInfoField + (_decl, offsets) <- accessPath path + traceDepth offsets + getPtr pos offsets + where + accessString = "Ptr" + traceInfoField = traceGenBind $ "** " ++ accessString ++ " hook:\n" + traceDepth offsets = traceGenBind $ "Depth of access path: " + ++ show (length offsets) ++ "\n" expandHook (CHSField access path pos) = do traceInfoField hunk ./src/C2HS/Gen/Bind.hs 1173 let pre = case access of CHSSet -> "(\\ptr val -> do {" CHSGet -> "(\\ptr -> do {" + CHSGetPtr -> "(\\ptr -> do {" body <- setGetBody (reverse offsets) return $ pre ++ body ++ "})" where hunk ./src/C2HS/Gen/Bind.hs 1185 Nothing -> return $ case access of -- not a bitfield CHSGet -> peekOp offset tyTag CHSSet -> pokeOp offset tyTag "val" + CHSGetPtr -> ptrOp offset --FIXME: must take `bitfieldDirection' into account Just (_, bs) -> return $ case access of -- a bitfield CHSGet -> "val <- " ++ peekOp offset tyTag hunk ./src/C2HS/Gen/Bind.hs 1193 CHSSet -> "org <- " ++ peekOp offset tyTag ++ insertBitfield ++ pokeOp offset tyTag "val'" + CHSGetPtr -> ptrOp offset where -- we have to be careful here to ensure proper sign extension; -- in particular, shifting right followed by anding a mask is hunk ./src/C2HS/Gen/Bind.hs 1235 peekOp off tyTag = "peekByteOff ptr " ++ show off ++ " ::IO " ++ tyTag pokeOp off tyTag var = "pokeByteOff ptr " ++ show off ++ " (" ++ var ++ "::" ++ tyTag ++ ")" + ptrOp off = "return $ plusPtr ptr " ++ show off + +-- | Haskell code for constructing a pointer to a field +-- +getPtr :: Position -> [BitSize] -> GB String +getPtr pos offsets = do + body <- getPtrBody (reverse offsets) + return $ "(\\ptr -> do {" ++ body ++ "})" + where + getPtrBody [BitSize offset _] = return $ ptrOp offset + getPtrBody (BitSize offset 0 : offsetsrem) = + do + code <- getPtrBody offsetsrem + return $ "ptr <- peekByteOff ptr " ++ show offset ++ "; " ++ code + getPtrBody (BitSize _ _ : _ ) = + derefBitfieldErr pos + -- + ptrOp off = "return $ plusPtr ptr " ++ show off -- | generate the type definition for a pointer hook and enter the required type -- mapping into the 'ptrmap' } Context: [Bump version to 0.16.5 Duncan Coutts **20130209030814 Ignore-this: 3c4f942bdf237be31ba431da24fa43fd ] [Update cabal info Duncan Coutts **20130209030801 Ignore-this: b1150f3919ab63ae2840c54cb9aa9643 ] [Update to language-c-0.4 Duncan Coutts **20130209030710 Ignore-this: 61b7a6de2fbb390791b7c82c18bfd127 ] [Parenthesize types in bindings, to allow function types without parentheses josh@joshtriplett.org**20130209021908 Ignore-this: d00baf1d19b1a6cdd7b56b97becff465 c2hs allows arbitrary types in function bindings. However, a function type such as T1 -> T2 will cause the generated code to parse incorrectly; since c2hs does not parenthesize each argument type, the argument and return types of the function type will parse as multiple arguments of the binding type, rather than as a single argument of function type. The binding can work around this by explicitly parenthesizing the function type, but since c2hs already requires quoting the entire type, the need for parentheses does not become apparent without reading the generated code (or encountering a compile error). Add parentheses around the types in bindings, so that unparenthesized function types as arguments will parse correctly. ] [Run return value marshaller before output parameter marshallers josh@joshtriplett.org**20121008021828 Ignore-this: 9bd29b32d053f6764805107a9228bc37 Many C functions provide an error code as a return value, and have output parameters that they do not set unless the return value indicates success. Handling such functions requires checking the return value before running any output marshallers. The reverse situation (an error code as an output parameter that needs checking before the return value) almost never occurs. Thus, run the return value marshaller before the output parameter marshallers, so that the return value marshaller can generate an exception that will prevent the output marshallers from running. ] [Parenthesize marshallers, to preserve Haskell expressions josh@joshtriplett.org**20121008021040 Ignore-this: 9f24488c2a00108e711876cea7d623a8 Marshallers can contain Haskell expressions; however, c2hs substitutes those expressions into Haskell code as function calls and adds arguments to the end, which limits these Haskell expressions to simple function calls with one or more arguments. Add parentheses to these expressions, allowing them to contain arbitrary Haskell expressions with lower precedence than function calls, such as operators. ] [TAG 0.16.4 Duncan Coutts **20121031210326 Ignore-this: 7b35601bc1d39c34d0cfc621bba76f63 ] Patch bundle hash: 2f4afa8b473e1e16e8e6738c221c94d07fd0ef1a