src/ebisp/interpreter.c

   1 #include <assert.h>
   2 #include <math.h>
   3 #include <string.h>
   4 #include <stdarg.h>
   5 #include <stdbool.h>
   6
   7 #include "./builtins.h"
   8 #include "./expr.h"
   9 #include "./interpreter.h"
  10 #include "./scope.h"
  11
  12 struct EvalResult eval_success(struct Expr expr)
  13 {
  14     struct EvalResult result = {
  15         .is_error = false,
  16         .expr = expr,
  17     };
  18
  19     return result;
  20 }
  21
  22 struct EvalResult eval_failure(struct Expr error)
  23 {
  24     struct EvalResult result = {
  25         .is_error = true,
  26         .expr = error,
  27     };
  28
  29     return result;
  30 }
  31
  32 struct EvalResult
  33 wrong_argument_type(Gc *gc, const char *type, struct Expr obj)
  34 {
  35     return eval_failure(
  36         list(gc, 3,
  37              SYMBOL(gc, "wrong-argument-type"),
  38              SYMBOL(gc, type),
  39              obj));
  40 }
  41
  42 struct EvalResult
  43 wrong_number_of_arguments(Gc *gc, long int count)
  44 {
  45     return eval_failure(
  46         CONS(gc,
  47              SYMBOL(gc, "wrong-number-of-arguments"),
  48              NUMBER(gc, count)));
  49 }
  50
  51 struct EvalResult
  52 not_implemented(Gc *gc)
  53 {
  54     return eval_failure(SYMBOL(gc, "not-implemented"));
  55 }
  56
  57 static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
  58 {
  59     (void) scope;
  60     (void) gc;
  61
  62     switch (atom->type) {
  63     case ATOM_NUMBER:
  64     case ATOM_STRING:
  65     case ATOM_NATIVE:
  66         return eval_success(atom_as_expr(atom));
  67
  68     case ATOM_SYMBOL: {
  69         struct Expr value = get_scope_value(scope, atom_as_expr(atom));
  70
  71         if (nil_p(value)) {
  72             return eval_failure(CONS(gc,
  73                                      SYMBOL(gc, "void-variable"),
  74                                      atom_as_expr(atom)));
  75         }
  76
  77         return eval_success(value.cons->cdr);
  78     }
  79     }
  80
  81     return eval_failure(CONS(gc,
  82                              SYMBOL(gc, "unexpected-expression"),
  83                              atom_as_expr(atom)));
  84 }
  85
  86 static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr args)
  87 {
  88     (void) scope;
  89     (void) args;
  90
  91     switch(args.type) {
  92     case EXPR_ATOM:
  93         return eval_atom(gc, scope, args.atom);
  94
  95     case EXPR_CONS: {
  96         struct EvalResult car = eval(gc, scope, args.cons->car);
  97         if (car.is_error) {
  98             return car;
  99         }
 100
 101         struct EvalResult cdr = eval_all_args(gc, scope, args.cons->cdr);
 102         if (cdr.is_error) {
 103             return cdr;
 104         }
 105
 106         return eval_success(cons_as_expr(create_cons(gc, car.expr, cdr.expr)));
 107     }
 108
 109     default: {}
 110     }
 111
 112     return eval_failure(CONS(gc,
 113                              SYMBOL(gc, "unexpected-expression"),
 114                              args));
 115 }
 116
 117 static struct EvalResult call_lambda(Gc *gc,
 118                                      struct Scope *scope,
 119                                      struct Expr lambda,
 120                                      struct Expr args) {
 121     if (!lambda_p(lambda)) {
 122         return eval_failure(CONS(gc,
 123                                  SYMBOL(gc, "expected-callable"),
 124                                  lambda));
 125     }
 126
 127     if (!list_p(args)) {
 128         return eval_failure(CONS(gc,
 129                                  SYMBOL(gc, "expected-list"),
 130                                  args));
 131     }
 132
 133     struct Expr vars = lambda.cons->cdr.cons->car;
 134
 135     if (length_of_list(args) != length_of_list(vars)) {
 136         return eval_failure(CONS(gc,
 137                                  SYMBOL(gc, "wrong-number-of-arguments"),
 138                                  NUMBER(gc, length_of_list(args))));
 139     }
 140
 141     push_scope_frame(gc, scope, vars, args);
 142     struct Expr body = lambda.cons->cdr.cons->cdr;
 143
 144     struct EvalResult result = eval_success(NIL(gc));
 145
 146     while (!nil_p(body)) {
 147         result = eval(gc, scope, body.cons->car);
 148         if (result.is_error) {
 149             return result;
 150         }
 151         body = body.cons->cdr;
 152     }
 153
 154     pop_scope_frame(gc, scope);
 155
 156     return result;
 157 }
 158
 159 static struct EvalResult call_callable(Gc *gc,
 160                                        struct Scope *scope,
 161                                        struct Expr callable_expr,
 162                                        struct Expr args_expr) {
 163     struct EvalResult callable_result = eval(gc, scope, callable_expr);
 164     if (callable_result.is_error) {
 165         return callable_result;
 166     }
 167
 168     struct EvalResult args_result = symbol_p(callable_expr) && is_special(callable_expr.atom->sym)
 169         ? eval_success(args_expr)
 170         : eval_all_args(gc, scope, args_expr);
 171
 172     if (args_result.is_error) {
 173         return args_result;
 174     }
 175
 176     if (callable_result.expr.type == EXPR_ATOM &&
 177         callable_result.expr.atom->type == ATOM_NATIVE) {
 178         return ((NativeFunction)callable_result.expr.atom->native.fun)(
 179             callable_result.expr.atom->native.param, gc, scope, args_result.expr);
 180     }
 181
 182     return call_lambda(gc, scope, callable_result.expr, args_result.expr);
 183 }
 184
 185
 186 struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
 187 {
 188     assert(gc);
 189     assert(scope);
 190
 191     if (!list_p(block)) {
 192         return wrong_argument_type(gc, "listp", block);
 193     }
 194
 195     struct Expr head = block;
 196     struct EvalResult eval_result = eval_success(NIL(gc));
 197
 198     while (cons_p(head)) {
 199         eval_result = eval(gc, scope, CAR(head));
 200         if (eval_result.is_error) {
 201             return eval_result;
 202         }
 203
 204         head = CDR(head);
 205     }
 206
 207     return eval_result;
 208 }
 209
 210 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
 211 {
 212     assert(cons);
 213     (void) scope;
 214
 215     if (symbol_p(cons->car) && is_lambda(cons)) {
 216         /* TODO(#335): lambda special form doesn't check if it forms a callable object */
 217         return eval_success(cons_as_expr(cons));
 218     }
 219
 220     return call_callable(gc, scope, cons->car, cons->cdr);
 221 }
 222
 223 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
 224 {
 225     switch(expr.type) {
 226     case EXPR_ATOM:
 227         return eval_atom(gc, scope, expr.atom);
 228
 229     case EXPR_CONS:
 230         return eval_funcall(gc, scope, expr.cons);
 231
 232     default: {}
 233     }
 234
 235     return eval_failure(CONS(gc,
 236                              SYMBOL(gc, "unexpected-expression"),
 237                              expr));
 238 }
 239
 240 struct EvalResult
 241 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 242 {
 243     (void) param;
 244     assert(gc);
 245     assert(scope);
 246
 247     struct Expr xs = NIL(gc);
 248
 249     struct EvalResult result = match_list(gc, "e", args, &xs);
 250     if (result.is_error) {
 251         return result;
 252     }
 253
 254     if (nil_p(xs)) {
 255         return eval_success(xs);
 256     }
 257
 258     if (!cons_p(xs)) {
 259         return wrong_argument_type(gc, "consp", xs);
 260     }
 261
 262     return eval_success(CAR(xs));
 263 }
 264
 265 struct EvalResult
 266 match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
 267 {
 268     va_list args_list;
 269     va_start(args_list, xs);
 270
 271     long int i = 0;
 272     for (i = 0; *format != 0 && !nil_p(xs); ++i) {
 273         if (!cons_p(xs)) {
 274             va_end(args_list);
 275             return wrong_argument_type(gc, "consp", xs);
 276         }
 277
 278         struct Expr x = CAR(xs);
 279
 280         switch (*format) {
 281         case 'd': {
 282             if (!number_p(x)) {
 283                 va_end(args_list);
 284                 return wrong_argument_type(gc, "numberp", x);
 285             }
 286
 287             long int *p = va_arg(args_list, long int *);
 288             if (p != NULL) {
 289                 *p = x.atom->num;
 290             }
 291         } break;
 292
 293         case 's': {
 294             if (!string_p(x)) {
 295                 va_end(args_list);
 296                 return wrong_argument_type(gc, "stringp", x);
 297             }
 298
 299             const char **p = va_arg(args_list, const char**);
 300             if (p != NULL) {
 301                 *p = x.atom->str;
 302             }
 303         } break;
 304
 305         case 'q': {
 306             if (!symbol_p(x)) {
 307                 va_end(args_list);
 308                 return wrong_argument_type(gc, "symbolp", x);
 309             }
 310
 311             const char **p = va_arg(args_list, const char**);
 312             if (p != NULL) {
 313                 *p = x.atom->sym;
 314             }
 315         } break;
 316
 317         case 'e': {
 318             struct Expr *p = va_arg(args_list, struct Expr*);
 319             *p = x;
 320         } break;
 321
 322         case '*': {
 323             struct Expr *p = va_arg(args_list, struct Expr*);
 324             if (p != NULL) {
 325                 *p = xs;
 326             }
 327             xs = NIL(gc);
 328         } break;
 329         }
 330
 331         format++;
 332         if (!nil_p(xs)) {
 333             xs = CDR(xs);
 334         }
 335     }
 336
 337     if (*format == '*' && nil_p(xs)) {
 338         struct Expr *p = va_arg(args_list, struct Expr*);
 339         if (p != NULL) {
 340             *p = NIL(gc);
 341         }
 342         format++;
 343     }
 344
 345     if (*format != 0 || !nil_p(xs)) {
 346         va_end(args_list);
 347         return wrong_number_of_arguments(gc, i);
 348     }
 349
 350     va_end(args_list);
 351     return eval_success(NIL(gc));
 352 }
 353
 354 static struct Expr
 355 format_list_rec(Gc *gc, const char *format, va_list args)
 356 {
 357     assert(gc);
 358     assert(format);
 359
 360     if (*format == 0) {
 361         return NIL(gc);
 362     }
 363
 364     switch (*format) {
 365     case 'd': {
 366         long int p = va_arg(args, long int);
 367         return CONS(gc, NUMBER(gc, p),
 368                     format_list_rec(gc, format + 1, args));
 369     }
 370
 371     case 's': {
 372         const char* p = va_arg(args, const char*);
 373         return CONS(gc, STRING(gc, p),
 374                     format_list_rec(gc, format + 1, args));
 375     }
 376
 377     case 'q': {
 378         const char* p = va_arg(args, const char*);
 379         return CONS(gc, SYMBOL(gc, p),
 380                     format_list_rec(gc, format + 1, args));
 381     }
 382
 383     case 'e': {
 384         struct Expr p = va_arg(args, struct Expr);
 385         return CONS(gc, p, format_list_rec(gc, format + 1, args));
 386     }
 387
 388     default: {
 389         fprintf(stderr, "Wrong format parameter: %c\n", *format);
 390         assert(0);
 391     }
 392     }
 393 }
 394
 395 struct Expr
 396 format_list(Gc *gc, const char *format, ...)
 397 {
 398     va_list args;
 399     va_start(args, format);
 400     struct Expr result = format_list_rec(gc, format, args);
 401     va_end(args);
 402
 403     return result;
 404 }