2014-09-05 23:55:16 +04:00
|
|
|
/* j/5/jam.c
|
2013-09-29 00:21:18 +04:00
|
|
|
**
|
|
|
|
*/
|
|
|
|
#include "all.h"
|
2014-09-04 07:10:43 +04:00
|
|
|
|
2013-09-29 00:21:18 +04:00
|
|
|
/* functions
|
|
|
|
*/
|
2014-09-06 00:13:24 +04:00
|
|
|
|
|
|
|
static u3_noun
|
2018-02-25 09:13:24 +03:00
|
|
|
_jam_pair(u3_noun x, u3_noun d, u3_noun e)
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2018-02-25 09:13:24 +03:00
|
|
|
u3_noun r, p_d, q_d, r_d;
|
|
|
|
u3x_trel(d, &p_d, &q_d, &r_d);
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2014-11-06 22:13:57 +03:00
|
|
|
u3_noun y = u3qa_add(x, p_d);
|
2014-09-06 00:13:24 +04:00
|
|
|
u3_noun p_e, q_e, r_e;
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2018-02-25 09:13:24 +03:00
|
|
|
u3x_trel(e, &p_e, &q_e, &r_e);
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2014-11-06 22:13:57 +03:00
|
|
|
u3_noun z = u3qa_add(p_d, p_e);
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2014-11-06 22:13:57 +03:00
|
|
|
r = u3nt(u3qa_add(2, z), u3k(q_e), 0);
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2014-09-06 00:13:24 +04:00
|
|
|
u3z(z);
|
2013-09-29 00:21:18 +04:00
|
|
|
}
|
2014-09-06 00:13:24 +04:00
|
|
|
u3z(y);
|
2013-09-29 00:21:18 +04:00
|
|
|
}
|
2014-09-06 00:13:24 +04:00
|
|
|
u3z(x);
|
2018-02-25 09:13:24 +03:00
|
|
|
u3z(d);
|
|
|
|
u3z(e);
|
2013-09-29 00:21:18 +04:00
|
|
|
return r;
|
|
|
|
}
|
|
|
|
|
2014-09-06 00:13:24 +04:00
|
|
|
static u3_noun
|
2018-02-25 09:13:24 +03:00
|
|
|
_jam_flat(u3_atom a, u3_noun l)
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2014-11-06 22:13:57 +03:00
|
|
|
u3_noun d = u3qe_mat(a);
|
|
|
|
u3_noun x = u3qa_add(1, u3h(d));
|
2014-09-06 00:13:24 +04:00
|
|
|
u3_noun y = u3nt
|
2014-11-06 22:13:57 +03:00
|
|
|
(u3k(x), u3nc(u3nc(x, u3qc_lsh(0, 1, u3t(d))), u3k(l)), 0);
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2014-09-06 00:13:24 +04:00
|
|
|
u3z(d);
|
2013-09-29 00:21:18 +04:00
|
|
|
|
|
|
|
return y;
|
|
|
|
}
|
|
|
|
|
2014-09-06 00:13:24 +04:00
|
|
|
static u3_noun
|
2018-02-25 09:13:24 +03:00
|
|
|
_jam_ptr(u3_atom u_c, u3_noun l)
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2014-11-06 22:13:57 +03:00
|
|
|
u3_noun d = u3qe_mat(u_c);
|
|
|
|
u3_atom x = u3qc_lsh(0, 2, u3t(d));
|
|
|
|
u3_atom y = u3qa_add(2, u3h(d));
|
2014-09-06 00:13:24 +04:00
|
|
|
u3_noun z = u3nt
|
2014-11-06 22:13:57 +03:00
|
|
|
(u3k(y), u3nc(u3nc(y, u3qc_mix(3, x)), u3k(l)), 0);
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2014-09-06 00:13:24 +04:00
|
|
|
u3z(d);
|
|
|
|
u3z(x);
|
2013-09-29 00:21:18 +04:00
|
|
|
|
|
|
|
return z;
|
|
|
|
}
|
|
|
|
|
2018-02-25 09:13:24 +03:00
|
|
|
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)
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2018-02-25 09:13:24 +03:00
|
|
|
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;
|
|
|
|
}
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2018-02-25 09:13:24 +03:00
|
|
|
static inline void
|
|
|
|
_jam_pop()
|
|
|
|
{
|
|
|
|
u3a_pop(sizeof(jamframe));
|
|
|
|
}
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2018-02-25 09:13:24 +03:00
|
|
|
static inline jamframe*
|
|
|
|
_jam_peek()
|
|
|
|
{
|
|
|
|
return (jamframe*) u3a_peek(sizeof(jamframe));
|
2013-09-29 00:21:18 +04:00
|
|
|
}
|
|
|
|
|
2014-09-06 00:13:24 +04:00
|
|
|
u3_noun
|
2014-11-06 22:13:57 +03:00
|
|
|
u3qe_jam(u3_atom a)
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2014-11-06 03:20:01 +03:00
|
|
|
u3p(u3h_root) har_p = u3h_new();
|
2018-02-25 09:13:24 +03:00
|
|
|
u3p(jamframe) empty = u3R->cap_p;
|
|
|
|
jamframe* fam;
|
|
|
|
u3_noun out, c, x, q, r;
|
|
|
|
|
|
|
|
_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();
|
|
|
|
}
|
2014-08-25 10:58:38 +04:00
|
|
|
|
2018-02-25 09:13:24 +03:00
|
|
|
q = u3qb_flop(u3h(u3t(out)));
|
|
|
|
r = u3qc_can(0, q);
|
|
|
|
u3z(out);
|
2014-09-06 00:13:24 +04:00
|
|
|
u3z(q);
|
2014-11-06 03:20:01 +03:00
|
|
|
u3h_free(har_p);
|
2013-09-29 00:21:18 +04:00
|
|
|
return r;
|
|
|
|
}
|
2014-09-06 00:13:24 +04:00
|
|
|
u3_noun
|
2014-11-06 22:13:57 +03:00
|
|
|
u3we_jam(u3_noun cor)
|
2013-09-29 00:21:18 +04:00
|
|
|
{
|
2014-09-06 00:13:24 +04:00
|
|
|
u3_noun a;
|
2013-09-29 00:21:18 +04:00
|
|
|
|
2014-11-18 00:56:51 +03:00
|
|
|
if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ) {
|
2014-11-06 03:20:01 +03:00
|
|
|
return u3m_bail(c3__fail);
|
2013-09-29 00:21:18 +04:00
|
|
|
} else {
|
2014-11-06 22:13:57 +03:00
|
|
|
return u3qe_jam(a);
|
2013-09-29 00:21:18 +04:00
|
|
|
}
|
|
|
|
}
|
2014-09-06 00:13:24 +04:00
|
|
|
u3_atom
|
2014-11-06 22:13:57 +03:00
|
|
|
u3ke_jam(u3_noun a)
|
2014-09-05 23:55:16 +04:00
|
|
|
{
|
2014-11-06 22:13:57 +03:00
|
|
|
u3_atom b = u3qe_jam(a);
|
2014-09-05 23:55:16 +04:00
|
|
|
|
2014-09-06 00:13:24 +04:00
|
|
|
u3z(a);
|
2014-09-05 23:55:16 +04:00
|
|
|
return b;
|
|
|
|
}
|
|
|
|
|