diff --git a/pkg/noun/jets/c/sew.c b/pkg/noun/jets/c/sew.c new file mode 100644 index 0000000000..5f27f10cbc --- /dev/null +++ b/pkg/noun/jets/c/sew.c @@ -0,0 +1,74 @@ +/// @file + +#include "jets/q.h" +#include "jets/w.h" + +#include "noun.h" + +u3_weak +u3qc_sew(u3_atom a, + u3_atom b, + u3_atom c, + u3_atom d, + u3_atom e + ) +{ + if (0 == c) return u3k(e); + if ( !_(u3a_is_cat(b)) || + !_(u3a_is_cat(c)) ) { + return u3_none; + } + if ( !_(u3a_is_cat(a)) || (a >= 32) ) { + return u3m_bail(c3__fail); + } + + c3_g a_g = a; + c3_w b_w = b, c_w = c; + c3_w len_e_w = u3r_met(a_g, e); + u3i_slab sab_u; + c3_w* src_w; + c3_w len_src_w; + if ( _(u3a_is_cat(e)) ) { + len_src_w = e ? 1 : 0; + src_w = &e; + } + else { + u3a_atom* src_u = u3a_to_ptr(e); + len_src_w = src_u->len_w; + src_w = src_u->buf_w; + } + u3i_slab_init(&sab_u, a_g, c3_max(len_e_w, b_w + c_w)); + u3r_chop_words(a_g, 0, b_w, 0, sab_u.buf_w, len_src_w, src_w); + u3r_chop(a_g, 0, c_w, b_w, sab_u.buf_w, d); + if (len_e_w > b_w + c_w) { + u3r_chop_words(a_g, + b_w + c_w, + len_e_w - (b_w + c_w), + b_w + c_w, + sab_u.buf_w, + len_src_w, + src_w); + } + return u3i_slab_mint(&sab_u); +} + +u3_weak +u3wc_sew(u3_noun cor) +{ + u3_noun a, b, c, d, e; + if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, + u3x_sam_12, &b, + 106, &c, + 107, &d, + u3x_sam_7, &e, 0)) || + (c3n == u3ud(a)) || + (c3n == u3ud(b)) || + (c3n == u3ud(c)) || + (c3n == u3ud(d)) || + (c3n == u3ud(e)) ) + { + return u3m_bail(c3__fail); + } else { + return u3qc_sew(a, b, c, d, e); + } +} \ No newline at end of file diff --git a/pkg/noun/jets/q.h b/pkg/noun/jets/q.h index fd7c5981fb..b4e57bae70 100644 --- a/pkg/noun/jets/q.h +++ b/pkg/noun/jets/q.h @@ -73,6 +73,7 @@ u3_noun u3qc_rev(u3_atom, u3_atom, u3_atom); u3_noun u3qc_rip(u3_atom, u3_atom, u3_atom); u3_noun u3qc_rsh(u3_atom, u3_atom, u3_atom); + u3_noun u3qc_sew(u3_atom, u3_atom, u3_atom, u3_atom, u3_atom); u3_noun u3qc_swp(u3_atom, u3_atom); u3_noun u3qc_sqt(u3_atom); diff --git a/pkg/noun/jets/tree.c b/pkg/noun/jets/tree.c index e40fe03846..996b3499df 100644 --- a/pkg/noun/jets/tree.c +++ b/pkg/noun/jets/tree.c @@ -2462,6 +2462,7 @@ static u3j_core _138_two__by_d[] = }; static u3j_harm _138_two_mate_a[] = {{".2", u3wb_mate, c3y}, {}}; +static u3j_harm _138_two_sew_a[] = {{".2", u3wc_sew, c3y}, {}}; static u3j_core _138_two_d[] = { { "tri", 3, 0, _138_tri_d, no_hashes, _140_tri_ho }, @@ -2515,6 +2516,7 @@ static u3j_core _138_two_d[] = { "swp", 7, _140_two_swp_a, 0, no_hashes }, { "rub", 7, _140_two_rub_a, 0, no_hashes }, { "pow", 7, _140_two_pow_a, 0, no_hashes }, + { "sew", 7, _138_two_sew_a, 0, no_hashes }, { "sqt", 7, _140_two_sqt_a, 0, no_hashes }, { "xeb", 7, _140_two_xeb_a, 0, no_hashes }, diff --git a/pkg/noun/jets/w.h b/pkg/noun/jets/w.h index 34716971bd..9d53a78281 100644 --- a/pkg/noun/jets/w.h +++ b/pkg/noun/jets/w.h @@ -76,6 +76,7 @@ u3_noun u3wc_rev(u3_noun); u3_noun u3wc_rip(u3_noun); u3_noun u3wc_rsh(u3_noun); + u3_noun u3wc_sew(u3_noun); u3_noun u3wc_swp(u3_noun); u3_noun u3wc_sqt(u3_noun);