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 /* TODO(#540): plus_op should be part of std library */
 131 static struct EvalResult
 132 plus_op(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 133 {
 134     (void) param;
 135     assert(gc);
 136     assert(scope);
 137
 138     long int result = 0L;
 139
 140     while (!nil_p(args)) {
 141         if (!cons_p(args)) {
 142             return wrong_argument_type(gc, "consp", args);
 143         }
 144
 145         if (!number_p(CAR(args))) {
 146             return wrong_argument_type(gc, "numberp", CAR(args));
 147         }
 148
 149         result += CAR(args).atom->num;
 150         args = CDR(args);
 151     }
 152
 153     return eval_success(NUMBER(gc, result));
 154 }
 155
 156 static struct EvalResult call_lambda(Gc *gc,
 157                                      struct Scope *scope,
 158                                      struct Expr lambda,
 159                                      struct Expr args) {
 160     if (!lambda_p(lambda)) {
 161         return eval_failure(CONS(gc,
 162                                  SYMBOL(gc, "expected-callable"),
 163                                  lambda));
 164     }
 165
 166     if (!list_p(args)) {
 167         return eval_failure(CONS(gc,
 168                                  SYMBOL(gc, "expected-list"),
 169                                  args));
 170     }
 171
 172     struct Expr vars = lambda.cons->cdr.cons->car;
 173
 174     if (length_of_list(args) != length_of_list(vars)) {
 175         return eval_failure(CONS(gc,
 176                                  SYMBOL(gc, "wrong-number-of-arguments"),
 177                                  NUMBER(gc, length_of_list(args))));
 178     }
 179
 180     push_scope_frame(gc, scope, vars, args);
 181     struct Expr body = lambda.cons->cdr.cons->cdr;
 182
 183     struct EvalResult result = eval_success(NIL(gc));
 184
 185     while (!nil_p(body)) {
 186         result = eval(gc, scope, body.cons->car);
 187         if (result.is_error) {
 188             return result;
 189         }
 190         body = body.cons->cdr;
 191     }
 192
 193     pop_scope_frame(gc, scope);
 194
 195     return result;
 196 }
 197
 198 static struct EvalResult call_callable(Gc *gc,
 199                                        struct Scope *scope,
 200                                        struct Expr callable,
 201                                        struct Expr args) {
 202     if (callable.type == EXPR_ATOM && callable.atom->type == ATOM_NATIVE) {
 203         return ((NativeFunction)callable.atom->native.fun)(callable.atom->native.param, gc, scope, args);
 204     }
 205
 206     return call_lambda(gc, scope, callable, args);
 207 }
 208
 209 static struct Expr
 210 lambda(Gc *gc, struct Expr args, struct Expr body)
 211 {
 212     return CONS(gc,
 213                 SYMBOL(gc, "lambda"),
 214                 CONS(gc, args, body));
 215 }
 216
 217 static struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
 218 {
 219     assert(gc);
 220     assert(scope);
 221
 222     if (!list_p(block)) {
 223         return wrong_argument_type(gc, "listp", block);
 224     }
 225
 226     struct Expr head = block;
 227     struct EvalResult eval_result = eval_success(NIL(gc));
 228
 229     while (cons_p(head)) {
 230         eval_result = eval(gc, scope, CAR(head));
 231         if (eval_result.is_error) {
 232             return eval_result;
 233         }
 234
 235         head = CDR(head);
 236     }
 237
 238     return eval_result;
 239 }
 240
 241 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
 242 {
 243     assert(cons);
 244     (void) scope;
 245
 246     if (symbol_p(cons->car)) {
 247         if (strcmp(cons->car.atom->sym, "set") == 0) {
 248             struct Expr args = cons->cdr;
 249             struct EvalResult n = length(gc, args);
 250
 251             if (n.is_error) {
 252                 return n;
 253             }
 254
 255             if (n.expr.atom->num != 2) {
 256                 return eval_failure(list(gc, 3,
 257                                          SYMBOL(gc, "wrong-number-of-arguments"),
 258                                          SYMBOL(gc, "set"),
 259                                          NUMBER(gc, n.expr.atom->num)));
 260             }
 261
 262             struct Expr name = args.cons->car;
 263             if (!symbol_p(name)) {
 264                 return eval_failure(list(gc, 3,
 265                                          SYMBOL(gc, "wrong-type-argument"),
 266                                          SYMBOL(gc, "symbolp"),
 267                                          name));
 268             }
 269
 270             struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
 271             if (value.is_error) {
 272                 return value;
 273             }
 274
 275             set_scope_value(gc, scope, name, value.expr);
 276
 277             return eval_success(value.expr);
 278         } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
 279             /* TODO(#334): quote does not check the amout of it's arguments */
 280             return eval_success(cons->cdr.cons->car);
 281         } else if (strcmp(cons->car.atom->sym, "begin") == 0) {
 282             return eval_block(gc, scope, CDR(cons_as_expr(cons)));
 283         } else if (is_lambda(cons)) {
 284             /* TODO(#335): lambda special form doesn't check if it forms a callable object */
 285             return eval_success(cons_as_expr(cons));
 286         } else if (strcmp(cons->car.atom->sym, "defun") == 0) {
 287             struct Expr name = NIL(gc);
 288             struct Expr args = NIL(gc);
 289             struct Expr body = NIL(gc);
 290
 291             /* TODO(#554): defun doesn't support functions with empty body because of #545 */
 292             struct EvalResult result = match_list(gc, "ee*", cons->cdr, &name, &args, &body);
 293             if (result.is_error) {
 294                 return result;
 295             }
 296
 297             return eval(gc, scope,
 298                         list(gc, 3,
 299                              SYMBOL(gc, "set"),
 300                              name,
 301                              lambda(gc, args, body)));
 302         } else if (strcmp(cons->car.atom->sym, "when") == 0) {
 303             struct Expr condition = NIL(gc);
 304             struct Expr body = NIL(gc);
 305
 306             struct EvalResult result = match_list(
 307                 gc, "e*", cons->cdr, &condition, &body);
 308             if (result.is_error) {
 309                 return result;
 310             }
 311
 312             result = eval(gc, scope, condition);
 313             if (result.is_error) {
 314                 return result;
 315             }
 316
 317             if (!nil_p(result.expr)) {
 318                 return eval_block(gc, scope, body);
 319             }
 320
 321             return eval_success(NIL(gc));
 322         }
 323     }
 324
 325     struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
 326
 327     if (r.is_error) {
 328         return r;
 329     }
 330
 331     return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
 332 }
 333
 334 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
 335 {
 336     switch(expr.type) {
 337     case EXPR_ATOM:
 338         return eval_atom(gc, scope, expr.atom);
 339
 340     case EXPR_CONS:
 341         return eval_funcall(gc, scope, expr.cons);
 342
 343     default: {}
 344     }
 345
 346     return eval_failure(CONS(gc,
 347                              SYMBOL(gc, "unexpected-expression"),
 348                              expr));
 349 }
 350
 351 struct EvalResult
 352 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 353 {
 354     (void) param;
 355     assert(gc);
 356     assert(scope);
 357
 358     struct Expr xs = NIL(gc);
 359
 360     struct EvalResult result = match_list(gc, "e", args, &xs);
 361     if (result.is_error) {
 362         return result;
 363     }
 364
 365     if (nil_p(xs)) {
 366         return eval_success(xs);
 367     }
 368
 369     if (!cons_p(xs)) {
 370         return wrong_argument_type(gc, "consp", xs);
 371     }
 372
 373     return eval_success(CAR(xs));
 374 }
 375
 376 /* TODO(#536): greaterThan does not support arbitrary amount of arguments */
 377 static struct EvalResult
 378 greaterThan(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 379 {
 380     assert(gc);
 381     assert(scope);
 382     (void) param;
 383
 384     long int x = 0, y = 0;
 385
 386     struct EvalResult result = match_list(gc, "dd", args, &x, &y);
 387     if (result.is_error) {
 388         return result;
 389     }
 390
 391     if (x > y) {
 392         /* TODO(#537): in ebisp t is not a special symbol that evaluates to itself */
 393         return eval_success(SYMBOL(gc, "t"));
 394     } else {
 395         return eval_success(NIL(gc));
 396     }
 397 }
 398
 399 void load_std_library(Gc *gc, struct Scope *scope)
 400 {
 401     set_scope_value(
 402         gc,
 403         scope,
 404         SYMBOL(gc, "car"),
 405         NATIVE(gc, car, NULL));
 406     set_scope_value(
 407         gc,
 408         scope,
 409         SYMBOL(gc, ">"),
 410         NATIVE(gc, greaterThan, NULL));
 411     set_scope_value(
 412         gc,
 413         scope,
 414         SYMBOL(gc, "+"),
 415         NATIVE(gc, plus_op, NULL));
 416 }
 417
 418 struct EvalResult
 419 match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
 420 {
 421     va_list args_list;
 422     va_start(args_list, xs);
 423
 424     long int i = 0;
 425     for (i = 0; *format != 0 && !nil_p(xs); ++i) {
 426         if (!cons_p(xs)) {
 427             va_end(args_list);
 428             return wrong_argument_type(gc, "consp", xs);
 429         }
 430
 431         struct Expr x = CAR(xs);
 432
 433         switch (*format) {
 434         case 'd': {
 435             if (!number_p(x)) {
 436                 va_end(args_list);
 437                 return wrong_argument_type(gc, "numberp", x);
 438             }
 439
 440             long int *p = va_arg(args_list, long int *);
 441             if (p != NULL) {
 442                 *p = x.atom->num;
 443             }
 444         } break;
 445
 446         case 's': {
 447             if (!string_p(x)) {
 448                 va_end(args_list);
 449                 return wrong_argument_type(gc, "stringp", x);
 450             }
 451
 452             const char **p = va_arg(args_list, const char**);
 453             if (p != NULL) {
 454                 *p = x.atom->str;
 455             }
 456         } break;
 457
 458         case 'q': {
 459             if (!symbol_p(x)) {
 460                 va_end(args_list);
 461                 return wrong_argument_type(gc, "symbolp", x);
 462             }
 463
 464             const char **p = va_arg(args_list, const char**);
 465             if (p != NULL) {
 466                 *p = x.atom->sym;
 467             }
 468         } break;
 469
 470         case 'e': {
 471             struct Expr *p = va_arg(args_list, struct Expr*);
 472             *p = x;
 473         } break;
 474
 475         case '*': {
 476             struct Expr *p = va_arg(args_list, struct Expr*);
 477             if (p != NULL) {
 478                 *p = xs;
 479             }
 480             xs = NIL(gc);
 481         } break;
 482         }
 483
 484         format++;
 485         if (!nil_p(xs)) {
 486             xs = CDR(xs);
 487         }
 488     }
 489
 490     if (*format != 0 || !nil_p(xs)) {
 491         va_end(args_list);
 492         return wrong_number_of_arguments(gc, i);
 493     }
 494
 495     va_end(args_list);
 496     return eval_success(NIL(gc));
 497 }
 498
 499 /* TODO(#542): format_list(). Similar to match_list() but for constructing list */