bindings-common 1.0 → 1.1

raw patch · 5 files changed

+144/−161 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• .hg_archival.txt +1/−1
• .hgtags +1/−0
• bindings-common.cabal +1/−1
• src/Bindings/C/Time.hsc +6/−9
• src/bindings.macros.h +135/−150

@@ -1,2 +1,2 @@ repo: db8906263ec6e2f02cd51ed9b583ad96027042e9-node: fd31e86f9340d433a6b137d5ce01a2ffb054b3da+node: a2dc49f39c0e3678a73d9b26594a245f377257af

@@ -18,3 +18,4 @@ 720960ad84b9248da6470fa90908a539c1c439bd posix-0.0.1 c000d3f4d858be75a9714d4cc930458c529876e4 0.2.1 0e7d69c9fbfe822197a36ff77d28e15ccb1c8e7e 1.0+56cd9fc29fc9268cda35557f39c13624d84a862f 1.1

@@ -19,7 +19,7 @@   (/Caveat/: fields of a struct declared as arrays are   not properly supported in this release. Pointer fieds, of course,   are okay.)-version: 1.0+version: 1.1 license: BSD3 license-file: LICENSE maintainer: Maurício C. Antunes <mauricio.antunes@gmail.com>

@@ -7,9 +7,6 @@ import Foreign import Foreign.C -#integral_t clock_t-#integral_t time_t- #starttype struct tm #field tm_sec , CInt #field tm_min , CInt@@ -25,11 +22,11 @@ #num CLOCKS_PER_SEC #num TIMER_ABSTIME -#ccall clock , IO <clock_t>-#ccall difftime , <time_t> -> <time_t> -> IO CDouble-#ccall gmtime , Ptr <time_t> -> IO (Ptr <tm>)-#ccall localtime , Ptr <time_t> -> IO (Ptr <tm>)-#ccall mktime , Ptr <tm> -> IO <time_t>+#ccall clock , IO CClock+#ccall difftime , CTime -> CTime -> IO CDouble+#ccall gmtime , Ptr CTime -> IO (Ptr <tm>)+#ccall localtime , Ptr CTime -> IO (Ptr <tm>)+#ccall mktime , Ptr <tm> -> IO CTime #ccall strftime , CString -> CSize -> CString -> Ptr <tm> -> IO CSize-#ccall time , Ptr <time_t> -> IO <time_t>+#ccall time , Ptr CTime -> IO CTime 

