shrub/jets/e/jam.c

210 lines
4.3 KiB
C
Raw Normal View History

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-01-25 00:16:44 +03:00
_jam_pair(u3_noun x, u3_noun d, u3_noun e)
2013-09-29 00:21:18 +04:00
{
2018-01-25 00:16:44 +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-01-25 00:16:44 +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-01-25 00:16:44 +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-01-25 00:16:44 +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);
2018-03-06 20:44:16 +03:00
u3z(l);
2013-09-29 00:21:18 +04:00
return y;
}
2014-09-06 00:13:24 +04:00
static u3_noun
2018-01-25 00:16:44 +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);
2018-03-06 20:44:16 +03:00
u3z(l);
2013-09-29 00:21:18 +04:00
return z;
}
2018-03-15 03:53:12 +03:00
#define JAM_NONE 0
#define JAM_HEAD 1
#define JAM_TAIL 2
2018-01-25 00:16:44 +03:00
typedef struct {
2018-03-15 03:53:12 +03:00
c3_y sat_y;
u3_noun nun;
u3_noun len;
u3_noun lis;
2018-01-25 00:16:44 +03:00
u3_noun hed;
} jamframe;
2018-03-15 03:53:12 +03:00
static inline jamframe*
_jam_push(c3_ys mov, c3_ys off)
2018-01-25 00:16:44 +03:00
{
2018-03-15 03:53:12 +03:00
u3R->cap_p += mov;
return u3to(jamframe, u3R->cap_p + off);
2018-01-25 00:16:44 +03:00
}
2013-09-29 00:21:18 +04:00
2018-01-25 00:16:44 +03:00
static inline jamframe*
2018-03-15 03:53:12 +03:00
_jam_pop(c3_ys mov, c3_ys off)
2018-01-25 00:16:44 +03:00
{
2018-03-15 03:53:12 +03:00
u3R->cap_p -= mov;
return u3to(jamframe, u3R->cap_p + off);
2013-09-29 00:21:18 +04:00
}
2018-03-15 03:53:12 +03:00
static u3_noun
_jam_cap(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-03-15 03:53:12 +03:00
c3_o nor_o = u3a_is_north(u3R);
c3_y wis_y = c3_wiseof(jamframe);
c3_ys mov = ( c3y == nor_o ? -wis_y : wis_y );
c3_ys off = ( c3y == nor_o ? 0 : -wis_y );
jamframe* fam = _jam_push(mov, off);
fam->sat_y = JAM_NONE;
fam->nun = a;
fam->len = 0;
fam->lis = u3_nul;
u3_noun q, r = u3_none;
c3_w dep_w;
for ( dep_w = 1; dep_w > 0; ) {
switch ( fam->sat_y ) {
case JAM_NONE: {
u3_noun nun = fam->nun;
u3_noun len = fam->len;
u3_noun lis = fam->lis;
u3_weak got = u3h_get(har_p, nun);
if ( u3_none == got ) {
u3h_put(har_p, nun, u3k(len));
if ( c3n == u3du(nun) ) {
r = _jam_flat(nun, lis);
fam = _jam_pop(mov, off);
--dep_w;
u3z(len);
}
else {
fam->sat_y = JAM_HEAD;
fam = _jam_push(mov, off);
fam->sat_y = JAM_NONE;
fam->nun = u3h(nun);
fam->len = u3qa_add(2, len);
fam->lis = u3nc(u3nc(2, 1), lis);
++dep_w;
}
2018-01-25 00:16:44 +03:00
}
else {
2018-03-15 03:53:12 +03:00
if ( c3y == u3ud(nun) && (u3r_met(0, nun) <= u3r_met(0, got)) ) {
r = _jam_flat(nun, lis);
}
else {
r = _jam_ptr(got, lis);
}
fam = _jam_pop(mov, off);
--dep_w;
u3z(len);
2018-01-25 00:16:44 +03:00
}
2018-03-15 03:53:12 +03:00
break;
2018-01-25 00:16:44 +03:00
}
2018-03-15 03:53:12 +03:00
case JAM_HEAD: {
u3_noun p_r, q_r, r_r;
u3x_trel(r, &p_r, &q_r, &r_r);
u3_noun nun = fam->nun;
fam->sat_y = JAM_TAIL;
fam->hed = r;
u3_noun z = u3qa_add(2, fam->len);
fam = _jam_push(mov, off);
fam->sat_y = JAM_NONE;
fam->nun = u3t(nun);
fam->len = u3qa_add(z, p_r);
fam->lis = u3k(q_r);
u3z(z);
++dep_w;
break;
}
case JAM_TAIL: {
u3_noun len = fam->len;
r = _jam_pair(u3qa_add(2, len), fam->hed, r);
fam = _jam_pop(mov, off);
--dep_w;
u3z(len);
break;
2018-01-25 00:16:44 +03:00
}
2018-03-15 03:53:12 +03:00
default:
c3_assert(0);
return u3_none;
2018-01-25 00:16:44 +03:00
}
}
2014-08-25 10:58:38 +04:00
2018-03-15 03:53:12 +03:00
q = u3qb_flop(u3h(u3t(r)));
u3z(r);
2018-01-25 00:16:44 +03:00
r = u3qc_can(0, q);
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;
}
2018-03-15 03:53:12 +03:00
u3_noun
u3qe_jam(u3_atom a)
{
return _jam_cap(a);
}
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;
}