bindings-common-0.2: src/bindings.macros.h

#define hsc_bindings_initialize(dummy)\
    char bindings_buffer[1000]; \
    char bindings_buffer2[1000];

#define bindings_varid(name) \
    (strcpy(bindings_buffer+1,name+(strspn(name," "))), \
     bindings_buffer[0]='_', \
     islower(bindings_buffer[1])?bindings_buffer+1:bindings_buffer)

#define bindings_conid(name) \
    (strcpy(bindings_buffer,name+(strspn(name," "))), \
     bindings_buffer[0] = toupper(bindings_buffer[0]), \
     bindings_buffer)

#define bindings_integer(name) \
    (((name)>0) \
        ? sprintf(bindings_buffer2,"%llu", \
          (long long unsigned)(name)) \
        : sprintf(bindings_buffer2,"%lld", \
          (long long)(name)) \
    , bindings_buffer2 )

#define hsc_bindings_export_varids(name) \
    { \
        char buf[50000]; \
        char *p = buf; \
        char *p2 = p; \
        strcpy(buf,# name); \
        while (*p) \
            if (*p == '|') p++; \
            else \
            { \
                p2 = p; \
                while (*p2 && *p2!='|') p2++; \
                if (*p2=='|') *(p2++) = '\0'; \
                printf("%s,",bindings_varid(p)); \
                p = p2; \
            } \
        printf("\n"); \
    }

#define hsc_bindings_export_conids(name) \
    { \
        char buf[50000]; \
        char *p = buf; \
        char *p2 = p; \
        strcpy(buf,# name); \
        while (*p) \
            if (*p == '|') p++; \
            else \
            { \
                p2 = p; \
                while (*p2 && *p2!='|') p2++; \
                if (*p2=='|') *(p2++) = '\0'; \
                printf("%s(..),",bindings_conid(p)); \
                p = p2; \
            } \
        printf("\n"); \
    }

#define hsc_bindings_integer_like(name,type) \
    printf("%s = %s :: %s\n",bindings_varid(# name), \
      bindings_integer(name),# type);

#define hsc_bindings_int(name) \
  printf ("%s = %d :: CInt\n", \
    bindings_varid(# name),(int)(name));

#define hsc_bindings_char(name) \
  printf ("%s = %d :: CChar\n", \
    bindings_varid(# name),(int)(name));

#define hsc_bindings_size(name) \
  printf ("%s = %zu :: CSize\n", \
    bindings_varid(# name),(size_t)(name));

#define hsc_bindings_long(name) \
  printf ("%s = %s :: CLong\n", \
    bindings_varid(# name),bindings_integer(name));

#define hsc_bindings_ulong(name) \
  printf ("%s = %s :: CULong\n", \
    bindings_varid(# name),bindings_integer(name));

#define hsc_bindings_short(name) \
  printf ("%s = %s :: CShort\n", \
    bindings_varid(# name),bindings_integer(name));

#define hsc_bindings_ptr(name,htype) \
  printf ("%s =  wordPtrToPtr (%zu :: WordPtr) :: %s\n", \
    bindings_varid(# name),(size_t)(name),# htype);

#define hsc_bindings_funptr(name,htype) \
  printf ("%s = castPtrToFunPtr $ wordPtrToPtr (%zu :: WordPtr) :: %s\n", \
    bindings_varid(# name),(size_t)(name),# htype);

#define hsc_bindings_num(name) \
  if ((name)>0) \
    printf ("%s = %lu :: (Num a) => a\n", \
      bindings_varid(# name),(long unsigned)(name)); \
  else \
    printf ("%s = %ld :: (Num a) => a\n", \
      bindings_varid(# name),(long)(name));

#define hsc_bindings_frac(name) \
  printf ("%s = %Le :: (Fractional a) => a\n", \
    bindings_varid(# name),(long double)(name));

#define hsc_bindings_function(name,type) \
    printf("foreign import ccall \"%s\" %s :: %s\n", \
      # name,bindings_varid(# name),# type);

#define hsc_bindings_starttype(name) \
    { \
        name *refpointer = 0; \
        char *type1 = # name; \
        int nfields = 0; \
        char *fieldnames[100]; \
        char *fieldtypes[100]; \
        size_t fieldoffsets[100]; \
        size_t typesize = sizeof (name); \
        int i; \
        for(i=0;type1[i] && !isspace(type1[i]);i++); \
        if (isspace(type1[i])) type1 += i+1;

#define hsc_bindings_field(name,type) \
        fieldnames[nfields] = # name; \
        fieldtypes[nfields] = # type; \
        fieldoffsets[nfields] = (size_t) &(refpointer->name); \
        nfields++;

#define hsc_bindings_stoptype(dummy) \
        printf("data %s = %s", bindings_conid(type1), \
          bindings_conid(type1)); \
        if (nfields>0) printf (" {"); \
        for(i=0;i<nfields;i++) \
        { \
            printf("%s'%s :: %s", bindings_varid(type1), \
              fieldnames[i], fieldtypes[i]); \
            if (i+1<nfields) printf(" , "); \
        } \
        if (nfields>0) printf ("}"); \
        printf("\ninstance Storable %s where {sizeOf _ = %zu ; " \
          "alignment = sizeOf ; peek p = ", bindings_conid(type1), \
          typesize); \
        for(i=0;i<nfields;i++) \
        { \
            printf("peekByteOff p %zu >>= \\v%d -> ", \
              fieldoffsets[i],i); \
        } \
        printf("return $ %s ",bindings_conid(type1)); \
        for(i=0;i<nfields;i++) printf("v%d ",i); \
        printf(" ; poke p (%s ",bindings_conid(type1)); \
        for(i=0;i<nfields;i++) printf("v%d ",i); \
        printf(") = "); \
        for(i=0;i<nfields;i++) printf("pokeByteOff p %zu v%d >> ", \
          fieldoffsets[i],i); \
        printf("return () }"); \
    }

#define hsc_bindings_globalvar(name,type) \
    printf("foreign import ccall \"&%s\" %s", \
      # name,bindings_varid(# name)); \
    printf(" :: GlobalVariable (Ptr (%s))\n",# type);

#define hsc_bindings_equivalent_integer(t) \
    printf("%s",(t)(-1)<(t)0?"Int":"Word"); \
    printf("%zu",sizeof(t)*8);