diff options
-rw-r--r-- | src/bootstrap/errors.c | 2 | ||||
-rwxr-xr-x | src/bootstrap/main.c | 1 | ||||
-rw-r--r-- | src/bootstrap/objects.c | 16 | ||||
-rw-r--r-- | src/bootstrap/primitives.c | 77 |
4 files changed, 96 insertions, 0 deletions
diff --git a/src/bootstrap/errors.c b/src/bootstrap/errors.c index 61ea902..c1d2879 100644 --- a/src/bootstrap/errors.c +++ b/src/bootstrap/errors.c | |||
@@ -16,6 +16,7 @@ typedef enum ErrorValue { | |||
16 | ERR_SYMBOL_NOT_FOUND, | 16 | ERR_SYMBOL_NOT_FOUND, |
17 | ERR_OBJ_NOT_CALLABLE, | 17 | ERR_OBJ_NOT_CALLABLE, |
18 | ERR_NOT_ENOUGH_ARGS, | 18 | ERR_NOT_ENOUGH_ARGS, |
19 | ERR_TOO_MANY_ARGS, | ||
19 | ERR_WRONG_ARG_TYPE, | 20 | ERR_WRONG_ARG_TYPE, |
20 | ERR_DIVISION_BY_ZERO, | 21 | ERR_DIVISION_BY_ZERO, |
21 | } ErrorValue; | 22 | } ErrorValue; |
@@ -39,6 +40,7 @@ static const char* error_msgs[] = { | |||
39 | [ERR_SYMBOL_NOT_FOUND] = "error: symbol not found", | 40 | [ERR_SYMBOL_NOT_FOUND] = "error: symbol not found", |
40 | [ERR_OBJ_NOT_CALLABLE] = "error: object is not callable", | 41 | [ERR_OBJ_NOT_CALLABLE] = "error: object is not callable", |
41 | [ERR_NOT_ENOUGH_ARGS] = "error: not enough arguments", | 42 | [ERR_NOT_ENOUGH_ARGS] = "error: not enough arguments", |
43 | [ERR_TOO_MANY_ARGS] = "error: too many arguments", | ||
42 | [ERR_WRONG_ARG_TYPE] = "error: wrong argument type", | 44 | [ERR_WRONG_ARG_TYPE] = "error: wrong argument type", |
43 | [ERR_DIVISION_BY_ZERO] = "error: division by zero", | 45 | [ERR_DIVISION_BY_ZERO] = "error: division by zero", |
44 | }; | 46 | }; |
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index c589b2d..7591834 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c | |||
@@ -75,6 +75,7 @@ init(void) { | |||
75 | MAKE_ENV_PROC(global_env, "eq?", proc_equal); | 75 | MAKE_ENV_PROC(global_env, "eq?", proc_equal); |
76 | MAKE_ENV_PROC(global_env, "def", proc_define); | 76 | MAKE_ENV_PROC(global_env, "def", proc_define); |
77 | MAKE_ENV_PROC(global_env, "set!", proc_set); | 77 | MAKE_ENV_PROC(global_env, "set!", proc_set); |
78 | MAKE_ENV_PROC(global_env, "lambda", proc_lambda); | ||
78 | 79 | ||
79 | // Runtime procedures. | 80 | // Runtime procedures. |
80 | MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors); | 81 | MAKE_ENV_PROC(global_env, "supress-errors", proc_supress_errors); |
diff --git a/src/bootstrap/objects.c b/src/bootstrap/objects.c index fd76166..b3aa3de 100644 --- a/src/bootstrap/objects.c +++ b/src/bootstrap/objects.c | |||
@@ -6,6 +6,7 @@ typedef enum ObjectType { | |||
6 | OBJ_TYPE_STRING, | 6 | OBJ_TYPE_STRING, |
7 | OBJ_TYPE_PAIR, | 7 | OBJ_TYPE_PAIR, |
8 | OBJ_TYPE_PROCEDURE, | 8 | OBJ_TYPE_PROCEDURE, |
9 | OBJ_TYPE_LAMBDA, | ||
9 | OBJ_TYPE_ERR, | 10 | OBJ_TYPE_ERR, |
10 | } ObjectType; | 11 | } ObjectType; |
11 | 12 | ||
@@ -37,6 +38,13 @@ typedef struct Object { | |||
37 | 38 | ||
38 | // OBJ_TYPE_PROCEDURE | 39 | // OBJ_TYPE_PROCEDURE |
39 | struct Object *(*proc)(struct Environment *env, struct Object *args); | 40 | struct Object *(*proc)(struct Environment *env, struct Object *args); |
41 | |||
42 | // OBJ_TYPE_LAMBDA | ||
43 | struct { | ||
44 | struct Object *args; | ||
45 | struct Object *body; | ||
46 | struct Environment *env; | ||
47 | }; | ||
40 | }; | 48 | }; |
41 | } Object; | 49 | } Object; |
42 | 50 | ||
@@ -118,6 +126,7 @@ obj_duplicate(Object *obj) { | |||
118 | case OBJ_TYPE_BOOL: | 126 | case OBJ_TYPE_BOOL: |
119 | case OBJ_TYPE_NIL: | 127 | case OBJ_TYPE_NIL: |
120 | case OBJ_TYPE_PROCEDURE: | 128 | case OBJ_TYPE_PROCEDURE: |
129 | case OBJ_TYPE_LAMBDA: // TODO: should we duplicate everything inside? | ||
121 | case OBJ_TYPE_ERR: { | 130 | case OBJ_TYPE_ERR: { |
122 | copy = obj; | 131 | copy = obj; |
123 | } break; | 132 | } break; |
@@ -176,6 +185,12 @@ free_objects(Object *root) { | |||
176 | } | 185 | } |
177 | free(root); | 186 | free(root); |
178 | } break; | 187 | } break; |
188 | case OBJ_TYPE_LAMBDA: { | ||
189 | free_objects(root->args); | ||
190 | free_objects(root->body); | ||
191 | // TODO: free_env(root->env); | ||
192 | free(root); | ||
193 | } break; | ||
179 | } | 194 | } |
180 | } | 195 | } |
181 | 196 | ||
@@ -222,6 +237,7 @@ display(Object *root) { | |||
222 | display_pair(root); | 237 | display_pair(root); |
223 | printf(")"); | 238 | printf(")"); |
224 | } break; | 239 | } break; |
240 | case OBJ_TYPE_LAMBDA: | ||
225 | case OBJ_TYPE_PROCEDURE: { | 241 | case OBJ_TYPE_PROCEDURE: { |
226 | printf("#{procedure}"); | 242 | printf("#{procedure}"); |
227 | } break; | 243 | } break; |
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); |