bindings-DSL 1.0.16 → 1.0.17

raw patch · 5 files changed

+109/−42 lines, 5 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Bindings.hs +0/−1
• Bindings/Utilities.hs +39/−0
• LICENSE +1/−1
• bindings-DSL.cabal +13/−5
• bindings.dsl.h +56/−35

@@ -1,1 +0,0 @@-module Bindings where

@@ -0,0 +1,39 @@+module Bindings.Utilities (+	storableCast,+	storableCastArray,+  ) where++import Foreign.C+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable++-- |'storableCast' works like 'storableCastArray', except that it+-- takes a single value and returns a single value.++storableCast :: (Storable a, Storable b) => a -> IO b+storableCast a = storableCastArray [a] >>= (return . head)++-- |'storableCastArray' takes a list of values of a first type, stores it+-- at a contiguous memory area (that is first blanked with 0s), and then+-- reads it as if it was a list of a second type, with enough elements to+-- fill at least the same space.+--+-- @+-- ghci+-- :m + Bindings.Sandbox Data.Int+-- storableCastArray (replicate 13 (1::Int8)) :: IO [Int32]+--         ==> [16843009,16843009,16843009,1]+-- @++storableCastArray :: (Storable a, Storable b) => [a] -> IO [b]+storableCastArray [] = return []+storableCastArray a = do+	u <- return undefined+	let (q,r) = divMod (length a * (sizeOf . head) a) (sizeOf u)+	let len = max 1 (if r > 0 then q + 1 else q)+	let blank = replicate (len * sizeOf u) (0::CChar)+	b <- withArray blank $ \ptr -> do+		pokeArray (castPtr ptr) a+		peekArray len (castPtr ptr)+	return $ if True then b else [u]

@@ -1,4 +1,4 @@-Copyright © <2008–2011>, <Maurício C. Antunes>+Copyright © <2008–2013>, <Maurício C. Antunes> All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,4 +1,4 @@-cabal-version: >= 1.2.3+cabal-version: >= 1.8 name: bindings-DSL homepage: http://bitbucket.org/mauricio/bindings-dsl synopsis:@@ -15,9 +15,9 @@   .   <http://bitbucket.org/mauricio/bindings-dsl>   .-  This package contains no Haskell code, only C header files-  designed for hsc2hs.-version: 1.0.16+  The extra module Bindings.Utilities will contain tools that may+  be convenient when working with FFI.+version: 1.0.17 license: BSD3 license-file: LICENSE maintainer: Maurício C. Antunes <mauricio.antunes@gmail.com>@@ -29,4 +29,12 @@ library   install-includes: bindings.dsl.h , bindings.cmacros.h   build-depends: base >= 0 && < 1000-  exposed-modules: Bindings+  exposed-modules: Bindings.Utilities+source-repository head+  type: git+  location: ssh://git@bitbucket.org/mauricio/bindings-dsl+  branch: master+source-repository this+  type: git+  location: ssh://git@bitbucket.org/mauricio/bindings-dsl+  tag: 1.0.17

