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

funcs "boolean=?", "symbol=?"

This commit is contained in:
Alex Kotov 2023-05-09 12:41:58 +04:00
parent 8748f2722c
commit ab3f62cc0c
Signed by: kotovalexarian
GPG Key ID: 553C0EBBEB5D5F08
3 changed files with 97 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile
View File

@ -39,6 +39,7 @@ test: arcana-lisp
$(CAT) tests/logic_ops.scm | ./arcana-lisp $(LIBS)
$(CAT) tests/syntax.scm | ./arcana-lisp $(LIBS)
$(CAT) tests/type_conv.scm | ./arcana-lisp $(LIBS)
$(CAT) tests/type_equiv_preds.scm | ./arcana-lisp $(LIBS)
$(CAT) tests/type_preds.scm | ./arcana-lisp $(LIBS)
clean:

58
src/builtins.c
View File

@ -27,6 +27,9 @@ static struct Object *func_cons(size_t args_count, struct Object **args_array);
static struct Object *func_list(size_t args_count, struct Object **args_array);
// Equivalence predicates
static struct Object *func_equal_QN(size_t args_count, struct Object **args_array);
// Type equivalence predicates
static struct Object *func_boolean_EQ_QN(size_t args_count, struct Object **args_array);
static struct Object *func_symbol_EQ_QN(size_t args_count, struct Object **args_array);
// Type conversion
static struct Object *func_number_TO_string(size_t args_count, struct Object **args_array);
static struct Object *func_string_TO_symbol(size_t args_count, struct Object **args_array);
@ -56,6 +59,9 @@ static struct Object builtins[] = {
{ .type = TYPE_PROCEDURE, .procedure = { "list", func_list } },
// Equivalence predicates
{ .type = TYPE_PROCEDURE, .procedure = { "equal?", func_equal_QN } },
// Type equivalence predicates
{ .type = TYPE_PROCEDURE, .procedure = { "boolean=?", func_boolean_EQ_QN } },
{ .type = TYPE_PROCEDURE, .procedure = { "symbol=?", func_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 } },
@ -332,7 +338,7 @@ struct Object *func_list(
**************************/
struct Object *func_equal_QN(
size_t args_count,
const size_t args_count,
struct Object **const args_array
) {
if (args_count <= 1) return Object_new_boolean(true);
@ -389,6 +395,56 @@ struct Object *func_equal_QN(
return result;
}
/*******************************
* Type equivalence predicates *
*******************************/
struct Object *func_boolean_EQ_QN(
const size_t args_count,
struct Object **const args_array
) {
assert(args_count > 0);
struct Object *const first = args_array[0];
assert(Object_is_boolean(first));
struct Object *const result = Object_new_boolean(true);
for (size_t index = 1; result->boolean && index < args_count; ++index) {
assert(Object_is_boolean(args_array[index]));
}
for (size_t index = 1; result->boolean && index < args_count; ++index) {
struct Object *const curr = args_array[index];
if (curr->boolean != first->boolean) result->boolean = false;
}
return result;
}
struct Object *func_symbol_EQ_QN(
const size_t args_count,
struct Object **const args_array
) {
assert(args_count > 0);
struct Object *const first = args_array[0];
assert(Object_is_symbol(first));
struct Object *const result = Object_new_boolean(true);
for (size_t index = 1; result->boolean && index < args_count; ++index) {
assert(Object_is_symbol(args_array[index]));
}
for (size_t index = 1; result->boolean && index < args_count; ++index) {
struct Object *const curr = args_array[index];
if (strcmp(curr->s, first->s)) result->boolean = false;
}
return result;
}
/*******************
* Type conversion *
*******************/

39
tests/type_equiv_preds.scm Normal file
View File

@ -0,0 +1,39 @@
;;; boolean=? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-true (boolean=? #false))
(assert-true (boolean=? #true))
(assert-true (boolean=? #false #false))
(assert-true (boolean=? #true #true))
(assert-true (boolean=? #false #false #false))
(assert-true (boolean=? #true #true #true))
(assert-true (boolean=? #false #false #false #false))
(assert-true (boolean=? #true #true #true #true))
(assert-true (boolean=? #false #false #false #false #false))
(assert-true (boolean=? #true #true #true #true #true))
(assert-false (boolean=? #false #true))
(assert-false (boolean=? #true #false))
(assert-false (boolean=? #false #false #true))
(assert-false (boolean=? #false #true #false))
(assert-false (boolean=? #false #true #true))
(assert-false (boolean=? #true #false #false))
(assert-false (boolean=? #true #false #true))
(assert-false (boolean=? #true #true #false))
;;; symbol=? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-true (symbol=? 'foo))
(assert-true (symbol=? 'bar))
(assert-true (symbol=? 'foo 'foo))
(assert-true (symbol=? 'bar 'bar))
(assert-true (symbol=? 'foo 'foo 'foo))
(assert-true (symbol=? 'bar 'bar 'bar))
(assert-true (symbol=? 'foo 'foo 'foo 'foo))
(assert-true (symbol=? 'bar 'bar 'bar 'bar))
(assert-true (symbol=? 'foo 'foo 'foo 'foo 'foo))
(assert-true (symbol=? 'bar 'bar 'bar 'bar 'bar))
(assert-false (symbol=? 'foo 'bar))
(assert-false (symbol=? 'bar 'foo))
(assert-false (symbol=? 'foo 'foo 'bar))
(assert-false (symbol=? 'foo 'bar 'foo))
(assert-false (symbol=? 'foo 'bar 'bar))
(assert-false (symbol=? 'bar 'foo 'foo))
(assert-false (symbol=? 'bar 'foo 'bar))
(assert-false (symbol=? 'bar 'bar 'foo))