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

tmp

This commit is contained in:
Alex Kotov 2023-05-06 00:49:04 +04:00
parent 640ee32606
commit 83516a0948
Signed by: kotovalexarian
GPG Key ID: 553C0EBBEB5D5F08
6 changed files with 142 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/builtins.c
View File

@ -135,11 +135,11 @@ struct Object *func_arcane_SLASH_tokenize(
Tokens_pop(tokens);
if (last) {
last->pair.b = new_pair;
last->pair.cdr = new_pair;
last = new_pair;
} else {
last = new_pair;
list->pair.b = last;
list->pair.cdr = last;
}
}
@ -160,7 +160,7 @@ struct Object *func_car(
struct Object *const arg = args_array[0];
assert(Object_is_pair(arg));
return arg->pair.a;
return arg->pair.car;
}
struct Object *func_cdr(
@ -172,7 +172,7 @@ struct Object *func_cdr(
struct Object *const arg = args_array[0];
assert(Object_is_pair(arg));
return arg->pair.b;
return arg->pair.cdr;
}
struct Object *func_cons(
@ -467,19 +467,19 @@ void display_pair(struct Object *const pair)
assert(pair);
assert(pair->type == TYPE_PAIR);
struct Object *pair1[2] = { Object_new_pair(pair->pair.a, NULL), NULL };
struct Object *pair1[2] = { Object_new_pair(pair->pair.car, NULL), NULL };
func_display(1, pair1);
if (!pair->pair.b) return;
if (!pair->pair.cdr) return;
printf(" ");
if (pair->pair.b->type == TYPE_PAIR) {
display_pair(pair->pair.b);
if (pair->pair.cdr->type == TYPE_PAIR) {
display_pair(pair->pair.cdr);
return;
}
printf(". ");
struct Object *pair2[2] = { Object_new_pair(pair->pair.b, NULL), NULL };
struct Object *pair2[2] = { Object_new_pair(pair->pair.cdr, NULL), NULL };
func_display(1, pair2);
}

12
src/eval.c
View File

@ -50,8 +50,8 @@ struct Object *eval(struct Object *const object)
// Almost everything evaluates to itself
if (!Object_is_pair(object)) return object;
struct Object *const func_expr = object->pair.a;
struct Object *const args = object->pair.b;
struct Object *const func_expr = object->pair.car;
struct Object *const args = object->pair.cdr;
if (Object_is_symbol(func_expr)) {
if (strcmp(func_expr->s, "begin") == 0) return syntax_begin(args);
@ -71,15 +71,15 @@ struct Object *eval_list(struct Object *const object)
if (OBJECT_IS_NULL(object)) return NULL;
if (OBJECT_IS_NULL(object->pair.a)) {
if (OBJECT_IS_NULL(object->pair.car)) {
return Object_new_pair(
NULL,
eval_list(object->pair.b)
eval_list(object->pair.cdr)
);
} else {
return Object_new_pair(
eval(object->pair.a),
eval_list(object->pair.b)
eval(object->pair.car),
eval_list(object->pair.cdr)
);
}
}

150
src/main-test.c
View File

@ -167,23 +167,23 @@ void test_arcane_SLASH_tokenize()
// ((TOKEN_ROUND_OPEN . ""))
result = eval_str("(arcane/tokenize \"(\")");
assert(Object_is_pair(result));
assert(OBJECT_IS_NULL(result->pair.b));
assert(Object_is_pair(result->pair.a));
assert(Object_is_symbol(result->pair.a->pair.a));
assert(Object_is_string(result->pair.a->pair.b));
assert(strcmp(result->pair.a->pair.a->s, "TOKEN_ROUND_OPEN") == 0);
assert(strcmp(result->pair.a->pair.b->s, "(") == 0);
assert(OBJECT_IS_NULL(result->pair.cdr));
assert(Object_is_pair(result->pair.car));
assert(Object_is_symbol(result->pair.car->pair.car));
assert(Object_is_string(result->pair.car->pair.cdr));
assert(strcmp(result->pair.car->pair.car->s, "TOKEN_ROUND_OPEN") == 0);
assert(strcmp(result->pair.car->pair.cdr->s, "(") == 0);
// (arcane/tokenize "#false")
// ((TOKEN_TAG . "false"))
result = eval_str("(arcane/tokenize \"#false\")");
assert(Object_is_pair(result));
assert(OBJECT_IS_NULL(result->pair.b));
assert(Object_is_pair(result->pair.a));
assert(Object_is_symbol(result->pair.a->pair.a));
assert(Object_is_string(result->pair.a->pair.b));
assert(strcmp(result->pair.a->pair.a->s, "TOKEN_TAG") == 0);
assert(strcmp(result->pair.a->pair.b->s, "false") == 0);
assert(OBJECT_IS_NULL(result->pair.cdr));
assert(Object_is_pair(result->pair.car));
assert(Object_is_symbol(result->pair.car->pair.car));
assert(Object_is_string(result->pair.car->pair.cdr));
assert(strcmp(result->pair.car->pair.car->s, "TOKEN_TAG") == 0);
assert(strcmp(result->pair.car->pair.cdr->s, "false") == 0);
// (arcane/tokenize "\"\"")
// ((TOKEN_STRING . ""))
@ -193,12 +193,12 @@ void test_arcane_SLASH_tokenize()
Object_new_string("\"\"")
));
assert(Object_is_pair(result));
assert(OBJECT_IS_NULL(result->pair.b));
assert(Object_is_pair(result->pair.a));
assert(Object_is_symbol(result->pair.a->pair.a));
assert(Object_is_string(result->pair.a->pair.b));
assert(strcmp(result->pair.a->pair.a->s, "TOKEN_STRING") == 0);
assert(strcmp(result->pair.a->pair.b->s, "") == 0);
assert(OBJECT_IS_NULL(result->pair.cdr));
assert(Object_is_pair(result->pair.car));
assert(Object_is_symbol(result->pair.car->pair.car));
assert(Object_is_string(result->pair.car->pair.cdr));
assert(strcmp(result->pair.car->pair.car->s, "TOKEN_STRING") == 0);
assert(strcmp(result->pair.car->pair.cdr->s, "") == 0);
// (arcane/tokenize "\"qwe\"")
// ((TOKEN_STRING . ""))
@ -208,33 +208,33 @@ void test_arcane_SLASH_tokenize()
Object_new_string("\"qwe\"")
));
assert(Object_is_pair(result));
assert(OBJECT_IS_NULL(result->pair.b));
assert(Object_is_pair(result->pair.a));
assert(Object_is_symbol(result->pair.a->pair.a));
assert(Object_is_string(result->pair.a->pair.b));
assert(strcmp(result->pair.a->pair.a->s, "TOKEN_STRING") == 0);
assert(strcmp(result->pair.a->pair.b->s, "qwe") == 0);
assert(OBJECT_IS_NULL(result->pair.cdr));
assert(Object_is_pair(result->pair.car));
assert(Object_is_symbol(result->pair.car->pair.car));
assert(Object_is_string(result->pair.car->pair.cdr));
assert(strcmp(result->pair.car->pair.car->s, "TOKEN_STRING") == 0);
assert(strcmp(result->pair.car->pair.cdr->s, "qwe") == 0);
// (arcane/tokenize "(displayln (list 1))")
// ((TOKEN_ROUND_OPEN . "(") (TOKEN_IDENT . "displayln") (TOKEN_ROUND_OPEN . "(") (TOKEN_IDENT . "list") (TOKEN_NUM . "1") (TOKEN_ROUND_CLOSE . ")") (TOKEN_ROUND_CLOSE . ")"))
result = eval_str("(arcane/tokenize \"(displayln (list 1))\")");
{
assert(Object_is_pair(result));
assert(Object_is_pair(result->pair.b));
assert(Object_is_pair(result->pair.b->pair.b));
assert(Object_is_pair(result->pair.b->pair.b->pair.b));
assert(Object_is_pair(result->pair.b->pair.b->pair.b->pair.b));
assert(Object_is_pair(result->pair.b->pair.b->pair.b->pair.b->pair.b));
assert(Object_is_pair(result->pair.b->pair.b->pair.b->pair.b->pair.b->pair.b));
assert(OBJECT_IS_NULL(result->pair.b->pair.b->pair.b->pair.b->pair.b->pair.b->pair.b));
assert(Object_is_pair(result->pair.cdr));
assert(Object_is_pair(result->pair.cdr->pair.cdr));
assert(Object_is_pair(result->pair.cdr->pair.cdr->pair.cdr));
assert(Object_is_pair(result->pair.cdr->pair.cdr->pair.cdr->pair.cdr));
assert(Object_is_pair(result->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr));
assert(Object_is_pair(result->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr));
assert(OBJECT_IS_NULL(result->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr));
struct Object *const token_open1 = result->pair.a;
struct Object *const token_ident_displayln = result->pair.b->pair.a;
struct Object *const token_open2 = result->pair.b->pair.b->pair.a;
struct Object *const token_ident_list = result->pair.b->pair.b->pair.b->pair.a;
struct Object *const token_num_1 = result->pair.b->pair.b->pair.b->pair.b->pair.a;
struct Object *const token_close2 = result->pair.b->pair.b->pair.b->pair.b->pair.b->pair.a;
struct Object *const token_close1 = result->pair.b->pair.b->pair.b->pair.b->pair.b->pair.b->pair.a;
struct Object *const token_open1 = result->pair.car;
struct Object *const token_ident_displayln = result->pair.cdr->pair.car;
struct Object *const token_open2 = result->pair.cdr->pair.cdr->pair.car;
struct Object *const token_ident_list = result->pair.cdr->pair.cdr->pair.cdr->pair.car;
struct Object *const token_num_1 = result->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.car;
struct Object *const token_close2 = result->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.car;
struct Object *const token_close1 = result->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.cdr->pair.car;
assert(Object_is_pair(token_open1));
assert(Object_is_pair(token_ident_displayln));
@ -244,37 +244,37 @@ void test_arcane_SLASH_tokenize()
assert(Object_is_pair(token_close2));
assert(Object_is_pair(token_close1));
assert(Object_is_symbol(token_open1->pair.a));
assert(Object_is_symbol(token_ident_displayln->pair.a));
assert(Object_is_symbol(token_open2->pair.a));
assert(Object_is_symbol(token_ident_list->pair.a));
assert(Object_is_symbol(token_num_1->pair.a));
assert(Object_is_symbol(token_close2->pair.a));
assert(Object_is_symbol(token_close1->pair.a));
assert(Object_is_symbol(token_open1->pair.car));
assert(Object_is_symbol(token_ident_displayln->pair.car));
assert(Object_is_symbol(token_open2->pair.car));
assert(Object_is_symbol(token_ident_list->pair.car));
assert(Object_is_symbol(token_num_1->pair.car));
assert(Object_is_symbol(token_close2->pair.car));
assert(Object_is_symbol(token_close1->pair.car));
assert(0 == strcmp("TOKEN_ROUND_OPEN", token_open1->pair.a->s));
assert(0 == strcmp("TOKEN_IDENT", token_ident_displayln->pair.a->s));
assert(0 == strcmp("TOKEN_ROUND_OPEN", token_open2->pair.a->s));
assert(0 == strcmp("TOKEN_IDENT", token_ident_list->pair.a->s));
assert(0 == strcmp("TOKEN_NUM", token_num_1->pair.a->s));
assert(0 == strcmp("TOKEN_ROUND_CLOSE", token_close2->pair.a->s));
assert(0 == strcmp("TOKEN_ROUND_CLOSE", token_close1->pair.a->s));
assert(0 == strcmp("TOKEN_ROUND_OPEN", token_open1->pair.car->s));
assert(0 == strcmp("TOKEN_IDENT", token_ident_displayln->pair.car->s));
assert(0 == strcmp("TOKEN_ROUND_OPEN", token_open2->pair.car->s));
assert(0 == strcmp("TOKEN_IDENT", token_ident_list->pair.car->s));
assert(0 == strcmp("TOKEN_NUM", token_num_1->pair.car->s));
assert(0 == strcmp("TOKEN_ROUND_CLOSE", token_close2->pair.car->s));
assert(0 == strcmp("TOKEN_ROUND_CLOSE", token_close1->pair.car->s));
assert(Object_is_string(token_open1->pair.b));
assert(Object_is_string(token_ident_displayln->pair.b));
assert(Object_is_string(token_open2->pair.b));
assert(Object_is_string(token_ident_list->pair.b));
assert(Object_is_string(token_num_1->pair.b));
assert(Object_is_string(token_close2->pair.b));
assert(Object_is_string(token_close1->pair.b));
assert(Object_is_string(token_open1->pair.cdr));
assert(Object_is_string(token_ident_displayln->pair.cdr));
assert(Object_is_string(token_open2->pair.cdr));
assert(Object_is_string(token_ident_list->pair.cdr));
assert(Object_is_string(token_num_1->pair.cdr));
assert(Object_is_string(token_close2->pair.cdr));
assert(Object_is_string(token_close1->pair.cdr));
assert(0 == strcmp("(", token_open1->pair.b->s));
assert(0 == strcmp("displayln", token_ident_displayln->pair.b->s));
assert(0 == strcmp("(", token_open2->pair.b->s));
assert(0 == strcmp("list", token_ident_list->pair.b->s));
assert(0 == strcmp("1", token_num_1->pair.b->s));
assert(0 == strcmp(")", token_close2->pair.b->s));
assert(0 == strcmp(")", token_close1->pair.b->s));
assert(0 == strcmp("(", token_open1->pair.cdr->s));
assert(0 == strcmp("displayln", token_ident_displayln->pair.cdr->s));
assert(0 == strcmp("(", token_open2->pair.cdr->s));
assert(0 == strcmp("list", token_ident_list->pair.cdr->s));
assert(0 == strcmp("1", token_num_1->pair.cdr->s));
assert(0 == strcmp(")", token_close2->pair.cdr->s));
assert(0 == strcmp(")", token_close1->pair.cdr->s));
}
}
@ -316,20 +316,20 @@ void test_list()
// (123)
result = eval_str("(list 123)");
assert(Object_is_pair(result));
assert(Object_is_number(result->pair.a));
assert(result->pair.a->i == 123);
assert(OBJECT_IS_NULL(result->pair.b));
assert(Object_is_number(result->pair.car));
assert(result->pair.car->i == 123);
assert(OBJECT_IS_NULL(result->pair.cdr));
// (list 123 456)
// (123 456)
result = eval_str("(list 123 456)");
assert(Object_is_pair(result));
assert(Object_is_number(result->pair.a));
assert(result->pair.a->i == 123);
assert(Object_is_pair(result->pair.b));
assert(Object_is_number(result->pair.b->pair.a));
assert(result->pair.b->pair.a->i == 456);
assert(OBJECT_IS_NULL(result->pair.b->pair.b));
assert(Object_is_number(result->pair.car));
assert(result->pair.car->i == 123);
assert(Object_is_pair(result->pair.cdr));
assert(Object_is_number(result->pair.cdr->pair.car));
assert(result->pair.cdr->pair.car->i == 456);
assert(OBJECT_IS_NULL(result->pair.cdr->pair.cdr));
}
/*******************

22
src/object.c
View File

@ -32,7 +32,7 @@ static struct Object *new(const enum Type type)
struct Object *Object_new_procedure(
const char *const name,
struct Object *(*const func)(size_t args_count, struct Object **args_array)
const Procedure_Func func
) {
struct Object *const object = new(TYPE_PROCEDURE);
object->procedure.name = NULL;
@ -45,11 +45,13 @@ struct Object *Object_new_procedure(
return object;
}
struct Object *Object_new_pair(struct Object *const a, struct Object *const b)
{
struct Object *Object_new_pair(
struct Object *const car,
struct Object *const cdr
) {
struct Object *const object = new(TYPE_PAIR);
object->pair.a = a;
object->pair.b = b;
object->pair.car = car;
object->pair.cdr = cdr;
return object;
}
@ -107,11 +109,11 @@ struct Object *Object_build_list(int count, ...)
Object_new_pair(va_arg(va, struct Object*), NULL);
if (last) {
last->pair.b = new_pair;
last->pair.cdr = new_pair;
last = new_pair;
} else {
last = new_pair;
list->pair.b = last;
list->pair.cdr = last;
}
}
@ -172,7 +174,7 @@ size_t Object_list_length(struct Object *list_obj)
while (!OBJECT_IS_NULL(list_obj)) {
++length;
assert(Object_is_pair(list_obj));
list_obj = list_obj->pair.b;
list_obj = list_obj->pair.cdr;
}
return length;
}
@ -202,8 +204,8 @@ struct Object *Object_procedure_call(
struct Object *arg = args;
for (size_t index = 0; index < args_count; ++index) {
assert(Object_is_pair(arg));
args_array[index] = arg->pair.a;
arg = arg->pair.b;
args_array[index] = arg->pair.car;
arg = arg->pair.cdr;
}
struct Object *const result =

39
src/object.h
View File

@ -15,18 +15,39 @@ enum Type {
TYPE_NUMBER,
};
/*************
* Procedure *
*************/
typedef struct Object *(*Procedure_Func)(
size_t args_count,
struct Object **args_array
);
struct Procedure {
char *name;
Procedure_Func func;
};
/********
* Pair *
********/
struct Pair {
struct Object *car, *cdr;
};
/**********
* Object *
**********/
struct Object {
enum Type type;
union {
// For PROCEDURE
struct {
char *name;
struct Object *(*func)(size_t args_count, struct Object **args_array);
} procedure;
struct Procedure procedure;
// For PAIR
struct {
struct Object *a, *b;
} pair;
struct Pair pair;
// For BOOLEAN
bool boolean;
// For CHAR
@ -42,9 +63,9 @@ const char *Type_to_str(enum Type type);
struct Object *Object_new_procedure(
const char *name,
struct Object *(*func)(size_t args_count, struct Object **args_array)
Procedure_Func func
);
struct Object *Object_new_pair(struct Object *a, struct Object *b);
struct Object *Object_new_pair(struct Object *car, struct Object *cdr);
struct Object *Object_new_boolean(bool boolean);
struct Object *Object_new_char(char chr);
struct Object *Object_new_symbol(const char *s);

20
src/syntax.c
View File

@ -11,8 +11,8 @@ struct Object *syntax_begin(struct Object *args)
struct Object *result = NULL;
while (!OBJECT_IS_NULL(args)) {
assert(Object_is_pair(args));
result = eval(args->pair.a);
args = args->pair.b;
result = eval(args->pair.car);
args = args->pair.cdr;
}
return result;
}
@ -20,16 +20,16 @@ struct Object *syntax_begin(struct Object *args)
struct Object *syntax_if(struct Object *const args)
{
assert(Object_is_pair(args));
struct Object *const cond = args->pair.a;
struct Object *const then_else_list = args->pair.b;
struct Object *const cond = args->pair.car;
struct Object *const then_else_list = args->pair.cdr;
assert(then_else_list);
assert(Object_is_pair(then_else_list));
struct Object *const then_branch = then_else_list->pair.a;
struct Object *const else_list = then_else_list->pair.b;
struct Object *const then_branch = then_else_list->pair.car;
struct Object *const else_list = then_else_list->pair.cdr;
assert(else_list);
assert(Object_is_pair(else_list));
struct Object *const else_branch = else_list->pair.a;
assert(OBJECT_IS_NULL(else_list->pair.b));
struct Object *const else_branch = else_list->pair.car;
assert(OBJECT_IS_NULL(else_list->pair.cdr));
if (Object_is_false(cond)) {
return eval(else_branch);
@ -41,6 +41,6 @@ struct Object *syntax_if(struct Object *const args)
struct Object *syntax_quote(struct Object *const args)
{
assert(Object_is_pair(args));
assert(OBJECT_IS_NULL(args->pair.b));
return args->pair.a;
assert(OBJECT_IS_NULL(args->pair.cdr));
return args->pair.car;
}