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

freezing; funcs "freeze", "frozen?"

This commit is contained in:
Alex Kotov 2023-05-09 13:27:59 +04:00
parent ab3f62cc0c
commit e585b52fb0
Signed by: kotovalexarian
GPG Key ID: 553C0EBBEB5D5F08
5 changed files with 115 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile
View File

@ -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)

97
src/builtins.c
View File

@ -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:
{

17
src/object.c
View File

@ -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);

1
src/object.h
View File

@ -56,6 +56,7 @@ struct Number {
struct Object {
enum Type type;
bool is_frozen;
union {
// For PROCEDURE
struct Procedure procedure;

32
tests/freezing.scm Normal file
View File

@ -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))))