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

syntax "define"

Browse source
This commit is contained in:
Alex Kotov 2023-05-07 17:28:45 +04:00
parent 27337e4624
commit e225caea00
Signed by: kotovalexarian
GPG key ID: 553C0EBBEB5D5F08
6 changed files with 112 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
src/eval.c
View file

@ -11,10 +11,15 @@
static struct Object *lookup(struct Object *namespace, struct Object *name);
static struct Object *eval_list(struct Object *object);
static struct Object *eval_list(
struct Object *object,
struct Object *environment
);
struct Object *eval_str(const char *const str)
{
struct Object *eval_str(
const char *const str,
struct Object *const environment
) {
assert(str);
Tokens tokens = Tokens_new();
@ -34,16 +39,21 @@ struct Object *eval_str(const char *const str)
struct Object *const program = parse(tokens);
TOKENS_DELETE(tokens);
return eval(program);
return eval(program, environment);
}
struct Object *eval(struct Object *const object)
{
struct Object *eval(
struct Object *const object,
struct Object *const environment
) {
assert(Object_is_pair(environment));
assert(OBJECT_IS_NULL(environment->pair.cdr));
// NULL is an empty list, can't eval
assert(object);
assert(!OBJECT_IS_NULL(object));
// SYMBOL performs lookup
if (Object_is_symbol(object)) return lookup(NULL, object);
if (Object_is_symbol(object)) return lookup(environment->pair.car, object);
// Almost everything evaluates to itself
if (!Object_is_pair(object)) return object;
@ -52,19 +62,30 @@ struct Object *eval(struct Object *const object)
struct Object *const args = object->pair.cdr;
if (Object_is_symbol(func_expr)) {
if (strcmp(func_expr->s, "begin") == 0) return syntax_begin(args);
if (strcmp(func_expr->s, "quote") == 0) return syntax_quote(args);
if (strcmp(func_expr->s, "if") == 0) return syntax_if(args);
if (strcmp(func_expr->s, "begin") == 0) {
return syntax_begin(args, environment);
}
if (strcmp(func_expr->s, "define") == 0) {
return syntax_define(args, environment);
}
if (strcmp(func_expr->s, "quote") == 0) {
return syntax_quote(args, environment);
}
if (strcmp(func_expr->s, "if") == 0) {
return syntax_if(args, environment);
}
}
struct Object *const func = eval(func_expr);
struct Object *const func = eval(func_expr, environment);
assert(Object_is_procedure(func));
struct Object *const evaluated_args = eval_list(args);
struct Object *const evaluated_args = eval_list(args, environment);
return Object_procedure_call(func, evaluated_args);
}
struct Object *eval_list(struct Object *const object)
{
struct Object *eval_list(
struct Object *const object,
struct Object *const environment
) {
assert(OBJECT_IS_LIST_HEAD(object));
if (OBJECT_IS_NULL(object)) return NULL;
@ -72,12 +93,12 @@ struct Object *eval_list(struct Object *const object)
if (OBJECT_IS_NULL(object->pair.car)) {
return Object_new_pair(
NULL,
eval_list(object->pair.cdr)
eval_list(object->pair.cdr, environment)
);
} else {
return Object_new_pair(
eval(object->pair.car),
eval_list(object->pair.cdr)
eval(object->pair.car, environment),
eval_list(object->pair.cdr, environment)
);
}
}

4
src/eval.h
View file

@ -3,7 +3,7 @@
#include "object.h"
struct Object *eval_str(const char * str);
struct Object *eval(struct Object *object);
struct Object *eval_str(const char * str, struct Object *environment);
struct Object *eval(struct Object *object, struct Object *environment);
#endif

14
src/main.c
View file

@ -32,6 +32,8 @@ void repl()
{
printf("Lisp by Causa Arcana\n\n");
struct Object *const environment = Object_new_pair(NULL, NULL);
while (true) {
Tokens tokens = Tokens_new();
assert(tokens);
@ -60,14 +62,17 @@ void repl()
struct Object *const program = parse(tokens);
TOKENS_DELETE(tokens);
struct Object *const result = eval(program);
struct Object *const result = eval(program, environment);
printf("=> ");
eval(Object_build_list(
eval(
Object_build_list(
2,
Object_new_symbol("displayln"),
Object_build_list(2, Object_new_symbol("quote"), result)
));
),
environment
);
}
}
@ -92,5 +97,6 @@ void script()
struct Object *const program = parse(tokens);
TOKENS_DELETE(tokens);
eval(program);
struct Object *const environment = Object_new_pair(NULL, NULL);
eval(program, environment);
}

48
src/syntax.c
View file

@ -5,20 +5,46 @@
#include <assert.h>
struct Object *syntax_begin(struct Object *args)
{
struct Object *syntax_begin(
struct Object *args,
struct Object *const environment
) {
assert(OBJECT_IS_LIST_HEAD(args));
struct Object *result = NULL;
while (!OBJECT_IS_NULL(args)) {
assert(Object_is_pair(args));
result = eval(args->pair.car);
result = eval(args->pair.car, environment);
args = args->pair.cdr;
}
return result;
}
struct Object *syntax_if(struct Object *const args)
{
struct Object *syntax_define(
struct Object *const args,
struct Object *const environment
) {
assert(Object_is_pair(args));
struct Object *const name = args->pair.car;
assert(Object_is_symbol(name));
assert(Object_is_pair(args->pair.cdr));
struct Object *const value_expr = args->pair.cdr->pair.car;
assert(OBJECT_IS_NULL(args->pair.cdr->pair.cdr));
assert(Object_is_pair(environment));
assert(OBJECT_IS_NULL(environment->pair.cdr));
assert(OBJECT_IS_LIST_HEAD(environment->pair.car));
environment->pair.car = Object_new_pair(
Object_new_pair(name, eval(value_expr, environment)),
environment->pair.car
);
return NULL;
}
struct Object *syntax_if(
struct Object *const args,
struct Object *const environment
) {
assert(Object_is_pair(args));
struct Object *const cond = args->pair.car;
struct Object *const then_else_list = args->pair.cdr;
@ -32,14 +58,18 @@ struct Object *syntax_if(struct Object *const args)
assert(OBJECT_IS_NULL(else_list->pair.cdr));
if (Object_is_false(cond)) {
return eval(else_branch);
return eval(else_branch, environment);
} else {
return eval(then_branch);
return eval(then_branch, environment);
}
}
struct Object *syntax_quote(struct Object *const args)
{
struct Object *syntax_quote(
struct Object *const args,
struct Object *const environment
) {
(void)environment; // unused
assert(Object_is_pair(args));
assert(OBJECT_IS_NULL(args->pair.cdr));
return args->pair.car;

7
src/syntax.h
View file

@ -3,8 +3,9 @@
#include "object.h"
struct Object *syntax_begin(struct Object *args);
struct Object *syntax_if(struct Object *args);
struct Object *syntax_quote(struct Object *args);
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_quote(struct Object *args, struct Object *environment);
#endif

15
tests/syntax.scm
View file

@ -5,6 +5,21 @@
(assert-equal 456 (begin 123 456))
(assert-equal 789 (begin 123 456 789))
;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal
'(123 579)
(begin
(define x 123)
(define y (+ x 456))
(list x y)))
(assert-equal
'(123 456)
(begin
(define x 123)
(define old x)
(define x 456)
(list old x)))
;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 123 (if #true 123 456))
(assert-equal 123 (if "foo" 123 456))