bindings-DSL (empty) → 1.0
raw patch · 5 files changed
+564/−0 lines, 5 filesdep +basesetup-changed
Dependencies added: base
Files
- LICENSE +29/−0
- Setup.hs +2/−0
- bindings-DSL.cabal +30/−0
- bindings.cmacros.h +270/−0
- bindings.dsl.h +233/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright © <2008–2009>, <Maurício C. Antunes>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++ * Neither the name of the author nor the names of contributors+ may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED+TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bindings-DSL.cabal view
@@ -0,0 +1,30 @@+cabal-version: >= 1.2.3+name: bindings-DSL+homepage: http://bitbucket.org/mauricio/bindings-dsl+synopsis:+ Domain specific language for FFI description, 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,+ so that hsc2hs can extract from them all Haskell code needed to+ mimic such interfaces. All Haskell names used are automatically+ derived from C names, structures are mapped to Haskell instances+ of Storable, and there are also macros you can use with C code+ to help write bindings to inline functions or macro functions.+ Documentation is available in package homepage:+ .+ <http>://bitbucket.org/mauricio/bindings-dsl+ .+ This package contains no Haskell code, only C header files+ designed for hsc2hsc.+version: 1.0+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.+build-type: Simple+bug-reports: http://bitbucket.org/mauricio/bindings-dsl/issues+category: FFI+install-includes: bindings.dsl.h , bindings.cmacros.h+build-depends: base >= 0 && < 1000
+ bindings.cmacros.h view
@@ -0,0 +1,270 @@+/******+ * Copyright © 2008–2009 Maurício C. Antunes+ * This file is distributed under the BSD license.+ * Check LICENSE file in distribution package for+ * details.+******/++#ifndef __BINDINGS_CMACROS_H__+#define __BINDINGS_CMACROS_H__++#define BC_GLOBALARRAY(name,type) \+const type* array_##name () \+{ \+ return name; \+} \++#define BC_INLINE_(name,ret) \+ret inline_##name () \+{ \+ return name; \+} \++#define BC_INLINE_VOID(name) \+void inline_##name () \+{ \+ name; \+} \++#define BC_INLINE1(name,t1,ret) \+ret inline_##name (t1 v1) \+{ \+ return name (v1); \+} \++#define BC_INLINE1VOID(name,t1) \+void inline_##name (t1 v1) \+{ \+ name (v1); \+} \++#define BC_INLINE2(name,t1,t2,ret) \+ret inline_##name (t1 v1,t2 v2) \+{ \+ return name (v1,v2); \+} \++#define BC_INLINE2VOID(name,t1,t2) \+void inline_##name (t1 v1,t2 v2) \+{ \+ name (v1,v2); \+} \++#define BC_INLINE3(name,t1,t2,t3,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3) \+{ \+ return name (v1,v2,v3); \+} \++#define BC_INLINE3VOID(name,t1,t2,t3) \+void inline_##name (t1 v1,t2 v2,t3 v3) \+{ \+ name (v1,v2,v3); \+} \++#define BC_INLINE4(name,t1,t2,t3,t4,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4) \+{ \+ return name (v1,v2,v3,v4); \+} \++#define BC_INLINE4VOID(name,t1,t2,t3,t4) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4) \+{ \+ name (v1,v2,v3,v4); \+} \++#define BC_INLINE5(name,t1,t2,t3,t4,t5,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5) \+{ \+ return name (v1,v2,v3,v4,v5); \+} \++#define BC_INLINE5VOID(name,t1,t2,t3,t4,t5) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5) \+{ \+ name (v1,v2,v3,v4,v5); \+} \++#define BC_INLINE6(name,t1,t2,t3,t4,t5,t6,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6) \+{ \+ return name (v1,v2,v3,v4,v5,v6); \+} \++#define BC_INLINE6VOID(name,t1,t2,t3,t4,t5,t6) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6) \+{ \+ name (v1,v2,v3,v4,v5,v6); \+} \++#define BC_INLINE7(name,t1,t2,t3,t4,t5,t6,t7,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7); \+} \++#define BC_INLINE7VOID(name,t1,t2,t3,t4,t5,t6,t7) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7); \+} \++#define BC_INLINE8(name,t1,t2,t3,t4,t5,t6,t7,t8,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8); \+} \++#define BC_INLINE8VOID(name,t1,t2,t3,t4,t5,t6,t7,t8) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8); \+} \++#define BC_INLINE9(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9); \+} \++#define BC_INLINE9VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9); \+} \++#define BC_INLINE10(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10); \+} \++#define BC_INLINE10VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10); \+} \++#define BC_INLINE11(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11); \+} \++#define BC_INLINE11VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11); \+} \++#define BC_INLINE12(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12); \+} \++#define BC_INLINE12VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12); \+} \++#define BC_INLINE13(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13); \+} \++#define BC_INLINE13VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13); \+} \++#define BC_INLINE14(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14); \+} \++#define BC_INLINE14VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14); \+} \++#define BC_INLINE15(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15); \+} \++#define BC_INLINE15VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15); \+} \++#define BC_INLINE16(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16); \+} \++#define BC_INLINE16VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16); \+} \++#define BC_INLINE17(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17); \+} \++#define BC_INLINE17VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17); \+} \++#define BC_INLINE18(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17,t18 v18) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18); \+} \++#define BC_INLINE18VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17,t18 v18) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18); \+} \++#define BC_INLINE19(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,t19,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17,t18 v18,t19 v19) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19); \+} \++#define BC_INLINE19VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,t19) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17,t18 v18,t19 v19) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19); \+} \++#define BC_INLINE20(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,t19,t20,ret) \+ret inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17,t18 v18,t19 v19,t20 v20) \+{ \+ return name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19,v20); \+} \++#define BC_INLINE20VOID(name,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,t19,t20) \+void inline_##name (t1 v1,t2 v2,t3 v3,t4 v4,t5 v5,t6 v6,t7 v7,t8 v8,t9 v9,t10 v10,t11 v11,t12 v12,t13 v13,t14 v14,t15 v15,t16 v16,t17 v17,t18 v18,t19 v19,t20 v20) \+{ \+ name (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19,v20); \+} \++#endif /* __BINDINGS_CMACROS_H__ */+
+ bindings.dsl.h view
@@ -0,0 +1,233 @@+/******+ * Copyright © 2008–2009 Maurício C. Antunes+ * This file is distributed under the BSD license.+ * Check LICENSE file in distribution package for+ * details.+******/++#ifndef __BINDINGS_DSL_H__+#define __BINDINGS_DSL_H__++#define hsc_strict_import(dummy) printf( \+ "import Foreign.Ptr (Ptr,FunPtr,plusPtr)\n" \+ "import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)\n" \+ "import Foreign.Storable\n" \+ "import Foreign.C.Types\n" \+ "import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)\n" \+ "import Foreign.Marshal.Array (peekArray,pokeArray)\n" \+ "import Data.Int\n" \+ "import Data.Word\n" \+ ); \++#define bc_word(name) \+ { \+ char *p, *q, buffer_w[strlen(name)+1]; \+ strcpy(buffer_w,name); \+ for (p=strtok(buffer_w," \t");(q=strtok(NULL," \t"));p=q); \+ printf("%s",p); \+ } \++#define bc_glue(type,field) \+ { \+ bc_word(type); \+ printf("'"); \+ char *p, buffer_g[strlen(field)+1]; \+ strcpy(buffer_g,field); \+ for (p=buffer_g;*p;p++) \+ *p = *p=='.' ? '\'' : ispunct(*p) ? '_' : *p; \+ bc_word(buffer_g); \+ } \++#define bc_typemarkup(name) \+ { \+ char buffer_t[strlen(name)+1]; \+ strcpy(buffer_t,name); \+ char *p1,*p2,*p3; \+ p1 = buffer_t; \+ while (*p1) \+ { \+ for (p2=p1;*p2 && *p2!='<';p2++); \+ for (p3=p2;*p3 && *p3!='>';p3++); \+ if (*p2 == '<') *p2++ = '\0'; \+ if (*p3 == '>') *p3++ = '\0'; \+ printf("%s",p1); \+ if (*p2) bc_conid(p2); \+ p1 = p3; \+ } \+ } \++#define bc_varid(name) {printf("c'");bc_word(name);}; \++#define bc_conid(name) {printf("C'");bc_word(name);}; \++#define bc_ptrid(name) {printf("p'");bc_word(name);}; \++#define bc_wrapper(name) {printf("mk'");bc_word(name);}; \++#define bc_fieldname(type,field) {printf("c'");bc_glue(type,field);}; \++#define bc_famaccess(type,field) {printf("p'");bc_glue(type,field);}; \++#define bc_decimal(name) (name) > 0 \+ ? printf("%ju",(uintmax_t)(name)) \+ : printf("%jd",(intmax_t)(name)) \++#define bc_float(name) printf("%Le",(long double)(name)) \++#define hsc_num(name) \+ bc_varid(# name);printf(" = ");bc_decimal(name);printf("\n"); \+ bc_varid(# name);printf(" :: (Num a) => a\n"); \++#define hsc_fractional(name) \+ bc_varid(# name);printf(" = ");bc_float(name);printf("\n"); \+ bc_varid(# name);printf(" :: (Fractional a) => a\n"); \++#define hsc_pointer(name) \+ bc_varid(# name);printf(" = wordPtrToPtr %zu\n",(size_t)(name)); \+ bc_varid(# name);printf(" :: Ptr a\n"); \++#define hsc_function_pointer(name) \+ bc_varid(# name);printf(" = (castPtrToFunPtr . wordPtrToPtr) "); \+ printf("%zu\n",(size_t)(name)); \+ bc_varid(# name);printf(" :: FunPtr a\n"); \++#define hsc_ccall(name,type) \+ printf("foreign import ccall \"%s\" ",# name); \+ bc_varid(# name);printf("\n"); \+ printf(" :: ");bc_typemarkup(# type);printf("\n"); \+ printf("foreign import ccall \"&%s\" ",# 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"); \+ printf(" :: ");bc_typemarkup(# type);printf("\n"); \++#define hsc_globalvar(name,type) \+ printf("foreign import ccall \"&%s\" ",# name); \+ bc_ptrid(# name);printf("\n"); \+ printf(" :: Ptr (");bc_typemarkup(# type);printf(")\n"); \++#define hsc_globalarray(name,type) \+ printf("foreign import ccall \"array_%s\" ",# name); \+ bc_varid(# name);printf("\n"); \+ printf(" :: Ptr (");bc_typemarkup(# type);printf(")\n"); \++#define hsc_integral_t(name) \+ printf("type ");bc_conid(# name);printf(" = "); \+ { \+ int sign = (name)(-1)<0; \+ size_t size = sizeof(name); \+ if (size==sizeof(int)) printf("%s",sign?"CInt":"CUInt"); \+ else if (size==sizeof(char)) printf("%s", \+ (char)(-1)<0?(sign?"CChar":"CUChar"):(sign?"CSChar":"CChar")); \+ else printf("%s%zu",sign?"Int":"Word",8*size); \+ printf("\n"); \+ } \++#define hsc_opaque_t(name) \+ printf("data ");bc_conid(# name); \+ printf(" = "); \+ bc_conid(# name);printf("\n"); \++#define hsc_synonym_t(name,type) \+ printf("type ");bc_conid(# name); \+ printf(" = "); \+ bc_typemarkup(# type); \+ printf("\n"); \++#define hsc_callback(name,type) \+ printf("type ");bc_conid(# name);printf(" = FunPtr ("); \+ bc_typemarkup(# type);printf(")\n"); \+ printf("foreign import ccall \"wrapper\" "); \+ bc_wrapper(# name);printf("\n"); \+ printf(" :: (");bc_typemarkup(# type); \+ printf(") -> IO ");bc_conid(# name);printf("\n"); \++#define hsc_starttype(name) \+ { \+ name *refpointer = 0; \+ struct {int n, k[500]; size_t s[500], o[500];} f; \+ f.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' ; \++#define bc_prefield(name,type,typeofarray) \+ if (f.n > 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); \++#define bc_posfield \+ f.n++; \++#define hsc_field(name,type) \+ bc_prefield(name,type,(-1)); \+ bc_posfield; \++#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_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; \++#define hsc_stoptype(dummy) \+ printf("\n } deriving (Eq,Show)\n"); \+ if (*fam.n) \+ { \+ bc_famaccess(typename,fam.n); \+ printf(" p = plusPtr p %d\n",fam.d); \+ bc_famaccess(typename,fam.n); \+ printf(" :: Ptr (");bc_conid(typename);printf(") -> "); \+ printf("Ptr (");bc_typemarkup(fam.t);printf(")\n"); \+ } \+ printf("instance Storable "); \+ bc_conid(typename);printf(" where\n"); \+ printf(" sizeOf _ = %zu\n alignment = sizeOf\n",typesize); \+ printf(" peek p = do\n"); \+ int i; \+ for (i=0;i<f.n;i++) \+ { \+ printf(" v%d <- ",i); \+ if (f.k[i] < 0) \+ printf("peekByteOff p %zu",f.o[i]); \+ if (f.k[i] > 0) \+ printf("peekArray %zu (plusPtr p %zu)",f.s[i],f.o[i]); \+ if (f.k[i] == 0) \+ printf("return []"); \+ printf("\n"); \+ } \+ printf(" return $ ");bc_conid(typename); \+ for (i=0;i<f.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++) \+ { \+ printf(" "); \+ if (f.k[i] < 0) \+ printf("pokeByteOff p %zu v%d",f.o[i],i); \+ if (f.k[i] > 0) \+ printf("pokeArray (plusPtr p %zu) " \+ "(take %zu v%d)",f.o[i],f.s[i],i); \+ if (f.k[i] == 0) \+ printf("pokeArray (plusPtr p %zu) v%d",f.o[i],i); \+ printf("\n"); \+ } \+ printf(" return ()\n"); \+ } \++#endif /* __BINDINGS_DSL_H__ */+