Support calling convention attributes in function pointer declarations

[mikesteele81]

Right now c2hs supports parsing attributes of C functions to look for calling convention designations. See issue #17 for details on that feature being added. I'd like this to be extended to C function pointer declarations so that c2hs can help me bind to COM on Windows.

Am I on the right track with the partial solution given below? So far I haven't discovered how to reach into the parentheses to find attributes where they are supposed to be.

Working Example

Here's a simplified example header and marshaling snippet:

c header

...
typedef struct IUnknownVtbl
{
    HRESULT (_stdcall *QueryInterface)(struct IUnknown *, REFIID, void **);
    ULONG (__stdcall *AddRef )(struct IUnknown *);
    ULONG (__stdcall *Release )(struct IUnknown *);
} IUnknownVtbl;
typedef IUnknownVtbl *IUnknown;
typedef IUnknown *LPUNKNOWN;
...

chs file

...
{#pointer *IUnknown as IUnknown newtype #}
{#pointer *IUnknownVtbl as VTable -> LPVOID #}
...
{#fun IUnknownVtbl->Release as release
    `IUnknownClass interface' =>
    { vtable* `interface'
    , `IUnknown'
    } -> `ULONG' id
#}
...

Problem

I'd like the generated foreign import declaration to specify stdcall, but ccall is used:

generated file

...
foreign import ccall safe "dynamic"
  release'_ :: FunPtr( ((IUnknown) -> (IO CULong)) ) -> ((IUnknown) -> (IO CULong))
...

Partial Solution

The following minimal patch almost does what I want, but only works if I modify headers to put the calling convention attribute in a different place. I don't think this is syntactically valid C:

modified C header

...
typedef struct IUnknownVtbl
{
    __stdcall HRESULT ( *QueryInterface)(struct IUnknown *, REFIID, void **);
    __stdcall ULONG ( *AddRef )(struct IUnknown *);
    __stdcall ULONG ( *Release )(struct IUnknown *);
} IUnknownVtbl;
typedef IUnknownVtbl *IUnknown;
typedef IUnknown *LPUNKNOWN;
...

patch

diff --git a/src/C2HS/Gen/Bind.hs b/src/C2HS/Gen/Bind.hs
index 6ac4324..e642eb7 100644
--- a/src/C2HS/Gen/Bind.hs
+++ b/src/C2HS/Gen/Bind.hs
@@ -511,7 +511,7 @@ expandHook hook@(CHSCall isPure isUns apath oalias pos) _ =
         -- cdecl'    = ide `simplifyDecl` cdecl
         args      = concat [ " x" ++ show n | n <- [1..numArgs ty] ]

-    callImportDyn hook isPure isUns ideLexeme hsLexeme ty pos
+    callImportDyn hook isPure isUns ideLexeme hsLexeme decl ty pos
     return $ "(\\o" ++ args ++ " -> " ++ set_get ++ " o >>= \\f -> "
              ++ hsLexeme ++ " f" ++ args ++ ")"
   where
@@ -566,7 +566,7 @@ expandHook (CHSFun isPure isUns apath oalias ctxt parms parm pos) hkpos =
         -- cdecl'    = cide `simplifyDecl` cdecl
         -- args      = concat [ " x" ++ show n | n <- [1..numArgs ty] ]
         callHook  = CHSCall isPure isUns apath (Just fiIde) pos
-    callImportDyn callHook isPure isUns ideLexeme fiLexeme ty pos
+    callImportDyn callHook isPure isUns ideLexeme fiLexeme decl ty pos

     set_get <- setGet pos CHSGet offsets ptrTy
     funDef isPure hsLexeme fiLexeme (FunET ptrTy $ purify ty)
@@ -858,15 +858,16 @@ callImport hook isPure isUns ideLexeme hsLexeme cdecl pos =
     traceFunType et = traceGenBind $
       "Imported function type: " ++ showExtType et ++ "\n"

-callImportDyn :: CHSHook -> Bool -> Bool -> String -> String -> ExtType
+callImportDyn :: CHSHook -> Bool -> Bool -> String -> String -> CDecl -> ExtType
               -> Position -> GB ()
-callImportDyn hook _isPure isUns ideLexeme hsLexeme ty pos =
+callImportDyn hook _isPure isUns ideLexeme hsLexeme cdecl ty pos =
   do
     -- compute the external type from the declaration, and delay the foreign
     -- export declaration
     --
     when (isVariadic ty) (variadicErr pos pos) -- FIXME? (posOf cdecl))
-    delayCode hook (foreignImportDyn ideLexeme hsLexeme isUns ty)
+    delayCode hook (foreignImportDyn (extractCallingConvention cdecl)
+                    ideLexeme hsLexeme isUns ty)
     traceFunType ty
   where
     traceFunType et = traceGenBind $
@@ -886,9 +887,10 @@ foreignImport cconv header ident hsIdent isUnsafe ty  =

 -- | Haskell code for the foreign import dynamic declaration needed by a call hook
 --
-foreignImportDyn :: String -> String -> Bool -> ExtType -> String
-foreignImportDyn _ident hsIdent isUnsafe ty  =
-  "foreign import ccall " ++ safety ++ " \"dynamic\"\n  " ++
+foreignImportDyn :: CallingConvention -> String -> String -> Bool -> ExtType -> String
+foreignImportDyn cconv _ident hsIdent isUnsafe ty  =
+  "foreign import " ++ showCallingConvention cconv ++ " " ++ safety
+    ++ " \"dynamic\"\n  " ++
     hsIdent ++ " :: FunPtr( " ++ showExtType ty ++ " ) -> " ++
     showExtType ty ++ "\n"
   where