src/script/interpreter.c

   1 #include <assert.h>
   2 #include <math.h>
   3 #include <string.h>
   4
   5 #include "./builtins.h"
   6 #include "./expr.h"
   7 #include "./interpreter.h"
   8 #include "./scope.h"
   9
  10 struct EvalResult eval_success(struct Expr expr)
  11 {
  12     struct EvalResult result = {
  13         .is_error = false,
  14         .expr = expr,
  15     };
  16
  17     return result;
  18 }
  19
  20 struct EvalResult eval_failure(struct Expr error)
  21 {
  22     struct EvalResult result = {
  23         .is_error = true,
  24         .expr = error,
  25     };
  26
  27     return result;
  28 }
  29
  30 static struct EvalResult length(Gc *gc, struct Expr obj)
  31 {
  32     if (!list_p(obj)) {
  33         return eval_failure(list(gc, 3,
  34                                  SYMBOL(gc, "wrong-argument-type"),
  35                                  SYMBOL(gc, "listp"),
  36                                  obj));
  37     }
  38
  39     return eval_success(NUMBER(gc, length_of_list(obj)));
  40 }
  41
  42 static struct EvalResult eval_atom(Gc *gc, struct Scope *scope, struct Atom *atom)
  43 {
  44     (void) scope;
  45     (void) gc;
  46
  47     switch (atom->type) {
  48     case ATOM_NUMBER:
  49     case ATOM_STRING:
  50     case ATOM_NATIVE:
  51         return eval_success(atom_as_expr(atom));
  52
  53     case ATOM_SYMBOL: {
  54         if (nil_p(atom_as_expr(atom))) {
  55             return eval_success(atom_as_expr(atom));
  56         }
  57
  58         struct Expr value = get_scope_value(scope, atom_as_expr(atom));
  59
  60         if (nil_p(value)) {
  61             return eval_failure(CONS(gc,
  62                                      SYMBOL(gc, "void-variable"),
  63                                      atom_as_expr(atom)));
  64         }
  65
  66         return eval_success(value.cons->cdr);
  67     }
  68     }
  69
  70     return eval_failure(CONS(gc,
  71                              SYMBOL(gc, "unexpected-expression"),
  72                              atom_as_expr(atom)));
  73 }
  74
  75 static struct EvalResult eval_all_args(Gc *gc, struct Scope *scope, struct Expr args)
  76 {
  77     (void) scope;
  78     (void) args;
  79
  80     switch(args.type) {
  81     case EXPR_ATOM:
  82         return eval_atom(gc, scope, args.atom);
  83
  84     case EXPR_CONS: {
  85         struct EvalResult car = eval(gc, scope, args.cons->car);
  86         if (car.is_error) {
  87             return car;
  88         }
  89
  90         struct EvalResult cdr = eval_all_args(gc, scope, args.cons->cdr);
  91         if (cdr.is_error) {
  92             return cdr;
  93         }
  94
  95         return eval_success(cons_as_expr(create_cons(gc, car.expr, cdr.expr)));
  96     }
  97
  98     default: {}
  99     }
 100
 101     return eval_failure(CONS(gc,
 102                              SYMBOL(gc, "unexpected-expression"),
 103                              args));
 104 }
 105
 106 static struct EvalResult plus_op(Gc *gc, struct Expr args)
 107 {
 108     long int result = 0.0f;
 109
 110     while (!nil_p(args)) {
 111         if (args.type != EXPR_CONS) {
 112             return eval_failure(CONS(gc,
 113                                      SYMBOL(gc, "expected-cons"),
 114                                      args));
 115         }
 116
 117         if (args.cons->car.type != EXPR_ATOM ||
 118             args.cons->car.atom->type != ATOM_NUMBER) {
 119             return eval_failure(CONS(gc,
 120                                      SYMBOL(gc, "expected-number"),
 121                                      args.cons->car));
 122         }
 123
 124         result += args.cons->car.atom->num;
 125         args = args.cons->cdr;
 126     }
 127
 128     return eval_success(atom_as_expr(create_number_atom(gc, result)));
 129 }
 130
 131 static struct EvalResult call_lambda(Gc *gc,
 132                                      struct Scope *scope,
 133                                      struct Expr lambda,
 134                                      struct Expr args) {
 135     if (!lambda_p(lambda)) {
 136         return eval_failure(CONS(gc,
 137                                  SYMBOL(gc, "expected-callable"),
 138                                  lambda));
 139     }
 140
 141     if (!list_p(args)) {
 142         return eval_failure(CONS(gc,
 143                                  SYMBOL(gc, "expected-list"),
 144                                  args));
 145     }
 146
 147     struct Expr vars = lambda.cons->cdr.cons->car;
 148
 149     if (length_of_list(args) != length_of_list(vars)) {
 150         return eval_failure(CONS(gc,
 151                                  SYMBOL(gc, "wrong-number-of-arguments"),
 152                                  NUMBER(gc, length_of_list(args))));
 153     }
 154
 155     push_scope_frame(gc, scope, vars, args);
 156     struct Expr body = lambda.cons->cdr.cons->cdr;
 157
 158     struct EvalResult result = eval_success(NIL(gc));
 159
 160     while (!nil_p(body)) {
 161         print_expr_as_sexpr(body.cons->car);
 162         result = eval(gc, scope, body.cons->car);
 163         if (result.is_error) {
 164             return result;
 165         }
 166         body = body.cons->cdr;
 167     }
 168
 169     pop_scope_frame(gc, scope);
 170
 171     return result;
 172 }
 173
 174 static struct EvalResult call_callable(Gc *gc,
 175                                        struct Scope *scope,
 176                                        struct Expr callable,
 177                                        struct Expr args) {
 178     if (callable.type == EXPR_ATOM && callable.atom->type == ATOM_NATIVE) {
 179         return ((NativeFunction)callable.atom->fun)(gc, scope, args);
 180     }
 181
 182     return call_lambda(gc, scope, callable, args);
 183 }
 184
 185 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
 186 {
 187     assert(cons);
 188     (void) scope;
 189
 190     if (symbol_p(cons->car)) {
 191         if (strcmp(cons->car.atom->sym, "+") == 0) {
 192             struct EvalResult args = eval_all_args(gc, scope, cons->cdr);
 193             if (args.is_error) {
 194                 return args;
 195             }
 196             return plus_op(gc, args.expr);
 197         } else if (strcmp(cons->car.atom->sym, "set") == 0) {
 198             struct Expr args = cons->cdr;
 199             struct EvalResult n = length(gc, args);
 200
 201             if (n.is_error) {
 202                 return n;
 203             }
 204
 205             if (n.expr.atom->num != 2) {
 206                 return eval_failure(list(gc, 3,
 207                                          SYMBOL(gc, "wrong-number-of-arguments"),
 208                                          SYMBOL(gc, "set"),
 209                                          NUMBER(gc, n.expr.atom->num)));
 210             }
 211
 212             struct Expr name = args.cons->car;
 213             if (!symbol_p(name)) {
 214                 return eval_failure(list(gc, 3,
 215                                          SYMBOL(gc, "wrong-type-argument"),
 216                                          SYMBOL(gc, "symbolp"),
 217                                          name));
 218             }
 219
 220             struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
 221             if (value.is_error) {
 222                 return value;
 223             }
 224
 225             set_scope_value(gc, scope, name, value.expr);
 226
 227             return eval_success(value.expr);
 228         } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
 229             /* TODO(#334): quote does not check the amout of it's arguments */
 230             return eval_success(cons->cdr.cons->car);
 231         } else if (strcmp(cons->car.atom->sym, "lambda") == 0) {
 232             /* TODO(#335): lambda special form doesn't check if it forms a callable object */
 233             return eval_success(cons_as_expr(cons));
 234         }
 235     }
 236
 237     struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
 238
 239     if (r.is_error) {
 240         return r;
 241     }
 242
 243     return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
 244 }
 245
 246 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
 247 {
 248     switch(expr.type) {
 249     case EXPR_ATOM:
 250         return eval_atom(gc, scope, expr.atom);
 251
 252     case EXPR_CONS:
 253         return eval_funcall(gc, scope, expr.cons);
 254
 255     default: {}
 256     }
 257
 258     return eval_failure(CONS(gc,
 259                              SYMBOL(gc, "unexpected-expression"),
 260                              expr));
 261 }