utils/hsc2hs/template-hsc.h

   1 #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409
   2 #include <Rts.h>
   3 #endif
   4 #include <HsFFI.h>
   5
   6 #include <stddef.h>
   7 #include <string.h>
   8 #include <stdio.h>
   9 #include <stdarg.h>
  10 #include <ctype.h>
  11
  12 #ifndef offsetof
  13 #define offsetof(t, f) ((size_t) &((t *)0)->f)
  14 #endif
  15
  16 #if __NHC__
  17 #define hsc_line(line, file) \
  18     printf ("# %d \"%s\"\n", line, file);
  19 #else
  20 #define hsc_line(line, file) \
  21     printf ("{-# LINE %d \"%s\" #-}\n", line, file);
  22 #endif
  23
  24 #define hsc_const(x)                        \
  25     if ((x) < 0)                            \
  26         printf ("%ld", (long)(x));          \
  27     else                                    \
  28         printf ("%lu", (unsigned long)(x));
  29
  30 #define hsc_const_str(x)                                          \
  31     {                                                             \
  32         const char *s = (x);                                      \
  33         printf ("\"");                                            \
  34         while (*s != '\0')                                        \
  35         {                                                         \
  36             if (*s == '"' || *s == '\\')                          \
  37                 printf ("\\%c", *s);                              \
  38             else if (*s >= 0x20 && *s <= 0x7E)                    \
  39                 printf ("%c", *s);                                \
  40             else                                                  \
  41                 printf ("\\%d%s",                                 \
  42                         (unsigned char) *s,                       \
  43                         s[1] >= '0' && s[1] <= '9' ? "\\&" : ""); \
  44             ++s;                                                  \
  45         }                                                         \
  46         printf ("\"");                                            \
  47     }
  48
  49 #define hsc_type(t)                                         \
  50     if ((t)(int)(t)1.4 == (t)1.4)                           \
  51         printf ("%s%d",                                     \
  52                 (t)(-1) < (t)0 ? "Int" : "Word",            \
  53                 sizeof (t) * 8);                            \
  54     else                                                    \
  55         printf ("%s",                                       \
  56                 sizeof (t) >  sizeof (double) ? "LDouble" : \
  57                 sizeof (t) == sizeof (double) ? "Double"  : \
  58                 "Float");
  59
  60 #define hsc_peek(t, f) \
  61     printf ("(\\hsc_ptr -> peekByteOff hsc_ptr %ld)", (long) offsetof (t, f));
  62
  63 #define hsc_poke(t, f) \
  64     printf ("(\\hsc_ptr -> pokeByteOff hsc_ptr %ld)", (long) offsetof (t, f));
  65
  66 #define hsc_ptr(t, f) \
  67     printf ("(\\hsc_ptr -> hsc_ptr `plusPtr` %ld)", (long) offsetof (t, f));
  68
  69 #define hsc_offset(t, f) \
  70     printf("(%ld)", (long) offsetof (t, f));
  71
  72 #define hsc_size(t) \
  73     printf("(%ld)", (long) sizeof(t));
  74
  75 #define hsc_enum(t, f, print_name, x)         \
  76     print_name;                               \
  77     printf (" :: %s\n", #t);                  \
  78     print_name;                               \
  79     printf (" = %s ", #f);                    \
  80     if ((x) < 0)                              \
  81         printf ("(%ld)\n", (long)(x));        \
  82     else                                      \
  83         printf ("%lu\n", (unsigned long)(x));
  84
  85 #define hsc_haskellize(x)                                          \
  86     {                                                              \
  87         const char *s = (x);                                       \
  88         int upper = 0;                                             \
  89         if (*s != '\0')                                            \
  90         {                                                          \
  91             putchar (tolower (*s));                                \
  92             ++s;                                                   \
  93             while (*s != '\0')                                     \
  94             {                                                      \
  95                 if (*s == '_')                                     \
  96                     upper = 1;                                     \
  97                 else                                               \
  98                 {                                                  \
  99                     putchar (upper ? toupper (*s) : tolower (*s)); \
 100                     upper = 0;                                     \
 101                 }                                                  \
 102                 ++s;                                               \
 103             }                                                      \
 104         }                                                          \
 105     }