bindings-DSL 1.0.23 → 1.0.24
raw patch · 2 files changed
+58/−21 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- bindings-DSL.cabal +2/−2
- bindings.dsl.h +56/−19
bindings-DSL.cabal view
@@ -17,7 +17,7 @@ . The extra module Bindings.Utilities will contain tools that may be convenient when working with FFI.-version: 1.0.23+version: 1.0.24 license: BSD3 license-file: LICENSE maintainer: John Wiegley <johnw@newartisans.com>@@ -38,4 +38,4 @@ source-repository this type: git location: git://github.com/jwiegley/bindings-dsl- tag: 1.0.23+ tag: 1.0.24
bindings.dsl.h view
@@ -85,6 +85,20 @@ #define bc_float(name) printf("%Le",(long double)(name)) \ +#if __GLASGOW_HASKELL__ >= 800+/* GHC has supported pattern synonym type signatures since 7.10, but due to a+ * bug in 7.10, GHC will reject the type signature we try to give to our+ * pattern synonyms, even though they are valid. As a result, we only produce+ * explicit type signatures on GHC 8.0 or later, where the feature works+ * as intended.+ */+# define bc_patsig(name,constr) \+ printf("pattern ");bc_conid(name); \+ printf(" :: (Eq a, %s a) => a",constr);+#else+# define bc_patsig(name,constr)+#endif+ #define hsc_num(name) \ bc_varid(# name);printf(" = ");bc_decimal(name);printf("\n"); \ bc_varid(# name);printf(" :: (Num a) => a\n"); \@@ -93,6 +107,20 @@ bc_varid(# name);printf(" = ");bc_float(name);printf("\n"); \ bc_varid(# name);printf(" :: (Fractional a) => a\n"); \ +#if __GLASGOW_HASKELL__ >= 710+# define hsc_num_pattern(name) \+ printf("pattern ");bc_conid(# name);printf(" <- ((== ("); \+ bc_decimal(name);printf(")) -> True) where\n "); \+ bc_conid(# name);printf(" = ");bc_decimal(name);printf("\n"); \+ bc_patsig(# name,"Num");++# define hsc_fractional_pattern(name) \+ printf("pattern ");bc_conid(# name);printf(" <- ((== ("); \+ bc_float(name);printf(")) -> True) where\n "); \+ bc_conid(# name);printf(" = ");bc_float(name);printf("\n"); \+ bc_patsig(# name,"Fractional");+#endif+ #define hsc_pointer(name) \ bc_varid(# name);printf(" = wordPtrToPtr "); \ bc_wordptr(name);printf("\n"); \@@ -126,6 +154,15 @@ bc_ptrid(# name);printf("\n"); \ printf(" :: FunPtr (");bc_typemarkup(# type);printf(")\n"); \ +/* experimental support for interruptible calls */+#define hsc_ccall_interruptible(name,type) \+ printf("foreign import ccall interruptible \"%s\" interruptible'",# name); \+ bc_varid(# name);printf("\n"); \+ printf(" :: ");bc_typemarkup(# type);printf("\n"); \+ printf("foreign import ccall interruptible \"&%s\" interruptible'",# name); \+ bc_ptrid(# name);printf("\n"); \+ printf(" :: FunPtr (");bc_typemarkup(# type);printf(")\n"); \+ #define hsc_cinline(name,type) \ printf("foreign import ccall \"inline_%s\" ",# name); \ bc_varid(# name);printf("\n"); \@@ -185,8 +222,8 @@ printf(" -> (");bc_typemarkup(# type);printf(")\n"); \ static struct {- int n, array_size[500], is_union[500], is_fam[500];- uintmax_t offset[500];+ int n, is_union[500], is_fam[500];+ uintmax_t array_size[500], offset[500]; char fname[500][1000], ftype[500][1000]; } bc_fielddata; @@ -280,11 +317,11 @@ printf(" poke p v\n"); \ if (bc_fielddata.array_size[i] > 0) \ { \- printf(" let s = div %" PRIuMAX " $ sizeOf $ (undefined :: ", \- bc_fielddata.array_size[i]); \+ printf(" let s%d = div %" PRIuMAX " $ sizeOf $ (undefined :: ", \+ i, 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(")\n pokeArray (plusPtr p %" PRIuMAX ") $ take s%d vf", \+ bc_fielddata.offset[i], i); \ } \ else \ printf(" pokeByteOff p %" PRIuMAX " vf", \@@ -304,7 +341,7 @@ bc_conid(typename);printf(" where\n"); \ printf(" sizeOf _ = %" PRIuMAX "\n alignment _ = %" PRIuMAX "\n", \ (uintmax_t)(typesize),(uintmax_t)(typealign)); \- printf(" peek p = do\n"); \+ printf(" peek _p = do\n"); \ for (i=0; i < bc_fielddata.n; i++) \ { \ printf(" v%d <- ",i); \@@ -312,37 +349,37 @@ printf("return []"); \ else if (bc_fielddata.array_size[i] > 0) \ { \- printf ("let s = div %" PRIuMAX " $ sizeOf $ (undefined :: ", \- bc_fielddata.array_size[i]); \+ printf ("let s%d = div %" PRIuMAX " $ sizeOf $ (undefined :: ", \+ i, bc_fielddata.array_size[i]); \ bc_typemarkup(bc_fielddata.ftype[i]); \- printf(") in peekArray s (plusPtr p %" PRIuMAX ")", \- bc_fielddata.offset[i]); \+ printf(") in peekArray s%d (plusPtr _p %" PRIuMAX ")", \+ i, bc_fielddata.offset[i]); \ } \ else \- printf("peekByteOff p %" PRIuMAX "", bc_fielddata.offset[i]); \+ 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"); \- printf(" poke p (");bc_conid(typename); \+ 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++) \ { \ 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.array_size[i] > 0) \ { \- printf(" let s = div %" PRIuMAX " $ sizeOf $ (undefined :: ", \- bc_fielddata.array_size[i]); \+ printf(" let s%d = div %" PRIuMAX " $ sizeOf $ (undefined :: ", \+ i, 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); \+ printf(")\n pokeArray (plusPtr _p %" PRIuMAX ") (take s%d v%d)", \+ bc_fielddata.offset[i], i, i); \ } \ else \- printf(" pokeByteOff p %" PRIuMAX " v%d", \+ printf(" pokeByteOff _p %" PRIuMAX " v%d", \ bc_fielddata.offset[i],i); \ printf("\n"); \ } \