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         result = eval(gc, scope, body.cons->car);
 162         if (result.is_error) {
 163             return result;
 164         }
 165         body = body.cons->cdr;
 166     }
 167
 168     pop_scope_frame(gc, scope);
 169
 170     return result;
 171 }
 172
 173 static struct EvalResult call_callable(Gc *gc,
 174                                        struct Scope *scope,
 175                                        struct Expr callable,
 176                                        struct Expr args) {
 177     if (callable.type == EXPR_ATOM && callable.atom->type == ATOM_NATIVE) {
 178         return ((NativeFunction)callable.atom->native.fun)(callable.atom->native.param, gc, scope, args);
 179     }
 180
 181     return call_lambda(gc, scope, callable, args);
 182 }
 183
 184 static struct EvalResult eval_funcall(Gc *gc, struct Scope *scope, struct Cons *cons)
 185 {
 186     assert(cons);
 187     (void) scope;
 188
 189     if (symbol_p(cons->car)) {
 190         if (strcmp(cons->car.atom->sym, "+") == 0) {
 191             struct EvalResult args = eval_all_args(gc, scope, cons->cdr);
 192             if (args.is_error) {
 193                 return args;
 194             }
 195             return plus_op(gc, args.expr);
 196         } else if (strcmp(cons->car.atom->sym, "set") == 0) {
 197             struct Expr args = cons->cdr;
 198             struct EvalResult n = length(gc, args);
 199
 200             if (n.is_error) {
 201                 return n;
 202             }
 203
 204             if (n.expr.atom->num != 2) {
 205                 return eval_failure(list(gc, 3,
 206                                          SYMBOL(gc, "wrong-number-of-arguments"),
 207                                          SYMBOL(gc, "set"),
 208                                          NUMBER(gc, n.expr.atom->num)));
 209             }
 210
 211             struct Expr name = args.cons->car;
 212             if (!symbol_p(name)) {
 213                 return eval_failure(list(gc, 3,
 214                                          SYMBOL(gc, "wrong-type-argument"),
 215                                          SYMBOL(gc, "symbolp"),
 216                                          name));
 217             }
 218
 219             struct EvalResult value = eval(gc, scope, args.cons->cdr.cons->car);
 220             if (value.is_error) {
 221                 return value;
 222             }
 223
 224             set_scope_value(gc, scope, name, value.expr);
 225
 226             return eval_success(value.expr);
 227         } else if (strcmp(cons->car.atom->sym, "quote") == 0) {
 228             /* TODO(#334): quote does not check the amout of it's arguments */
 229             return eval_success(cons->cdr.cons->car);
 230         } else if (strcmp(cons->car.atom->sym, "lambda") == 0) {
 231             /* TODO(#335): lambda special form doesn't check if it forms a callable object */
 232             return eval_success(cons_as_expr(cons));
 233         }
 234     }
 235
 236     struct EvalResult r = eval_all_args(gc, scope, cons_as_expr(cons));
 237
 238     if (r.is_error) {
 239         return r;
 240     }
 241
 242     return call_callable(gc, scope, r.expr.cons->car, r.expr.cons->cdr);
 243 }
 244
 245 struct EvalResult eval(Gc *gc, struct Scope *scope, struct Expr expr)
 246 {
 247     switch(expr.type) {
 248     case EXPR_ATOM:
 249         return eval_atom(gc, scope, expr.atom);
 250
 251     case EXPR_CONS:
 252         return eval_funcall(gc, scope, expr.cons);
 253
 254     default: {}
 255     }
 256
 257     return eval_failure(CONS(gc,
 258                              SYMBOL(gc, "unexpected-expression"),
 259                              expr));
 260 }