causa-arcana-misc/lesson-lisp
1
0
Fork 0
Code Activity

syntax "let"

Browse source
This commit is contained in:
Alex Kotov 2023-05-07 19:13:16 +04:00
parent 730d2ff638
commit 6b6f7abbea
Signed by: kotovalexarian
GPG key ID: 553C0EBBEB5D5F08
4 changed files with 46 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/eval.c
View file

@ -41,6 +41,9 @@ struct Object *eval(
if (strcmp(func_expr->s, "define") == 0) {
return syntax_define(args, environment);
}
if (strcmp(func_expr->s, "let") == 0) {
return syntax_let(args, environment);
}
if (strcmp(func_expr->s, "quote") == 0) {
return syntax_quote(args, environment);
}

34
src/syntax.c
View file

@ -86,6 +86,40 @@ struct Object *syntax_if(
}
}
struct Object *syntax_let(
struct Object *const args,
struct Object *environment
) {
assert(Object_is_pair(args));
struct Object *bindings = args->pair.car;
assert(OBJECT_IS_LIST_HEAD(bindings));
assert(Object_is_pair(args->pair.cdr));
struct Object *const expr = args->pair.cdr->pair.car;
assert(OBJECT_IS_NULL(args->pair.cdr->pair.cdr));
assert(OBJECT_IS_LIST_HEAD(environment));
environment = Object_new_pair(NULL, environment);
while (!OBJECT_IS_NULL(bindings)) {
assert(Object_is_pair(bindings));
assert(Object_is_pair(bindings->pair.car));
struct Object *const name = bindings->pair.car->pair.car;
assert(Object_is_symbol(name));
assert(Object_is_pair(bindings->pair.car->pair.cdr));
struct Object *const val_expr = bindings->pair.car->pair.cdr->pair.car;
assert(OBJECT_IS_NULL(bindings->pair.car->pair.cdr->pair.cdr));
environment->pair.car = Object_new_pair(
Object_new_pair(name, eval(val_expr, environment)),
environment->pair.car
);
bindings = bindings->pair.cdr;
}
return eval(expr, environment);
}
struct Object *syntax_quote(
struct Object *const args,
struct Object *const environment

1
src/syntax.h
View file

@ -17,6 +17,7 @@ struct Object *syntax_script(struct Object *args, struct Object *environment);
struct Object *syntax_begin(struct Object *args, struct Object *environment);
struct Object *syntax_define(struct Object *args, struct Object *environment);
struct Object *syntax_if(struct Object *args, struct Object *environment);
struct Object *syntax_let(struct Object *args, struct Object *environment);
struct Object *syntax_quote(struct Object *args, struct Object *environment);
#endif

8
tests/syntax.scm
View file

@ -24,6 +24,14 @@
(assert-equal 123 (if "foo" 123 456))
(assert-equal 456 (if #false 123 456))
;;; let ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 'foo (let () 'foo))
(assert-equal '(1) (let { [a 1] } (list a)))
(assert-equal '(1 2) (let { [a 1] [b 2] } (list a b)))
(assert-equal '(1 3) (let { [a 1] [b (+ a 2)] } (list a b)))
(assert-equal '(1 2 3) (let { [a 1] [b 2] [c 3] } (list a b c)))
(assert-equal '(1 3 6) (let { [a 1] [b (+ a 2)] [c (+ b 3)] } (list a b c)))
;;; quote ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal '+ (quote +))
(assert-equal '+ '+)