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 eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
  58 {
  59     (void) scope;
  60     (void) gc;
  61
  62     switch (atom->type) {
  63     case ATOM_NUMBER:
  64     case ATOM_STRING:
  65     case ATOM_NATIVE:
  66         return eval_success(atom_as_expr(atom));
  67
  68     case ATOM_SYMBOL: {
  69         struct Expr value = get_scope_value(scope, atom_as_expr(atom));
  70
  71         if (nil_p(value)) {
  72             return eval_failure(CONS(gc,
  73                                      SYMBOL(gc, "void-variable"),
  74                                      atom_as_expr(atom)));
  75         }
  76
  77         return eval_success(value.cons->cdr);
  78     }
  79     }
  80
  81     return eval_failure(CONS(gc,
  82                              SYMBOL(gc, "unexpected-expression"),
  83                              atom_as_expr(atom)));
  84 }
  85
  86 static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr args)
  87 {
  88     (void) scope;
  89     (void) args;
  90
  91     switch(args.type) {
  92     case EXPR_ATOM:
  93         return eval_atom(gc, scope, args.atom);
  94
  95     case EXPR_CONS: {
  96         struct EvalResult car = eval(gc, scope, args.cons->car);
  97         if (car.is_error) {
  98             return car;
  99         }
 100
 101         struct EvalResult cdr = eval_all_args(gc, scope, args.cons->cdr);
 102         if (cdr.is_error) {
 103             return cdr;
 104         }
 105
 106         return eval_success(cons_as_expr(create_cons(gc, car.expr, cdr.expr)));
 107     }
 108
 109     default: {}
 110     }
 111
 112     return eval_failure(CONS(gc,
 113                              SYMBOL(gc, "unexpected-expression"),
 114                              args));
 115 }
 116
 117 static struct EvalResult call_lambda(Gc *gc,
 118                                      struct Scope *scope,
 119                                      struct Expr lambda,
 120                                      struct Expr args) {
 121     if (!lambda_p(lambda)) {
 122         return eval_failure(CONS(gc,
 123                                  SYMBOL(gc, "expected-callable"),
 124                                  lambda));
 125     }
 126
 127     if (!list_p(args)) {
 128         return eval_failure(CONS(gc,
 129                                  SYMBOL(gc, "expected-list"),
 130                                  args));
 131     }
 132
 133     struct Expr vars = lambda.cons->cdr.cons->car;
 134
 135     if (length_of_list(args) != length_of_list(vars)) {
 136         return eval_failure(CONS(gc,
 137                                  SYMBOL(gc, "wrong-number-of-arguments"),
 138                                  NUMBER(gc, length_of_list(args))));
 139     }
 140
 141     push_scope_frame(gc, scope, vars, args);
 142     struct Expr body = lambda.cons->cdr.cons->cdr;
 143
 144     struct EvalResult result = eval_success(NIL(gc));
 145
 146     while (!nil_p(body)) {
 147         result = eval(gc, scope, body.cons->car);
 148         if (result.is_error) {
 149             return result;
 150         }
 151         body = body.cons->cdr;
 152     }
 153
 154     pop_scope_frame(gc, scope);
 155
 156     return result;
 157 }
 158
 159 static struct EvalResult call_callable(Gc *gc,
 160                                        struct Scope *scope,
 161                                        struct Expr callable_expr,
 162                                        struct Expr args_expr) {
 163     struct EvalResult callable_result = eval(gc, scope, callable_expr);
 164     if (callable_result.is_error) {
 165         return callable_result;
 166     }
 167
 168     struct EvalResult args_result = symbol_p(callable_expr) && is_special(callable_expr.atom->sym)
 169         ? eval_success(args_expr)
 170         : eval_all_args(gc, scope, args_expr);
 171
 172     if (args_result.is_error) {
 173         return args_result;
 174     }
 175
 176     if (callable_result.expr.type == EXPR_ATOM &&
 177         callable_result.expr.atom->type == ATOM_NATIVE) {
 178         return ((NativeFunction)callable_result.expr.atom->native.fun)(
 179             callable_result.expr.atom->native.param, gc, scope, args_result.expr);
 180     }
 181
 182     return call_lambda(gc, scope, callable_result.expr, args_result.expr);
 183 }
 184
 185
 186 struct EvalResult eval_block(Gc *gc, struct Scope *scope, struct Expr block)
 187 {
 188     assert(gc);
 189     assert(scope);
 190
 191     if (!list_p(block)) {
 192         return wrong_argument_type(gc, "listp", block);
 193     }
 194
 195     struct Expr head = block;
 196     struct EvalResult eval_result = eval_success(NIL(gc));
 197
 198     while (cons_p(head)) {
 199         eval_result = eval(gc, scope, CAR(head));
 200         if (eval_result.is_error) {
 201             return eval_result;
 202         }
 203
 204         head = CDR(head);
 205     }
 206
 207     return eval_result;
 208 }
 209
 210 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
 211 {
 212     switch(expr.type) {
 213     case EXPR_ATOM:
 214         return eval_atom(gc, scope, expr.atom);
 215
 216     case EXPR_CONS:
 217         return call_callable(gc, scope, expr.cons->car, expr.cons->cdr);
 218
 219     default: {}
 220     }
 221
 222     return eval_failure(CONS(gc,
 223                              SYMBOL(gc, "unexpected-expression"),
 224                              expr));
 225 }
 226
 227 struct EvalResult
 228 car(void *param, Gc *gc, struct Scope *scope, struct Expr args)
 229 {
 230     (void) param;
 231     assert(gc);
 232     assert(scope);
 233
 234     struct Expr xs = NIL(gc);
 235
 236     struct EvalResult result = match_list(gc, "e", args, &xs);
 237     if (result.is_error) {
 238         return result;
 239     }
 240
 241     if (nil_p(xs)) {
 242         return eval_success(xs);
 243     }
 244
 245     if (!cons_p(xs)) {
 246         return wrong_argument_type(gc, "consp", xs);
 247     }
 248
 249     return eval_success(CAR(xs));
 250 }
 251
 252 struct EvalResult
 253 match_list(struct Gc *gc, const char *format, struct Expr xs, ...)
 254 {
 255     va_list args_list;
 256     va_start(args_list, xs);
 257
 258     long int i = 0;
 259     for (i = 0; *format != 0 && !nil_p(xs); ++i) {
 260         if (!cons_p(xs)) {
 261             va_end(args_list);
 262             return wrong_argument_type(gc, "consp", xs);
 263         }
 264
 265         struct Expr x = CAR(xs);
 266
 267         switch (*format) {
 268         case 'd': {
 269             if (!number_p(x)) {
 270                 va_end(args_list);
 271                 return wrong_argument_type(gc, "numberp", x);
 272             }
 273
 274             long int *p = va_arg(args_list, long int *);
 275             if (p != NULL) {
 276                 *p = x.atom->num;
 277             }
 278         } break;
 279
 280         case 's': {
 281             if (!string_p(x)) {
 282                 va_end(args_list);
 283                 return wrong_argument_type(gc, "stringp", x);
 284             }
 285
 286             const char **p = va_arg(args_list, const char**);
 287             if (p != NULL) {
 288                 *p = x.atom->str;
 289             }
 290         } break;
 291
 292         case 'q': {
 293             if (!symbol_p(x)) {
 294                 va_end(args_list);
 295                 return wrong_argument_type(gc, "symbolp", x);
 296             }
 297
 298             const char **p = va_arg(args_list, const char**);
 299             if (p != NULL) {
 300                 *p = x.atom->sym;
 301             }
 302         } break;
 303
 304         case 'e': {
 305             struct Expr *p = va_arg(args_list, struct Expr*);
 306             *p = x;
 307         } break;
 308
 309         case '*': {
 310             struct Expr *p = va_arg(args_list, struct Expr*);
 311             if (p != NULL) {
 312                 *p = xs;
 313             }
 314             xs = NIL(gc);
 315         } break;
 316         }
 317
 318         format++;
 319         if (!nil_p(xs)) {
 320             xs = CDR(xs);
 321         }
 322     }
 323
 324     if (*format == '*' && nil_p(xs)) {
 325         struct Expr *p = va_arg(args_list, struct Expr*);
 326         if (p != NULL) {
 327             *p = NIL(gc);
 328         }
 329         format++;
 330     }
 331
 332     if (*format != 0 || !nil_p(xs)) {
 333         va_end(args_list);
 334         return wrong_number_of_arguments(gc, i);
 335     }
 336
 337     va_end(args_list);
 338     return eval_success(NIL(gc));
 339 }
 340
 341 static struct Expr
 342 format_list_rec(Gc *gc, const char *format, va_list args)
 343 {
 344     assert(gc);
 345     assert(format);
 346
 347     if (*format == 0) {
 348         return NIL(gc);
 349     }
 350
 351     switch (*format) {
 352     case 'd': {
 353         long int p = va_arg(args, long int);
 354         return CONS(gc, NUMBER(gc, p),
 355                     format_list_rec(gc, format + 1, args));
 356     }
 357
 358     case 's': {
 359         const char* p = va_arg(args, const char*);
 360         return CONS(gc, STRING(gc, p),
 361                     format_list_rec(gc, format + 1, args));
 362     }
 363
 364     case 'q': {
 365         const char* p = va_arg(args, const char*);
 366         return CONS(gc, SYMBOL(gc, p),
 367                     format_list_rec(gc, format + 1, args));
 368     }
 369
 370     case 'e': {
 371         struct Expr p = va_arg(args, struct Expr);
 372         return CONS(gc, p, format_list_rec(gc, format + 1, args));
 373     }
 374
 375     default: {
 376         fprintf(stderr, "Wrong format parameter: %c\n", *format);
 377         assert(0);
 378     }
 379     }
 380 }
 381
 382 struct Expr
 383 format_list(Gc *gc, const char *format, ...)
 384 {
 385     va_list args;
 386     va_start(args, format);
 387     struct Expr result = format_list_rec(gc, format, args);
 388     va_end(args);
 389
 390     return result;
 391 }