freezing; funcs "freeze", "frozen?"

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)

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          } },
+    BUILTIN("assert-equal", assert_equal),
-    { .type = TYPE_PROCEDURE, .procedure = { "assert-false",    func_assert_false          } },
+    BUILTIN("assert-false", assert_false),
-    { .type = TYPE_PROCEDURE, .procedure = { "assert-true",     func_assert_true           } },
+    BUILTIN("assert-true",  assert_true),
     // Arcana Lisp internals
-    { .type = TYPE_PROCEDURE, .procedure = { "arcana/builtin",  func_arcana_SLASH_builtin  } },
+    BUILTIN("arcana/builtin",  arcana_SLASH_builtin),
-    { .type = TYPE_PROCEDURE, .procedure = { "arcana/parse",    func_arcana_SLASH_parse    } },
+    BUILTIN("arcana/parse",    arcana_SLASH_parse),
-    { .type = TYPE_PROCEDURE, .procedure = { "arcana/tokenize", func_arcana_SLASH_tokenize } },
+    BUILTIN("arcana/tokenize", arcana_SLASH_tokenize),
-    { .type = TYPE_PROCEDURE, .procedure = { "arcana/typeof",   func_arcana_SLASH_typeof   } },
+    BUILTIN("arcana/typeof",   arcana_SLASH_typeof),
+    // Freezing
+    BUILTIN("freeze",  freeze),
+    BUILTIN("frozen?", frozen_QN),
     // Basic data structures
-    { .type = TYPE_PROCEDURE, .procedure = { "car",             func_car                   } },
+    BUILTIN("car",  car),
-    { .type = TYPE_PROCEDURE, .procedure = { "cdr",             func_cdr                   } },
+    BUILTIN("cdr",  cdr),
-    { .type = TYPE_PROCEDURE, .procedure = { "cons",            func_cons                  } },
+    BUILTIN("cons", cons),
-    { .type = TYPE_PROCEDURE, .procedure = { "list",            func_list                  } },
+    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         } },
+    BUILTIN("boolean=?", boolean_EQ_QN),
-    { .type = TYPE_PROCEDURE, .procedure = { "symbol=?",        func_symbol_EQ_QN          } },
+    BUILTIN("symbol=?",  symbol_EQ_QN),
     // Type conversion
-    { .type = TYPE_PROCEDURE, .procedure = { "number->string",  func_number_TO_string      } },
+    BUILTIN("number->string", number_TO_string),
-    { .type = TYPE_PROCEDURE, .procedure = { "string->symbol",  func_string_TO_symbol      } },
+    BUILTIN("string->symbol", string_TO_symbol),
-    { .type = TYPE_PROCEDURE, .procedure = { "symbol->string",  func_symbol_TO_string      } },
+    BUILTIN("symbol->string", symbol_TO_string),
     // Arithmetic operators
-    { .type = TYPE_PROCEDURE, .procedure = { "=",               func_EQ                    } },
+    BUILTIN("=", EQ),
-    { .type = TYPE_PROCEDURE, .procedure = { "+",               func_PLUS                  } },
+    BUILTIN("+", PLUS),
-    { .type = TYPE_PROCEDURE, .procedure = { "-",               func_MINUS                 } },
+    BUILTIN("-", MINUS),
     // IO
-    { .type = TYPE_PROCEDURE, .procedure = { "display",         func_display               } },
+    BUILTIN("display", display),
-    { .type = TYPE_PROCEDURE, .procedure = { "newline",         func_newline               } },
+    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 =
+                // Built-in
-                    !strcmp(first->procedure.name, curr->procedure.name);
+                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:
             {

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

src/object.h

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

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