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 length(Gc *gc, struct Expr obj)
  58 {
  59     if (!list_p(obj)) {
  60         return wrong_argument_type(gc, "listp", obj);
  61     }
  62
  63     return eval_success(NUMBER(gc, length_of_list(obj)));
  64 }
  65
  66 static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
  67 {
  68     (void) scope;
  69     (void) gc;
  70
  71     switch (atom->type) {
  72     case ATOM_NUMBER:
  73     case ATOM_STRING:
  74     case ATOM_NATIVE:
  75         return eval_success(atom_as_expr(atom));
  76
  77     case ATOM_SYMBOL: {
  78         if (nil_p(atom_as_expr(atom))) {
  79             return eval_success(atom_as_expr(atom));
  80         }
  81
  82         struct Expr value = get_scope_value(scope, atom_as_expr(atom));
  83
  84         if (nil_p(value)) {
  85             return eval_failure(CONS(gc,
  86                                      SYMBOL(gc, "void-variable"),
  87                                      atom_as_expr(atom)));
  88         }
  89
  90         return eval_success(value.cons->cdr);
  91     }
  92     }
  93
  94     return eval_failure(CONS(gc,
  95                              SYMBOL(gc, "unexpected-expression"),
  96                              atom_as_expr(atom)));
  97 }
  98
  99 static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr args)
 100 {
 101     (void) scope;
 102     (void) args;
 103
 104     switch(args.type) {
 105     case EXPR_ATOM:
 106         return eval_atom(gc, scope, args.atom);
 107
 108     case EXPR_CONS: {
 109         struct EvalResult car = eval(gc, scope, args.cons->car);
 110         if (car.is_error) {
 111             return car;
 112         }
 113
 114         struct EvalResult cdr = eval_all_args(gc, scope, args.cons->cdr);
 115         if (cdr.is_error) {
 116             return cdr;
 117         }
 118
 119         return eval_success(cons_as_expr(create_cons(gc, car.expr, cdr.expr)));
 120     }
 121
 122     default: {}
 123     }
 124
 125     return eval_failure(CONS(gc,
 126                              SYMBOL(gc, "unexpected-expression"),
 127                              args));
 128 }
 129
 130 static struct EvalResult
 131 plus_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 132 {
 133     (void) param;
 134     assert(gc);
 135     assert(scope);
 136
 137     long int result = 0L;
 138
 139     while (!nil_p(args)) {
 140         if (!cons_p(args)) {
 141             return wrong_argument_type(gc, "consp", args);
 142         }
 143
 144         if (!number_p(CAR(args))) {
 145             return wrong_argument_type(gc, "numberp", CAR(args));
 146         }
 147
 148         result += CAR(args).atom->num;
 149         args = CDR(args);
 150     }
 151
 152     return eval_success(NUMBER(gc, result));
 153 }
 154
 155 static struct EvalResult call_lambda(Gc *gc,
 156                                      struct Scope *scope,
 157                                      struct Expr lambda,
 158                                      struct Expr args) {
 159     if (!lambda_p(lambda)) {
 160         return eval_failure(CONS(gc,
 161                                  SYMBOL(gc, "expected-callable"),
 162                                  lambda));
 163     }
 164
 165     if (!list_p(args)) {
 166         return eval_failure(CONS(gc,
 167                                  SYMBOL(gc, "expected-list"),
 168                                  args));
 169     }
 170
 171     struct Expr vars = lambda.cons->cdr.cons->car;
 172
 173     if (length_of_list(args) != length_of_list(vars)) {
 174         return eval_failure(CONS(gc,
 175                                  SYMBOL(gc, "wrong-number-of-arguments"),
 176                                  NUMBER(gc, length_of_list(args))));
 177     }
 178
 179     push_scope_frame(gc, scope, vars, args);
 180     struct Expr body = lambda.cons->cdr.cons->cdr;
 181
 182     struct EvalResult result = eval_success(NIL(gc));
 183
 184     while (!nil_p(body)) {
 185         result = eval(gc, scope, body.cons->car);
 186         if (result.is_error) {
 187             return result;
 188         }
 189         body = body.cons->cdr;
 190     }
 191
 192     pop_scope_frame(gc, scope);
 193
 194     return result;
 195 }
 196
 197 static struct EvalResult call_callable(Gc *gc,
 198                                        struct Scope *scope,
 199                                        struct Expr callable,
 200                                        struct Expr args) {
 201     if (callable.type == EXPR_ATOM && callable.atom->type == ATOM_NATIVE) {
 202         return ((NativeFunction)callable.atom->native.fun)(callable.atom->native.param, gc, scope, args);
 203     }
 204
 205     return call_lambda(gc, scope, callable, args);
 206 }
 207
 208 static struct Expr
 209 lambda(Gc *gc, struct Expr args, struct Expr body)
 210 {
 211     return CONS(gc,
 212                 SYMBOL(gc, "lambda"),
 213                 CONS(gc, args, body));
 214 }
 215
 216 static struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
 217 {
 218     assert(gc);
 219     assert(scope);
 220
 221     if (!list_p(block)) {
 222         return wrong_argument_type(gc, "listp", block);
 223     }
 224
 225     struct Expr head = block;
 226     struct EvalResult eval_result = eval_success(NIL(gc));
 227
 228     while (cons_p(head)) {
 229         eval_result = eval(gc, scope, CAR(head));
 230         if (eval_result.is_error) {
 231             return eval_result;
 232         }
 233
 234         head = CDR(head);
 235     }
 236
 237     return eval_result;
 238 }
 239
 240 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
 241 {
 242     assert(cons);
 243     (void) scope;
 244
 245     if (symbol_p(cons->car)) {
 246         if (strcmp(cons->car.atom->sym, "set") == 0) {
 247             struct Expr args = cons->cdr;
 248             struct EvalResult n = length(gc, args);
 249
 250             if (n.is_error) {
 251                 return n;
 252             }
 253
 254             if (n.expr.atom->num != 2) {
 255                 return eval_failure(list(gc, 3,
 256                                          SYMBOL(gc, "wrong-number-of-arguments"),
 257                                          SYMBOL(gc, "set"),
 258                                          NUMBER(gc, n.expr.atom->num)));
 259             }
 260
 261             struct Expr name = args.cons->car;
 262             if (!symbol_p(name)) {
 263                 return eval_failure(list(gc, 3,
 264                                          SYMBOL(gc, "wrong-type-argument"),
 265                                          SYMBOL(gc, "symbolp"),
 266                                          name));
 267             }
 268
 269             struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
 270             if (value.is_error) {
 271                 return value;
 272             }
 273
 274             set_scope_value(gc, scope, name, value.expr);
 275
 276             return eval_success(value.expr);
 277         } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
 278             /* TODO(#334): quote does not check the amout of it's arguments */
 279             return eval_success(cons->cdr.cons->car);
 280         } else if (strcmp(cons->car.atom->sym, "begin") == 0) {
 281             return eval_block(gc, scope, CDR(cons_as_expr(cons)));
 282         } else if (is_lambda(cons)) {
 283             /* TODO(#335): lambda special form doesn't check if it forms a callable object */
 284             return eval_success(cons_as_expr(cons));
 285         } else if (strcmp(cons->car.atom->sym, "defun") == 0) {
 286             struct Expr name = NIL(gc);
 287             struct Expr args = NIL(gc);
 288             struct Expr body = NIL(gc);
 289
 290             /* TODO(#554): defun doesn't support functions with empty body because of #545 */
 291             struct EvalResult result = match_list(gc, "ee*", cons->cdr, &name, &args, &body);
 292             if (result.is_error) {
 293                 return result;
 294             }
 295
 296             return eval(gc, scope,
 297                         list(gc, 3,
 298                              SYMBOL(gc, "set"),
 299                              name,
 300                              lambda(gc, args, body)));
 301         } else if (strcmp(cons->car.atom->sym, "when") == 0) {
 302             struct Expr condition = NIL(gc);
 303             struct Expr body = NIL(gc);
 304
 305             struct EvalResult result = match_list(
 306                 gc, "e*", cons->cdr, &condition, &body);
 307             if (result.is_error) {
 308                 return result;
 309             }
 310
 311             result = eval(gc, scope, condition);
 312             if (result.is_error) {
 313                 return result;
 314             }
 315
 316             if (!nil_p(result.expr)) {
 317                 return eval_block(gc, scope, body);
 318             }
 319
 320             return eval_success(NIL(gc));
 321         }
 322     }
 323
 324     struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
 325
 326     if (r.is_error) {
 327         return r;
 328     }
 329
 330     return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
 331 }
 332
 333 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
 334 {
 335     switch(expr.type) {
 336     case EXPR_ATOM:
 337         return eval_atom(gc, scope, expr.atom);
 338
 339     case EXPR_CONS:
 340         return eval_funcall(gc, scope, expr.cons);
 341
 342     default: {}
 343     }
 344
 345     return eval_failure(CONS(gc,
 346                              SYMBOL(gc, "unexpected-expression"),
 347                              expr));
 348 }
 349
 350 struct EvalResult
 351 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 352 {
 353     (void) param;
 354     assert(gc);
 355     assert(scope);
 356
 357     struct Expr xs = NIL(gc);
 358
 359     struct EvalResult result = match_list(gc, "e", args, &xs);
 360     if (result.is_error) {
 361         return result;
 362     }
 363
 364     if (nil_p(xs)) {
 365         return eval_success(xs);
 366     }
 367
 368     if (!cons_p(xs)) {
 369         return wrong_argument_type(gc, "consp", xs);
 370     }
 371
 372     return eval_success(CAR(xs));
 373 }
 374
 375 static struct EvalResult
 376 list_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 377 {
 378     assert(gc);
 379     assert(scope);
 380     (void) param;
 381
 382     return eval_success(args);
 383 }
 384
 385 /* TODO(#536): greaterThan does not support arbitrary amount of arguments */
 386 static struct EvalResult
 387 greaterThan(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 388 {
 389     assert(gc);
 390     assert(scope);
 391     (void) param;
 392
 393     long int x = 0, y = 0;
 394
 395     struct EvalResult result = match_list(gc, "dd", args, &x, &y);
 396     if (result.is_error) {
 397         return result;
 398     }
 399
 400     if (x > y) {
 401         return eval_success(SYMBOL(gc, "t"));
 402     } else {
 403         return eval_success(NIL(gc));
 404     }
 405 }
 406
 407 void load_std_library(Gc *gc, struct Scope *scope)
 408 {
 409     set_scope_value(
 410         gc,
 411         scope,
 412         SYMBOL(gc, "car"),
 413         NATIVE(gc, car, NULL));
 414     set_scope_value(
 415         gc,
 416         scope,
 417         SYMBOL(gc, ">"),
 418         NATIVE(gc, greaterThan, NULL));
 419     set_scope_value(
 420         gc,
 421         scope,
 422         SYMBOL(gc, "+"),
 423         NATIVE(gc, plus_op, NULL));
 424     set_scope_value(
 425         gc,
 426         scope,
 427         SYMBOL(gc, "list"),
 428         NATIVE(gc, list_op, NULL));
 429     set_scope_value(
 430         gc,
 431         scope,
 432         SYMBOL(gc, "t"),
 433         SYMBOL(gc, "t"));
 434 }
 435
 436 struct EvalResult
 437 match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
 438 {
 439     va_list args_list;
 440     va_start(args_list, xs);
 441
 442     long int i = 0;
 443     for (i = 0; *format != 0 && !nil_p(xs); ++i) {
 444         if (!cons_p(xs)) {
 445             va_end(args_list);
 446             return wrong_argument_type(gc, "consp", xs);
 447         }
 448
 449         struct Expr x = CAR(xs);
 450
 451         switch (*format) {
 452         case 'd': {
 453             if (!number_p(x)) {
 454                 va_end(args_list);
 455                 return wrong_argument_type(gc, "numberp", x);
 456             }
 457
 458             long int *p = va_arg(args_list, long int *);
 459             if (p != NULL) {
 460                 *p = x.atom->num;
 461             }
 462         } break;
 463
 464         case 's': {
 465             if (!string_p(x)) {
 466                 va_end(args_list);
 467                 return wrong_argument_type(gc, "stringp", x);
 468             }
 469
 470             const char **p = va_arg(args_list, const char**);
 471             if (p != NULL) {
 472                 *p = x.atom->str;
 473             }
 474         } break;
 475
 476         case 'q': {
 477             if (!symbol_p(x)) {
 478                 va_end(args_list);
 479                 return wrong_argument_type(gc, "symbolp", x);
 480             }
 481
 482             const char **p = va_arg(args_list, const char**);
 483             if (p != NULL) {
 484                 *p = x.atom->sym;
 485             }
 486         } break;
 487
 488         case 'e': {
 489             struct Expr *p = va_arg(args_list, struct Expr*);
 490             *p = x;
 491         } break;
 492
 493         case '*': {
 494             struct Expr *p = va_arg(args_list, struct Expr*);
 495             if (p != NULL) {
 496                 *p = xs;
 497             }
 498             xs = NIL(gc);
 499         } break;
 500         }
 501
 502         format++;
 503         if (!nil_p(xs)) {
 504             xs = CDR(xs);
 505         }
 506     }
 507
 508     if (*format == '*' && nil_p(xs)) {
 509         struct Expr *p = va_arg(args_list, struct Expr*);
 510         if (p != NULL) {
 511             *p = NIL(gc);
 512         }
 513         format++;
 514     }
 515
 516     if (*format != 0 || !nil_p(xs)) {
 517         va_end(args_list);
 518         return wrong_number_of_arguments(gc, i);
 519     }
 520
 521     va_end(args_list);
 522     return eval_success(NIL(gc));
 523 }
 524
 525 static struct Expr
 526 format_list_rec(Gc *gc, const char *format, va_list args)
 527 {
 528     assert(gc);
 529     assert(format);
 530
 531     if (*format == 0) {
 532         return NIL(gc);
 533     }
 534
 535     switch (*format) {
 536     case 'd': {
 537         long int p = va_arg(args, long int);
 538         return CONS(gc, NUMBER(gc, p),
 539                     format_list_rec(gc, format + 1, args));
 540     }
 541
 542     case 's': {
 543         const char* p = va_arg(args, const char*);
 544         return CONS(gc, STRING(gc, p),
 545                     format_list_rec(gc, format + 1, args));
 546     }
 547
 548     case 'q': {
 549         const char* p = va_arg(args, const char*);
 550         return CONS(gc, SYMBOL(gc, p),
 551                     format_list_rec(gc, format + 1, args));
 552     }
 553
 554     case 'e': {
 555         struct Expr p = va_arg(args, struct Expr);
 556         return CONS(gc, p, format_list_rec(gc, format + 1, args));
 557     }
 558
 559     default: {
 560         fprintf(stderr, "Wrong format parameter: %c\n", *format);
 561         assert(0);
 562     }
 563     }
 564 }
 565
 566 struct Expr
 567 format_list(Gc *gc, const char *format, ...)
 568 {
 569     va_list args;
 570     va_start(args, format);
 571     struct Expr result = format_list_rec(gc, format, args);
 572     va_end(args);
 573
 574     return result;
 575 }