[hcoop/debian/mlton.git] / runtime / gen / gen-types.c

/* Copyright (C) 2012,2017 Matthew Fluet.
 * Copyright (C) 2004-2008 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 *
 * MLton is released under a BSD-style license.
 * See the file MLton-LICENSE for details.
 */

#include "cenv.h"
#include "util.h"

static const char* mlTypesHPrefix[] = {
  "/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh",
  " *    Jagannathan, and Stephen Weeks.",
  " *",
  " * MLton is released under a BSD-style license.",
  " * See the file MLton-LICENSE for details.",
  " */",
  "",
  "#ifndef _MLTON_MLTYPES_H_",
  "#define _MLTON_MLTYPES_H_",
  "",
  "/* We need these because in header files for exported SML functions, ",
  " * types.h is included without cenv.h.",
  " */",
  "#if (defined (_AIX) || defined (__hpux__) || defined (__OpenBSD__))",
  "#include <inttypes.h>",
  "#elif (defined (__sun__))",
  "#include <sys/int_types.h>",
  "#else",
  "#include <stdint.h>",
  "#endif",
  "",
  NULL
};

static const char* cTypesHPrefix[] = {
  "/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh",
  " *    Jagannathan, and Stephen Weeks.",
  " *",
  " * MLton is released under a BSD-style license.",
  " * See the file MLton-LICENSE for details.",
  " */",
  "",
  "#ifndef _MLTON_CTYPES_H_",
  "#define _MLTON_CTYPES_H_",
  "",
  NULL
};

static const char* cTypesSMLPrefix[] = {
  "(* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh",
  " *    Jagannathan, and Stephen Weeks.",
  " *",
  " * MLton is released under a BSD-style license.",
  " * See the file MLton-LICENSE for details.",
  " *)",
  "",
  NULL
};

static const char* mlTypesHStd[] = {
  "/* ML types */",
  // "typedef void* Pointer;",
  // "typedef uintptr_t Pointer;",
  // "typedef unsigned char* Pointer;",
  "typedef unsigned char PointerAux __attribute__ ((may_alias));",
  "typedef PointerAux* Pointer;",
  "#define Array(t) Pointer",
  "#define Ref(t) Pointer",
  "#define Vector(t) Pointer",
  "",
  "typedef int8_t Int8_t;",
  "typedef int8_t Int8;",
  "typedef int16_t Int16_t;",
  "typedef int16_t Int16;",
  "typedef int32_t Int32_t;",
  "typedef int32_t Int32;",
  "typedef int64_t Int64_t;",
  "typedef int64_t Int64;",
  "typedef float Real32_t;",
  "typedef float Real32;",
  "typedef double Real64_t;",
  "typedef double Real64;",
  // "typedef long double Real128_t;",
  // "typedef long double Real128;",
  "typedef uint8_t Word8_t;",
  "typedef uint8_t Word8;",
  "typedef uint16_t Word16_t;",
  "typedef uint16_t Word16;",
  "typedef uint32_t Word32_t;",
  "typedef uint32_t Word32;",
  "typedef uint64_t Word64_t;",
  "typedef uint64_t Word64;",
  "",
  "typedef Int8_t WordS8_t;",
  "typedef Int8_t WordS8;",
  "typedef Int16_t WordS16_t;",
  "typedef Int16_t WordS16;",
  "typedef Int32_t WordS32_t;",
  "typedef Int32_t WordS32;",
  "typedef Int64_t WordS64_t;",
  "typedef Int64_t WordS64;",
  "",
  "typedef Word8_t WordU8_t;",
  "typedef Word8_t WordU8;",
  "typedef Word16_t WordU16_t;",
  "typedef Word16_t WordU16;",
  "typedef Word32_t WordU32_t;",
  "typedef Word32_t WordU32;",
  "typedef Word64_t WordU64_t;",
  "typedef Word64_t WordU64;",
  "",
  "typedef WordU8_t Char8_t;",
  "typedef WordU8_t Char8;",
  "typedef WordU16_t Char16_t;",
  "typedef WordU16_t Char16;",
  "typedef WordU32_t Char32_t;",
  "typedef WordU32_t Char32;",
  "",
  "typedef Vector(Char8_t) String8_t;",
  "typedef Vector(Char8_t) String8;",
  "typedef Vector(Char16_t) String16_t;",
  "typedef Vector(Char16_t) String16;",
  "typedef Vector(Char32_t) String32_t;",
  "typedef Vector(Char32_t) String32;",
  "",
  "typedef Int32_t Bool_t;",
  "typedef Int32_t Bool;",
  // "typedef Char8_t Char_t;",
  // "typedef Char8_t Char;",
  // "typedef Int32_t Int_t;",
  // "typedef Int32_t Int;",
  // "typedef Real64_t Real_t;",
  // "typedef Real64_t Real;",
  // "typedef String8_t String_t;",
  // "typedef String8_t String;",
  // "typedef Word32_t Word_t;",
  // "typedef Word32_t Word;",
  ""
  "typedef String8_t NullString8_t;",
  "typedef String8_t NullString8;",
  "",
  "typedef void* CPointer;",
  "typedef Pointer Objptr;",
  NULL
};

