diff --git a/src/consspaceobject.h b/src/consspaceobject.h index 5526e8c..0d92e25 100644 --- a/src/consspaceobject.h +++ b/src/consspaceobject.h @@ -8,6 +8,7 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include #include @@ -52,6 +53,7 @@ /** * true if conspointer points to the special cell NIL, else false + * (there should only be one of these so it's slightly redundant). */ #define nilp(conspoint) (check_tag(conspoint,NILTAG)) @@ -65,6 +67,35 @@ */ #define stringp(conspoint) (check_tag(conspoint,STRINGTAG)) +/** + * true if conspointer points to an integer cell, else false + */ +#define integerp(conspoint) (check_tag(conspoint,INTEGERTAG)) + +/** + * true if conspointer points to a real number cell, else false + */ +#define realp(conspoint) (check_tag(conspoint,REALTAG)) + +/** + * true if conspointer points to some sort of a number cell, + * else false + */ +#define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,REALTAG)) + +/** + * true if conspointer points to a true cell, else false + * (there should only be one of these so it's slightly redundant). + * Also note that anything that is not NIL is truthy. + */ +#define tp(conspoint) (checktag(conspoint,TRUETAG)) + +/** + * true if conspoint points to something that is truthy, i.e. + * anything but NIL. + */ +#define truep(conspoint) (!checktag(conspoint,NILTAG)) + /** * An indirect pointer to a cons cell */ diff --git a/src/equal.c b/src/equal.c new file mode 100644 index 0000000..3b5cc6b --- /dev/null +++ b/src/equal.c @@ -0,0 +1,62 @@ +/** + * equal.c + * + * Checks for shallow and deep equality + * + * (c) 2017 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include +#include + +#include "conspage.h" +#include "consspaceobject.h" +#include "integer.h" + +/** + * Shallow, and thus cheap, equality: true if these two objects are + * the same object, else false. + */ +bool eq( struct cons_pointer a, struct cons_pointer b) { + return ((a.page == b.page) && (a.offset == b.offset)); +} + + +/** + * Deep, and thus expensive, equality: true if these two objects have + * identical structure, else false. + */ +bool equal( struct cons_pointer a, struct cons_pointer b) { + bool result = eq( a, b); + + if ( ! result) { + struct cons_space_object* cell_a = &pointer2cell( a); + struct cons_space_object* cell_b = &pointer2cell( b); + + if ( consp( a) && consp( b)) { + result = equal( cell_a->payload.cons.car, cell_b->payload.cons.car) && + equal( cell_a->payload.cons.cdr, cell_b->payload.cons.cdr); + } else if ( stringp( a) && stringp( b)) { + /* slightly complex because a string may or may not have a '\0' cell + * at the end, but I'll ignore that for now. I think in practice only + * the empty string will. */ + result = cell_a->payload.string.character == cell_b->payload.string.character && + equal( cell_a->payload.string.cdr, cell_b->payload.string.cdr); + } else if ( numberp( a) && numberp( b)) { + double num_a = numeric_value( a); + double num_b = numeric_value( b); + double max = fabs( num_a) > fabs( num_b) ? fabs( num_a) : fabs( num_b); + + /* not more different than one part in a million - close enough */ + result = fabs( num_a - num_b) < (max / 1000000.0); + } + /* there's only supposed ever to be one T and one NIL cell, so each should + * be caught by eq; equality of vector-space objects is a whole other ball + * game so we won't deal with it now (and indeedmay never). I'm not certain + * what equality means for read and write streams, so I'll ignore them, too, + * for now.*/ + } + + return result; +} diff --git a/src/equal.h b/src/equal.h new file mode 100644 index 0000000..502dd32 --- /dev/null +++ b/src/equal.h @@ -0,0 +1,28 @@ +/** + * equal.h + * + * Checks for shallow and deep equality + * + * (c) 2017 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include +#include + +#ifndef __equal_h +#define __equal_h + +/** + * Shallow, and thus cheap, equality: true if these two objects are + * the same object, else false. + */ +bool eq( struct cons_pointer a, struct cons_pointer b); + +/** + * Deep, and thus expensive, equality: true if these two objects have + * identical structure, else false. + */ +bool equal( struct cons_pointer a, struct cons_pointer b); + +#endif diff --git a/src/integer.c b/src/integer.c index 1493c9d..8f7b044 100644 --- a/src/integer.c +++ b/src/integer.c @@ -7,10 +7,32 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#define _GNU_SOURCE +#include + #include "conspage.h" #include "consspaceobject.h" #include "read.h" +/** + * return the numeric value of this cell, as a C primitive double, not + * as a cons-space object. Cell may in principle be any kind of number, + * but only integers and reals are so far implemented. + */ +double numeric_value( struct cons_pointer pointer) { + double result = NAN; + struct cons_space_object* cell = &pointer2cell(pointer); + + if ( integerp( pointer)) { + result = (double) cell->payload.integer.value; + } else if ( realp( pointer)) { + result = cell->payload.real.value; + } + + return result; +} + + /** * Allocate an integer cell representing this value and return a cons pointer to it. */ diff --git a/src/integer.h b/src/integer.h index 83f4f57..5d1df67 100644 --- a/src/integer.h +++ b/src/integer.h @@ -11,6 +11,8 @@ #ifndef __integer_h #define __integer_h +double numeric_value( struct cons_pointer pointer); + /** * Allocate an integer cell representing this value and return a cons pointer to it. */ diff --git a/src/print.c b/src/print.c index be6cac8..479454e 100644 --- a/src/print.c +++ b/src/print.c @@ -60,6 +60,9 @@ void print_list( FILE* output, struct cons_pointer pointer) { void print( FILE* output, struct cons_pointer pointer) { struct cons_space_object cell = pointer2cell( pointer); + /* Because tags have values as well as bytes, this if ... else if + * statement can ultimately be replaced by a switch, which will + * be neater. */ if ( check_tag( pointer, CONSTAG)) { print_list( output, pointer); } else if ( check_tag( pointer, INTEGERTAG)) {