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         /* TODO(#537): in ebisp t is not a special symbol that evaluates to itself */
 402         return eval_success(SYMBOL(gc, "t"));
 403     } else {
 404         return eval_success(NIL(gc));
 405     }
 406 }
 407
 408 void load_std_library(Gc *gc, struct Scope *scope)
 409 {
 410     set_scope_value(
 411         gc,
 412         scope,
 413         SYMBOL(gc, "car"),
 414         NATIVE(gc, car, NULL));
 415     set_scope_value(
 416         gc,
 417         scope,
 418         SYMBOL(gc, ">"),
 419         NATIVE(gc, greaterThan, NULL));
 420     set_scope_value(
 421         gc,
 422         scope,
 423         SYMBOL(gc, "+"),
 424         NATIVE(gc, plus_op, NULL));
 425     set_scope_value(
 426         gc,
 427         scope,
 428         SYMBOL(gc, "list"),
 429         NATIVE(gc, list_op, NULL));
 430 }
 431
 432 struct EvalResult
 433 match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
 434 {
 435     va_list args_list;
 436     va_start(args_list, xs);
 437
 438     long int i = 0;
 439     for (i = 0; *format != 0 && !nil_p(xs); ++i) {
 440         if (!cons_p(xs)) {
 441             va_end(args_list);
 442             return wrong_argument_type(gc, "consp", xs);
 443         }
 444
 445         struct Expr x = CAR(xs);
 446
 447         switch (*format) {
 448         case 'd': {
 449             if (!number_p(x)) {
 450                 va_end(args_list);
 451                 return wrong_argument_type(gc, "numberp", x);
 452             }
 453
 454             long int *p = va_arg(args_list, long int *);
 455             if (p != NULL) {
 456                 *p = x.atom->num;
 457             }
 458         } break;
 459
 460         case 's': {
 461             if (!string_p(x)) {
 462                 va_end(args_list);
 463                 return wrong_argument_type(gc, "stringp", x);
 464             }
 465
 466             const char **p = va_arg(args_list, const char**);
 467             if (p != NULL) {
 468                 *p = x.atom->str;
 469             }
 470         } break;
 471
 472         case 'q': {
 473             if (!symbol_p(x)) {
 474                 va_end(args_list);
 475                 return wrong_argument_type(gc, "symbolp", x);
 476             }
 477
 478             const char **p = va_arg(args_list, const char**);
 479             if (p != NULL) {
 480                 *p = x.atom->sym;
 481             }
 482         } break;
 483
 484         case 'e': {
 485             struct Expr *p = va_arg(args_list, struct Expr*);
 486             *p = x;
 487         } break;
 488
 489         case '*': {
 490             struct Expr *p = va_arg(args_list, struct Expr*);
 491             if (p != NULL) {
 492                 *p = xs;
 493             }
 494             xs = NIL(gc);
 495         } break;
 496         }
 497
 498         format++;
 499         if (!nil_p(xs)) {
 500             xs = CDR(xs);
 501         }
 502     }
 503
 504     if (*format == '*' && nil_p(xs)) {
 505         struct Expr *p = va_arg(args_list, struct Expr*);
 506         if (p != NULL) {
 507             *p = NIL(gc);
 508         }
 509         format++;
 510     }
 511
 512     if (*format != 0 || !nil_p(xs)) {
 513         va_end(args_list);
 514         return wrong_number_of_arguments(gc, i);
 515     }
 516
 517     va_end(args_list);
 518     return eval_success(NIL(gc));
 519 }
 520
 521 /* TODO(#542): format_list(). Similar to match_list() but for constructing list */