@@ -1,190 +1,175 @@-#define bindings_initialize(dummy)\-    char conid_buffer[1000] = "C'"; \-    char varid_buffer[1000] = "c'"; \-    char ptr_buffer[1000] = "p'"; \-    char decimal_buffer[1000]; \-    char wrapper_buffer[1000] = "mk'"; -#define bc_varid(name) \-    (strcpy(varid_buffer+2,name),varid_buffer)+#define bc_varid(name) printf("c'%s",(name)) \  #define bc_conid(name) \-    (strcpy(conid_buffer+2,name),conid_buffer)+    { \+     char buffer[strlen(name)+1]; \+     strcpy(buffer,name); \+     char *p, *q; \+     p = strtok(buffer," "); \+     while (q = strtok(NULL," ")) p = q; \+     printf("C'%s",p); \+    } \ -#define bc_ptrid(name) \-    (strcpy(ptr_buffer+2,name),ptr_buffer)+#define bc_ptrid(name) printf("p'%s",(name)) \ -#define bc_decimal(name) \-    (((name)>0) \-        ? sprintf(decimal_buffer,"%llu", \-          (long long unsigned)(name)) \-        : sprintf(decimal_buffer,"%lld", \-          (long long)(name)) \-    , decimal_buffer )+#define bc_wrapper(name) printf("mk'%s",(name)) \ -#define bc_wrapper(name) \-    (strcpy(wrapper_buffer+3,name),wrapper_buffer)+#define bc_fieldname(type,field) \+    { \+     char buffer[strlen(type)+1]; \+     strcpy(buffer,type); \+     char *p = buffer; \+     char *q = strtok(p," "); \+     while (q = strtok(NULL," ")) p = q; \+     printf("%s'%s",p,field); \+    } \ -#define bc_printtype(name) \+#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 bc_typemarkup(name) \     { \-     char pb[strlen(name)+1]; \-     strcpy (pb,name); \-     char *p = pb; \-     while (p) \+     char buffer[strlen(name)+1]; \+     strcpy(buffer,name); \+     char *p1,*p2,*p3; \+     p1 = buffer; \+     while (*p1) \         { \-         char *p1 = strpbrk(p,"<"); \-         char *p2 = strpbrk(p,">"); \-         if (p1 && p2) \-            { \-             printf("%.*s",(int)(p1-p),p); \-             p = p1; \-             if (p1 < p2) \-                { \-                 printf(" %s ",bc_conid(strtok(p1,"<>"))); \-                 p = ++p2; \-                } \-            } \-         else \-             { \-              printf("%s",p); \-              p = NULL; \-             } \+         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 hsc_num(name) \-    { \-     bindings_initialize(); \-     printf("%s = %s ; %s :: (Num a) => a\n", \-       bc_varid(# name),bc_decimal(name),bc_varid(# name)); \-    }+    bc_varid(# name);printf(" = ");bc_decimal(name);printf("\n"); \+    bc_varid(# name);printf(" :: (Num a) => a\n"); \  #define hsc_fractional(name) \-    { \-     bindings_initialize(); \-     printf("%s = %Le ; %s :: (Fractional a) => a\n", \-       bc_varid(# name),(long double)(name),bc_varid(# name)); \-    }+    bc_varid(# name);printf(" = ");bc_float(name);printf("\n"); \+    bc_varid(# name);printf(" :: (Fractional a) => a\n"); \  #define hsc_pointer(name) \-    { \-     bindings_initialize(); \-     printf("%s = wordPtrToPtr (%zu :: WordPtr) ; %s :: Ptr a\n", \-       bc_varid(# name),(size_t)(name),bc_varid(# name)); \-    }+    bc_varid(# name);printf(" = wordPtrToPtr %zu\n",(size_t)(name)); \+    bc_varid(# name);printf(" :: Ptr a\n"); \  #define hsc_ccall(name,type) \-    { \-     bindings_initialize(); \-     printf("foreign import ccall \"%s\" %s :: ", \-       # name,bc_varid(# name)); \-     bc_printtype(# type); \-     printf("\n"); \-     printf("foreign import ccall \"&%s\" %s :: FunPtr (", \-       # name,bc_ptrid(# name)); \-     bc_printtype(# type); \-     printf(")\n"); \-    }+    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) \-    { \-     bindings_initialize(); \-     printf("foreign import ccall \"%s\" %s :: ", \-       "inline_"# name,bc_varid(# name)); \-     bc_printtype(# type); \-     printf("\n"); \-    }+    printf("foreign import ccall \"inline_%s\" ",# name); \+    bc_varid(# name);printf("\n"); \+    printf("  :: ");bc_typemarkup(# type);printf("\n"); \  #define hsc_globalvar(name,type) \-    { \-     bindings_initialize(); \-     printf("foreign import ccall \"&%s\" %s :: %s", \-       # name,bc_ptrid(# name),"Ptr ("); \-     bc_printtype(# type); \-     printf(")\n"); \-    }+    printf("foreign import ccall \"&%s\" ",# name); \+    bc_ptrid(# name);printf("\n"); \+    printf("  :: Ptr (");bc_typemarkup(# type);printf(")\n"); \  #define hsc_integral_t(name) \-    { \-     bindings_initialize(); \-     char fulltype[] = # name; \-     char type[1000]; \-     char *p = strtok(fulltype," "); \-     while (p) {strcpy(type,p); p = strtok(NULL," ");} \-     printf("type %s = %s%zu\n",bc_conid(type), \-       (name)(-1)<(name)(0)?"Int":"Word",sizeof(name)*8) ; \-    }+    printf("type ");bc_conid(# name);printf(" = "); \+    printf("%s%zu\n",(name)(-1)<0?"Int":"Word",8*sizeof(name)); \  #define hsc_opaque_t(name) \-    { \-     bindings_initialize(); \-     printf("data %s = %s\n",bc_conid(# name),bc_conid(# name)); \-    }+    printf("data ");bc_conid(# name); \+    printf(" = "); \+    bc_conid(# name);printf("\n"); \  #define hsc_callback(name,type) \-    { \-     bindings_initialize(); \-     printf("type %s = FunPtr (",bc_conid(# name)); \-     bc_printtype(# type); \-     printf(")\n"); \-     printf("foreign import ccall \"wrapper\" %s\n", \-       bc_wrapper(# name)); \-     printf("  :: ("); \-     bc_printtype(# type); \-     printf(")\n"); \-     printf("  -> IO %s\n",bc_conid(# name)); \-    }+    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) \     { \-     bindings_initialize(); \      name *refpointer = 0; \-     char fulltype[] = # name; \-     char type[1000]; \-     char *p = strtok(fulltype," "); \-     while (p) {strcpy(type,p); p = strtok(NULL," ");} \-     int nfields = 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); \-     char *fieldnames[1000], *fieldtypes[1000]; \-     size_t fieldoffsets[1000]; +#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) \-     fieldnames[nfields] = # name; \-     fieldtypes[nfields] = # type; \-     fieldoffsets[nfields] = (size_t) &(refpointer->name); \-     nfields++;+     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); \+     bc_posfield; \+ #define hsc_stoptype(dummy) \-     printf("data %s = %s",bc_conid(type),bc_conid(type)); \-     if (nfields>0) \+     printf("\n } deriving (Eq,Show)\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 (" {"); \-         int i; \-         for(i=0;i<nfields;i++) \-            { \-             printf("%s'%s :: ",type,fieldnames[i]); \-             bc_printtype(fieldtypes[i]); \-             if (i+1<nfields) printf(" , "); \-            } \-         printf ("}"); \+         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("\n"); \-     printf("instance Storable %s where\n",bc_conid(type)); \-     printf(" sizeOf _ = %zu\n",typesize); \-     printf(" alignment = sizeOf\n"); \-     printf(" peek p = do\n"); \-     int i; \-     for(i=0;i<nfields;i++) \-        printf("  v%d <- peekByteOff p %zu\n",i,fieldoffsets[i]); \-     printf("  return $ %s",bc_conid(type)); \-     for(i=0;i<nfields;i++) printf(" v%d",i); \-     printf("\n"); \-     printf(" poke p (%s",bc_conid(type)); \-     for(i=0;i<nfields;i++) printf(" v%d",i); \-     printf("  ) = do\n"); \-     for(i=0;i<nfields;i++) \-        printf("  pokeByteOff p %zu v%d\n",fieldoffsets[i],i); \-     printf("  return ()\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"); \+    } \