diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright © <2008–2009>, +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bindings-DSL.cabal b/bindings-DSL.cabal new file mode 100644 --- /dev/null +++ b/bindings-DSL.cabal @@ -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: + . + ://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 +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 diff --git a/bindings.cmacros.h b/bindings.cmacros.h new file mode 100644 --- /dev/null +++ b/bindings.cmacros.h @@ -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__ */ + diff --git a/bindings.dsl.h b/bindings.dsl.h new file mode 100644 --- /dev/null +++ b/bindings.dsl.h @@ -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 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 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__ */ +