#define booltype(t, bt, name)                       \
  do {                                              \
  writeString (cTypesHFd, "typedef");               \
  writeString (cTypesHFd, " /* ");                  \
  writeString (cTypesHFd, #t);                      \
  writeString (cTypesHFd, " */ ");                  \
  writeString (cTypesHFd, bt);                      \
  writeUintmaxU (cTypesHFd, CHAR_BIT * sizeof(t));  \
  writeString (cTypesHFd, "_t");                    \
  writeString (cTypesHFd, " ");                     \
  writeString (cTypesHFd, "C_");                    \
  writeString (cTypesHFd, name);                    \
  writeString (cTypesHFd, "_t;");                   \
  writeNewline (cTypesHFd);                         \
  writeString (cTypesSMLFd, "structure C_");        \
  writeString (cTypesSMLFd, name);                  \
  writeString (cTypesSMLFd, " = WordToBool (");     \
  writeString (cTypesSMLFd, "type t = ");           \
  writeString (cTypesSMLFd, "Word");                \
  writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
  writeString (cTypesSMLFd, ".word");               \
  writeString (cTypesSMLFd, " ");                   \
  writeString (cTypesSMLFd, "val zero: t = 0wx0");  \
  writeString (cTypesSMLFd, " ");                   \
  writeString (cTypesSMLFd, "val one: t = 0wx1");   \
  writeString (cTypesSMLFd, ")");                   \
  writeNewline (cTypesSMLFd);                       \
  } while (0)
#define systype(t, bt, name)                        \
  do {                                              \
  char *btLower = strdup(bt);                       \
  for (size_t i = 0; i < strlen(btLower); i++)      \
    btLower[i] = (char)(tolower((int)(bt[i])));     \
  char *btUpper = strdup(bt);                       \
  for (size_t i = 0; i < strlen(btUpper); i++)      \
    btUpper[i] = (char)(toupper((int)(bt[i])));     \
  writeString (cTypesHFd, "typedef");               \
  writeString (cTypesHFd, " /* ");                  \
  writeString (cTypesHFd, #t);                      \
  writeString (cTypesHFd, " */ ");                  \
  writeString (cTypesHFd, bt);                      \
  writeUintmaxU (cTypesHFd, CHAR_BIT * sizeof(t));  \
  writeString (cTypesHFd, "_t");                    \
  writeString (cTypesHFd, " ");                     \
  writeString (cTypesHFd, "C_");                    \
  writeString (cTypesHFd, name);                    \
  writeString (cTypesHFd, "_t;");                   \
  writeNewline (cTypesHFd);                         \
  writeString (cTypesSMLFd, "structure C_");        \
  writeString (cTypesSMLFd, name);                  \
  writeString (cTypesSMLFd, " = struct open ");     \
  writeString (cTypesSMLFd, bt);                    \
  writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
  writeString (cTypesSMLFd, " type t = ");          \
  writeString (cTypesSMLFd, btLower);               \
  writeString (cTypesSMLFd, " end");                \
  writeNewline (cTypesSMLFd);                       \
  writeString (cTypesSMLFd, "functor C_");          \
  writeString (cTypesSMLFd, name);                  \
  writeString (cTypesSMLFd, "_Choose");             \
  writeString (cTypesSMLFd, bt);                    \
  writeString (cTypesSMLFd, "N (A: CHOOSE_");       \
  writeString (cTypesSMLFd, btUpper);               \
  writeString (cTypesSMLFd, "N_ARG) = Choose");     \
  writeString (cTypesSMLFd, bt);                    \
  writeString (cTypesSMLFd, "N_");                  \
  writeString (cTypesSMLFd, bt);                    \
  writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
  writeString (cTypesSMLFd, " (A)");                \
  writeNewline (cTypesSMLFd);                       \
  free (btLower);                                   \
  free (btUpper);                                   \
  } while (0)
#define chksystype(t, name)                \
  do {                                     \
  if ((double)((t)(0.25)) > 0)             \
  systype(t, "Real", name);                \
  else if ((double)((t)(-1)) > 0)          \
  systype(t, "Word", name);                \
  else                                     \
  systype(t, "Int", name);                 \
  } while (0)
#define ptrtype(t, name)                            \
  do {                                              \
  systype(t, "Word", name);                         \
  } while (0)

#define aliastype(name1, bt, name2)                 \
  do {                                              \
  char *btLower = strdup(bt);                       \
  for (size_t i = 0; i < strlen(btLower); i++)      \
    btLower[i] = (char)(tolower((int)(bt[i])));     \
  char *btUpper = strdup(bt);                       \
  for (size_t i = 0; i < strlen(btUpper); i++)      \
    btUpper[i] = (char)(toupper((int)(bt[i])));     \
  writeString (cTypesHFd, "typedef ");              \
  writeString (cTypesHFd, "C_");                    \
  writeString (cTypesHFd, name1);                   \
  writeString (cTypesHFd, "_t ");                   \
  writeString (cTypesHFd, "C_");                    \
  writeString (cTypesHFd, name2);                   \
  writeString (cTypesHFd, "_t;");                   \
  writeNewline (cTypesHFd);                         \
  writeString (cTypesSMLFd, "structure C_");        \
  writeString (cTypesSMLFd, name2);                 \
  writeString (cTypesSMLFd, " = C_");               \
  writeString (cTypesSMLFd, name1);                 \
  writeNewline (cTypesSMLFd);                       \
  writeString (cTypesSMLFd, "functor C_");          \
  writeString (cTypesSMLFd, name2);                 \
  writeString (cTypesSMLFd, "_Choose");             \
  writeString (cTypesSMLFd, bt);                    \
  writeString (cTypesSMLFd, "N (A: CHOOSE_");       \
  writeString (cTypesSMLFd, btUpper);               \
  writeString (cTypesSMLFd, "N_ARG) = C_");         \
  writeString (cTypesSMLFd, name1);                 \
  writeString (cTypesSMLFd, "_Choose");             \
  writeString (cTypesSMLFd, bt);                    \
  writeString (cTypesSMLFd, "N (A)");               \
  writeNewline (cTypesSMLFd);                       \
  free (btLower);                                   \
  free (btUpper);                                   \
  } while (0)

static const char* mlTypesHSuffix[] = {
  "#endif /* _MLTON_MLTYPES_H_ */",
  NULL
};

static const char* cTypesHSuffix[] = {
  "#define C_Errno_t(t) t",
  "",
  "#endif /* _MLTON_CTYPES_H_ */",
  NULL
};

static const char* cTypesSMLSuffix[] = {
  NULL
};

int main (__attribute__ ((unused)) int argc,
          __attribute__ ((unused)) char* argv[]) {
  FILE *mlTypesHFd;
  FILE *cTypesHFd;
  FILE *cTypesSMLFd;

  mlTypesHFd = fopen_safe ("ml-types.h", "w");
  for (int i = 0; mlTypesHPrefix[i] != NULL; i++)
    writeStringWithNewline (mlTypesHFd, mlTypesHPrefix[i]);
  for (int i = 0; mlTypesHStd[i] != NULL; i++)
    writeStringWithNewline (mlTypesHFd, mlTypesHStd[i]);
  for (int i = 0; mlTypesHSuffix[i] != NULL; i++)
    writeStringWithNewline (mlTypesHFd, mlTypesHSuffix[i]);

  cTypesHFd = fopen_safe ("c-types.h", "w");
  cTypesSMLFd = fopen_safe ("c-types.sml", "w");

  for (int i = 0; cTypesHPrefix[i] != NULL; i++)
    writeStringWithNewline (cTypesHFd, cTypesHPrefix[i]);
  for (int i = 0; cTypesSMLPrefix[i] != NULL; i++)
    writeStringWithNewline (cTypesSMLFd, cTypesSMLPrefix[i]);

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* C */");
  writeStringWithNewline (cTypesSMLFd, "(* C *)");
  booltype(_Bool, "Word", "Bool");
  chksystype(char, "Char");
  chksystype(signed char, "SChar");
  chksystype(unsigned char, "UChar");
  chksystype(short, "Short");
  chksystype(signed short, "SShort");
  chksystype(unsigned short, "UShort");
  chksystype(int, "Int");
  chksystype(signed int, "SInt");
  chksystype(unsigned int, "UInt");
  chksystype(long, "Long");
  chksystype(signed long, "SLong");
  chksystype(unsigned long, "ULong");
  chksystype(long long, "LongLong");
  chksystype(signed long long, "SLongLong");
  chksystype(unsigned long long, "ULongLong");
  chksystype(float, "Float");
  chksystype(double, "Double");
  // chksystype(long double, "LongDouble");
  chksystype(size_t, "Size");
  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  ptrtype(unsigned char*, "Pointer");
  // ptrtype(void*, "Pointer");
  // ptrtype(uintptr_t, "Pointer");
  ptrtype(char*, "String");
  ptrtype(char**, "StringArray");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* Generic integers */");
  writeStringWithNewline (cTypesSMLFd, "(* Generic integers *)");
  aliastype("Int", "Int", "Fd");
  aliastype("Int", "Int", "Signal");
  aliastype("Int", "Int", "Status");
  aliastype("Int", "Int", "Sock");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* C99 */");
  writeStringWithNewline (cTypesSMLFd, "(* C99 *)");
  chksystype(ptrdiff_t, "Ptrdiff");
  chksystype(intmax_t, "Intmax");
  chksystype(uintmax_t, "UIntmax");
  chksystype(intptr_t, "Intptr");
  chksystype(uintptr_t, "UIntptr");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* from <dirent.h> */");
  writeStringWithNewline (cTypesSMLFd, "(* from <dirent.h> *)");
  // ptrtype(DIR*, "DirP");
  systype(DIR*, "Word", "DirP");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* from <poll.h> */");
  writeStringWithNewline (cTypesSMLFd, "(* from <poll.h> *)");
  chksystype(nfds_t, "NFds");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* from <resource.h> */");
  writeStringWithNewline (cTypesSMLFd, "(* from <resource.h> *)");
  chksystype(rlim_t, "RLim");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* from <sys/types.h> */");
  writeStringWithNewline (cTypesSMLFd, "(* from <sys/types.h> *)");
  // chksystype(blkcnt_t, "BlkCnt");
  // chksystype(blksize_t, "BlkSize");
  chksystype(clock_t, "Clock");
  chksystype(dev_t, "Dev");
  chksystype(gid_t, "GId");
  // chksystype(id_t, "Id");
  chksystype(ino_t, "INo");
  chksystype(mode_t, "Mode");
  chksystype(nlink_t, "NLink");
  chksystype(off_t, "Off");
  chksystype(pid_t, "PId");
  chksystype(ssize_t, "SSize");
  chksystype(suseconds_t, "SUSeconds");
  chksystype(time_t, "Time");
  chksystype(uid_t, "UId");
  // chksystype(useconds_t, "USeconds");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* from <sys/socket.h> */");
  writeStringWithNewline (cTypesSMLFd, "(* from <sys/socket.h> *)");
  chksystype(socklen_t, "Socklen");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* from <termios.h> */");
  writeStringWithNewline (cTypesSMLFd, "(* from <termios.h> *)");
  chksystype(cc_t, "CC");
  chksystype(speed_t, "Speed");
  chksystype(tcflag_t, "TCFlag");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  writeStringWithNewline (cTypesHFd, "/* from \"gmp.h\" */");
  writeStringWithNewline (cTypesSMLFd, "(* from \"gmp.h\" *)");
  chksystype(mp_limb_t, "MPLimb");

  writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
  for (int i = 0; cTypesHSuffix[i] != NULL; i++)
    writeStringWithNewline (cTypesHFd, cTypesHSuffix[i]);
  for (int i = 0; cTypesSMLSuffix[i] != NULL; i++)
    writeStringWithNewline (cTypesSMLFd, cTypesSMLSuffix[i]);

  fclose_safe(mlTypesHFd);
  fclose_safe(cTypesHFd);
  fclose_safe(cTypesSMLFd);

  return 0;
}
Commit	Line	Data
7f918cf1 CE	1	/* Copyright (C) 2012,2017 Matthew Fluet.
	2	* Copyright (C) 2004-2008 Henry Cejtin, Matthew Fluet, Suresh
	3	* Jagannathan, and Stephen Weeks.
	4	*
	5	* MLton is released under a BSD-style license.
	6	* See the file MLton-LICENSE for details.
	7	*/
	8
	9	#include "cenv.h"
	10	#include "util.h"
	11
	12	static const char* mlTypesHPrefix[] = {
	13	"/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh",
	14	" * Jagannathan, and Stephen Weeks.",
	15	" *",
	16	" * MLton is released under a BSD-style license.",
	17	" * See the file MLton-LICENSE for details.",
	18	" */",
	19	"",
	20	"#ifndef _MLTON_MLTYPES_H_",
	21	"#define _MLTON_MLTYPES_H_",
	22	"",
	23	"/* We need these because in header files for exported SML functions, ",
	24	" * types.h is included without cenv.h.",
	25	" */",
	26	"#if (defined (_AIX) \|\| defined (__hpux__) \|\| defined (__OpenBSD__))",
	27	"#include <inttypes.h>",
	28	"#elif (defined (__sun__))",
	29	"#include <sys/int_types.h>",
	30	"#else",
	31	"#include <stdint.h>",
	32	"#endif",
	33	"",
	34	NULL
	35	};
	36
	37	static const char* cTypesHPrefix[] = {
	38	"/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh",
	39	" * Jagannathan, and Stephen Weeks.",
	40	" *",
	41	" * MLton is released under a BSD-style license.",
	42	" * See the file MLton-LICENSE for details.",
	43	" */",
	44	"",
	45	"#ifndef _MLTON_CTYPES_H_",
	46	"#define _MLTON_CTYPES_H_",
	47	"",
	48	NULL
	49	};
	50
	51	static const char* cTypesSMLPrefix[] = {
	52	"(* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh",
	53	" * Jagannathan, and Stephen Weeks.",
	54	" *",
	55	" * MLton is released under a BSD-style license.",
	56	" * See the file MLton-LICENSE for details.",
	57	" *)",
	58	"",
	59	NULL
	60	};
	61
	62	static const char* mlTypesHStd[] = {
	63	"/* ML types */",
	64	// "typedef void* Pointer;",
65	// "typedef uintptr_t Pointer;",
66	// "typedef unsigned char* Pointer;",
67	"typedef unsigned char PointerAux __attribute__ ((may_alias));",
68	"typedef PointerAux* Pointer;",
69	"#define Array(t) Pointer",
70	"#define Ref(t) Pointer",
71	"#define Vector(t) Pointer",
72	"",
73	"typedef int8_t Int8_t;",
74	"typedef int8_t Int8;",
75	"typedef int16_t Int16_t;",
76	"typedef int16_t Int16;",
77	"typedef int32_t Int32_t;",
78	"typedef int32_t Int32;",
79	"typedef int64_t Int64_t;",
80	"typedef int64_t Int64;",
81	"typedef float Real32_t;",
82	"typedef float Real32;",
83	"typedef double Real64_t;",
84	"typedef double Real64;",
85	// "typedef long double Real128_t;",
86	// "typedef long double Real128;",
87	"typedef uint8_t Word8_t;",
88	"typedef uint8_t Word8;",
89	"typedef uint16_t Word16_t;",
90	"typedef uint16_t Word16;",
91	"typedef uint32_t Word32_t;",
92	"typedef uint32_t Word32;",
93	"typedef uint64_t Word64_t;",
94	"typedef uint64_t Word64;",
95	"",
96	"typedef Int8_t WordS8_t;",
97	"typedef Int8_t WordS8;",
98	"typedef Int16_t WordS16_t;",
99	"typedef Int16_t WordS16;",
100	"typedef Int32_t WordS32_t;",
101	"typedef Int32_t WordS32;",
102	"typedef Int64_t WordS64_t;",
103	"typedef Int64_t WordS64;",
104	"",
105	"typedef Word8_t WordU8_t;",
106	"typedef Word8_t WordU8;",
107	"typedef Word16_t WordU16_t;",
108	"typedef Word16_t WordU16;",
109	"typedef Word32_t WordU32_t;",
110	"typedef Word32_t WordU32;",
111	"typedef Word64_t WordU64_t;",
112	"typedef Word64_t WordU64;",
113	"",
114	"typedef WordU8_t Char8_t;",
115	"typedef WordU8_t Char8;",
116	"typedef WordU16_t Char16_t;",
117	"typedef WordU16_t Char16;",
118	"typedef WordU32_t Char32_t;",
119	"typedef WordU32_t Char32;",
120	"",
121	"typedef Vector(Char8_t) String8_t;",
122	"typedef Vector(Char8_t) String8;",
123	"typedef Vector(Char16_t) String16_t;",
124	"typedef Vector(Char16_t) String16;",
125	"typedef Vector(Char32_t) String32_t;",
126	"typedef Vector(Char32_t) String32;",
127	"",
128	"typedef Int32_t Bool_t;",
129	"typedef Int32_t Bool;",
130	// "typedef Char8_t Char_t;",
131	// "typedef Char8_t Char;",
132	// "typedef Int32_t Int_t;",
133	// "typedef Int32_t Int;",
134	// "typedef Real64_t Real_t;",
135	// "typedef Real64_t Real;",
136	// "typedef String8_t String_t;",
137	// "typedef String8_t String;",
138	// "typedef Word32_t Word_t;",
139	// "typedef Word32_t Word;",
140	""
141	"typedef String8_t NullString8_t;",
142	"typedef String8_t NullString8;",
143	"",
144	"typedef void* CPointer;",
145	"typedef Pointer Objptr;",
146	NULL
147	};
148
149	#define booltype(t, bt, name) \
150	do { \
151	writeString (cTypesHFd, "typedef"); \
152	writeString (cTypesHFd, " /* "); \
153	writeString (cTypesHFd, #t); \
154	writeString (cTypesHFd, " */ "); \
155	writeString (cTypesHFd, bt); \
156	writeUintmaxU (cTypesHFd, CHAR_BIT * sizeof(t)); \
157	writeString (cTypesHFd, "_t"); \
158	writeString (cTypesHFd, " "); \
159	writeString (cTypesHFd, "C_"); \
160	writeString (cTypesHFd, name); \
161	writeString (cTypesHFd, "_t;"); \
162	writeNewline (cTypesHFd); \
163	writeString (cTypesSMLFd, "structure C_"); \
164	writeString (cTypesSMLFd, name); \
165	writeString (cTypesSMLFd, " = WordToBool ("); \
166	writeString (cTypesSMLFd, "type t = "); \
167	writeString (cTypesSMLFd, "Word"); \
168	writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
169	writeString (cTypesSMLFd, ".word"); \
170	writeString (cTypesSMLFd, " "); \
171	writeString (cTypesSMLFd, "val zero: t = 0wx0"); \
172	writeString (cTypesSMLFd, " "); \
173	writeString (cTypesSMLFd, "val one: t = 0wx1"); \
174	writeString (cTypesSMLFd, ")"); \
175	writeNewline (cTypesSMLFd); \
176	} while (0)
177	#define systype(t, bt, name) \
178	do { \
179	char *btLower = strdup(bt); \
180	for (size_t i = 0; i < strlen(btLower); i++) \
181	btLower[i] = (char)(tolower((int)(bt[i]))); \
182	char *btUpper = strdup(bt); \
183	for (size_t i = 0; i < strlen(btUpper); i++) \
184	btUpper[i] = (char)(toupper((int)(bt[i]))); \
185	writeString (cTypesHFd, "typedef"); \
186	writeString (cTypesHFd, " /* "); \
187	writeString (cTypesHFd, #t); \
188	writeString (cTypesHFd, " */ "); \
189	writeString (cTypesHFd, bt); \
190	writeUintmaxU (cTypesHFd, CHAR_BIT * sizeof(t)); \
191	writeString (cTypesHFd, "_t"); \
192	writeString (cTypesHFd, " "); \
193	writeString (cTypesHFd, "C_"); \
194	writeString (cTypesHFd, name); \
195	writeString (cTypesHFd, "_t;"); \
196	writeNewline (cTypesHFd); \
197	writeString (cTypesSMLFd, "structure C_"); \
198	writeString (cTypesSMLFd, name); \
199	writeString (cTypesSMLFd, " = struct open "); \
200	writeString (cTypesSMLFd, bt); \
201	writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
202	writeString (cTypesSMLFd, " type t = "); \
203	writeString (cTypesSMLFd, btLower); \
204	writeString (cTypesSMLFd, " end"); \
205	writeNewline (cTypesSMLFd); \
206	writeString (cTypesSMLFd, "functor C_"); \
207	writeString (cTypesSMLFd, name); \
208	writeString (cTypesSMLFd, "_Choose"); \
209	writeString (cTypesSMLFd, bt); \
210	writeString (cTypesSMLFd, "N (A: CHOOSE_"); \
211	writeString (cTypesSMLFd, btUpper); \
212	writeString (cTypesSMLFd, "N_ARG) = Choose"); \
213	writeString (cTypesSMLFd, bt); \
214	writeString (cTypesSMLFd, "N_"); \
215	writeString (cTypesSMLFd, bt); \
216	writeUintmaxU (cTypesSMLFd, CHAR_BIT * sizeof(t));\
217	writeString (cTypesSMLFd, " (A)"); \
218	writeNewline (cTypesSMLFd); \
219	free (btLower); \
220	free (btUpper); \
221	} while (0)
222	#define chksystype(t, name) \
223	do { \
224	if ((double)((t)(0.25)) > 0) \
225	systype(t, "Real", name); \
226	else if ((double)((t)(-1)) > 0) \
227	systype(t, "Word", name); \
228	else \
229	systype(t, "Int", name); \
230	} while (0)
231	#define ptrtype(t, name) \
232	do { \
233	systype(t, "Word", name); \
234	} while (0)
235
236	#define aliastype(name1, bt, name2) \
237	do { \
238	char *btLower = strdup(bt); \
239	for (size_t i = 0; i < strlen(btLower); i++) \
240	btLower[i] = (char)(tolower((int)(bt[i]))); \
241	char *btUpper = strdup(bt); \
242	for (size_t i = 0; i < strlen(btUpper); i++) \
243	btUpper[i] = (char)(toupper((int)(bt[i]))); \
244	writeString (cTypesHFd, "typedef "); \
245	writeString (cTypesHFd, "C_"); \
246	writeString (cTypesHFd, name1); \
247	writeString (cTypesHFd, "_t "); \
248	writeString (cTypesHFd, "C_"); \
249	writeString (cTypesHFd, name2); \
250	writeString (cTypesHFd, "_t;"); \
251	writeNewline (cTypesHFd); \
252	writeString (cTypesSMLFd, "structure C_"); \
253	writeString (cTypesSMLFd, name2); \
254	writeString (cTypesSMLFd, " = C_"); \
255	writeString (cTypesSMLFd, name1); \
256	writeNewline (cTypesSMLFd); \
257	writeString (cTypesSMLFd, "functor C_"); \
258	writeString (cTypesSMLFd, name2); \
259	writeString (cTypesSMLFd, "_Choose"); \
260	writeString (cTypesSMLFd, bt); \
261	writeString (cTypesSMLFd, "N (A: CHOOSE_"); \
262	writeString (cTypesSMLFd, btUpper); \
263	writeString (cTypesSMLFd, "N_ARG) = C_"); \
264	writeString (cTypesSMLFd, name1); \
265	writeString (cTypesSMLFd, "_Choose"); \
266	writeString (cTypesSMLFd, bt); \
267	writeString (cTypesSMLFd, "N (A)"); \
268	writeNewline (cTypesSMLFd); \
269	free (btLower); \
270	free (btUpper); \
271	} while (0)
272
273	static const char* mlTypesHSuffix[] = {
274	"#endif /* _MLTON_MLTYPES_H_ */",
275	NULL
276	};
277
278	static const char* cTypesHSuffix[] = {
279	"#define C_Errno_t(t) t",
280	"",
281	"#endif /* _MLTON_CTYPES_H_ */",
282	NULL
283	};
284
285	static const char* cTypesSMLSuffix[] = {
286	NULL
287	};
288
289	int main (__attribute__ ((unused)) int argc,
290	__attribute__ ((unused)) char* argv[]) {
291	FILE *mlTypesHFd;
292	FILE *cTypesHFd;
293	FILE *cTypesSMLFd;
294
295	mlTypesHFd = fopen_safe ("ml-types.h", "w");
296	for (int i = 0; mlTypesHPrefix[i] != NULL; i++)
297	writeStringWithNewline (mlTypesHFd, mlTypesHPrefix[i]);
298	for (int i = 0; mlTypesHStd[i] != NULL; i++)
299	writeStringWithNewline (mlTypesHFd, mlTypesHStd[i]);
300	for (int i = 0; mlTypesHSuffix[i] != NULL; i++)
301	writeStringWithNewline (mlTypesHFd, mlTypesHSuffix[i]);
302
303	cTypesHFd = fopen_safe ("c-types.h", "w");
304	cTypesSMLFd = fopen_safe ("c-types.sml", "w");
305
306	for (int i = 0; cTypesHPrefix[i] != NULL; i++)
307	writeStringWithNewline (cTypesHFd, cTypesHPrefix[i]);
308	for (int i = 0; cTypesSMLPrefix[i] != NULL; i++)
309	writeStringWithNewline (cTypesSMLFd, cTypesSMLPrefix[i]);
310
311	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
312	writeStringWithNewline (cTypesHFd, "/* C */");
313	writeStringWithNewline (cTypesSMLFd, "(* C *)");
314	booltype(_Bool, "Word", "Bool");
315	chksystype(char, "Char");
316	chksystype(signed char, "SChar");
317	chksystype(unsigned char, "UChar");
318	chksystype(short, "Short");
319	chksystype(signed short, "SShort");
320	chksystype(unsigned short, "UShort");
321	chksystype(int, "Int");
322	chksystype(signed int, "SInt");
323	chksystype(unsigned int, "UInt");
324	chksystype(long, "Long");
325	chksystype(signed long, "SLong");
326	chksystype(unsigned long, "ULong");
327	chksystype(long long, "LongLong");
328	chksystype(signed long long, "SLongLong");
329	chksystype(unsigned long long, "ULongLong");
330	chksystype(float, "Float");
331	chksystype(double, "Double");
332	// chksystype(long double, "LongDouble");
333	chksystype(size_t, "Size");
334	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
335	ptrtype(unsigned char*, "Pointer");
336	// ptrtype(void*, "Pointer");
337	// ptrtype(uintptr_t, "Pointer");
338	ptrtype(char*, "String");
339	ptrtype(char**, "StringArray");
340
341	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
342	writeStringWithNewline (cTypesHFd, "/* Generic integers */");
343	writeStringWithNewline (cTypesSMLFd, "(* Generic integers *)");
344	aliastype("Int", "Int", "Fd");
345	aliastype("Int", "Int", "Signal");
346	aliastype("Int", "Int", "Status");
347	aliastype("Int", "Int", "Sock");
348
349	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
350	writeStringWithNewline (cTypesHFd, "/* C99 */");
351	writeStringWithNewline (cTypesSMLFd, "(* C99 *)");
352	chksystype(ptrdiff_t, "Ptrdiff");
353	chksystype(intmax_t, "Intmax");
354	chksystype(uintmax_t, "UIntmax");
355	chksystype(intptr_t, "Intptr");
356	chksystype(uintptr_t, "UIntptr");
357
358	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
359	writeStringWithNewline (cTypesHFd, "/* from <dirent.h> */");
360	writeStringWithNewline (cTypesSMLFd, "(* from <dirent.h> *)");
361	// ptrtype(DIR*, "DirP");
362	systype(DIR*, "Word", "DirP");
363
364	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
365	writeStringWithNewline (cTypesHFd, "/* from <poll.h> */");
366	writeStringWithNewline (cTypesSMLFd, "(* from <poll.h> *)");
367	chksystype(nfds_t, "NFds");
368
369	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
370	writeStringWithNewline (cTypesHFd, "/* from <resource.h> */");
371	writeStringWithNewline (cTypesSMLFd, "(* from <resource.h> *)");
372	chksystype(rlim_t, "RLim");
373
374	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
375	writeStringWithNewline (cTypesHFd, "/* from <sys/types.h> */");
376	writeStringWithNewline (cTypesSMLFd, "(* from <sys/types.h> *)");
377	// chksystype(blkcnt_t, "BlkCnt");
378	// chksystype(blksize_t, "BlkSize");
379	chksystype(clock_t, "Clock");
380	chksystype(dev_t, "Dev");
381	chksystype(gid_t, "GId");
382	// chksystype(id_t, "Id");
383	chksystype(ino_t, "INo");
384	chksystype(mode_t, "Mode");
385	chksystype(nlink_t, "NLink");
386	chksystype(off_t, "Off");
387	chksystype(pid_t, "PId");
388	chksystype(ssize_t, "SSize");
389	chksystype(suseconds_t, "SUSeconds");
390	chksystype(time_t, "Time");
391	chksystype(uid_t, "UId");
392	// chksystype(useconds_t, "USeconds");
393
394	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
395	writeStringWithNewline (cTypesHFd, "/* from <sys/socket.h> */");
396	writeStringWithNewline (cTypesSMLFd, "(* from <sys/socket.h> *)");
397	chksystype(socklen_t, "Socklen");
398
399	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
400	writeStringWithNewline (cTypesHFd, "/* from <termios.h> */");
401	writeStringWithNewline (cTypesSMLFd, "(* from <termios.h> *)");
402	chksystype(cc_t, "CC");
403	chksystype(speed_t, "Speed");
404	chksystype(tcflag_t, "TCFlag");
405
406	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
407	writeStringWithNewline (cTypesHFd, "/* from \"gmp.h\" */");
408	writeStringWithNewline (cTypesSMLFd, "(* from \"gmp.h\" *)");
409	chksystype(mp_limb_t, "MPLimb");
410
411	writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
412	for (int i = 0; cTypesHSuffix[i] != NULL; i++)
413	writeStringWithNewline (cTypesHFd, cTypesHSuffix[i]);
414	for (int i = 0; cTypesSMLSuffix[i] != NULL; i++)
415	writeStringWithNewline (cTypesSMLFd, cTypesSMLSuffix[i]);
416
417	fclose_safe(mlTypesHFd);
418	fclose_safe(cTypesHFd);
419	fclose_safe(cTypesSMLFd);
420
421	return 0;
422	}