diff options
Diffstat (limited to 'vere/pkg/noun/jets/b')
-rw-r--r-- | vere/pkg/noun/jets/b/bind.c | 30 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/clap.c | 36 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/find.c | 50 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/flop.c | 34 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/lent.c | 37 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/levy.c | 51 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/lien.c | 51 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/mate.c | 30 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/murn.c | 54 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/need.c | 30 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/reap.c | 41 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/reel.c | 52 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/roll.c | 44 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/scag.c | 53 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/skid.c | 62 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/skim.c | 56 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/skip.c | 56 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/slag.c | 43 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/snag.c | 44 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/sort.c | 125 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/turn.c | 49 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/weld.c | 48 | ||||
-rw-r--r-- | vere/pkg/noun/jets/b/zing.c | 47 |
23 files changed, 1123 insertions, 0 deletions
diff --git a/vere/pkg/noun/jets/b/bind.c b/vere/pkg/noun/jets/b/bind.c new file mode 100644 index 0000000..7f37a69 --- /dev/null +++ b/vere/pkg/noun/jets/b/bind.c @@ -0,0 +1,30 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qb_bind(u3_noun a, + u3_noun b) + { + if ( 0 == a ) { + return 0; + } else { + return u3nc(0, u3n_slam_on(u3k(b), u3k(u3t(a)))); + } + } + u3_noun + u3wb_bind(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0) ) { + return u3m_bail(c3__exit); + } else { + return u3qb_bind(a, b); + } + } + diff --git a/vere/pkg/noun/jets/b/clap.c b/vere/pkg/noun/jets/b/clap.c new file mode 100644 index 0000000..9cfb41a --- /dev/null +++ b/vere/pkg/noun/jets/b/clap.c @@ -0,0 +1,36 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qb_clap(u3_noun a, + u3_noun b, + u3_noun c) + { + if ( 0 == a ) { + return u3k(b); + } + else if ( 0 == b ) { + return u3k(a); + } + else { + return u3nc(0, u3n_slam_on(u3k(c), u3nc(u3k(u3t(a)), u3k(u3t(b))))); + } + } + u3_noun + u3wb_clap(u3_noun cor) + { + u3_noun a, b, c; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, + u3x_sam_6, &b, + u3x_sam_7, &c, 0) ) { + return u3m_bail(c3__exit); + } else { + return u3qb_clap(a, b, c); + } + } diff --git a/vere/pkg/noun/jets/b/find.c b/vere/pkg/noun/jets/b/find.c new file mode 100644 index 0000000..c0295d2 --- /dev/null +++ b/vere/pkg/noun/jets/b/find.c @@ -0,0 +1,50 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +STATIC_ASSERT( (UINT32_MAX > u3a_cells), + "list index precision" ); + +u3_noun +u3qb_find(u3_noun nedl, u3_noun hstk) +{ + if ( u3_nul != nedl ) { + c3_w i_w = 0; + + while ( u3_nul != hstk ) { + u3_noun i_h, t_h = hstk; + u3_noun i_n, t_n = nedl; + u3x_cell(t_h, &i_h, &t_h); + u3x_cell(t_n, &i_n, &t_n); + + while ( c3y == u3r_sing(i_n, i_h) ) { + if ( u3_nul == t_n ) { + return u3nc(u3_nul, u3i_word(i_w)); + } + else if ( u3_nul == t_h ) { + break; + } + else { + u3x_cell(t_h, &i_h, &t_h); + u3x_cell(t_n, &i_n, &t_n); + } + } + + hstk = u3t(hstk); + i_w++; + } + } + + return u3_nul; +} + +u3_noun +u3wb_find(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_find(a, b); +} diff --git a/vere/pkg/noun/jets/b/flop.c b/vere/pkg/noun/jets/b/flop.c new file mode 100644 index 0000000..0574e4e --- /dev/null +++ b/vere/pkg/noun/jets/b/flop.c @@ -0,0 +1,34 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_flop(u3_noun a) +{ + u3_noun i, t = a, b = u3_nul; + + while ( u3_nul != t ) { + u3x_cell(t, &i, &t); + b = u3nc(u3k(i), b); + } + + return b; +} + +u3_noun +u3wb_flop(u3_noun cor) +{ + return u3qb_flop(u3x_at(u3x_sam, cor)); +} + +u3_noun +u3kb_flop(u3_noun a) +{ + u3_noun b = u3qb_flop(a); + u3z(a); + return b; +} diff --git a/vere/pkg/noun/jets/b/lent.c b/vere/pkg/noun/jets/b/lent.c new file mode 100644 index 0000000..aa3a701 --- /dev/null +++ b/vere/pkg/noun/jets/b/lent.c @@ -0,0 +1,37 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +STATIC_ASSERT( (UINT32_MAX > u3a_cells), + "length precision" ); + +u3_noun +u3qb_lent(u3_noun a) +{ + c3_w len_w = 0; + + while ( u3_nul != a ) { + a = u3t(a); + len_w++; + } + + return u3i_word(len_w); +} + +u3_noun +u3wb_lent(u3_noun cor) +{ + return u3qb_lent(u3x_at(u3x_sam, cor)); +} + +u3_noun +u3kb_lent(u3_noun a) +{ + u3_noun b = u3qb_lent(a); + u3z(a); + return b; +} diff --git a/vere/pkg/noun/jets/b/levy.c b/vere/pkg/noun/jets/b/levy.c new file mode 100644 index 0000000..39d6f39 --- /dev/null +++ b/vere/pkg/noun/jets/b/levy.c @@ -0,0 +1,51 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + u3_noun + u3qb_levy(u3_noun a, + u3_noun b) + { + u3_noun pro = c3y; + c3_o loz_o; + + if ( u3_nul != a ) { + u3j_site sit_u; + u3_noun i, t; + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + loz_o = u3x_loob(u3j_gate_slam(&sit_u, u3k(i))); + if ( c3n == loz_o ) { + pro = c3n; + break; + } + + t = u3k(u3t(a)); + u3z(a), a = t; + } while ( u3_nul != a ); + + u3z(a); + u3j_gate_lose(&sit_u); + } + + return pro; + } + + u3_noun + u3wb_levy(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0) ) { + return u3m_bail(c3__exit); + } else { + return u3qb_levy(a, b); + } + } diff --git a/vere/pkg/noun/jets/b/lien.c b/vere/pkg/noun/jets/b/lien.c new file mode 100644 index 0000000..2a9290a --- /dev/null +++ b/vere/pkg/noun/jets/b/lien.c @@ -0,0 +1,51 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + u3_noun + u3qb_lien(u3_noun a, + u3_noun b) + { + u3_noun pro = c3n; + c3_o loz_o; + + if ( u3_nul != a ) { + u3j_site sit_u; + u3_noun i, t; + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + loz_o = u3x_loob(u3j_gate_slam(&sit_u, u3k(i))); + if ( c3y == loz_o ) { + pro = c3y; + break; + } + + t = u3k(u3t(a)); + u3z(a), a = t; + } while ( u3_nul != a ); + + u3z(a); + u3j_gate_lose(&sit_u); + } + + return pro; + } + + u3_noun + u3wb_lien(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0) ) { + return u3m_bail(c3__exit); + } else { + return u3qb_lien(a, b); + } + } diff --git a/vere/pkg/noun/jets/b/mate.c b/vere/pkg/noun/jets/b/mate.c new file mode 100644 index 0000000..f8dbd31 --- /dev/null +++ b/vere/pkg/noun/jets/b/mate.c @@ -0,0 +1,30 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qb_mate(u3_noun a, + u3_noun b) + { + if ( u3_nul == b ) { + return u3k(a); + } else if ( u3_nul == a ) { + return u3k(b); + } else if ( c3y == u3r_sing(u3t(a), u3t(b)) ) { + return u3k(a); + } else { + return u3m_error("mate"); + } + } + u3_noun + u3wb_mate(u3_noun cor) + { + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_mate(a, b); + } + diff --git a/vere/pkg/noun/jets/b/murn.c b/vere/pkg/noun/jets/b/murn.c new file mode 100644 index 0000000..dcb592b --- /dev/null +++ b/vere/pkg/noun/jets/b/murn.c @@ -0,0 +1,54 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_murn(u3_noun a, u3_noun b) +{ + u3_noun pro; + u3_noun* lit = &pro; + + if ( u3_nul != a ) { + u3_noun* hed; + u3_noun* tel; + u3_noun res, i, t; + u3j_site sit_u; + + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + res = u3j_gate_slam(&sit_u, u3k(i)); + + if ( u3_nul != res ) { + *lit = u3i_defcons(&hed, &tel); + *hed = u3k(u3t(res)); + lit = tel; + u3z(res); + } + + t = u3k(u3t(a)); + u3z(a), a = t; + } + while ( u3_nul != a ); + + u3j_gate_lose(&sit_u); + } + + *lit = u3_nul; + + return pro; +} + +u3_noun +u3wb_murn(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_murn(a, b); +} diff --git a/vere/pkg/noun/jets/b/need.c b/vere/pkg/noun/jets/b/need.c new file mode 100644 index 0000000..8723699 --- /dev/null +++ b/vere/pkg/noun/jets/b/need.c @@ -0,0 +1,30 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qb_need(u3_noun a) + { + if ( 0 == a ) { + return u3m_bail(c3__exit); + } + else { + return u3k(u3t(a)); + } + } + u3_noun + u3wb_need(u3_noun cor) + { + u3_noun a; + + if ( u3_none == (a = u3r_at(u3x_sam, cor)) ) { + return u3m_bail(c3__exit); + } else { + return u3qb_need(a); + } + } + diff --git a/vere/pkg/noun/jets/b/reap.c b/vere/pkg/noun/jets/b/reap.c new file mode 100644 index 0000000..35dd055 --- /dev/null +++ b/vere/pkg/noun/jets/b/reap.c @@ -0,0 +1,41 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qb_reap(u3_atom a, + u3_noun b) + { + if ( !_(u3a_is_cat(a)) ) { + return u3m_bail(c3__fail); + } + else { + u3_noun acc = u3_nul; + c3_w i_w = a; + + while ( i_w ) { + acc = u3nc(u3k(b), acc); + i_w--; + } + + return acc; + } + } + + u3_noun + u3wb_reap(u3_noun cor) + { + u3_noun a, b; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) || + (c3n == u3ud(a)) ) + { + return u3m_bail(c3__exit); + } else { + return u3qb_reap(a, b); + } + } diff --git a/vere/pkg/noun/jets/b/reel.c b/vere/pkg/noun/jets/b/reel.c new file mode 100644 index 0000000..fe84f5a --- /dev/null +++ b/vere/pkg/noun/jets/b/reel.c @@ -0,0 +1,52 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + u3_noun + u3qb_reel(u3_noun a, + u3_noun b) + { + u3_noun pro = u3k(u3x_at(u3x_sam_3, b)); + + if ( u3_nul != a ) { + u3a_pile pil_u; + u3j_site sit_u; + u3_noun* top; + u3_noun i, t = a; + + u3a_pile_prep(&pil_u, sizeof(u3_noun)); + + // push list onto road stack + // + do { + u3x_cell(t, &i, &t); + top = u3a_push(&pil_u); + *top = u3k(i); + } while ( u3_nul != t ); + + u3j_gate_prep(&sit_u, u3k(b)); + + while ( c3n == u3a_pile_done(&pil_u) ) { + pro = u3j_gate_slam(&sit_u, u3nc(*top, pro)); + top = u3a_pop(&pil_u); + } + + u3j_gate_lose(&sit_u); + } + + return pro; + } + u3_noun + u3wb_reel(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0) ) { + return u3m_bail(c3__exit); + } else { + return u3qb_reel(a, b); + } + } diff --git a/vere/pkg/noun/jets/b/roll.c b/vere/pkg/noun/jets/b/roll.c new file mode 100644 index 0000000..66a4726 --- /dev/null +++ b/vere/pkg/noun/jets/b/roll.c @@ -0,0 +1,44 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + u3_noun + u3qb_roll(u3_noun a, + u3_noun b) + { + u3_noun pro = u3k(u3x_at(u3x_sam_3, b)); + + if ( u3_nul != a ) { + u3j_site sit_u; + u3_noun i, t; + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + pro = u3j_gate_slam(&sit_u, u3nc(u3k(i), pro)); + + t = u3k(u3t(a)); + u3z(a), a = t; + } while ( u3_nul != a ); + u3j_gate_lose(&sit_u); + } + + return pro; + } + u3_noun + u3wb_roll(u3_noun cor) + { + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0) ) { + return u3m_bail(c3__exit); + } else { + return u3qb_roll(a, b); + } + } + diff --git a/vere/pkg/noun/jets/b/scag.c b/vere/pkg/noun/jets/b/scag.c new file mode 100644 index 0000000..d13dd46 --- /dev/null +++ b/vere/pkg/noun/jets/b/scag.c @@ -0,0 +1,53 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_scag(u3_atom a, u3_noun b) +{ + if ( u3_nul == b ) { + return u3_nul; + } + else if ( !_(u3a_is_cat(a)) ) { + return u3m_bail(c3__fail); + } + else { + u3_noun pro; + u3_noun* lit = &pro; + + { + c3_w len_w = (c3_w)a; + u3_noun* hed; + u3_noun* tel; + u3_noun i, t = b; + + while ( len_w-- && (u3_nul != t) ) { + u3x_cell(t, &i, &t); + + *lit = u3i_defcons(&hed, &tel); + *hed = u3k(i); + lit = tel; + } + } + + *lit = u3_nul; + + return pro; + } +} + +u3_noun +u3wb_scag(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + + if ( (c3n == u3ud(a)) && (u3_nul != b) ) { + return u3m_bail(c3__exit); + } + + return u3qb_scag(a, b); +} diff --git a/vere/pkg/noun/jets/b/skid.c b/vere/pkg/noun/jets/b/skid.c new file mode 100644 index 0000000..8d0d7ef --- /dev/null +++ b/vere/pkg/noun/jets/b/skid.c @@ -0,0 +1,62 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_skid(u3_noun a, u3_noun b) +{ + u3_noun l, r; + u3_noun* lef = &l; + u3_noun* rig = &r; + + if ( u3_nul != a) { + u3_noun i, t; + u3_noun* hed; + u3_noun* tel; + u3j_site sit_u; + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + switch ( u3j_gate_slam(&sit_u, u3k(i)) ) { + case c3y: { + *lef = u3i_defcons(&hed, &tel); + *hed = u3k(i); + lef = tel; + } break; + + case c3n: { + *rig = u3i_defcons(&hed, &tel); + *hed = u3k(i); + rig = tel; + } break; + + default: u3m_bail(c3__exit); + } + + t = u3k(u3t(a)); + u3z(a), a = t; + } + while ( u3_nul != a ); + + u3j_gate_lose(&sit_u); + } + + *lef = u3_nul; + *rig = u3_nul; + + return u3nc(l, r); +} + +u3_noun +u3wb_skid(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_skid(a, b); +} diff --git a/vere/pkg/noun/jets/b/skim.c b/vere/pkg/noun/jets/b/skim.c new file mode 100644 index 0000000..b0f2255 --- /dev/null +++ b/vere/pkg/noun/jets/b/skim.c @@ -0,0 +1,56 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_skim(u3_noun a, u3_noun b) +{ + u3_noun pro; + u3_noun* lit = &pro; + + if ( u3_nul != a) { + u3_noun i, t; + u3_noun* hed; + u3_noun* tel; + u3j_site sit_u; + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + switch ( u3j_gate_slam(&sit_u, u3k(i)) ) { + case c3y: { + *lit = u3i_defcons(&hed, &tel); + *hed = u3k(i); + lit = tel; + } break; + + case c3n: break; + + default: u3m_bail(c3__exit); + } + + t = u3k(u3t(a)); + u3z(a), a = t; + } + while ( u3_nul != a ); + + u3j_gate_lose(&sit_u); + } + + *lit = u3_nul; + + return pro; +} + +u3_noun +u3wb_skim(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_skim(a, b); +} diff --git a/vere/pkg/noun/jets/b/skip.c b/vere/pkg/noun/jets/b/skip.c new file mode 100644 index 0000000..67f537d --- /dev/null +++ b/vere/pkg/noun/jets/b/skip.c @@ -0,0 +1,56 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_skip(u3_noun a, u3_noun b) +{ + u3_noun pro; + u3_noun* lit = &pro; + + if ( u3_nul != a) { + u3_noun i, t; + u3_noun* hed; + u3_noun* tel; + u3j_site sit_u; + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + switch ( u3j_gate_slam(&sit_u, u3k(i)) ) { + case c3y: break; + + case c3n: { + *lit = u3i_defcons(&hed, &tel); + *hed = u3k(i); + lit = tel; + } break; + + default: u3m_bail(c3__exit); + } + + t = u3k(u3t(a)); + u3z(a), a = t; + } + while ( u3_nul != a ); + + u3j_gate_lose(&sit_u); + } + + *lit = u3_nul; + + return pro; +} + +u3_noun +u3wb_skip(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_skip(a, b); +} diff --git a/vere/pkg/noun/jets/b/slag.c b/vere/pkg/noun/jets/b/slag.c new file mode 100644 index 0000000..fad88b0 --- /dev/null +++ b/vere/pkg/noun/jets/b/slag.c @@ -0,0 +1,43 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qb_slag(u3_atom a, u3_noun b) + { + if ( u3_nul == b ) { + return u3_nul; + } + else if ( !_(u3a_is_cat(a)) ) { + return u3m_bail(c3__fail); + } + else { + c3_w len_w = a; + + while ( len_w ) { + if ( c3n == u3du(b) ) { + return u3_nul; + } + b = u3t(b); + len_w--; + } + return u3k(b); + } + } + u3_noun + u3wb_slag(u3_noun cor) + { + u3_noun a, b; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) || + (c3n == u3ud(a) && u3_nul != b) ) + { + return u3m_bail(c3__exit); + } else { + return u3qb_slag(a, b); + } + } diff --git a/vere/pkg/noun/jets/b/snag.c b/vere/pkg/noun/jets/b/snag.c new file mode 100644 index 0000000..4b6dad8 --- /dev/null +++ b/vere/pkg/noun/jets/b/snag.c @@ -0,0 +1,44 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + + u3_noun + u3qb_snag(u3_atom a, + u3_noun b) + { + if ( !_(u3a_is_cat(a)) ) { + return u3m_bail(c3__fail); + } + else { + c3_w len_w = a; + + while ( len_w ) { + if ( c3n == u3du(b) ) { + return u3m_bail(c3__exit); + } + b = u3t(b); + len_w--; + } + if ( c3n == u3du(b) ) { + return u3m_bail(c3__exit); + } + return u3k(u3h(b)); + } + } + u3_noun + u3wb_snag(u3_noun cor) + { + u3_noun a, b; + + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) || + (c3n == u3ud(a)) ) + { + return u3m_bail(c3__exit); + } else { + return u3qb_snag(a, b); + } + } diff --git a/vere/pkg/noun/jets/b/sort.c b/vere/pkg/noun/jets/b/sort.c new file mode 100644 index 0000000..ea5507c --- /dev/null +++ b/vere/pkg/noun/jets/b/sort.c @@ -0,0 +1,125 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + + +static_assert( (UINT32_MAX > u3a_cells), + "length precision" ); + +static_assert( + (UINT32_MAX < (SIZE_MAX / (2 * sizeof(u3_noun)))), + "len_w * sizeof u3_noun overflow" +); + +static void +_merge_sort(u3_noun* restrict arr_u, + u3_noun* restrict tmp_u, + c3_w lef_w, + c3_w rit_w, + u3j_site* sit_u) +{ + if ( lef_w >= rit_w ) return; + c3_w mid_w = (lef_w + rit_w) / 2; + if (mid_w < lef_w) + { + // addition wrapped around + // + u3m_bail(c3__fail); + } + _merge_sort(arr_u, tmp_u, lef_w, mid_w, sit_u); + _merge_sort(arr_u, tmp_u, mid_w + 1, rit_w, sit_u); + + c3_w i_w = lef_w, j_w = mid_w + 1, k_w = lef_w; + while (i_w <= mid_w && j_w <= rit_w) + { + // reversed comparison to mimick order reversal of pivot + // and compared element in Hoon + // + u3_noun sam = u3nc(u3k(arr_u[j_w]), u3k(arr_u[i_w])); + c3_o hoz_o = u3x_loob(u3j_gate_slam(sit_u, sam)); + if ( c3n == hoz_o ) + tmp_u[k_w++] = arr_u[i_w++]; + else + tmp_u[k_w++] = arr_u[j_w++]; + } + + while (i_w <= mid_w) tmp_u[k_w++] = arr_u[i_w++]; + while (j_w <= rit_w) tmp_u[k_w++] = arr_u[j_w++]; + + for (i_w = lef_w; i_w <= rit_w; i_w++) + { + arr_u[i_w] = tmp_u[i_w]; + } +} + +// RETAINS list, transfers product +// +static u3_noun +_sort(u3j_site* sit_u, u3_noun list) +{ + if (u3_nul == list) return u3_nul; + + c3_w len_w = 1; + { + u3_noun t = u3t(list); + while (u3_nul != t) + { + ++len_w; t = u3t(t); + } + } + + if (1 == len_w) return u3k(list); + u3_noun* arr_u = u3a_malloc(sizeof(u3_noun) * len_w * 2); + u3_noun* tmp_u = arr_u + len_w; + for (c3_w i_w = 0; i_w < len_w; i_w++) + { + // inlined u3r_cell without any checks + // since the list was already validated and measured + // + u3a_cell* cel_u = u3a_to_ptr(list); + arr_u[i_w] = u3k(cel_u->hed); + list = cel_u->tel; + } + + _merge_sort(arr_u, tmp_u, 0, len_w - 1, sit_u); + + u3_noun pro = u3_nul; + for (c3_w i_w = len_w; i_w--;) + { + pro = u3nc(arr_u[i_w], pro); + } + + u3a_free(arr_u); + + return pro; +} + +u3_noun +u3qb_sort(u3_noun a, + u3_noun b) +{ + u3_noun pro; + u3j_site sit_u; + u3j_gate_prep(&sit_u, u3k(b)); + pro = _sort(&sit_u, a); + u3j_gate_lose(&sit_u); + return pro; +} + +u3_noun +u3wb_sort(u3_noun cor) +{ + u3_noun a, b; + + if ( c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0) ) + { + return u3m_bail(c3__exit); + } + else + { + return u3qb_sort(a, b); + } +} diff --git a/vere/pkg/noun/jets/b/turn.c b/vere/pkg/noun/jets/b/turn.c new file mode 100644 index 0000000..e5ee5f7 --- /dev/null +++ b/vere/pkg/noun/jets/b/turn.c @@ -0,0 +1,49 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_turn(u3_noun a, u3_noun b) +{ + u3_noun pro; + u3_noun* lit = &pro; + + if ( u3_nul != a ) { + u3_noun* hed; + u3_noun* tel; + u3_noun i, t; + u3j_site sit_u; + + u3j_gate_prep(&sit_u, u3k(b)); + u3k(a); + + do { + i = u3h(a); + + *lit = u3i_defcons(&hed, &tel); + *hed = u3j_gate_slam(&sit_u, u3k(i)); + lit = tel; + + t = u3k(u3t(a)); + u3z(a), a = t; + } + while ( u3_nul != a ); + + u3j_gate_lose(&sit_u); + } + + *lit = u3_nul; + + return pro; +} + +u3_noun +u3wb_turn(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_turn(a, b); +} diff --git a/vere/pkg/noun/jets/b/weld.c b/vere/pkg/noun/jets/b/weld.c new file mode 100644 index 0000000..d50fa1c --- /dev/null +++ b/vere/pkg/noun/jets/b/weld.c @@ -0,0 +1,48 @@ +/// @file + +#include "jets/k.h" +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_weld(u3_noun a, u3_noun b) +{ + u3_noun pro; + u3_noun* lit = &pro; + + { + u3_noun* hed; + u3_noun* tel; + u3_noun i, t = a; + + while ( u3_nul != t ) { + u3x_cell(t, &i, &t); + + *lit = u3i_defcons(&hed, &tel); + *hed = u3k(i); + lit = tel; + } + } + + *lit = u3k(b); + + return pro; +} + +u3_noun +u3wb_weld(u3_noun cor) +{ + u3_noun a, b; + u3x_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0); + return u3qb_weld(a, b); +} + +u3_noun +u3kb_weld(u3_noun a, u3_noun b) +{ + u3_noun c = u3qb_weld(a, b); + u3z(a); u3z(b); + return c; +} diff --git a/vere/pkg/noun/jets/b/zing.c b/vere/pkg/noun/jets/b/zing.c new file mode 100644 index 0000000..1172d5e --- /dev/null +++ b/vere/pkg/noun/jets/b/zing.c @@ -0,0 +1,47 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_noun +u3qb_zing(u3_noun a) +{ + u3_noun pro; + u3_noun* lit = &pro; + + if ( u3_nul == a ) { + *lit = u3_nul; + } + else { + u3_noun i, t = a; + u3x_cell(t, &i, &t); + + while ( u3_nul != t ) { + u3_noun* hed; + u3_noun* tel; + u3_noun i_i, t_i = i; + + while ( u3_nul != t_i ) { + u3x_cell(t_i, &i_i, &t_i); + + *lit = u3i_defcons(&hed, &tel); + *hed = u3k(i_i); + lit = tel; + } + + u3x_cell(t, &i, &t); + } + + *lit = u3k(i); + } + + return pro; +} + +u3_noun +u3wb_zing(u3_noun cor) +{ + return u3qb_zing(u3x_at(u3x_sam, cor)); +} |