diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2015-11-19 20:36:21 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2015-11-20 16:17:20 -0800 |
commit | 3c09800abda31a3f5da8157b0ef2863850f6b662 (patch) | |
tree | c60d7424fab9b35ff6c4cb7ce344a9fb7cf57c72 /lib.c | |
parent | 4caf98c502bf3cc80e20dba74eb941f50b58216e (diff) | |
download | txr-3c09800abda31a3f5da8157b0ef2863850f6b662.tar.gz txr-3c09800abda31a3f5da8157b0ef2863850f6b662.tar.bz2 txr-3c09800abda31a3f5da8157b0ef2863850f6b662.zip |
New equality substitution.
If the equal method is defined for structs, its return
value is used in their place for hashing and comparison.
* eval.h (eq_s, eql_s, equal_s): Declared.
* hash.c (equal_hash): If a COBJ defines an equalsub
function, we call it. If it returns non-nil, we
take the object in its place and recurse.
* lib.c (equal): Refactored to support equality substitution.
(less): Support equality substitution.
* lib.h (cobj_ops): New function pointer member, equalsub.
Only struct instances define this, currently.
(cobj_ops_init): Add null entry to initializer for equalsub.
(cobj_ops_init_ex): New initialiation macro for
situations when the equalsub member must be provided.
* struct.c (struct struct_type): new member eqmslot.
(make_struct_type): Initialize emslot to zero.
(static_slot_set, static_slot_ensure): If eqmslot is -1,
indicating positive knowledge that there is no equal method
static slot, we must invalidate that with a zero: it is no
longer known whether there is or isn't such a slot.
(get_equal_method, struct_inst_equalsub): New static functions.
(struct_inst_ops): Initialize the equalsub member using
new cobj_ops_init_ex macro.
* txr.1: Document equality substitution.
Diffstat (limited to 'lib.c')
-rw-r--r-- | lib.c | 99 |
1 files changed, 73 insertions, 26 deletions
@@ -2066,16 +2066,16 @@ val equal(val left, val right) case NIL: case CHR: case NUM: - return nil; + break; case CONS: case LCONS: - if ((type(right) == CONS || type(right) == LCONS) && - equal(car(left), car(right)) && - equal(cdr(left), cdr(right))) + if (type(right) == CONS || type(right) == LCONS) { - return t; + if (equal(car(left), car(right)) && equal(cdr(left), cdr(right))) + return t; + return nil; } - return nil; + break; case LIT: switch (type(right)) { case LIT: @@ -2085,10 +2085,12 @@ val equal(val left, val right) case LSTR: lazy_str_force(right); return equal(left, right->ls.prefix); - default: + case COBJ: break; + default: + return nil; } - return nil; + break; case STR: switch (type(right)) { case LIT: @@ -2098,14 +2100,16 @@ val equal(val left, val right) case LSTR: lazy_str_force(right); return equal(left, right->ls.prefix); - default: + case COBJ: break; + default: + return nil; } - return nil; + break; case SYM: case PKG: case ENV: - return right == left ? t : nil; + break; case FUN: if (type(right) == FUN && left->f.functype == right->f.functype && @@ -2129,7 +2133,7 @@ val equal(val left, val right) } return nil; } - return nil; + break; case VEC: if (type(right) == VEC) { cnum i, length; @@ -2142,7 +2146,7 @@ val equal(val left, val right) } return t; } - return nil; + break; case LSTR: switch (type(right)) { case LIT: @@ -2150,31 +2154,57 @@ val equal(val left, val right) case LSTR: lazy_str_force(left); return equal(left->ls.prefix, right); - default: + case COBJ: break; + default: + return nil; } return nil; case BGNUM: - if (type(right) == BGNUM && mp_cmp(mp(left), mp(right)) == MP_EQ) - return t; - return nil; + if (type(right) == BGNUM) { + if (mp_cmp(mp(left), mp(right)) == MP_EQ) + return t; + return nil; + } + break; case FLNUM: - if (type(right) == FLNUM && left->fl.n == right->fl.n) - return t; - return nil; + if (type(right) == FLNUM) { + if (left->fl.n == right->fl.n) + return t; + return nil; + } + break; case RNG: - if (type(right) == RNG && - equal(from(left), from(right)) && - equal(to(left), to(right))) - return t; - return nil; + if (type(right) == RNG) { + if (equal(from(left), from(right)) && + equal(to(left), to(right))) + return t; + return nil; + } + break; case COBJ: + if (left->co.ops->equalsub) { + val lsub = left->co.ops->equalsub(left); + if (lsub) + return equal(lsub, right); + } + if (type(right) == COBJ && left->co.ops == right->co.ops) return left->co.ops->equal(left, right); + return nil; } - internal_error("unhandled case in equal function"); + if (type(right) != COBJ) + return nil; + + if (right->co.ops->equalsub) { + val rsub = right->co.ops->equalsub(right); + if (rsub) + return equal(left, rsub); + } + + return nil; } alloc_bytes_t malloc_bytes; @@ -3769,9 +3799,26 @@ val less(val left, val right) if (left == right) return nil; +tail: l_type = type(left); r_type = type(right); + if (l_type == COBJ && left->co.ops->equalsub) { + val lsub = left->co.ops->equalsub(left); + if (lsub) { + left = lsub; + goto tail; + } + } + + if (r_type == COBJ && right->co.ops->equalsub) { + val rsub = right->co.ops->equalsub(right); + if (rsub) { + right = rsub; + goto tail; + } + } + switch (less_tab[l_type][r_type]) { case less_false: return nil; |