@@ -152,8 +152,10 @@  #ifdef BINDINGS_STDCALLCONV #define hsc_callback(name,type) hsc_callbackconv(name,stdcall,type)+#define hsc_callback_t(name,type) hsc_callbackconv(name,stdcall,type) #else #define hsc_callback(name,type) hsc_callbackconv(name,ccall,type)+#define hsc_callback_t(name,type) hsc_callbackconv(name,ccall,type) #endif  #define hsc_callbackconv(name,conv,type) \@@ -169,8 +171,8 @@     printf(" -> (");bc_typemarkup(# type);printf(")\n"); \  static struct {-	int n, is_array[500], is_union[500], is_fam[500];-	uintmax_t howmany[500], offset[500];+	int n, array_size[500], is_union[500], is_fam[500];+	uintmax_t offset[500]; 	char fname[500][1000], ftype[500][1000]; } bc_fielddata; @@ -188,35 +190,34 @@      bc_fielddata.n = 0; \      char typename[] = # name; \      int index; \+     int standalone_deriving = 0; \ -#define bc_basicfield(name,type,a,u,f) \+#define bc_basicfield(name,type,u,f) \      index = bc_fielddata.n++; \      bc_fielddata.offset[index] = (uintmax_t) \          ((char*)&bc_refdata.v.name - (char*)&bc_refdata.v); \-     bc_fielddata.is_array[index] = a; \+     bc_fielddata.array_size[index] = 0; \      bc_fielddata.is_union[index] = u; \      bc_fielddata.is_fam[index] = f; \      strcpy(bc_fielddata.fname[index],# name); \      strcpy(bc_fielddata.ftype[index],type); \  #define hsc_field(name,type) \-     bc_basicfield(name,# type,0,0,0); \+     bc_basicfield(name,# type,0,0); \  #define hsc_union_field(name,type) \-     bc_basicfield(name,# type,0,1,0); \+     bc_basicfield(name,# type,1,0); \  #define hsc_flexible_array_member(name,type) \-     bc_basicfield(name,# type,1,0,1); \+     bc_basicfield(name,# type,0,1); \  #define hsc_array_field(name,type) \-     bc_basicfield(name,# type,1,0,0); \-     bc_fielddata.howmany[index] = sizeof bc_refdata.v.name \-       / sizeof bc_refdata.v.name[0]; \+     bc_basicfield(name,# type,0,0); \+     bc_fielddata.array_size[index] = sizeof bc_refdata.v.name \  #define hsc_union_array_field(name,type) \-     bc_basicfield(name,# type,1,1,0); \-     bc_fielddata.howmany[index] = sizeof bc_refdata.v.name \-       / sizeof bc_refdata.v.name[0]; \+     bc_basicfield(name,# type,1,0); \+     bc_fielddata.array_size[index] = sizeof bc_refdata.v.name \  #define hsc_stoptype(dummy) \      printf("data ");bc_conid(typename);printf(" = "); \@@ -227,13 +228,22 @@          printf("  "); \          bc_fieldname(typename,bc_fielddata.fname[i]); \          printf(" :: "); \-         if (bc_fielddata.is_array[i]) printf("["); \+         if (bc_fielddata.array_size[i] > 0 || bc_fielddata.is_fam[i]) \+             printf("["); \          bc_typemarkup(bc_fielddata.ftype[i]); \-         if (bc_fielddata.is_array[i]) printf("]"); \+         if (bc_fielddata.array_size[i] > 0 || bc_fielddata.is_fam[i]) \+             printf("]"); \          if (i+1 < bc_fielddata.n) printf(","); \          printf("\n"); \         } \-     printf("} deriving (Eq,Show)\n"); \+     if (!standalone_deriving) \+         printf("} deriving (Eq,Show)\n"); \+     else \+        { \+         printf("}\n"); \+         printf("deriving instance Eq ");bc_conid(typename);printf("\n"); \+         printf("deriving instance Show ");bc_conid(typename);printf("\n"); \+        } \      for (i=0; i < bc_fielddata.n; i++) \         { \          bc_fieldoffset(typename,bc_fielddata.fname[i]); \@@ -246,20 +256,21 @@         { \          bc_unionupdate(typename,bc_fielddata.fname[i]); \          printf(" :: ");bc_conid(typename);printf(" -> "); \-         if (bc_fielddata.is_array[i]) printf("["); \+         if (bc_fielddata.array_size[i] > 0) printf("["); \          bc_typemarkup(bc_fielddata.ftype[i]); \-         if (bc_fielddata.is_array[i]) printf("]"); \+         if (bc_fielddata.array_size[i] > 0) printf("]"); \          printf(" -> IO ");bc_conid(typename); \          printf("\n"); \          bc_unionupdate(typename,bc_fielddata.fname[i]); \          printf(" v vf = alloca $ \\p -> do\n"); \          printf("  poke p v\n"); \-         if (bc_fielddata.is_array[i]) \+         if (bc_fielddata.array_size[i] > 0) \             { \-             printf("  pokeArray (plusPtr p %"PRIuMAX") ", \+             printf("  let s = div %"PRIuMAX" $ sizeOf $ (undefined :: ", \+               bc_fielddata.array_size[i]); \+             bc_typemarkup(bc_fielddata.ftype[i]); \+             printf(")\n  pokeArray (plusPtr p %"PRIuMAX") $ take s vf", \                bc_fielddata.offset[i]); \-             printf("(take %"PRIuMAX" vf)", \-               bc_fielddata.howmany[i]); \             } \          else \            printf("  pokeByteOff p %"PRIuMAX" vf", \@@ -285,29 +296,39 @@          printf("    v%d <- ",i); \          if (bc_fielddata.is_fam[i]) \             printf("return []"); \-         else if (bc_fielddata.is_array[i]) \-            printf("peekArray %"PRIuMAX" (plusPtr p %"PRIuMAX")", \-              bc_fielddata.howmany[i], bc_fielddata.offset[i]); \-         else \-            printf("peekByteOff p %"PRIuMAX"", \+         else if (bc_fielddata.array_size[i] > 0) \+           { \+            printf ("let s = div %"PRIuMAX" $ sizeOf $ (undefined :: ", \+              bc_fielddata.array_size[i]); \+            bc_typemarkup(bc_fielddata.ftype[i]); \+            printf(") in peekArray s (plusPtr p %"PRIuMAX")", \               bc_fielddata.offset[i]); \+           } \+         else \+            printf("peekByteOff p %"PRIuMAX"", bc_fielddata.offset[i]); \          printf("\n"); \         } \      printf("    return $ ");bc_conid(typename); \-     for (i=0; i < bc_fielddata.n; i++) printf(" v%d",i); printf("\n"); \+     for (i=0; i < bc_fielddata.n; i++) printf(" v%d",i); \+     printf("\n"); \      printf("  poke p (");bc_conid(typename); \-     for (i=0; i < bc_fielddata.n; i++) printf(" v%d",i); printf(") = do\n"); \+     for (i=0; i < bc_fielddata.n; i++) printf(" v%d",i); \+     printf(") = do\n"); \      for (i=0; i < bc_fielddata.n; i++) \         { \-         printf("    "); \          if (bc_fielddata.is_fam[i]) \-            printf("pokeArray (plusPtr p %"PRIuMAX") v%d", \+            printf("    pokeArray (plusPtr p %"PRIuMAX") v%d", \               bc_fielddata.offset[i],i); \-         else if (bc_fielddata.is_array[i]) \-            printf("pokeArray (plusPtr p %"PRIuMAX") (take %"PRIuMAX" v%d)", \-              bc_fielddata.offset[i], bc_fielddata.howmany[i],i); \+         else if (bc_fielddata.array_size[i] > 0) \+           { \+            printf("    let s = div %"PRIuMAX" $ sizeOf $ (undefined :: ", \+              bc_fielddata.array_size[i]); \+            bc_typemarkup(bc_fielddata.ftype[i]); \+            printf(")\n    pokeArray (plusPtr p %"PRIuMAX") (take s v%d)", \+              bc_fielddata.offset[i], i); \+           } \          else \-            printf("pokeByteOff p %"PRIuMAX" v%d", \+            printf("    pokeByteOff p %"PRIuMAX" v%d", \               bc_fielddata.offset[i],i); \          printf("\n"); \         } \