From e585b52fb08b5185528402da8a205b05a5aab96b Mon Sep 17 00:00:00 2001 From: Alex Kotov Date: Tue, 9 May 2023 13:27:59 +0400 Subject: [PATCH] freezing; funcs "freeze", "frozen?" --- Makefile | 1 + src/builtins.c | 97 ++++++++++++++++++++++++++++++++++------------ src/object.c | 17 ++++---- src/object.h | 1 + tests/freezing.scm | 32 +++++++++++++++ 5 files changed, 115 insertions(+), 33 deletions(-) create mode 100644 tests/freezing.scm diff --git a/Makefile b/Makefile index 7167146..ba8471e 100644 --- a/Makefile +++ b/Makefile @@ -35,6 +35,7 @@ test: arcana-lisp $(CAT) tests/arithm_ops.scm | ./arcana-lisp $(LIBS) $(CAT) tests/basic_data_structs.scm | ./arcana-lisp $(LIBS) $(CAT) tests/equiv.scm | ./arcana-lisp $(LIBS) + $(CAT) tests/freezing.scm | ./arcana-lisp $(LIBS) $(CAT) tests/lists.scm | ./arcana-lisp $(LIBS) $(CAT) tests/logic_ops.scm | ./arcana-lisp $(LIBS) $(CAT) tests/syntax.scm | ./arcana-lisp $(LIBS) diff --git a/src/builtins.c b/src/builtins.c index 56b8ae6..5081f4c 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -20,6 +20,9 @@ static struct Object *func_arcana_SLASH_builtin(size_t args_count, struct Object static struct Object *func_arcana_SLASH_parse(size_t args_count, struct Object **args_array); static struct Object *func_arcana_SLASH_tokenize(size_t args_count, struct Object **args_array); static struct Object *func_arcana_SLASH_typeof(size_t args_count, struct Object **args_array); +// Freezing +static struct Object *func_freeze(size_t args_count, struct Object **args_array); +static struct Object *func_frozen_QN(size_t args_count, struct Object **args_array); // Basic data structures static struct Object *func_car(size_t args_count, struct Object **args_array); static struct Object *func_cdr(size_t args_count, struct Object **args_array); @@ -42,39 +45,51 @@ static struct Object *func_MINUS(size_t args_count, struct Object **args_array); static struct Object *func_display(size_t args_count, struct Object **args_array); static struct Object *func_newline(size_t args_count, struct Object **args_array); +#define BUILTIN(name_str, func_name) { \ + .type = TYPE_PROCEDURE, \ + .is_frozen = true, \ + .procedure = { \ + .name = name_str, \ + .func = func_##func_name, \ + }, \ +} + static struct Object builtins[] = { // Assertions - { .type = TYPE_PROCEDURE, .procedure = { "assert-equal", func_assert_equal } }, - { .type = TYPE_PROCEDURE, .procedure = { "assert-false", func_assert_false } }, - { .type = TYPE_PROCEDURE, .procedure = { "assert-true", func_assert_true } }, + BUILTIN("assert-equal", assert_equal), + BUILTIN("assert-false", assert_false), + BUILTIN("assert-true", assert_true), // Arcana Lisp internals - { .type = TYPE_PROCEDURE, .procedure = { "arcana/builtin", func_arcana_SLASH_builtin } }, - { .type = TYPE_PROCEDURE, .procedure = { "arcana/parse", func_arcana_SLASH_parse } }, - { .type = TYPE_PROCEDURE, .procedure = { "arcana/tokenize", func_arcana_SLASH_tokenize } }, - { .type = TYPE_PROCEDURE, .procedure = { "arcana/typeof", func_arcana_SLASH_typeof } }, + BUILTIN("arcana/builtin", arcana_SLASH_builtin), + BUILTIN("arcana/parse", arcana_SLASH_parse), + BUILTIN("arcana/tokenize", arcana_SLASH_tokenize), + BUILTIN("arcana/typeof", arcana_SLASH_typeof), + // Freezing + BUILTIN("freeze", freeze), + BUILTIN("frozen?", frozen_QN), // Basic data structures - { .type = TYPE_PROCEDURE, .procedure = { "car", func_car } }, - { .type = TYPE_PROCEDURE, .procedure = { "cdr", func_cdr } }, - { .type = TYPE_PROCEDURE, .procedure = { "cons", func_cons } }, - { .type = TYPE_PROCEDURE, .procedure = { "list", func_list } }, + BUILTIN("car", car), + BUILTIN("cdr", cdr), + BUILTIN("cons", cons), + BUILTIN("list", list), // Equivalence predicates - { .type = TYPE_PROCEDURE, .procedure = { "equal?", func_equal_QN } }, + BUILTIN("equal?", equal_QN), // Type equivalence predicates - { .type = TYPE_PROCEDURE, .procedure = { "boolean=?", func_boolean_EQ_QN } }, - { .type = TYPE_PROCEDURE, .procedure = { "symbol=?", func_symbol_EQ_QN } }, + BUILTIN("boolean=?", boolean_EQ_QN), + BUILTIN("symbol=?", symbol_EQ_QN), // Type conversion - { .type = TYPE_PROCEDURE, .procedure = { "number->string", func_number_TO_string } }, - { .type = TYPE_PROCEDURE, .procedure = { "string->symbol", func_string_TO_symbol } }, - { .type = TYPE_PROCEDURE, .procedure = { "symbol->string", func_symbol_TO_string } }, + BUILTIN("number->string", number_TO_string), + BUILTIN("string->symbol", string_TO_symbol), + BUILTIN("symbol->string", symbol_TO_string), // Arithmetic operators - { .type = TYPE_PROCEDURE, .procedure = { "=", func_EQ } }, - { .type = TYPE_PROCEDURE, .procedure = { "+", func_PLUS } }, - { .type = TYPE_PROCEDURE, .procedure = { "-", func_MINUS } }, + BUILTIN("=", EQ), + BUILTIN("+", PLUS), + BUILTIN("-", MINUS), // IO - { .type = TYPE_PROCEDURE, .procedure = { "display", func_display } }, - { .type = TYPE_PROCEDURE, .procedure = { "newline", func_newline } }, + BUILTIN("display", display), + BUILTIN("newline", newline), // NULL - { .type = TYPE_PROCEDURE, .procedure = { NULL, NULL } }, + { .type = TYPE_PROCEDURE, .is_frozen = true, .procedure = { NULL, NULL } }, }; struct Object *builtins_get(const char *name) @@ -286,6 +301,30 @@ struct Object *func_arcana_SLASH_typeof( return NULL; } +/************ + * Freezing * + ************/ + +struct Object *func_freeze( + const size_t args_count, + struct Object **const args_array +) { + assert(args_count == 1); + if (!OBJECT_IS_NULL(args_array[0])) args_array[0]->is_frozen = true; + return args_array[0]; +} + +struct Object *func_frozen_QN( + const size_t args_count, + struct Object **const args_array +) { + assert(args_count == 1); + return Object_new_boolean( + OBJECT_IS_NULL(args_array[0]) || + args_array[0]->is_frozen + ); +} + /************************* * Basic data structures * *************************/ @@ -359,8 +398,16 @@ struct Object *func_equal_QN( switch (first->type) { case TYPE_PROCEDURE: - result->boolean = - !strcmp(first->procedure.name, curr->procedure.name); + // Built-in + if (first->procedure.func) { + result->boolean = + curr->procedure.func && + !strcmp(first->procedure.name, curr->procedure.name); + } + // Lambda + else { + result->boolean = curr == first; + } break; case TYPE_PAIR: { diff --git a/src/object.c b/src/object.c index 3d8d453..a962551 100644 --- a/src/object.c +++ b/src/object.c @@ -27,12 +27,13 @@ const char *Type_to_str(const enum Type type) * Creation * ************/ -static struct Object *new(const enum Type type) +static struct Object *new(const enum Type type, const bool is_frozen) { struct Object *const object = malloc(sizeof(struct Object)); assert(object); memset(object, 0, sizeof(struct Object)); object->type = type; + object->is_frozen = is_frozen; return object; } @@ -40,7 +41,7 @@ struct Object *Object_new_pair( struct Object *const car, struct Object *const cdr ) { - struct Object *const object = new(TYPE_PAIR); + struct Object *const object = new(TYPE_PAIR, false); object->pair.car = car; object->pair.cdr = cdr; return object; @@ -48,21 +49,21 @@ struct Object *Object_new_pair( struct Object *Object_new_boolean(const bool boolean) { - struct Object *const object = new(TYPE_BOOLEAN); + struct Object *const object = new(TYPE_BOOLEAN, true); object->boolean = boolean; return object; } struct Object *Object_new_char(const char chr) { - struct Object *const object = new(TYPE_CHAR); + struct Object *const object = new(TYPE_CHAR, true); object->chr = chr; return object; } struct Object *Object_new_symbol(const char *const s) { - struct Object *const object = new(TYPE_SYMBOL); + struct Object *const object = new(TYPE_SYMBOL, true); object->s = malloc(strlen(s) + 1); assert(object->s); strcpy(object->s, s); @@ -71,7 +72,7 @@ struct Object *Object_new_symbol(const char *const s) struct Object *Object_new_string(const char *const s) { - struct Object *const object = new(TYPE_STRING); + struct Object *const object = new(TYPE_STRING, false); object->s = malloc(strlen(s) + 1); assert(object->s); strcpy(object->s, s); @@ -80,7 +81,7 @@ struct Object *Object_new_string(const char *const s) struct Object *Object_new_number(const int64_t i64) { - struct Object *const object = new(TYPE_NUMBER); + struct Object *const object = new(TYPE_NUMBER, true); object->number.i64 = i64; return object; } @@ -101,7 +102,7 @@ struct Object *Object_new_lambda( assert(Object_is_symbol(arg_name->pair.car)); } - struct Object *const object = new(TYPE_PROCEDURE); + struct Object *const object = new(TYPE_PROCEDURE, true); object->procedure.name = NULL; if (name && name[0]) { object->procedure.name = malloc(strlen(name) + 1); diff --git a/src/object.h b/src/object.h index baae3f6..70bfe9e 100644 --- a/src/object.h +++ b/src/object.h @@ -56,6 +56,7 @@ struct Number { struct Object { enum Type type; + bool is_frozen; union { // For PROCEDURE struct Procedure procedure; diff --git a/tests/freezing.scm b/tests/freezing.scm new file mode 100644 index 0000000..e1741b7 --- /dev/null +++ b/tests/freezing.scm @@ -0,0 +1,32 @@ +;;; frozen? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-true (frozen? +)) +(assert-true (frozen? (lambda (x) x))) +(assert-true (frozen? '())) +(assert-true (frozen? #false)) +;(assert-true (frozen? #\n)) +(assert-true (frozen? 'foo)) +(assert-false (frozen? "foo")) +(assert-true (frozen? 123)) +(assert-false (frozen? (cons 123 456))) + +;;; freeze ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal + (freeze +)) +(let ([f (lambda (x) x)]) + (assert-equal f (freeze f))) +(assert-equal '() (freeze '())) +(assert-equal #false (freeze #false)) +;(assert-equal #\n (freeze #\n)) +(assert-equal 'foo (freeze 'foo)) +(assert-equal "foo" (freeze "foo")) +(assert-equal 123 (freeze 123)) +(assert-equal (cons 123 456) (freeze (cons 123 456))) + +(assert-true (frozen? (freeze +))) +(assert-true (frozen? (freeze (lambda (x) x)))) +(assert-true (frozen? (freeze '()))) +(assert-true (frozen? (freeze #false))) +;(assert-true (frozen? (freeze #\n))) +(assert-true (frozen? (freeze 'foo))) +(assert-true (frozen? (freeze "foo"))) +(assert-true (frozen? (freeze 123))) +(assert-true (frozen? (freeze (cons 123 456))))