diff options
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r-- | src/bootstrap/primitives.c | 77 |
1 files changed, 77 insertions, 0 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 3afeef6..461799e 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -1,8 +1,10 @@ | |||
1 | Object * | 1 | Object * |
2 | eval(Environment* env, Object *root) { | 2 | eval(Environment* env, Object *root) { |
3 | tailcall: | ||
3 | switch (root->type) { | 4 | switch (root->type) { |
4 | case OBJ_TYPE_ERR: | 5 | case OBJ_TYPE_ERR: |
5 | case OBJ_TYPE_PROCEDURE: | 6 | case OBJ_TYPE_PROCEDURE: |
7 | case OBJ_TYPE_LAMBDA: | ||
6 | case OBJ_TYPE_FIXNUM: | 8 | case OBJ_TYPE_FIXNUM: |
7 | case OBJ_TYPE_BOOL: | 9 | case OBJ_TYPE_BOOL: |
8 | case OBJ_TYPE_NIL: | 10 | case OBJ_TYPE_NIL: |
@@ -39,6 +41,52 @@ eval(Environment* env, Object *root) { | |||
39 | }); | 41 | }); |
40 | return obj_err; | 42 | return obj_err; |
41 | } | 43 | } |
44 | Object* lambda = eval(env, root->car); | ||
45 | if (lambda->type == OBJ_TYPE_LAMBDA) { | ||
46 | Object *fun = lambda; | ||
47 | Object *args = root->cdr; | ||
48 | Object *params = fun->args; | ||
49 | while (params != obj_nil) { | ||
50 | if (args == obj_nil) { | ||
51 | error_push((Error){ | ||
52 | .type = ERR_TYPE_RUNTIME, | ||
53 | .value = ERR_NOT_ENOUGH_ARGS, | ||
54 | }); | ||
55 | return obj_err; | ||
56 | } | ||
57 | Object *symbol = params->car; | ||
58 | Object *value = eval(env, args->car); | ||
59 | if (value == obj_err) { | ||
60 | return obj_err; | ||
61 | } | ||
62 | if (value == obj_nil) { | ||
63 | error_push((Error){ | ||
64 | .type = ERR_TYPE_RUNTIME, | ||
65 | .value = ERR_NOT_ENOUGH_ARGS, | ||
66 | }); | ||
67 | return obj_err; | ||
68 | } | ||
69 | ssize_t index = env_symbol_index_in_current_env(fun->env, symbol); | ||
70 | if (index == -1) { | ||
71 | env_add_symbol(fun->env, obj_duplicate(symbol), obj_duplicate(value)); | ||
72 | } else { | ||
73 | fun->env->buf[index].value = obj_duplicate(value); | ||
74 | } | ||
75 | args = args->cdr; | ||
76 | params = params->cdr; | ||
77 | } | ||
78 | if (args != obj_nil) { | ||
79 | error_push((Error){ | ||
80 | .type = ERR_TYPE_RUNTIME, | ||
81 | .value = ERR_TOO_MANY_ARGS, | ||
82 | }); | ||
83 | return obj_err; | ||
84 | } | ||
85 | |||
86 | env = fun->env; | ||
87 | root = fun->body; | ||
88 | goto tailcall; | ||
89 | } | ||
42 | } break; | 90 | } break; |
43 | } | 91 | } |
44 | 92 | ||
@@ -692,6 +740,31 @@ proc_set(Environment *env, Object *obj) { | |||
692 | return obj_nil; | 740 | return obj_nil; |
693 | } | 741 | } |
694 | 742 | ||
743 | Object * | ||
744 | proc_lambda(Environment *env, Object *obj) { | ||
745 | if (obj == obj_nil || obj->cdr == obj_nil) { | ||
746 | error_push((Error){ | ||
747 | .type = ERR_TYPE_RUNTIME, | ||
748 | .value = ERR_NOT_ENOUGH_ARGS, | ||
749 | }); | ||
750 | return obj_err; | ||
751 | } | ||
752 | Object *args = obj->car; | ||
753 | if (args != obj_nil && args->type != OBJ_TYPE_PAIR) { | ||
754 | error_push((Error){ | ||
755 | .type = ERR_TYPE_RUNTIME, | ||
756 | .value = ERR_WRONG_ARG_TYPE, | ||
757 | }); | ||
758 | return obj_err; | ||
759 | } | ||
760 | Object *body = obj->cdr->car; | ||
761 | Object *fun = alloc_object(OBJ_TYPE_LAMBDA); | ||
762 | fun->args = obj_duplicate(args); | ||
763 | fun->body = obj_duplicate(body); | ||
764 | fun->env = env_create(env); | ||
765 | return fun; | ||
766 | } | ||
767 | |||
695 | 768 | ||
696 | // | 769 | // |
697 | // Evaluation. | 770 | // Evaluation. |
@@ -709,6 +782,10 @@ proc_eval(Environment *env, Object *obj) { | |||
709 | return eval(env, eval(env, obj->car)); | 782 | return eval(env, eval(env, obj->car)); |
710 | } | 783 | } |
711 | 784 | ||
785 | // | ||
786 | // Runtime configuration options. | ||
787 | // | ||
788 | |||
712 | Object * | 789 | Object * |
713 | proc_supress_errors(Environment *env, Object *obj) { | 790 | proc_supress_errors(Environment *env, Object *obj) { |
714 | Object *car = extract_car_with_type(env, obj, OBJ_TYPE_BOOL); | 791 | Object *car = extract_car_with_type(env, obj, OBJ_TYPE_BOOL); |