bindings-DSL 1.0.3 → 1.0.4
raw patch · 2 files changed
+96/−50 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- bindings-DSL.cabal +4/−4
- bindings.dsl.h +92/−46
bindings-DSL.cabal view
@@ -2,7 +2,7 @@ name: bindings-DSL homepage: http://bitbucket.org/mauricio/bindings-dsl synopsis:- Domain specific language for FFI description, on top of hsc2hs.+ FFI domain specific language, on top of hsc2hs. description: This is a set of macros to be used when writing Haskell FFI. They were designed to be able to fully describe C interfaces,@@ -16,13 +16,13 @@ <http://bitbucket.org/mauricio/bindings-dsl> . This package contains no Haskell code, only C header files- designed for hsc2hsc.-version: 1.0.3+ designed for hsc2hs.+version: 1.0.4 license: BSD3 license-file: LICENSE maintainer: Maurício C. Antunes <mauricio.antunes@gmail.com> author: Maurício C. Antunes-stability: Stable API, ready for production use. Maintained with care.+stability: Stable API, well tested, ready for production use. Carefully maintained. build-type: Simple bug-reports: http://bitbucket.org/mauricio/bindings-dsl/issues category: FFI
bindings.dsl.h view
@@ -16,6 +16,7 @@ "import Foreign.Storable\n" \ "import Foreign.C.Types\n" \ "import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)\n" \+ "import Foreign.Marshal.Alloc (alloca)\n" \ "import Foreign.Marshal.Array (peekArray,pokeArray)\n" \ "import Data.Int\n" \ "import Data.Word\n" \@@ -68,6 +69,8 @@ #define bc_fieldname(type,field) {printf("c'");bc_glue(type,field);}; \ +#define bc_unionupdate(type,field) {printf("u'");bc_glue(type,field);}; \+ #define bc_famaccess(type,field) {printf("p'");bc_glue(type,field);}; \ #define bc_decimal(name) (name) > 0 \@@ -150,89 +153,132 @@ printf(" :: (");bc_typemarkup(# type); \ printf(") -> IO ");bc_conid(# name);printf("\n"); \ +static struct {+ int n, is_array[500], is_union[500], is_fam[500];+ size_t howmany[500], offset[500];+ char fname[500][1000], ftype[500][1000];+} bc_fielddata;+ #define hsc_starttype(name) \ { \ name *refpointer = 0; \- struct {int n, k[500]; size_t s[500], o[500];} f; \- f.n = 0; \+ bc_fielddata.n = 0; \ printf("data ");bc_conid(# name);printf(" = "); \ bc_conid(# name);printf("{"); \ char typename[] = # name; \ size_t typesize = sizeof(name); \- struct {int d; char n[1000], t[1000];} fam; \- fam.n[0] = '\0' ; \+ int index; \ -#define bc_prefield(name,type,typeofarray) \- if (f.n > 0) printf(","); \+#define hsc_field(name,type) \+ index = bc_fielddata.n++; \+ if (index > 0) printf(","); \ printf("\n "); \ bc_fieldname(typename,# name); \ printf(" :: ");bc_typemarkup(# type); \- f.k[f.n] = typeofarray; \- f.o[f.n] = (size_t)&(refpointer->name); \+ bc_fielddata.offset[index] = (size_t)&(refpointer->name); \+ bc_fielddata.is_array[index] = 0; \+ bc_fielddata.is_union[index] = 0; \+ bc_fielddata.is_fam[index] = 0; \+ strcpy(bc_fielddata.fname[index],# name); \+ strcpy(bc_fielddata.ftype[index],# type); \ -#define bc_posfield \- f.n++; \+#define hsc_array_field(name,type) \+ hsc_field(name,[type]); \+ bc_fielddata.howmany[index] = sizeof(refpointer->name) \+ / sizeof(refpointer->name[0]); \+ bc_fielddata.is_array[index] = 1; \ -#define hsc_field(name,type) \- bc_prefield(name,type,(-1)); \- bc_posfield; \+#define hsc_union_field(name,type) \+ hsc_field(name,type); \+ bc_fielddata.is_union[index] = 1; \ -#define hsc_array_field(name,type) \- bc_prefield(name,[type],1); \- f.s[f.n] = sizeof(refpointer->name); \- f.s[f.n] /= sizeof(refpointer->name[0]); \- bc_posfield; \+#define hsc_union_array_field(name,type) \+ hsc_array_field(name,type); \+ bc_fielddata.is_union[index] = 1; \ #define hsc_flexible_array_member(name,type) \- bc_prefield(name,[type],0); \- strcpy(fam.n,# name); strcpy(fam.t,# type); \- fam.d = f.o[f.n]; \- bc_posfield; \+ hsc_field(name,[type]); \+ bc_fielddata.is_fam[index] = 1; \+ strcpy(bc_fielddata.ftype[index],# type); \ #define hsc_stoptype(dummy) \ printf("\n } deriving (Eq,Show)\n"); \- if (*fam.n) \+ int i; \+ for (i=0; i < bc_fielddata.n; i++) if (bc_fielddata.is_fam[i]) \ { \- bc_famaccess(typename,fam.n); \- printf(" p = plusPtr p %d\n",fam.d); \- bc_famaccess(typename,fam.n); \+ bc_famaccess(typename,bc_fielddata.fname[i]); \+ printf(" p = plusPtr p %d\n",bc_fielddata.offset[i]); \+ bc_famaccess(typename,bc_fielddata.fname[i]); \ printf(" :: Ptr (");bc_conid(typename);printf(") -> "); \- printf("Ptr (");bc_typemarkup(fam.t);printf(")\n"); \+ printf("Ptr (");bc_typemarkup(bc_fielddata.ftype[i]);printf(")\n"); \ } \+ for (i=0; i < bc_fielddata.n; i++) if (bc_fielddata.is_union[i]) \+ { \+ 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]) \+ { \+ printf(" pokeArray (plusPtr p %"PRIuMAX") ", \+ (uintmax_t)(bc_fielddata.offset[i])); \+ printf("(take %"PRIuMAX" vf)", \+ (uintmax_t)(bc_fielddata.howmany[i])); \+ } \+ else \+ printf(" pokeByteOff p %"PRIuMAX" vf", \+ (uintmax_t)(bc_fielddata.offset[i])); \+ printf("\n"); \+ printf(" vu <- peek p\n"); \+ printf(" return $ v \n"); \+ int j; \+ for (j=0; j < bc_fielddata.n; j++) if (bc_fielddata.is_union[j]) \+ { \+ printf(" {"); bc_fieldname(typename,bc_fielddata.fname[j]); \+ printf(" = "); bc_fieldname(typename,bc_fielddata.fname[j]); \+ printf(" vu}\n"); \+ } \+ bc_unionupdate(typename,bc_fielddata.fname[i]); \+ printf(" :: ");bc_conid(typename); \+ printf(" -> ");bc_typemarkup(bc_fielddata.ftype[i]) \+ printf(" -> IO ");bc_conid(typename); \+ printf("\n"); \+ } \ printf("instance Storable "); \ bc_conid(typename);printf(" where\n"); \ printf(" sizeOf _ = %"PRIuMAX"\n alignment = sizeOf\n", \ (uintmax_t)(typesize)); \ printf(" peek p = do\n"); \- int i; \- for (i=0;i<f.n;i++) \+ for (i=0; i < bc_fielddata.n; i++) \ { \ printf(" v%d <- ",i); \- if (f.k[i] < 0) \- printf("peekByteOff p %"PRIuMAX"",(uintmax_t)(f.o[i])); \- if (f.k[i] > 0) \- printf("peekArray %"PRIuMAX" (plusPtr p %"PRIuMAX")", \- (uintmax_t)(f.s[i]),(uintmax_t)(f.o[i])); \- if (f.k[i] == 0) \+ if (bc_fielddata.is_fam[i]) \ printf("return []"); \+ else if (bc_fielddata.is_array[i]) \+ printf("peekArray %"PRIuMAX" (plusPtr p %"PRIuMAX")", \+ (uintmax_t)(bc_fielddata.howmany[i]), \+ (uintmax_t)(bc_fielddata.offset[i])); \+ else \+ printf("peekByteOff p %"PRIuMAX"", \+ (uintmax_t)(bc_fielddata.offset[i])); \ printf("\n"); \ } \ printf(" return $ ");bc_conid(typename); \- for (i=0;i<f.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<f.n;i++) printf(" v%d",i); printf(") = do\n"); \- for (i=0;i<f.n;i++) \+ 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 (f.k[i] < 0) \- printf("pokeByteOff p %"PRIuMAX" v%d",(uintmax_t)(f.o[i]),i); \- if (f.k[i] > 0) \- printf("pokeArray (plusPtr p %"PRIuMAX") " \- "(take %"PRIuMAX" v%d)",(uintmax_t)(f.o[i]), \- (uintmax_t)(f.s[i]),i); \- if (f.k[i] == 0) \+ if (bc_fielddata.is_fam[i]) \ printf("pokeArray (plusPtr p %"PRIuMAX") v%d", \- (uintmax_t)(f.o[i]),i); \+ (uintmax_t)(bc_fielddata.offset[i]),i); \+ else if (bc_fielddata.is_array[i]) \+ printf("pokeArray (plusPtr p %"PRIuMAX") " \+ "(take %"PRIuMAX" v%d)",(uintmax_t)(bc_fielddata.offset[i]), \+ (uintmax_t)(bc_fielddata.howmany[i]),i); \+ else \+ printf("pokeByteOff p %"PRIuMAX" v%d", \+ (uintmax_t)(bc_fielddata.offset[i]),i); \ printf("\n"); \ } \ printf(" return ()\n"); \