diff --git a/pkg/noun/build.zig b/pkg/noun/build.zig index d6c2df3d70..c46f1029ab 100644 --- a/pkg/noun/build.zig +++ b/pkg/noun/build.zig @@ -235,6 +235,7 @@ const c_source_files = [_][]const u8{ "jets/c/rig.c", "jets/c/rip.c", "jets/c/rsh.c", + "jets/c/sew.c", "jets/c/sqt.c", "jets/c/swp.c", "jets/c/xeb.c", diff --git a/pkg/noun/jets/137/tree.c b/pkg/noun/jets/137/tree.c index 2bfd1f3392..1ce21ebf99 100644 --- a/pkg/noun/jets/137/tree.c +++ b/pkg/noun/jets/137/tree.c @@ -1084,6 +1084,7 @@ static u3j_core _137_two__in_d[] = static u3j_harm _137_two_rig_a[] = {{".2", u3wc_rig, c3n}, {}}; static u3j_harm _137_two_mate_a[] = {{".2", u3wb_mate, c3y}, {}}; +static u3j_harm _137_two_sew_a[] = {{".2", u3wc_sew, c3y}, {}}; static u3j_core _137_two_d[] = { { "tri", 3, 0, _137_tri_d, no_hashes, _137_tri_ho }, @@ -1142,6 +1143,7 @@ static u3j_core _137_two_d[] = { "swp", 7, _137_two_swp_a, 0, no_hashes }, { "rub", 7, _137_two_rub_a, 0, no_hashes }, { "pow", 7, _137_two_pow_a, 0, no_hashes }, + { "sew", 7, _137_two_sew_a, 0, no_hashes }, { "sqt", 7, _137_two_sqt_a, 0, no_hashes }, { "xeb", 7, _137_two_xeb_a, 0, no_hashes }, diff --git a/pkg/noun/jets/c/sew.c b/pkg/noun/jets/c/sew.c new file mode 100644 index 0000000000..fd85d0b9c7 --- /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); + } +} diff --git a/pkg/noun/jets/q.h b/pkg/noun/jets/q.h index 5160058a9d..ee059c43f4 100644 --- a/pkg/noun/jets/q.h +++ b/pkg/noun/jets/q.h @@ -79,6 +79,7 @@ u3_noun u3qc_rig(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/w.h b/pkg/noun/jets/w.h index 48380b829f..2a2a2c9999 100644 --- a/pkg/noun/jets/w.h +++ b/pkg/noun/jets/w.h @@ -82,6 +82,7 @@ u3_noun u3wc_rig(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);