diff --git a/Bindings.hs b/Bindings.hs deleted file mode 100644 --- a/Bindings.hs +++ /dev/null @@ -1,1 +0,0 @@ -module Bindings where diff --git a/Bindings/Utilities.hs b/Bindings/Utilities.hs new file mode 100644 --- /dev/null +++ b/Bindings/Utilities.hs @@ -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] diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright © <2008–2011>, +Copyright © <2008–2013>, All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/bindings-DSL.cabal b/bindings-DSL.cabal --- a/bindings-DSL.cabal +++ b/bindings-DSL.cabal @@ -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 @@ . . - 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 @@ -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 diff --git a/bindings.dsl.h b/bindings.dsl.h --- a/bindings.dsl.h +++ b/bindings.dsl.h @@ -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"); \ } \