From 714d7e7608c1dbe484318baf300a40ca24fb6018 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Tue, 23 Jan 2018 17:22:27 -0800 Subject: [PATCH 1/8] use explicit stack in unifying equals --- include/noun/allocate.h | 16 ++ noun/allocate.c | 59 +++++++ noun/retrieve.c | 378 ++++++++++++++++++++++------------------ 3 files changed, 285 insertions(+), 168 deletions(-) diff --git a/include/noun/allocate.h b/include/noun/allocate.h index 1549948f80..075b12d2fe 100644 --- a/include/noun/allocate.h +++ b/include/noun/allocate.h @@ -291,6 +291,22 @@ void* u3a_wealloc(void* lag_v, c3_w len_w); + /* u3a_push(): allocate space on the road stack + */ + void* + u3a_push(c3_w len_w); + + /* u3a_pop(): deallocate space on the road stack + */ + void + u3a_pop(c3_w len_w); + + /* u3a_peek(): examine the top of the road stack + */ + void* + u3a_peek(c3_w len_w); + + /* C-style aligned allocation - *not* compatible with above. */ /* u3a_malloc(): aligned storage measured in bytes. diff --git a/noun/allocate.c b/noun/allocate.c index f8dd50f318..fcd216cc09 100644 --- a/noun/allocate.c +++ b/noun/allocate.c @@ -576,6 +576,65 @@ u3a_wealloc(void* lag_v, c3_w len_w) } } } +/* u3a_push(): allocate space on the road stack +*/ +void* +u3a_push(c3_w len_w) +{ + void *cur, *top = u3to(void, u3R->cap_p); + if ( c3y == u3a_is_north(u3R) ) { + top -= len_w; + cur = top; + u3R->cap_p = u3of(void, top); + if ( (u3R->cap_p <= u3R->hat_p) ) { + u3m_bail(c3__fail); + } + else { + return cur; + } + } + else { + cur = top; + top += len_w; + u3R->cap_p = u3of(void, top); + if (u3R->cap_p >= u3R->hat_p) { + u3m_bail(c3__fail); + } + else { + return cur; + } + } +} + +/* u3a_pop(): deallocate space on the road stack +*/ +void +u3a_pop(c3_w len_w) +{ + void* top = u3to(void, u3R->cap_p); + if ( c3y == u3a_is_north(u3R) ) { + top += len_w; + u3R->cap_p = u3of(void, top); + if ( u3R->cap_p > u3R->mat_p ) { + u3m_bail(c3__fail); + } + } + else { + top -= len_w; + u3R->cap_p = u3of(void, top); + if ( u3R->cap_p < u3R->mat_p ) { + u3m_bail(c3__fail); + } + } +} + +/* u3a_peek(): examine the top of the road stack +*/ +void* +u3a_peek(c3_w len_w) +{ + return u3to(void, u3R->cap_p) - (c3y == u3a_is_north(u3R) ? 0 : len_w); +} /* u3a_wfree(): free storage. */ diff --git a/noun/retrieve.c b/noun/retrieve.c index 4000074894..5c15fca5d5 100644 --- a/noun/retrieve.c +++ b/noun/retrieve.c @@ -502,87 +502,119 @@ _sang_one(u3_noun* a, u3_noun* b) } } +typedef struct { + u3_noun a; + u3_noun b; + c3_t returning; +} eqframe; + +static inline eqframe* +_eq_peek() +{ + return (eqframe*) u3a_peek(sizeof(eqframe)); +} + +static inline void +_eq_push(u3_noun a, u3_noun b) +{ + eqframe* cur = (eqframe*) u3a_push(sizeof(eqframe)); + cur->a = a; + cur->b = b; + cur->returning = 0; +} + +static inline void +_eq_pop() +{ + u3a_pop(sizeof(eqframe)); +} + +#define _eq_yes _eq_pop(); continue +#define _eq_no u3R->cap_p = empty; return c3n + /* _sang_x(): yes if a and b are the same noun, unifying but leaking. */ static c3_o _sang_x(u3_noun a, u3_noun b) { - if ( a == b ) { - return c3y; - } - else { - if ( _(u3a_is_atom(a)) ) { - u3a_atom* a_u = u3a_to_ptr(a); + u3p(eqframe) empty = u3R->cap_p; + eqframe *fam; - if ( !_(u3a_is_atom(b)) || - _(u3a_is_cat(a)) || - _(u3a_is_cat(b)) ) - { - return c3n; - } - else { - u3a_atom* b_u = u3a_to_ptr(b); - - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - return c3n; - } - else { - c3_w w_rez = a_u->len_w; - c3_w w_mox = b_u->len_w; - - if ( w_rez != w_mox ) { - return c3n; - } - else { - c3_w i_w; - - for ( i_w = 0; i_w < w_rez; i_w++ ) { - if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - return c3n; - } - } - return c3y; - } - } - } + _eq_push(a, b); + while ( empty != u3R->cap_p ) { + fam = _eq_peek(); + a = fam->a; + b = fam->b; + if ( fam->returning ) { + _sang_one(&a, &b); + _eq_yes; + } + else if ( a == b ) { + _eq_yes; } else { - if ( _(u3a_is_atom(b)) ) { - return c3n; - } - else { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); + if ( _(u3a_is_atom(a)) ) { + u3a_atom* a_u = u3a_to_ptr(a); - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) + if ( !_(u3a_is_atom(b)) || + _(u3a_is_cat(a)) || + _(u3a_is_cat(b)) ) { - return c3n; + _eq_no; } else { - if ( c3n == _sang_x(a_u->hed, b_u->hed) ) { - return c3n; + u3a_atom* b_u = u3a_to_ptr(b); + + if ( a_u->mug_w && + b_u->mug_w && + (a_u->mug_w != b_u->mug_w) ) + { + _eq_no; } else { - _sang_one(&a_u->hed, &b_u->hed); + c3_w w_rez = a_u->len_w; + c3_w w_mox = b_u->len_w; - if ( c3n == _sang_x(a_u->tel, b_u->tel) ) { - return c3n; + if ( w_rez != w_mox ) { + _eq_no; } else { - _sang_one(&a_u->tel, &b_u->tel); + c3_w i_w; - return c3y; + for ( i_w = 0; i_w < w_rez; i_w++ ) { + if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { + _eq_no; + } + } + _eq_yes; } } } } + else { + if ( _(u3a_is_atom(b)) ) { + _eq_no; + } + else { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + + if ( a_u->mug_w && + b_u->mug_w && + (a_u->mug_w != b_u->mug_w) ) + { + _eq_no; + } + else { + _eq_push(a_u->hed, b_u->hed); + _eq_push(a_u->tel, b_u->tel); + fam->returning = 1; + } + } + } } } + return c3y; } /* _sung_one(): pick a unified pointer for identical (a) and (b). @@ -674,82 +706,84 @@ _sung_one(u3_noun* a, u3_noun* b) static c3_o _sung_x(u3_noun a, u3_noun b) { - if ( a == b ) { - return c3y; - } - else { - if ( _(u3a_is_atom(a)) ) { - u3a_atom* a_u = u3a_to_ptr(a); + u3p(eqframe) empty = u3R->cap_p; + eqframe *fam; - if ( !_(u3a_is_atom(b)) || - _(u3a_is_cat(a)) || - _(u3a_is_cat(b)) ) - { - return c3n; - } - else { - u3a_atom* b_u = u3a_to_ptr(b); - - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - return c3n; - } - else { - c3_w w_rez = a_u->len_w; - c3_w w_mox = b_u->len_w; - - if ( w_rez != w_mox ) { - return c3n; - } - else { - c3_w i_w; - - for ( i_w = 0; i_w < w_rez; i_w++ ) { - if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - return c3n; - } - } - return c3y; - } - } - } + _eq_push(a, b); + while ( empty != u3R->cap_p ) { + fam = _eq_peek(); + a = fam->a; + b = fam->b; + if ( fam->returning ) { + _sung_one(&a, &b); + _eq_yes; + } + else if ( a == b ) { + _eq_yes; } else { - if ( _(u3a_is_atom(b)) ) { - return c3n; - } - else { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); + if ( _(u3a_is_atom(a)) ) { + u3a_atom* a_u = u3a_to_ptr(a); - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) + if ( !_(u3a_is_atom(b)) || + _(u3a_is_cat(a)) || + _(u3a_is_cat(b)) ) { - return c3n; + _eq_no; } else { - if ( c3n == _sung_x(a_u->hed, b_u->hed) ) { - return c3n; + u3a_atom* b_u = u3a_to_ptr(b); + + if ( a_u->mug_w && + b_u->mug_w && + (a_u->mug_w != b_u->mug_w) ) + { + _eq_no; } else { - _sung_one(&a_u->hed, &b_u->hed); + c3_w w_rez = a_u->len_w; + c3_w w_mox = b_u->len_w; - if ( c3n == _sung_x(a_u->tel, b_u->tel) ) { - return c3n; + if ( w_rez != w_mox ) { + _eq_no; } else { - _sung_one(&a_u->tel, &b_u->tel); + c3_w i_w; - return c3y; + for ( i_w = 0; i_w < w_rez; i_w++ ) { + if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { + _eq_no; + } + } + _eq_yes; } } } } + else { + if ( _(u3a_is_atom(b)) ) { + _eq_no; + } + else { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + + if ( a_u->mug_w && + b_u->mug_w && + (a_u->mug_w != b_u->mug_w) ) + { + _eq_no; + } + else { + _eq_push(a_u->hed, b_u->hed); + _eq_push(a_u->tel, b_u->tel); + fam->returning = 1; + } + } + } } } + return c3y; } /* _sing_x(): @@ -763,74 +797,82 @@ _sing_x(u3_noun a, c3_assert(u3_none != a); c3_assert(u3_none != b); - if ( a == b ) { - return c3y; - } - else { - if ( _(u3a_is_atom(a)) ) { - u3a_atom* a_u = u3a_to_ptr(a); + u3p(eqframe) empty = u3R->cap_p; + eqframe *fam; - if ( !_(u3a_is_atom(b)) || - _(u3a_is_cat(a)) || - _(u3a_is_cat(b)) ) - { - return c3n; - } - else { - u3a_atom* b_u = u3a_to_ptr(b); + _eq_push(a, b); - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - return c3n; - } - else { - c3_w w_rez = a_u->len_w; - c3_w w_mox = b_u->len_w; - - if ( w_rez != w_mox ) { - return c3n; - } - else { - c3_w i_w; - - for ( i_w = 0; i_w < w_rez; i_w++ ) { - if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - return c3n; - } - } - return c3y; - } - } - } + while ( empty != u3R->cap_p ) { + fam = _eq_peek(); + if ( fam->returning ) { + _eq_yes; + } + else if ( (a = fam->a) == (b = fam->b) ) { + _eq_yes; } else { - if ( _(u3a_is_atom(b)) ) { - return c3n; - } - else { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); + if ( _(u3a_is_atom(a)) ) { + u3a_atom* a_u = u3a_to_ptr(a); - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) + if ( !_(u3a_is_atom(b)) || + _(u3a_is_cat(a)) || + _(u3a_is_cat(b)) ) { - return c3n; + _eq_no; } else { - if ( c3n == _sing_x(u3a_h(a), u3a_h(b)) ) { - return c3n; + u3a_atom* b_u = u3a_to_ptr(b); + + if ( a_u->mug_w && + b_u->mug_w && + (a_u->mug_w != b_u->mug_w) ) + { + _eq_no; } - else if ( c3n == _sing_x(u3a_t(a), u3a_t(b)) ) { - return c3n; + else { + c3_w w_rez = a_u->len_w; + c3_w w_mox = b_u->len_w; + + if ( w_rez != w_mox ) { + _eq_no; + } + else { + c3_w i_w; + + for ( i_w = 0; i_w < w_rez; i_w++ ) { + if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { + _eq_no; + } + } + _eq_yes; + } + } + } + } + else { + if ( _(u3a_is_atom(b)) ) { + _eq_no; + } + else { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + + if ( a_u->mug_w && + b_u->mug_w && + (a_u->mug_w != b_u->mug_w) ) + { + _eq_no; + } + else { + _eq_push(a_u->hed, b_u->hed); + _eq_push(a_u->tel, b_u->tel); + fam->returning = 1; } - return c3y; } } } } + return c3y; } /* u3r_sang(): yes iff (a) and (b) are the same noun, unifying equals. From e7a7db6b84c90222aa279b849edb74cdba7a0570 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Wed, 24 Jan 2018 13:14:56 -0800 Subject: [PATCH 2/8] check heads first in sing and friends --- noun/retrieve.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/noun/retrieve.c b/noun/retrieve.c index 5c15fca5d5..26bc8aa385 100644 --- a/noun/retrieve.c +++ b/noun/retrieve.c @@ -606,8 +606,8 @@ _sang_x(u3_noun a, u3_noun b) _eq_no; } else { - _eq_push(a_u->hed, b_u->hed); _eq_push(a_u->tel, b_u->tel); + _eq_push(a_u->hed, b_u->hed); fam->returning = 1; } } @@ -775,8 +775,8 @@ _sung_x(u3_noun a, u3_noun b) _eq_no; } else { - _eq_push(a_u->hed, b_u->hed); _eq_push(a_u->tel, b_u->tel); + _eq_push(a_u->hed, b_u->hed); fam->returning = 1; } } @@ -864,8 +864,8 @@ _sing_x(u3_noun a, _eq_no; } else { - _eq_push(a_u->hed, b_u->hed); _eq_push(a_u->tel, b_u->tel); + _eq_push(a_u->hed, b_u->hed); fam->returning = 1; } } From ed41d43a94c20a949435e7564a179bdd1f2c988b Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Wed, 24 Jan 2018 13:16:44 -0800 Subject: [PATCH 3/8] use explicit stack in jam --- jets/e/jam.c | 143 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 88 insertions(+), 55 deletions(-) diff --git a/jets/e/jam.c b/jets/e/jam.c index 7751aa05c0..a773911906 100644 --- a/jets/e/jam.c +++ b/jets/e/jam.c @@ -3,32 +3,19 @@ */ #include "all.h" - /* functions */ - static u3_noun - _jam_in(u3p(u3h_root) har_p, u3_atom, u3_atom, u3_noun); static u3_noun - _jam_in_pair(u3p(u3h_root) har_p, - u3_atom h_a, - u3_atom t_a, - u3_atom b, - u3_noun l) + _jam_pair(u3_noun x, u3_noun d, u3_noun e) { - u3_noun w = u3nc(u3nc(2, 1), u3k(l)); - u3_noun x = u3qa_add(2, b); - u3_noun d = _jam_in(har_p, h_a, x, w); - u3_noun p_d, q_d, r_d; - u3_noun r; - - u3r_trel(d, &p_d, &q_d, &r_d); + u3_noun r, p_d, q_d, r_d; + u3x_trel(d, &p_d, &q_d, &r_d); { u3_noun y = u3qa_add(x, p_d); - u3_noun e = _jam_in(har_p, t_a, y, q_d); u3_noun p_e, q_e, r_e; - u3r_trel(e, &p_e, &q_e, &r_e); + u3x_trel(e, &p_e, &q_e, &r_e); { u3_noun z = u3qa_add(p_d, p_e); @@ -36,20 +23,16 @@ u3z(z); } - u3z(e); u3z(y); } - u3z(d); u3z(x); - u3z(w); - + u3z(d); + u3z(e); return r; } static u3_noun - _jam_in_flat(u3p(u3h_root) har_p, - u3_atom a, - u3_noun l) + _jam_flat(u3_atom a, u3_noun l) { u3_noun d = u3qe_mat(a); u3_noun x = u3qa_add(1, u3h(d)); @@ -62,9 +45,7 @@ } static u3_noun - _jam_in_ptr(u3p(u3h_root) har_p, - u3_atom u_c, - u3_noun l) + _jam_ptr(u3_atom u_c, u3_noun l) { u3_noun d = u3qe_mat(u_c); u3_atom x = u3qc_lsh(0, 2, u3t(d)); @@ -78,45 +59,97 @@ return z; } - static u3_noun - _jam_in(u3p(u3h_root) har_p, - u3_noun a, - u3_atom b, - u3_noun l) + typedef struct { + u3_noun a; + u3_noun b; + u3_noun l; + u3_noun* r; + u3_noun hed; + u3_noun tel; + } jamframe; + + static inline void + _jam_push(u3_noun a, u3_noun b, u3_noun l, u3_noun *r) { - u3_noun c = u3h_get(har_p, a); - u3_noun x; + jamframe* fam = u3a_push(sizeof(jamframe)); + fam->a = a; + fam->b = b; + fam->l = l; + fam->r = r; + fam->hed = u3_none; + fam->tel = u3_none; + } - if ( u3_none == c ) { - u3h_put(har_p, a, u3k(b)); + static inline void + _jam_pop() + { + u3a_pop(sizeof(jamframe)); + } - if ( c3y == u3ud(a) ) { - x = _jam_in_flat(har_p, a, l); - } else { - x = _jam_in_pair(har_p, u3h(a), u3t(a), b, l); - } - } - else { - if ( c3y == u3ud(a) && u3r_met(0, a) <= u3r_met(0, c) ) { - x = _jam_in_flat(har_p, a, l); - } - else { - x = _jam_in_ptr(har_p, c, l); - } - } - return x; + static inline jamframe* + _jam_peek() + { + return (jamframe*) u3a_peek(sizeof(jamframe)); } u3_noun u3qe_jam(u3_atom a) { u3p(u3h_root) har_p = u3h_new(); + u3p(jamframe) empty = u3R->cap_p; + jamframe* fam; + u3_noun out, c, x, q, r; - u3_noun x = _jam_in(har_p, a, 0, u3_nul); - u3_noun q = u3qb_flop(u3h(u3t(x))); - u3_noun r = u3qc_can(0, q); + _jam_push(a, 0, u3_nul, &out); + while ( empty != u3R->cap_p ) { + fam = _jam_peek(); + if ( u3_none != fam->tel ) { + u3_noun z = u3qa_add(2, fam->b); + x = _jam_pair(z, fam->hed, fam->tel); + } + else if ( u3_none != fam->hed ) { + u3_noun p_d, q_d, r_d; + u3x_trel(fam->hed, &p_d, &q_d, &r_d); + { + u3_noun z = u3qa_add(2, fam->b); + u3_noun y = u3qa_add(z, p_d); + _jam_push(u3t(fam->a), y, q_d, &(fam->tel)); + u3z(z); + continue; + } + } + else { + a = fam->a; + c = u3h_get(har_p, a); + if ( u3_none != c ) { + if ( (c3y == u3ud(a)) && u3r_met(0, a) <= u3r_met(0, c) ) { + x = _jam_flat(a, fam->l); + } + else { + x = _jam_ptr(c, fam->l); + } + } + else { + u3h_put(har_p, a, u3k(fam->b)); + if ( c3y == u3ud(a) ) { + x = _jam_flat(a, fam->l); + } + else { + u3_noun z = u3qa_add(2, fam->b); + u3_noun w = u3nc(u3nc(2, 1), u3k(fam->l)); + _jam_push(u3h(a), z, w, &(fam->hed)); + continue; + } + } + } + *(fam->r) = x; + u3z(fam->b); + _jam_pop(); + } - u3z(x); + q = u3qb_flop(u3h(u3t(out))); + r = u3qc_can(0, q); + u3z(out); u3z(q); u3h_free(har_p); return r; From 3be6b258b050cb015591291ab9a5fc1cf3a0d549 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Wed, 24 Jan 2018 15:27:21 -0800 Subject: [PATCH 4/8] be more unified about unification (and fix a crash) --- noun/allocate.c | 35 +++---- noun/retrieve.c | 250 ++++++++++-------------------------------------- 2 files changed, 62 insertions(+), 223 deletions(-) diff --git a/noun/allocate.c b/noun/allocate.c index fcd216cc09..92af40851f 100644 --- a/noun/allocate.c +++ b/noun/allocate.c @@ -585,24 +585,19 @@ u3a_push(c3_w len_w) if ( c3y == u3a_is_north(u3R) ) { top -= len_w; cur = top; - u3R->cap_p = u3of(void, top); - if ( (u3R->cap_p <= u3R->hat_p) ) { - u3m_bail(c3__fail); - } - else { - return cur; - } + u3p(void) cap_p = u3R->cap_p = u3of(void, top); + c3_assert(cap_p < u3R->mat_p); + c3_assert(cap_p > u3R->hat_p); + return cur; } else { cur = top; top += len_w; u3R->cap_p = u3of(void, top); - if (u3R->cap_p >= u3R->hat_p) { - u3m_bail(c3__fail); - } - else { - return cur; - } + u3p(void) cap_p = u3R->cap_p = u3of(void, top); + c3_assert(cap_p > u3R->mat_p); + c3_assert(cap_p < u3R->hat_p); + return cur; } } @@ -614,17 +609,15 @@ u3a_pop(c3_w len_w) void* top = u3to(void, u3R->cap_p); if ( c3y == u3a_is_north(u3R) ) { top += len_w; - u3R->cap_p = u3of(void, top); - if ( u3R->cap_p > u3R->mat_p ) { - u3m_bail(c3__fail); - } + u3p(void) cap_p = u3R->cap_p = u3of(void, top); + c3_assert(cap_p <= u3R->mat_p); + c3_assert(cap_p > u3R->hat_p); } else { top -= len_w; - u3R->cap_p = u3of(void, top); - if ( u3R->cap_p < u3R->mat_p ) { - u3m_bail(c3__fail); - } + u3p(void) cap_p = u3R->cap_p = u3of(void, top); + c3_assert(cap_p >= u3R->mat_p); + c3_assert(cap_p < u3R->hat_p); } } diff --git a/noun/retrieve.c b/noun/retrieve.c index 26bc8aa385..187307546f 100644 --- a/noun/retrieve.c +++ b/noun/retrieve.c @@ -505,7 +505,9 @@ _sang_one(u3_noun* a, u3_noun* b) typedef struct { u3_noun a; u3_noun b; - c3_t returning; + c3_o* r; + c3_o hed; + c3_o tel; } eqframe; static inline eqframe* @@ -515,12 +517,14 @@ _eq_peek() } static inline void -_eq_push(u3_noun a, u3_noun b) +_eq_push(u3_noun a, u3_noun b, c3_o *r) { eqframe* cur = (eqframe*) u3a_push(sizeof(eqframe)); cur->a = a; cur->b = b; - cur->returning = 0; + cur->r = r; + cur->hed = c3n; + cur->tel = c3n; } static inline void @@ -532,91 +536,6 @@ _eq_pop() #define _eq_yes _eq_pop(); continue #define _eq_no u3R->cap_p = empty; return c3n -/* _sang_x(): yes if a and b are the same noun, unifying but leaking. -*/ -static c3_o -_sang_x(u3_noun a, u3_noun b) -{ - u3p(eqframe) empty = u3R->cap_p; - eqframe *fam; - - _eq_push(a, b); - while ( empty != u3R->cap_p ) { - fam = _eq_peek(); - a = fam->a; - b = fam->b; - if ( fam->returning ) { - _sang_one(&a, &b); - _eq_yes; - } - else if ( a == b ) { - _eq_yes; - } - else { - if ( _(u3a_is_atom(a)) ) { - u3a_atom* a_u = u3a_to_ptr(a); - - if ( !_(u3a_is_atom(b)) || - _(u3a_is_cat(a)) || - _(u3a_is_cat(b)) ) - { - _eq_no; - } - else { - u3a_atom* b_u = u3a_to_ptr(b); - - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - _eq_no; - } - else { - c3_w w_rez = a_u->len_w; - c3_w w_mox = b_u->len_w; - - if ( w_rez != w_mox ) { - _eq_no; - } - else { - c3_w i_w; - - for ( i_w = 0; i_w < w_rez; i_w++ ) { - if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - _eq_no; - } - } - _eq_yes; - } - } - } - } - else { - if ( _(u3a_is_atom(b)) ) { - _eq_no; - } - else { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - _eq_no; - } - else { - _eq_push(a_u->tel, b_u->tel); - _eq_push(a_u->hed, b_u->hed); - fam->returning = 1; - } - } - } - } - } - return c3y; -} - /* _sung_one(): pick a unified pointer for identical (a) and (b). ** ** Assumes exclusive access to noun memory. @@ -701,27 +620,34 @@ _sung_one(u3_noun* a, u3_noun* b) } } -/* _sung_x(): yes if a and b are the same noun, unifying. + +/* _song_x(): yes if a and b are the same noun, use one for unification */ static c3_o -_sung_x(u3_noun a, u3_noun b) +_song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) { u3p(eqframe) empty = u3R->cap_p; - eqframe *fam; + c3_o out; + eqframe* fam; - _eq_push(a, b); + _eq_push(a, b, &out); while ( empty != u3R->cap_p ) { fam = _eq_peek(); - a = fam->a; - b = fam->b; - if ( fam->returning ) { - _sung_one(&a, &b); - _eq_yes; + a = fam->a; + b = fam->b; + if ( c3y == fam->tel ) { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + one(&(a_u->tel), &(b_u->tel)); } - else if ( a == b ) { - _eq_yes; + else if ( c3y == fam->hed ) { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + one(&(a_u->hed), &(b_u->hed)); + _eq_push(u3t(a), u3t(b), &(fam->tel)); + continue; } - else { + else if ( a != b ) { if ( _(u3a_is_atom(a)) ) { u3a_atom* a_u = u3a_to_ptr(a); @@ -729,7 +655,7 @@ _sung_x(u3_noun a, u3_noun b) _(u3a_is_cat(a)) || _(u3a_is_cat(b)) ) { - _eq_no; + goto NO; } else { u3a_atom* b_u = u3a_to_ptr(b); @@ -738,31 +664,30 @@ _sung_x(u3_noun a, u3_noun b) b_u->mug_w && (a_u->mug_w != b_u->mug_w) ) { - _eq_no; + goto NO; } else { c3_w w_rez = a_u->len_w; c3_w w_mox = b_u->len_w; if ( w_rez != w_mox ) { - _eq_no; + goto NO; } else { c3_w i_w; for ( i_w = 0; i_w < w_rez; i_w++ ) { if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - _eq_no; + goto NO; } } - _eq_yes; } } } } else { if ( _(u3a_is_atom(b)) ) { - _eq_no; + goto NO; } else { u3a_cell* a_u = u3a_to_ptr(a); @@ -772,107 +697,22 @@ _sung_x(u3_noun a, u3_noun b) b_u->mug_w && (a_u->mug_w != b_u->mug_w) ) { - _eq_no; + goto NO; } else { - _eq_push(a_u->tel, b_u->tel); - _eq_push(a_u->hed, b_u->hed); - fam->returning = 1; - } - } - } - } - } - return c3y; -} - -/* _sing_x(): -** -** Yes iff (a) and (b) are the same noun. -*/ -static c3_o -_sing_x(u3_noun a, - u3_noun b) -{ - c3_assert(u3_none != a); - c3_assert(u3_none != b); - - u3p(eqframe) empty = u3R->cap_p; - eqframe *fam; - - _eq_push(a, b); - - while ( empty != u3R->cap_p ) { - fam = _eq_peek(); - if ( fam->returning ) { - _eq_yes; - } - else if ( (a = fam->a) == (b = fam->b) ) { - _eq_yes; - } - else { - if ( _(u3a_is_atom(a)) ) { - u3a_atom* a_u = u3a_to_ptr(a); - - if ( !_(u3a_is_atom(b)) || - _(u3a_is_cat(a)) || - _(u3a_is_cat(b)) ) - { - _eq_no; - } - else { - u3a_atom* b_u = u3a_to_ptr(b); - - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - _eq_no; - } - else { - c3_w w_rez = a_u->len_w; - c3_w w_mox = b_u->len_w; - - if ( w_rez != w_mox ) { - _eq_no; - } - else { - c3_w i_w; - - for ( i_w = 0; i_w < w_rez; i_w++ ) { - if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - _eq_no; - } - } - _eq_yes; - } - } - } - } - else { - if ( _(u3a_is_atom(b)) ) { - _eq_no; - } - else { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - _eq_no; - } - else { - _eq_push(a_u->tel, b_u->tel); - _eq_push(a_u->hed, b_u->hed); - fam->returning = 1; + _eq_push(u3h(a), u3h(b), &(fam->hed)); + continue; } } } } + *(fam->r) = c3y; + _eq_pop(); } return c3y; +NO: + u3R->cap_p = empty; + return c3n; } /* u3r_sang(): yes iff (a) and (b) are the same noun, unifying equals. @@ -880,7 +720,13 @@ _sing_x(u3_noun a, c3_o u3r_sang(u3_noun a, u3_noun b) { - return _sang_x(a, b); + return _song_x(a, b, &_sang_one); +} + +/* _sing_one(): do not unify */ +void +_sing_one(u3_noun *a, u3_noun *b) { + // this space left intentionally blank } /* u3r_sing(): @@ -905,7 +751,7 @@ u3r_sing(u3_noun a, u3_noun b) c3_o ret_o; u3t_on(euq_o); - ret_o = _sing_x(a, b); + ret_o = _song_x(a, b, &_sing_one); u3t_off(euq_o); return ret_o; @@ -917,7 +763,7 @@ u3r_sing(u3_noun a, u3_noun b) c3_o u3r_sung(u3_noun a, u3_noun b) { - return _sung_x(a, b); + return _song_x(a, b, &_sung_one); } c3_o From 674af1842d0215c4f1c101c3052ad11784cc0ea2 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Wed, 24 Jan 2018 15:42:23 -0800 Subject: [PATCH 5/8] whoops, left these unused macros in --- noun/retrieve.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/noun/retrieve.c b/noun/retrieve.c index 187307546f..e015a27c76 100644 --- a/noun/retrieve.c +++ b/noun/retrieve.c @@ -533,9 +533,6 @@ _eq_pop() u3a_pop(sizeof(eqframe)); } -#define _eq_yes _eq_pop(); continue -#define _eq_no u3R->cap_p = empty; return c3n - /* _sung_one(): pick a unified pointer for identical (a) and (b). ** ** Assumes exclusive access to noun memory. From 70f6cd4df503942c7fb3637808e95cf5a0d1e98b Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Fri, 26 Jan 2018 11:49:56 -0800 Subject: [PATCH 6/8] unification redesign -- initial recursive version --- noun/retrieve.c | 265 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 221 insertions(+), 44 deletions(-) diff --git a/noun/retrieve.c b/noun/retrieve.c index e015a27c76..6c50a8bcf4 100644 --- a/noun/retrieve.c +++ b/noun/retrieve.c @@ -450,7 +450,6 @@ u3r_mug_qual(u3_noun a, } /* _sang_one(): unify but leak old. -*/ static void _sang_one(u3_noun* a, u3_noun* b) { @@ -501,13 +500,14 @@ _sang_one(u3_noun* a, u3_noun* b) } } } +*/ typedef struct { - u3_noun a; - u3_noun b; - c3_o* r; - c3_o hed; - c3_o tel; + u3_noun a; + u3_noun b; + u3_noun* r; + u3_noun hed; + u3_noun tel; } eqframe; static inline eqframe* @@ -517,14 +517,14 @@ _eq_peek() } static inline void -_eq_push(u3_noun a, u3_noun b, c3_o *r) +_eq_push(u3_noun a, u3_noun b, u3_noun* r) { eqframe* cur = (eqframe*) u3a_push(sizeof(eqframe)); cur->a = a; cur->b = b; cur->r = r; - cur->hed = c3n; - cur->tel = c3n; + cur->hed = u3_none; + cur->tel = u3_none; } static inline void @@ -536,7 +536,6 @@ _eq_pop() /* _sung_one(): pick a unified pointer for identical (a) and (b). ** ** Assumes exclusive access to noun memory. -*/ static void _sung_one(u3_noun* a, u3_noun* b) { @@ -616,15 +615,140 @@ _sung_one(u3_noun* a, u3_noun* b) u3R = rod_u; } } +*/ +/* _sang_pick(): pick a unified pointer, lose the other */ +static inline void +_sang_pick(u3_noun* keep, u3_noun* lose) +{ + u3k(*keep); + u3z(*lose); + *lose = *keep; +} -/* _song_x(): yes if a and b are the same noun, use one for unification +/* _song_pick(): pick a unified pointer, leak the other */ +static inline void +_song_pick(u3_noun* keep, u3_noun* leak) +{ + u3k(*keep); + *leak = *keep; +} + +static void _song_uni_up(u3_noun*, u3_noun*); + +/* _song_uni_here(): unify on a senior road + */ +static void +_song_uni_here(u3_noun* a, u3_noun* b) { + if ( *a != *b ) { + c3_o asr = u3a_is_senior(u3R, *a), + bsr = u3a_is_senior(u3R, *b); + if ( c3y == asr ) { + if ( c3y == bsr ) { + _song_uni_up(a, b); + } + else { + _song_pick(a, b); + } + } + else if ( c3y == bsr ) { + _song_pick(b, a); + } + else if ( c3y == u3du(*a) ) { + u3a_cell* a_u = u3a_to_ptr(*a); + u3a_cell* b_u = u3a_to_ptr(*a); + _song_uni_here(&(a_u->hed), &(b_u->hed)); + _song_uni_here(&(a_u->tel), &(b_u->tel)); + // keep closer to the rut + if ( (c3y == u3a_is_north(u3R)) && (*a <= *b) ) { + _song_pick(a, b); + } + else { + _song_pick(b, a); + } + } + } +} + +/* _song_uni(): go up a road and unify + */ +static void +_song_uni_up(u3_noun *a, u3_noun* b) +{ + // + // when unifying on a higher road, we can't free nouns, + // because we can't track junior nouns that point into + // that road. + // + // this is just an implementation issue -- we could set use + // counts to 0 without actually freeing. but the allocator + // would have to be actually designed for this. + // + // not freeing may generate spurious leaks, so we disable + // senior unification when debugging memory. this will + // cause a very slow boot process as the compiler compiles + // itself, constantly running into duplicates. + // +#ifdef U3_MEMORY_DEBUG + return; +#else + if ( u3R != &u3H->rod_u ) { + u3_road* rod_u = u3R; + u3R = u3to(u3_road, u3R->par_p); + _song_uni_here(a, b); + u3R = rod_u; + } +#endif +} + +/* _sang_uni(): top-down unification of equal a and b on active road + */ +static void +_sang_uni(u3_noun* a, u3_noun* b) +{ + // + // we can't perform this kind of butchery on the home road, + // where asynchronous things can allocate. + // + c3_assert( u3R != &u3H->rod_u ); + if ( *a != *b ) { + c3_o asr = u3a_is_senior(u3R, *a), + bsr = u3a_is_senior(u3R, *b); + if ( c3y == asr ) { + if ( c3y == bsr ) { + _song_uni_up(a, b); + } + else { + _sang_pick(a, b); + } + } + else if ( c3y == bsr ) { + _sang_pick(b, a); + } + else if ( c3y == u3du(*a) ) { + u3a_cell* a_u = u3a_to_ptr(*a); + u3a_cell* b_u = u3a_to_ptr(*a); + _sang_uni(&(a_u->hed), &(b_u->hed)); + _sang_uni(&(a_u->tel), &(b_u->tel)); + // keep closer to the rut + if ( (c3y == u3a_is_north(u3R)) && (*a <= *b) ) { + _sang_pick(a, b); + } + else { + _sang_pick(b, a); + } + } + } +} + +/* _sang_x(): yes if a and b are the same noun, uni yes to unify */ static c3_o -_song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) +_sang_x(u3_noun a, u3_noun b, c3_o uni) { u3p(eqframe) empty = u3R->cap_p; - c3_o out; + u3_noun out; + c3_o r_o; eqframe* fam; _eq_push(a, b, &out); @@ -632,17 +756,25 @@ _song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) fam = _eq_peek(); a = fam->a; b = fam->b; - if ( c3y == fam->tel ) { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - one(&(a_u->tel), &(b_u->tel)); + r_o = c3y; + if ( u3_none != fam->tel ) { + if ( c3n == fam->tel ) { + if ( c3y == uni ) { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + _sang_uni(&(a_u->hed), &(b_u->hed)); + } + r_o = c3n; + } } - else if ( c3y == fam->hed ) { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - one(&(a_u->hed), &(b_u->hed)); - _eq_push(u3t(a), u3t(b), &(fam->tel)); - continue; + else if ( u3_none != fam->hed ) { + if ( c3y == fam->hed ) { + _eq_push(u3t(a), u3t(b), &(fam->tel)); + continue; + } + else { + r_o = c3n; + } } else if ( a != b ) { if ( _(u3a_is_atom(a)) ) { @@ -652,7 +784,7 @@ _song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) _(u3a_is_cat(a)) || _(u3a_is_cat(b)) ) { - goto NO; + r_o = c3n; } else { u3a_atom* b_u = u3a_to_ptr(b); @@ -661,21 +793,22 @@ _song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) b_u->mug_w && (a_u->mug_w != b_u->mug_w) ) { - goto NO; + r_o = c3n; } else { c3_w w_rez = a_u->len_w; c3_w w_mox = b_u->len_w; if ( w_rez != w_mox ) { - goto NO; + r_o = c3n; } else { c3_w i_w; for ( i_w = 0; i_w < w_rez; i_w++ ) { if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - goto NO; + r_o = c3n; + break; } } } @@ -684,7 +817,7 @@ _song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) } else { if ( _(u3a_is_atom(b)) ) { - goto NO; + r_o = c3n; } else { u3a_cell* a_u = u3a_to_ptr(a); @@ -694,7 +827,7 @@ _song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) b_u->mug_w && (a_u->mug_w != b_u->mug_w) ) { - goto NO; + r_o = c3n; } else { _eq_push(u3h(a), u3h(b), &(fam->hed)); @@ -703,27 +836,70 @@ _song_x(u3_noun a, u3_noun b, void (*one)(u3_noun*, u3_noun*)) } } } - *(fam->r) = c3y; - _eq_pop(); + if ( c3n == uni && c3n == r_o ) { + // early exit, since we're not unifying + u3R->cap_p = empty; + return c3n; + } + else { + *(fam->r) = r_o; + _eq_pop(); + } } - return c3y; -NO: - u3R->cap_p = empty; - return c3n; + if ( (a != b) && ( c3y == r_o ) && (c3y == uni) && (c3y == u3ud(a)) ) { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + _sang_uni(&(a_u->hed), &(b_u->hed)); + _sang_uni(&(a_u->tel), &(b_u->tel)); + } + return r_o; } +/* +void _song_deep(u3_noun, u3_noun); + +void _song_one(u3_noun *a, u3_noun *b) { + if ( c3y == u3a_is_senior(u3R, *a) ) { + if ( c3n == u3a_is_senior(u3R, *b) ) { + u3_noun old = *b; + *b = *a; + c3_assert(c3n == u3a_is_junior(u3R, old)); + u3z(old); + } + } + else if ( c3y == u3a_is_senior(u3R, *b) ) { + u3_noun old = *a; + *a = *b; + c3_assert(c3n == u3a_is_junior(u3R, old)); + u3z(old); + } + else if ( c3y == u3du(*a) ) { + _song_deep(*a, *b); + } +} + +// post-equality unification. verify a and b are equal before calling. +void _song_deep(u3_noun a, u3_noun b) { + if ( a != b ) { + if ( c3y == u3du(a) ) { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); + _song_one(&(a_u->hed), &(b_u->hed)); + _song_one(&(a_u->tel), &(b_u->tel)); + } + else { + //_song_one(&a, &b); + } + } +} +*/ + /* u3r_sang(): yes iff (a) and (b) are the same noun, unifying equals. */ c3_o u3r_sang(u3_noun a, u3_noun b) { - return _song_x(a, b, &_sang_one); -} - -/* _sing_one(): do not unify */ -void -_sing_one(u3_noun *a, u3_noun *b) { - // this space left intentionally blank + return _sang_x(a, b, c3y); } /* u3r_sing(): @@ -748,7 +924,7 @@ u3r_sing(u3_noun a, u3_noun b) c3_o ret_o; u3t_on(euq_o); - ret_o = _song_x(a, b, &_sing_one); + ret_o = _sang_x(a, b, c3n); u3t_off(euq_o); return ret_o; @@ -756,11 +932,12 @@ u3r_sing(u3_noun a, u3_noun b) } /* u3r_sung(): yes iff (a) and (b) are the same noun, unifying equals. + * DEPRECATED: this is the same as u3r_sang() now. */ c3_o u3r_sung(u3_noun a, u3_noun b) { - return _song_x(a, b, &_sung_one); + return u3r_sang(a, b); } c3_o From 665e0899adb99632320913c0c8a6ce1e9b1d8964 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Mon, 29 Jan 2018 10:16:20 -0800 Subject: [PATCH 7/8] revert unification redesign, memoize-by-pointer for large equality traverses --- noun/retrieve.c | 359 +++++++++++++++--------------------------------- 1 file changed, 113 insertions(+), 246 deletions(-) diff --git a/noun/retrieve.c b/noun/retrieve.c index 6c50a8bcf4..a8a3a41dd2 100644 --- a/noun/retrieve.c +++ b/noun/retrieve.c @@ -450,6 +450,7 @@ u3r_mug_qual(u3_noun a, } /* _sang_one(): unify but leak old. +*/ static void _sang_one(u3_noun* a, u3_noun* b) { @@ -500,14 +501,11 @@ _sang_one(u3_noun* a, u3_noun* b) } } } -*/ typedef struct { u3_noun a; u3_noun b; - u3_noun* r; - u3_noun hed; - u3_noun tel; + c3_y sat_y; } eqframe; static inline eqframe* @@ -517,14 +515,12 @@ _eq_peek() } static inline void -_eq_push(u3_noun a, u3_noun b, u3_noun* r) +_eq_push(u3_noun a, u3_noun b) { eqframe* cur = (eqframe*) u3a_push(sizeof(eqframe)); - cur->a = a; - cur->b = b; - cur->r = r; - cur->hed = u3_none; - cur->tel = u3_none; + cur->a = a; + cur->b = b; + cur->sat_y = 0; } static inline void @@ -533,9 +529,18 @@ _eq_pop() u3a_pop(sizeof(eqframe)); } +/* _sing_one(): do not pick a unified pointer for identical (a) and (b). +*/ +static void +_sing_one(u3_noun* a, u3_noun* b) +{ + // this space left intentionally blank +} + /* _sung_one(): pick a unified pointer for identical (a) and (b). ** ** Assumes exclusive access to noun memory. +*/ static void _sung_one(u3_noun* a, u3_noun* b) { @@ -615,291 +620,154 @@ _sung_one(u3_noun* a, u3_noun* b) u3R = rod_u; } } -*/ -/* _sang_pick(): pick a unified pointer, lose the other */ -static inline void -_sang_pick(u3_noun* keep, u3_noun* lose) +static inline c3_o +_song_atom(u3_atom(a), u3_atom(b)) { - u3k(*keep); - u3z(*lose); - *lose = *keep; -} + u3a_atom* a_u = u3a_to_ptr(a); -/* _song_pick(): pick a unified pointer, leak the other */ -static inline void -_song_pick(u3_noun* keep, u3_noun* leak) -{ - u3k(*keep); - *leak = *keep; -} + if ( !_(u3a_is_atom(b)) || + _(u3a_is_cat(a)) || + _(u3a_is_cat(b)) ) + { + return c3n; + } + else { + u3a_atom* b_u = u3a_to_ptr(b); -static void _song_uni_up(u3_noun*, u3_noun*); + if ( a_u->mug_w && + b_u->mug_w && + (a_u->mug_w != b_u->mug_w) ) + { + return c3n; + } + else { + c3_w w_rez = a_u->len_w; + c3_w w_mox = b_u->len_w; -/* _song_uni_here(): unify on a senior road - */ -static void -_song_uni_here(u3_noun* a, u3_noun* b) { - if ( *a != *b ) { - c3_o asr = u3a_is_senior(u3R, *a), - bsr = u3a_is_senior(u3R, *b); - if ( c3y == asr ) { - if ( c3y == bsr ) { - _song_uni_up(a, b); + if ( w_rez != w_mox ) { + return c3n; } else { - _song_pick(a, b); - } - } - else if ( c3y == bsr ) { - _song_pick(b, a); - } - else if ( c3y == u3du(*a) ) { - u3a_cell* a_u = u3a_to_ptr(*a); - u3a_cell* b_u = u3a_to_ptr(*a); - _song_uni_here(&(a_u->hed), &(b_u->hed)); - _song_uni_here(&(a_u->tel), &(b_u->tel)); - // keep closer to the rut - if ( (c3y == u3a_is_north(u3R)) && (*a <= *b) ) { - _song_pick(a, b); - } - else { - _song_pick(b, a); + c3_w i_w; + + for ( i_w = 0; i_w < w_rez; i_w++ ) { + if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { + return c3n; + } + } } } } + return c3y; } -/* _song_uni(): go up a road and unify - */ -static void -_song_uni_up(u3_noun *a, u3_noun* b) -{ - // - // when unifying on a higher road, we can't free nouns, - // because we can't track junior nouns that point into - // that road. - // - // this is just an implementation issue -- we could set use - // counts to 0 without actually freeing. but the allocator - // would have to be actually designed for this. - // - // not freeing may generate spurious leaks, so we disable - // senior unification when debugging memory. this will - // cause a very slow boot process as the compiler compiles - // itself, constantly running into duplicates. - // -#ifdef U3_MEMORY_DEBUG - return; -#else - if ( u3R != &u3H->rod_u ) { - u3_road* rod_u = u3R; - u3R = u3to(u3_road, u3R->par_p); - _song_uni_here(a, b); - u3R = rod_u; - } -#endif -} +/* knob: set lower to get more/earlier memoize-by-pointer, + * higher to avoid allocating the u3h as often */ +#define EQ_WHISTLE 1024 -/* _sang_uni(): top-down unification of equal a and b on active road - */ -static void -_sang_uni(u3_noun* a, u3_noun* b) -{ - // - // we can't perform this kind of butchery on the home road, - // where asynchronous things can allocate. - // - c3_assert( u3R != &u3H->rod_u ); - if ( *a != *b ) { - c3_o asr = u3a_is_senior(u3R, *a), - bsr = u3a_is_senior(u3R, *b); - if ( c3y == asr ) { - if ( c3y == bsr ) { - _song_uni_up(a, b); - } - else { - _sang_pick(a, b); - } - } - else if ( c3y == bsr ) { - _sang_pick(b, a); - } - else if ( c3y == u3du(*a) ) { - u3a_cell* a_u = u3a_to_ptr(*a); - u3a_cell* b_u = u3a_to_ptr(*a); - _sang_uni(&(a_u->hed), &(b_u->hed)); - _sang_uni(&(a_u->tel), &(b_u->tel)); - // keep closer to the rut - if ( (c3y == u3a_is_north(u3R)) && (*a <= *b) ) { - _sang_pick(a, b); - } - else { - _sang_pick(b, a); - } - } - } -} - -/* _sang_x(): yes if a and b are the same noun, uni yes to unify +/* _song_x(): yes if a and b are the same noun, use uni to unify */ static c3_o -_sang_x(u3_noun a, u3_noun b, c3_o uni) +_song_x(u3_noun a, u3_noun b, void (*uni)(u3_noun*, u3_noun*)) { - u3p(eqframe) empty = u3R->cap_p; - u3_noun out; - c3_o r_o; eqframe* fam; + u3p(eqframe) empty = u3R->cap_p; + c3_w wis_w = 0; + c3_o r_o = c3n; + u3p(u3h_root) har_p = 0; - _eq_push(a, b, &out); + _eq_push(a, b); + /* there's a while and a switch here. continues all mean "do the loop again" + ** and breaks all mean "fall through this switch case". There are no breaks + ** that early terminate the loop. + */ while ( empty != u3R->cap_p ) { fam = _eq_peek(); - a = fam->a; - b = fam->b; - r_o = c3y; - if ( u3_none != fam->tel ) { - if ( c3n == fam->tel ) { - if ( c3y == uni ) { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - _sang_uni(&(a_u->hed), &(b_u->hed)); - } - r_o = c3n; - } + if ( (a = fam->a) == (b = fam->b) ) { + r_o = c3y; } - else if ( u3_none != fam->hed ) { - if ( c3y == fam->hed ) { - _eq_push(u3t(a), u3t(b), &(fam->tel)); - continue; - } - else { - r_o = c3n; - } + else if ( c3y == u3a_is_atom(a) ) { + r_o = _song_atom(a, b); } - else if ( a != b ) { - if ( _(u3a_is_atom(a)) ) { - u3a_atom* a_u = u3a_to_ptr(a); + else if ( c3y == u3a_is_atom(b) ) { + r_o = c3n; + } + else { + u3a_cell* a_u = u3a_to_ptr(a); + u3a_cell* b_u = u3a_to_ptr(b); - if ( !_(u3a_is_atom(b)) || - _(u3a_is_cat(a)) || - _(u3a_is_cat(b)) ) - { - r_o = c3n; - } - else { - u3a_atom* b_u = u3a_to_ptr(b); + switch ( fam->sat_y ) { + case 2: + uni(&(a_u->tel), &(b_u->tel)); + r_o = c3y; + break; + case 1: + uni(&(a_u->hed), &(b_u->hed)); + _eq_push(a_u->tel, b_u->tel); + fam->sat_y = 2; + continue; + + case 0: { if ( a_u->mug_w && b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { + (a_u->mug_w != b_u->mug_w) ) { r_o = c3n; + break; } else { - c3_w w_rez = a_u->len_w; - c3_w w_mox = b_u->len_w; - - if ( w_rez != w_mox ) { - r_o = c3n; - } - else { - c3_w i_w; - - for ( i_w = 0; i_w < w_rez; i_w++ ) { - if ( a_u->buf_w[i_w] != b_u->buf_w[i_w] ) { - r_o = c3n; - break; - } + if ( har_p != 0 ) { + u3_noun key = u3nc(u3a_to_off(a), u3a_to_off(b)); + u3_noun got = u3h_get(har_p, key); + u3z(key); + if ( u3_none != got ) { + _eq_pop(); + continue; } } - } - } - } - else { - if ( _(u3a_is_atom(b)) ) { - r_o = c3n; - } - else { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - - if ( a_u->mug_w && - b_u->mug_w && - (a_u->mug_w != b_u->mug_w) ) - { - r_o = c3n; - } - else { - _eq_push(u3h(a), u3h(b), &(fam->hed)); + _eq_push(a_u->hed, b_u->hed); + fam->sat_y = 1; continue; } } + default: + c3_assert(0); } } - if ( c3n == uni && c3n == r_o ) { - // early exit, since we're not unifying + + if ( c3n == r_o ) { + if ( 0 != har_p ) { + u3h_free(har_p); + } u3R->cap_p = empty; return c3n; } else { - *(fam->r) = r_o; + if ( 0 == har_p && (wis_w++ > EQ_WHISTLE) ) { + har_p = u3h_new(); + } + if ( 0 != har_p ) { + u3_noun key = u3nc(u3a_to_off(a), u3a_to_off(b)); + u3h_put(har_p, key, c3y); + u3z(key); + } _eq_pop(); } } - if ( (a != b) && ( c3y == r_o ) && (c3y == uni) && (c3y == u3ud(a)) ) { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - _sang_uni(&(a_u->hed), &(b_u->hed)); - _sang_uni(&(a_u->tel), &(b_u->tel)); - } - return r_o; -} -/* -void _song_deep(u3_noun, u3_noun); - -void _song_one(u3_noun *a, u3_noun *b) { - if ( c3y == u3a_is_senior(u3R, *a) ) { - if ( c3n == u3a_is_senior(u3R, *b) ) { - u3_noun old = *b; - *b = *a; - c3_assert(c3n == u3a_is_junior(u3R, old)); - u3z(old); - } - } - else if ( c3y == u3a_is_senior(u3R, *b) ) { - u3_noun old = *a; - *a = *b; - c3_assert(c3n == u3a_is_junior(u3R, old)); - u3z(old); - } - else if ( c3y == u3du(*a) ) { - _song_deep(*a, *b); + if ( 0 != har_p ) { + u3h_free(har_p); } + return c3y; } -// post-equality unification. verify a and b are equal before calling. -void _song_deep(u3_noun a, u3_noun b) { - if ( a != b ) { - if ( c3y == u3du(a) ) { - u3a_cell* a_u = u3a_to_ptr(a); - u3a_cell* b_u = u3a_to_ptr(b); - _song_one(&(a_u->hed), &(b_u->hed)); - _song_one(&(a_u->tel), &(b_u->tel)); - } - else { - //_song_one(&a, &b); - } - } -} -*/ - /* u3r_sang(): yes iff (a) and (b) are the same noun, unifying equals. */ c3_o u3r_sang(u3_noun a, u3_noun b) { - return _sang_x(a, b, c3y); + return _song_x(a, b, &_sang_one); } /* u3r_sing(): @@ -924,7 +792,7 @@ u3r_sing(u3_noun a, u3_noun b) c3_o ret_o; u3t_on(euq_o); - ret_o = _sang_x(a, b, c3n); + ret_o = _song_x(a, b, &_sing_one); u3t_off(euq_o); return ret_o; @@ -932,12 +800,11 @@ u3r_sing(u3_noun a, u3_noun b) } /* u3r_sung(): yes iff (a) and (b) are the same noun, unifying equals. - * DEPRECATED: this is the same as u3r_sang() now. */ c3_o u3r_sung(u3_noun a, u3_noun b) { - return u3r_sang(a, b); + return _song_x(a, b, &_sung_one); } c3_o From d214d00e89c19bbb57e32a79c9e895a518aebf04 Mon Sep 17 00:00:00 2001 From: Paul Driver Date: Mon, 29 Jan 2018 10:52:47 -0800 Subject: [PATCH 8/8] slightly odd syntax on _song_atom --- noun/retrieve.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/noun/retrieve.c b/noun/retrieve.c index a8a3a41dd2..e25965995a 100644 --- a/noun/retrieve.c +++ b/noun/retrieve.c @@ -622,7 +622,7 @@ _sung_one(u3_noun* a, u3_noun* b) } static inline c3_o -_song_atom(u3_atom(a), u3_atom(b)) +_song_atom(u3_atom a, u3_atom b) { u3a_atom* a_u = u3a_to_ptr(a);