From ab23395b1fc88bbc63bef88de3477cc316857ace Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Thu, 14 Oct 2021 10:29:55 +0200 Subject: Add initial lambda implementation --- src/bootstrap/errors.c | 2 ++ src/bootstrap/main.c | 1 + src/bootstrap/objects.c | 16 ++++++++++ src/bootstrap/primitives.c | 77 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 96 insertions(+) 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 { ERR_SYMBOL_NOT_FOUND, ERR_OBJ_NOT_CALLABLE, ERR_NOT_ENOUGH_ARGS, + ERR_TOO_MANY_ARGS, ERR_WRONG_ARG_TYPE, ERR_DIVISION_BY_ZERO, } ErrorValue; @@ -39,6 +40,7 @@ static const char* error_msgs[] = { [ERR_SYMBOL_NOT_FOUND] = "error: symbol not found", [ERR_OBJ_NOT_CALLABLE] = "error: object is not callable", [ERR_NOT_ENOUGH_ARGS] = "error: not enough arguments", + [ERR_TOO_MANY_ARGS] = "error: too many arguments", [ERR_WRONG_ARG_TYPE] = "error: wrong argument type", [ERR_DIVISION_BY_ZERO] = "error: division by zero", }; 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) { MAKE_ENV_PROC(global_env, "eq?", proc_equal); MAKE_ENV_PROC(global_env, "def", proc_define); MAKE_ENV_PROC(global_env, "set!", proc_set); + MAKE_ENV_PROC(global_env, "lambda", proc_lambda); // Runtime procedures. 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 { OBJ_TYPE_STRING, OBJ_TYPE_PAIR, OBJ_TYPE_PROCEDURE, + OBJ_TYPE_LAMBDA, OBJ_TYPE_ERR, } ObjectType; @@ -37,6 +38,13 @@ typedef struct Object { // OBJ_TYPE_PROCEDURE struct Object *(*proc)(struct Environment *env, struct Object *args); + + // OBJ_TYPE_LAMBDA + struct { + struct Object *args; + struct Object *body; + struct Environment *env; + }; }; } Object; @@ -118,6 +126,7 @@ obj_duplicate(Object *obj) { case OBJ_TYPE_BOOL: case OBJ_TYPE_NIL: case OBJ_TYPE_PROCEDURE: + case OBJ_TYPE_LAMBDA: // TODO: should we duplicate everything inside? case OBJ_TYPE_ERR: { copy = obj; } break; @@ -176,6 +185,12 @@ free_objects(Object *root) { } free(root); } break; + case OBJ_TYPE_LAMBDA: { + free_objects(root->args); + free_objects(root->body); + // TODO: free_env(root->env); + free(root); + } break; } } @@ -222,6 +237,7 @@ display(Object *root) { display_pair(root); printf(")"); } break; + case OBJ_TYPE_LAMBDA: case OBJ_TYPE_PROCEDURE: { printf("#{procedure}"); } 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 @@ Object * eval(Environment* env, Object *root) { +tailcall: switch (root->type) { case OBJ_TYPE_ERR: case OBJ_TYPE_PROCEDURE: + case OBJ_TYPE_LAMBDA: case OBJ_TYPE_FIXNUM: case OBJ_TYPE_BOOL: case OBJ_TYPE_NIL: @@ -39,6 +41,52 @@ eval(Environment* env, Object *root) { }); return obj_err; } + Object* lambda = eval(env, root->car); + if (lambda->type == OBJ_TYPE_LAMBDA) { + Object *fun = lambda; + Object *args = root->cdr; + Object *params = fun->args; + while (params != obj_nil) { + if (args == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *symbol = params->car; + Object *value = eval(env, args->car); + if (value == obj_err) { + return obj_err; + } + if (value == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + ssize_t index = env_symbol_index_in_current_env(fun->env, symbol); + if (index == -1) { + env_add_symbol(fun->env, obj_duplicate(symbol), obj_duplicate(value)); + } else { + fun->env->buf[index].value = obj_duplicate(value); + } + args = args->cdr; + params = params->cdr; + } + if (args != obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_TOO_MANY_ARGS, + }); + return obj_err; + } + + env = fun->env; + root = fun->body; + goto tailcall; + } } break; } @@ -692,6 +740,31 @@ proc_set(Environment *env, Object *obj) { return obj_nil; } +Object * +proc_lambda(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + Object *args = obj->car; + if (args != obj_nil && args->type != OBJ_TYPE_PAIR) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + Object *body = obj->cdr->car; + Object *fun = alloc_object(OBJ_TYPE_LAMBDA); + fun->args = obj_duplicate(args); + fun->body = obj_duplicate(body); + fun->env = env_create(env); + return fun; +} + // // Evaluation. @@ -709,6 +782,10 @@ proc_eval(Environment *env, Object *obj) { return eval(env, eval(env, obj->car)); } +// +// Runtime configuration options. +// + Object * proc_supress_errors(Environment *env, Object *obj) { Object *car = extract_car_with_type(env, obj, OBJ_TYPE_BOOL); -- cgit v1.2.1