example/lambda/datatype.h

   1 #ifndef ORDER_EXAMPLE_LAMBDA_DATATYPE_H_VAJK20040620
   2 #define ORDER_EXAMPLE_LAMBDA_DATATYPE_H_VAJK20040620
   3
   4 // (C) Copyright Vesa Karvonen 2004.
   5 //
   6 // Distributed under the Boost Software License, Version 1.0.
   7 // (See accompanying file LICENSE.)
   8
   9 #include "checked_malloc.h"
  10 #include "order/interpreter.h"
  11
  12 #define ORDER_PP_DEF_8dt_type_name ORDER_PP_MACRO(8tuple_at_0)
  13 #define ORDER_PP_DEF_8dt_type_variants ORDER_PP_MACRO(8tuple_at_1)
  14
  15 #define ORDER_PP_DEF_8dt_variant_name ORDER_PP_MACRO(8tuple_at_0)
  16 #define ORDER_PP_DEF_8dt_variant_field_types ORDER_PP_MACRO(8tuple_at_1)
  17
  18 #define ORDER_PP_DEF_8dt_import_datatypes                                       \
  19 ORDER_PP_FN(8fn(8S,                                                             \
  20                 8seq_map(8fn(8D,                                                \
  21                              8tuple(8tuple_at_0(8D),                            \
  22                                     8vseq_to_seq_of_tuples(8tuple_at_1(8D)))),  \
  23                          8vseq_to_seq_of_tuples(8S))))
  24
  25 #define DATATYPE_define(datatypes)                                              \
  26 ORDER_PP(8let((8S, 8dt_import_datatypes(8(datatypes))),                         \
  27               8seq_for_each(8fn(8N,                                             \
  28                                 8print((typedef const struct)8N(*)8N(;))),      \
  29                             8seq_map(8dt_type_name, 8S)),                       \
  30               8seq_emit(8(DATATYPE_GEN_datatype), 8S)))
  31
  32 #define DATATYPE_GEN_datatype(type_name, variants)                      \
  33 ORDER_PP(8seq_for_each                                                  \
  34          (8apply(8fn(8C,                                                \
  35                      8seq_for_each_with_idx                             \
  36                      (8fn(8I, 8N,                                       \
  37                           8print((typedef) 8N 8cat(8(DATATYPE_FIELD_),  \
  38                                                    8to_lit(8I),         \
  39                                                    8(_TYPE_),           \
  40                                                    8C)                  \
  41                                  (;))),                                 \
  42                       0))),                                             \
  43           8(variants)))                                                 \
  44                                                                         \
  45 struct type_name {                                                      \
  46   enum {                                                                \
  47     ORDER_PP(8seq_for_each                                              \
  48              (8fn(8N,                                                   \
  49                   8print(8cat(8(DATATYPE_TAG_), 8N)                     \
  50                          (,))),                                         \
  51               8seq_map(8dt_variant_name, 8(variants))))                 \
  52   } tag;                                                                \
  53                                                                         \
  54   union {                                                               \
  55     ORDER_PP(8seq_emit                                                  \
  56              (8(DATATYPE_GEN_variant_struct),                           \
  57               8seq_filter(8chain(8seq_isnt_nil,                         \
  58                                  8dt_variant_field_types),              \
  59                           8(variants))))                                \
  60   } datum;                                                              \
  61 };                                                                      \
  62                                                                         \
  63 ORDER_PP(8seq_emit_map                                                  \
  64          (8(DATATYPE_GEN_ctor),                                         \
  65           8step(8tuple(8delay(8(type_name)),                            \
  66                        8tuple_at_0,                                     \
  67                        8chain(8seq_size, 8tuple_at_1))),                \
  68           8(variants)))
  69
  70 #define DATATYPE_GEN_variant_struct(variant_name, field_types)          \
  71 struct {                                                                \
  72   ORDER_PP(8seq_for_each_with_idx                                       \
  73            (8fn(8I, 8T,                                                 \
  74                 8print(8T 8cat(8(_), 8to_lit(8I)) (;))),                \
  75             0,                                                          \
  76             8(field_types)))                                            \
  77 } variant_name;
  78
  79 #define DATATYPE_GEN_ctor(type_name, variant_name, field_cnt)                   \
  80 inline type_name                                                                \
  81 variant_name(ORDER_PP(8for_each_in_range                                        \
  82                       (8fn(8I,                                                  \
  83                            8print(8unless(8is_0(8I),                            \
  84                                           8emit_comma(8nil))                    \
  85                                   8cat(8(DATATYPE_FIELD_),                      \
  86                                        8to_lit(8I),                             \
  87                                        8(_TYPE_##variant_name))                 \
  88                                   8cat(8(_), 8to_lit(8I)))),                    \
  89                        0, 8(field_cnt)))) {                                     \
  90   struct type_name* ORDER_PP_FRESH_ID(result) =                                 \
  91     checked_malloc(sizeof(struct type_name));                                   \
  92                                                                                 \
  93   ORDER_PP_FRESH_ID(result)->tag = DATATYPE_TAG_##variant_name;                 \
  94                                                                                 \
  95   ORDER_PP(8for_each_in_range                                                   \
  96            (8fn(8I,                                                             \
  97                 8let((8F, 8cat(8(_),8to_lit(8I))),                              \
  98                      8print((ORDER_PP_FRESH_ID(result)->datum.variant_name.)    \
  99                             8F (=) 8F (;)))),                                   \
 100             0, 8(field_cnt)))                                                   \
 101                                                                                 \
 102   return ORDER_PP_FRESH_ID(result);                                             \
 103 }
 104
 105 #define ORDER_PP_DEF_8dt_import_cases           \
 106 ORDER_PP_FN(8fn(8S,                             \
 107                 8vseq_to_seq_of_tuples(8S)))
 108
 109 #define DATATYPE_switch(expr, type_name, cases)         \
 110 do {                                                    \
 111   const type_name ORDER_PP_FRESH_ID(value) = (expr);    \
 112                                                         \
 113   switch (ORDER_PP_FRESH_ID(value)->tag) {              \
 114     ORDER_PP(8seq_emit                                  \
 115              (8(DATATYPE_GEN_case),                     \
 116               8dt_import_cases(8(cases))))              \
 117   default:                                              \
 118     ERROR_exit("Invalid tag %d resulting from '%s'.",   \
 119                ORDER_PP_FRESH_ID(value)->tag, #expr);   \
 120   }                                                     \
 121 } while (0)
 122
 123 #define DATATYPE_GEN_case(variant_name, field_names, ...)                       \
 124 case DATATYPE_TAG_##variant_name: {                                             \
 125   ORDER_PP(8seq_for_each_with_idx                                               \
 126            (8fn(8I, 8F,                                                         \
 127                 8let((8I, 8to_lit(8I)),                                         \
 128                      8print((const) 8cat(8(DATATYPE_FIELD_),                    \
 129                                          8I,                                    \
 130                                          8(_TYPE_##variant_name))               \
 131                             8F (=)                                              \
 132                             (ORDER_PP_FRESH_ID(value)->datum.variant_name.)     \
 133                             8cat(8(_),8I) (;)))),                               \
 134             0,                                                                  \
 135             8(field_names)))                                                    \
 136   do { __VA_ARGS__ } while (0);                                                 \
 137   break;                                                                        \
 138 }
 139
 140 #endif