#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]; \ int is_array[100]; \ int array_size[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; \ is_array[nfields] = 0; \ fieldoffsets[nfields] = (size_t) &(refpointer->name); \ nfields++; #define hsc_bindings_array_field(name,type,size) \ fieldnames[nfields] = # name; \ fieldtypes[nfields] = # type; \ is_array[nfields] = 1; \ array_size[nfields] = size; \ 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;i0) printf ("}"); \ printf("\ninstance Storable %s where {sizeOf _ = %zu ; " \ "alignment = sizeOf ; peek p = ", bindings_conid(type1), \ typesize); \ for(i=0;i>= \\v%d -> ", \ array_size[i],fieldoffsets[i],i); \ else \ printf("peekByteOff p %zu >>= \\v%d -> ", \ fieldoffsets[i],i); \ } \ printf("return $ %s ",bindings_conid(type1)); \ for(i=0;i> ", \ fieldoffsets[i],array_size[i],i); \ else \ 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);