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