src/ebisp/interpreter.c

   1 #include <assert.h>
   2 #include <math.h>
   3 #include <string.h>
   4 #include <stdarg.h>
   5
   6 #include "./builtins.h"
   7 #include "./expr.h"
   8 #include "./interpreter.h"
   9 #include "./scope.h"
  10
  11 struct EvalResult eval_success(struct Expr expr)
  12 {
  13     struct EvalResult result = {
  14         .is_error = false,
  15         .expr = expr,
  16     };
  17
  18     return result;
  19 }
  20
  21 struct EvalResult eval_failure(struct Expr error)
  22 {
  23     struct EvalResult result = {
  24         .is_error = true,
  25         .expr = error,
  26     };
  27
  28     return result;
  29 }
  30
  31 struct EvalResult
  32 wrong_argument_type(Gc *gc, const char *type, struct Expr obj)
  33 {
  34     return eval_failure(
  35         list(gc, 3,
  36              SYMBOL(gc, "wrong-argument-type"),
  37              SYMBOL(gc, type),
  38              obj));
  39 }
  40
  41 struct EvalResult
  42 wrong_number_of_arguments(Gc *gc, long int count)
  43 {
  44     return eval_failure(
  45         CONS(gc,
  46              SYMBOL(gc, "wrong-number-of-arguments"),
  47              NUMBER(gc, count)));
  48 }
  49
  50 struct EvalResult
  51 not_implemented(Gc *gc)
  52 {
  53     return eval_failure(SYMBOL(gc, "not-implemented"));
  54 }
  55
  56 static struct EvalResult length(Gc *gc, struct Expr obj)
  57 {
  58     if (!list_p(obj)) {
  59         return wrong_argument_type(gc, "listp", obj);
  60     }
  61
  62     return eval_success(NUMBER(gc, length_of_list(obj)));
  63 }
  64
  65 static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
  66 {
  67     (void) scope;
  68     (void) gc;
  69
  70     switch (atom->type) {
  71     case ATOM_NUMBER:
  72     case ATOM_STRING:
  73     case ATOM_NATIVE:
  74         return eval_success(atom_as_expr(atom));
  75
  76     case ATOM_SYMBOL: {
  77         if (nil_p(atom_as_expr(atom))) {
  78             return eval_success(atom_as_expr(atom));
  79         }
  80
  81         struct Expr value = get_scope_value(scope, atom_as_expr(atom));
  82
  83         if (nil_p(value)) {
  84             return eval_failure(CONS(gc,
  85                                      SYMBOL(gc, "void-variable"),
  86                                      atom_as_expr(atom)));
  87         }
  88
  89         return eval_success(value.cons->cdr);
  90     }
  91     }
  92
  93     return eval_failure(CONS(gc,
  94                              SYMBOL(gc, "unexpected-expression"),
  95                              atom_as_expr(atom)));
  96 }
  97
  98 static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr args)
  99 {
 100     (void) scope;
 101     (void) args;
 102
 103     switch(args.type) {
 104     case EXPR_ATOM:
 105         return eval_atom(gc, scope, args.atom);
 106
 107     case EXPR_CONS: {
 108         struct EvalResult car = eval(gc, scope, args.cons->car);
 109         if (car.is_error) {
 110             return car;
 111         }
 112
 113         struct EvalResult cdr = eval_all_args(gc, scope, args.cons->cdr);
 114         if (cdr.is_error) {
 115             return cdr;
 116         }
 117
 118         return eval_success(cons_as_expr(create_cons(gc, car.expr, cdr.expr)));
 119     }
 120
 121     default: {}
 122     }
 123
 124     return eval_failure(CONS(gc,
 125                              SYMBOL(gc, "unexpected-expression"),
 126                              args));
 127 }
 128
 129 /* TODO(#540): plus_op should be part of std library */
 130 static struct EvalResult plus_op(Gc *gc, struct Expr args)
 131 {
 132     long int result = 0.0f;
 133
 134     while (!nil_p(args)) {
 135         if (args.type != EXPR_CONS) {
 136             return eval_failure(CONS(gc,
 137                                      SYMBOL(gc, "expected-cons"),
 138                                      args));
 139         }
 140
 141         if (args.cons->car.type != EXPR_ATOM ||
 142             args.cons->car.atom->type != ATOM_NUMBER) {
 143             return eval_failure(CONS(gc,
 144                                      SYMBOL(gc, "expected-number"),
 145                                      args.cons->car));
 146         }
 147
 148         result += args.cons->car.atom->num;
 149         args = args.cons->cdr;
 150     }
 151
 152     return eval_success(atom_as_expr(create_number_atom(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 EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
 209 {
 210     assert(gc);
 211     assert(scope);
 212
 213     if (!list_p(block)) {
 214         return wrong_argument_type(gc, "listp", block);
 215     }
 216
 217     struct Expr head = block;
 218     struct EvalResult eval_result = eval_success(NIL(gc));
 219
 220     while (cons_p(head)) {
 221         eval_result = eval(gc, scope, CAR(head));
 222         if (eval_result.is_error) {
 223             return eval_result;
 224         }
 225
 226         head = CDR(head);
 227     }
 228
 229     return eval_result;
 230 }
 231
 232 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
 233 {
 234     assert(cons);
 235     (void) scope;
 236
 237     if (symbol_p(cons->car)) {
 238         /* TODO(#541): special forms should be just regular native functions but with no arguments evaluation */
 239         if (strcmp(cons->car.atom->sym, "+") == 0) {
 240             struct EvalResult args = eval_all_args(gc, scope, cons->cdr);
 241             if (args.is_error) {
 242                 return args;
 243             }
 244             return plus_op(gc, args.expr);
 245         } else if (strcmp(cons->car.atom->sym, "set") == 0) {
 246             struct Expr args = cons->cdr;
 247             struct EvalResult n = length(gc, args);
 248
 249             if (n.is_error) {
 250                 return n;
 251             }
 252
 253             if (n.expr.atom->num != 2) {
 254                 return eval_failure(list(gc, 3,
 255                                          SYMBOL(gc, "wrong-number-of-arguments"),
 256                                          SYMBOL(gc, "set"),
 257                                          NUMBER(gc, n.expr.atom->num)));
 258             }
 259
 260             struct Expr name = args.cons->car;
 261             if (!symbol_p(name)) {
 262                 return eval_failure(list(gc, 3,
 263                                          SYMBOL(gc, "wrong-type-argument"),
 264                                          SYMBOL(gc, "symbolp"),
 265                                          name));
 266             }
 267
 268             struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
 269             if (value.is_error) {
 270                 return value;
 271             }
 272
 273             set_scope_value(gc, scope, name, value.expr);
 274
 275             return eval_success(value.expr);
 276         } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
 277             /* TODO(#334): quote does not check the amout of it's arguments */
 278             return eval_success(cons->cdr.cons->car);
 279         } else if (strcmp(cons->car.atom->sym, "begin") == 0) {
 280             return eval_block(gc, scope, CDR(cons_as_expr(cons)));
 281         } else if (strcmp(cons->car.atom->sym, "lambda") == 0) {
 282             /* TODO(#335): lambda special form doesn't check if it forms a callable object */
 283             return eval_success(cons_as_expr(cons));
 284         } else if (strcmp(cons->car.atom->sym, "when") == 0) {
 285             struct Expr condition = NIL(gc);
 286             struct Expr body = NIL(gc);
 287
 288             struct EvalResult result = match_list(
 289                 gc, "e*", cons->cdr, &condition, &body);
 290             if (result.is_error) {
 291                 return result;
 292             }
 293
 294             result = eval(gc, scope, condition);
 295             if (result.is_error) {
 296                 return result;
 297             }
 298
 299             if (!nil_p(result.expr)) {
 300                 return eval_block(gc, scope, body);
 301             }
 302
 303             return eval_success(NIL(gc));
 304         }
 305     }
 306
 307     struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
 308
 309     if (r.is_error) {
 310         return r;
 311     }
 312
 313     return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
 314 }
 315
 316 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
 317 {
 318     switch(expr.type) {
 319     case EXPR_ATOM:
 320         return eval_atom(gc, scope, expr.atom);
 321
 322     case EXPR_CONS:
 323         return eval_funcall(gc, scope, expr.cons);
 324
 325     default: {}
 326     }
 327
 328     return eval_failure(CONS(gc,
 329                              SYMBOL(gc, "unexpected-expression"),
 330                              expr));
 331 }
 332
 333 struct EvalResult
 334 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 335 {
 336     (void) param;
 337     assert(gc);
 338     assert(scope);
 339
 340     struct Expr xs = NIL(gc);
 341     struct Expr x = NIL(gc);
 342
 343     struct EvalResult result = match_list(gc, "e", args, &xs);
 344     if (result.is_error) {
 345         return result;
 346     }
 347
 348     if (nil_p(xs)) {
 349         return eval_success(xs);
 350     }
 351
 352     result = match_list(gc, "e*", xs, &x, NULL);
 353     if (result.is_error) {
 354         return result;
 355     }
 356
 357     return eval_success(x);
 358 }
 359
 360 /* TODO(#536): greaterThan does not support arbitrary amount of arguments */
 361 static struct EvalResult
 362 greaterThan(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 363 {
 364     assert(gc);
 365     assert(scope);
 366     (void) param;
 367
 368     long int x = 0, y = 0;
 369
 370     struct EvalResult result = match_list(gc, "dd", args, &x, &y);
 371     if (result.is_error) {
 372         return result;
 373     }
 374
 375     if (x > y) {
 376         /* TODO(#537): in ebisp t is not a special symbol that evaluates to itself */
 377         return eval_success(SYMBOL(gc, "t"));
 378     } else {
 379         return eval_success(NIL(gc));
 380     }
 381 }
 382
 383 void load_std_library(Gc *gc, struct Scope *scope)
 384 {
 385     set_scope_value(
 386         gc,
 387         scope,
 388         SYMBOL(gc, "car"),
 389         NATIVE(gc, car, NULL));
 390
 391     set_scope_value(
 392         gc,
 393         scope,
 394         SYMBOL(gc, ">"),
 395         NATIVE(gc, greaterThan, NULL));
 396 }
 397
 398 struct EvalResult
 399 match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
 400 {
 401     va_list args_list;
 402     va_start(args_list, xs);
 403
 404     if (!list_p(xs)) {
 405         va_end(args_list);
 406         return wrong_argument_type(gc, "listp", xs);
 407     }
 408
 409     long int i = 0;
 410     for (i = 0; *format != 0 && !nil_p(xs); ++i) {
 411         struct Expr x = CAR(xs);
 412
 413         switch (*format) {
 414         case 'd': {
 415             if (!number_p(x)) {
 416                 va_end(args_list);
 417                 return wrong_argument_type(gc, "numberp", x);
 418             }
 419
 420             long int *p = va_arg(args_list, long int *);
 421             if (p != NULL) {
 422                 *p = x.atom->num;
 423             }
 424         } break;
 425
 426         case 's': {
 427             if (!string_p(x)) {
 428                 va_end(args_list);
 429                 return wrong_argument_type(gc, "stringp", x);
 430             }
 431
 432             const char **p = va_arg(args_list, const char**);
 433             if (p != NULL) {
 434                 *p = x.atom->str;
 435             }
 436         } break;
 437
 438         case 'q': {
 439             if (!symbol_p(x)) {
 440                 va_end(args_list);
 441                 return wrong_argument_type(gc, "symbolp", x);
 442             }
 443
 444             const char **p = va_arg(args_list, const char**);
 445             if (p != NULL) {
 446                 *p = x.atom->sym;
 447             }
 448         } break;
 449
 450         case 'e': {
 451             struct Expr *p = va_arg(args_list, struct Expr*);
 452             *p = x;
 453         } break;
 454
 455         case '*': {
 456             struct Expr *p = va_arg(args_list, struct Expr*);
 457             if (p != NULL) {
 458                 *p = xs;
 459             }
 460             xs = NIL(gc);
 461         } break;
 462         }
 463
 464         format++;
 465         if (!nil_p(xs)) {
 466             xs = CDR(xs);
 467         }
 468     }
 469
 470     if (*format != 0 || !nil_p(xs)) {
 471         return eval_failure(
 472             CONS(gc,
 473                  SYMBOL(gc, "wrong-number-of-arguments"),
 474                  NUMBER(gc, i)));
 475     }
 476
 477     return eval_success(NIL(gc));
 478 }
 479
 480 /* TODO(#542): format_list(). Similar to match_list() but for constructing list */