From 14814ecbf53760654aab34e0613abf347a54113f Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Thu, 14 Oct 2021 18:06:54 +0200 Subject: Add fun sugar for function variable declaration --- examples/variables.bdl | 80 +++++++++++++++++++------------------------- src/bootstrap/environment.c | 8 ++--- src/bootstrap/main.c | 1 + src/bootstrap/objects.c | 4 +-- src/bootstrap/primitives.c | 43 +++++++++++++++++++++--- tests/variables_expected.txt | 34 +++++++++++++------ 6 files changed, 104 insertions(+), 66 deletions(-) diff --git a/examples/variables.bdl b/examples/variables.bdl index 2e2543a..7b343d1 100644 --- a/examples/variables.bdl +++ b/examples/variables.bdl @@ -2,64 +2,55 @@ ;; Variable declarations and updates ;; -(supress-errors true) -(print "(error? (def a 1)) -> ") (error? (def a 1)) -(print "a -> ") a -(print "(error? (def a 300)) -> ") (error? (def a 300)) -(print "a -> ") a -(print "(error? (def a \"strings\")) -> ") (error? (def a "strings")) -(print "a -> ") a -(print "(error? (def a 1)) -> ") (error? (def a '(quoted symbols 123 or "strings"))) -(print "a -> ") a -(print "(error? (set! a 42)) -> ") (error? (set! a 42)) -(print "a -> ") a -(print "(error? (set! b 99)) -> ") (error? (set! b 99)) -(lambda (a b) (+ 10 a b)) - -(def a 20) -((lambda (a b) (+ 10 a b)) 1 2) -((lambda (a b) (+ 10 a b)) a 3) -(def myfun (lambda (a b) (+ a b))) -(myfun 6 9) -(+ 1 (myfun 10 (myfun a a)) 30) -(myfun 10 (myfun 5 0)) +(print "(def a 20)") (def a 20) (newline) +(print "((lambda (a b) (+ 10 a b)) 1 2) -> ") ((lambda (a b) (+ 10 a b)) 1 2) +(print "((lambda (a b) (+ 10 a b)) a 3) -> ") ((lambda (a b) (+ 10 a b)) a 3) +(print "(def myfun (lambda (a b) (+ a b))) (myfun 6 9) -> ") (def myfun (lambda (a b) (+ a b))) (myfun 6 9) +(print "(fun myfun (a b) (+ a b)) (myfun 6 9) -> ") (fun myfun (a b) (+ a b)) (myfun 6 9) +(print "(+ 1 (myfun 10 (myfun a a)) 30) -> ") (+ 1 (myfun 10 (myfun a a)) 30) +(print "(myfun 10 (myfun 5 0)) -> ") (myfun 10 (myfun 5 0)) ;; Closures. -(def make-counter (lambda () +(print "(fun make-counter () (def value 0) (def counter (lambda () (set! value (+ value 1)) value)) counter)") +(newline) +(fun make-counter () (def value 0) (def counter (lambda () (set! value (+ value 1)) value)) - counter)) - -(def counter-a (make-counter)) -(def counter-b (make-counter)) -(counter-a) -(counter-a) -(counter-b) -(counter-b) -(counter-b) -(counter-b) -(counter-a) + counter) + +(print "(def counter-a (make-counter))") (def counter-a (make-counter)) (newline) +(print "(def counter-b (make-counter))") (def counter-b (make-counter)) (newline) +(print "(counter-a) -> ") (counter-a) +(print "(counter-b) -> ") (counter-b) +(print "(counter-a) -> ") (counter-a) +(print "(counter-a) -> ") (counter-a) +(print "(counter-a) -> ") (counter-a) +(print "(counter-b) -> ") (counter-b) +(print "(counter-b) -> ") (counter-b) +(print "(counter-b) -> ") (counter-b) ;; Fibonacci. -(def fib (lambda (n) - (if (<= n 2) - 1 - (+ (fib (- n 1)) (fib (- n 2)))))) -(fib 15) +(print "(fun fib (n) (if (<= n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))") (newline) +(fun fib (n) + (if (<= n 2) + 1 + (+ (fib (- n 1)) (fib (- n 2))))) + +(print "(fib 15) -> ")(fib 15) ;; Lambda capture. -(def a 20) -(def b (lambda () +(print "(fun b () (display a) (print \" --- \") (def a 42) (display a) (newline))") (newline) +(fun b () (display a) - (newline) + (print " --- ") (def a 42) (display a) - (newline))) + (newline)) -(b) -(b) +(print "(b) -> ") (b) +(print "(b) -> ") (b) ;; Infinite loop. (For teseting purposes) @@ -68,5 +59,4 @@ ; (if (<= n 2) ; 'ok ; (test (+ n 1))))) - ; (test 3) diff --git a/src/bootstrap/environment.c b/src/bootstrap/environment.c index e111753..78f31fb 100644 --- a/src/bootstrap/environment.c +++ b/src/bootstrap/environment.c @@ -106,15 +106,15 @@ env_extend(Environment *parent, Environment *extra) { for (size_t i = 0; i < extra->size; i++) { EnvEntry entry = extra->buf[i]; Environment *tmp = env; - ssize_t idx = -1; + bool found = false; while (tmp != NULL) { - idx = env_index_current(tmp, entry.symbol); - if (idx != -1) { + if (env_index_current(tmp, entry.symbol) != -1) { + found = true; break; } tmp = tmp->parent; } - if (idx == -1) { + if (!found) { env_add_symbol(env, obj_duplicate(entry.symbol), obj_duplicate(entry.value)); } } diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index 7591834..5191fd0 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c @@ -76,6 +76,7 @@ init(void) { MAKE_ENV_PROC(global_env, "def", proc_define); MAKE_ENV_PROC(global_env, "set!", proc_set); MAKE_ENV_PROC(global_env, "lambda", proc_lambda); + MAKE_ENV_PROC(global_env, "fun", proc_fun); // 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 b3aa3de..b03a616 100644 --- a/src/bootstrap/objects.c +++ b/src/bootstrap/objects.c @@ -41,7 +41,7 @@ typedef struct Object { // OBJ_TYPE_LAMBDA struct { - struct Object *args; + struct Object *params; struct Object *body; struct Environment *env; }; @@ -186,7 +186,7 @@ free_objects(Object *root) { free(root); } break; case OBJ_TYPE_LAMBDA: { - free_objects(root->args); + free_objects(root->params); free_objects(root->body); // TODO: free_env(root->env); free(root); diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 4ef56d5..4c3e4c6 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c @@ -54,7 +54,7 @@ eval_lambda: if (lambda->type == OBJ_TYPE_LAMBDA) { Object *fun = lambda; Object *args = root->cdr; - Object *params = fun->args; + Object *params = fun->params; env = env_extend(fun->env, env); while (params != obj_nil) { if (args == obj_nil) { @@ -742,8 +742,8 @@ proc_lambda(Environment *env, Object *obj) { }); return obj_err; } - Object *args = obj->car; - if (args != obj_nil && args->type != OBJ_TYPE_PAIR) { + Object *params = obj->car; + if (params != obj_nil && params->type != OBJ_TYPE_PAIR) { error_push((Error){ .type = ERR_TYPE_RUNTIME, .value = ERR_WRONG_ARG_TYPE, @@ -752,12 +752,47 @@ proc_lambda(Environment *env, Object *obj) { } Object *body = obj->cdr; Object *fun = alloc_object(OBJ_TYPE_LAMBDA); - fun->args = obj_duplicate(args); + fun->params = obj_duplicate(params); fun->body = obj_duplicate(body); fun->env = env; return fun; } +Object * +proc_fun(Environment *env, Object *obj) { + if (obj == obj_nil || obj->cdr == obj_nil || obj->cdr->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; + } + + Object *name = obj->car; + if (name->type != OBJ_TYPE_SYMBOL) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + + Object *params = obj->cdr->car; + if (params != obj_nil && params->type != OBJ_TYPE_PAIR) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_WRONG_ARG_TYPE, + }); + return obj_err; + } + Object *body = obj->cdr->cdr; + Object *fun = alloc_object(OBJ_TYPE_LAMBDA); + fun->params = obj_duplicate(params); + fun->body = obj_duplicate(body); + fun->env = env; + env_add_or_update_current(env, name, fun); + return obj_nil; +} // // Evaluation. diff --git a/tests/variables_expected.txt b/tests/variables_expected.txt index 2e6e2be..02a5f7a 100644 --- a/tests/variables_expected.txt +++ b/tests/variables_expected.txt @@ -1,11 +1,23 @@ -(error? (def a 1)) -> false -a -> 1 -(error? (def a 300)) -> false -a -> 300 -(error? (def a "strings")) -> false -a -> "strings" -(error? (def a 1)) -> false -a -> (:quoted :symbols 123 :or "strings") -(error? (set! a 42)) -> false -a -> 42 -(error? (set! b 99)) -> true +(def a 20) +((lambda (a b) (+ 10 a b)) 1 2) -> 13 +((lambda (a b) (+ 10 a b)) a 3) -> 33 +(def myfun (lambda (a b) (+ a b))) (myfun 6 9) -> 15 +(fun myfun (a b) (+ a b)) (myfun 6 9) -> 15 +(+ 1 (myfun 10 (myfun a a)) 30) -> 81 +(myfun 10 (myfun 5 0)) -> 15 +(fun make-counter () (def value 0) (def counter (lambda () (set! value (+ value 1)) value)) counter) +(def counter-a (make-counter)) +(def counter-b (make-counter)) +(counter-a) -> 1 +(counter-b) -> 1 +(counter-a) -> 2 +(counter-a) -> 3 +(counter-a) -> 4 +(counter-b) -> 2 +(counter-b) -> 3 +(counter-b) -> 4 +(fun fib (n) (if (<= n 2) 1 (+ (fib (- n 1)) (fib (- n 2))))) +(fib 15) -> 610 +(fun b () (display a) (print " --- ") (def a 42) (display a) (newline)) +(b) -> 20 --- 42 +(b) -> 20 --- 42 -- cgit v1.2.1