jets: refactors and optimizes tree-math jets

pkg/noun/imprison.c

@@ -149,6 +149,21 @@ u3i_slab_from(u3i_slab* sab_u, u3_atom a, c3_g met_g, c3_d len_d)
   //  copies [a], zero-initializes any additional space
   //
   u3r_words(0, sab_u->len_w, sab_u->buf_w, a);
+
+  //  if necessary, mask off extra most-significant bits
+  //  from most-significant word
+  //
+  if ( (5 > met_g) && (u3r_met(5, a) >= sab_u->len_w) ) {
+    //  NB: overflow already checked in _ci_slab_size()
+    //
+    c3_d bit_d = len_d << met_g;
+    c3_w wor_w = bit_d >> 5;
+    c3_w bit_w = bit_d & 0x1f;
+
+    if ( bit_w ) {
+      sab_u->buf_w[wor_w] &= ((c3_w)1 << bit_w) - 1;
+    }
+  }
 }
 
 /* u3i_slab_grow(): resize slab, zero-initializing new space.

pkg/noun/jets/c/cap.c

@@ -5,32 +5,21 @@
 
 #include "noun.h"
 
+u3_noun
+u3qc_cap(u3_atom a)
+{
+  c3_w met_w = u3r_met(0, a);
 
-  u3_noun
-  u3qc_cap(u3_atom a)
-  {
-    c3_w met_w = u3r_met(0, a);
-
-    if ( met_w < 2 ) {
-      return u3m_bail(c3__exit);
-    }
-    else if ( (1 == u3r_bit((met_w - 2), a)) ) {
-      return 3;
-    } else {
-      return 2;
-    }
+  if ( 2 > met_w ) {
+    return u3m_bail(c3__exit);
   }
-  u3_noun
-  u3wc_cap(u3_noun cor)
-  {
-    u3_noun a;
-
-    if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ||
-         (c3n == u3ud(a)) )
-    {
-      return u3m_bail(c3__exit);
-    } else {
-      return u3qc_cap(a);
-    }
+  else {
+    return 2 + u3r_bit((met_w - 2), a);
   }
+}
 
+u3_noun
+u3wc_cap(u3_noun cor)
+{
+  return u3qc_cap(u3x_atom(u3x_at(u3x_sam, cor)));
+}

pkg/noun/jets/c/mas.c

@@ -1,45 +1,48 @@
-/// @file
-
 #include "jets/q.h"
 #include "jets/w.h"
 
 #include "noun.h"
 
+u3_noun
+u3qc_mas(u3_atom a)
+{
+  c3_w b_w;
 
-  u3_noun
-  u3qc_mas(u3_atom a)
-  {
-    c3_w b_w;
-    u3_atom c, d, e, f;
+  if ( c3y == u3a_is_cat(a) ) {
+    b_w = c3_bits_word(a);
 
-    b_w = u3r_met(0, a);
-    if ( b_w < 2 ) {
+    if ( 2 > b_w ) {
       return u3m_bail(c3__exit);
     }
     else {
-      c = u3qc_bex((b_w - 1));
-      d = u3qc_bex((b_w - 2));
-      e = u3qa_sub(a, c);
-      f = u3qc_con(e, d);
-
-      u3z(c);
-      u3z(d);
-      u3z(e);
-
-      return f;
+      a  &= ~((c3_w)1 << (b_w - 1));
+      a  |=  ((c3_w)1 << (b_w - 2));
+      return a;
     }
   }
-  u3_noun
-  u3wc_mas(u3_noun cor)
-  {
-    u3_noun a;
-
-    if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ||
-         (c3n == u3ud(a)) )
-    {
-      return u3m_bail(c3__exit);
-    } else {
-      return u3qc_mas(a);
+  else {
+    b_w = u3r_met(0, a);
+
+    if ( 64 > b_w ) {
+      c3_d a_d = u3r_chub(0, a);
+      a_d  &= ~((c3_d)1 << (b_w - 1));
+      a_d  |=  ((c3_d)1 << (b_w - 2));
+      return u3i_chub(a_d);
+    }
+    else {
+      u3i_slab sab_u;
+      u3i_slab_from(&sab_u, a, 0, b_w - 1);
+
+      b_w -= 2;
+      sab_u.buf_w[(b_w >> 5)] |= ((c3_w)1 << (b_w & 31));
+
+      return u3i_slab_mint(&sab_u);
     }
   }
+}
 
+u3_noun
+u3wc_mas(u3_noun cor)
+{
+  return u3qc_mas(u3x_atom(u3x_at(u3x_sam, cor)));
+}

pkg/noun/jets/c/peg.c

@@ -1,50 +1,66 @@
-/// @file
-
 #include "jets/q.h"
 #include "jets/w.h"
 
 #include "noun.h"
 
+u3_noun
+u3qc_peg(u3_atom a, u3_atom b)
+{
+  if ( (0 == a) || (0 == b) ) {
+    return u3m_bail(c3__exit);
+  }
+  else if ( 1 == b ) {
+    return u3k(a);
+  }
 
-  u3_noun
-  u3qc_peg(u3_atom a,
-           u3_atom b)
-  {
-    if ( 1 == b ) {
-      return u3k(a);
-    }
+  c3_d a_d, b_d;
+  c3_w c_w;
 
-    u3_atom c, d, e, f, g, h;
+  if ( (c3y == u3a_is_cat(a)) && (c3y == u3a_is_cat(b)) ) {
+    c_w = c3_bits_word(b) - 1;
+    a_d = a;
+    b_d = b;
+  }
+  else {
+    c3_w d_w = u3r_met(0, a);
+    c3_d e_d;
 
-    c = u3r_met(0, b);
-    d = u3qa_dec(c);
-    e = u3qc_lsh(0, d, 1);
-    f = u3qa_sub(b, e);
-    g = u3qc_lsh(0, d, a);
-    h = u3qa_add(f, g);
+    c_w = u3r_met(0, b) - 1;
+    e_d = (c3_d)c_w + d_w;
 
-    u3z(c);
-    u3z(d);
-    u3z(e);
-    u3z(f);
-    u3z(g);
+    if ( 64 <= e_d ) {
+      u3i_slab sab_u;
+      u3i_slab_init(&sab_u, 0, e_d);
 
-    return h;
-  }
-  u3_noun
-  u3wc_peg(u3_noun cor)
-  {
-    u3_noun a, b;
-
-    if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
-         (0 == a) ||
-         (0 == b) ||
-         (c3n == u3ud(b)) ||
-         (c3n == u3ud(a) && b != 1) )
-    {
-      return u3m_bail(c3__exit);
-    } else {
-      return u3qc_peg(a, b);
+      u3r_chop(0, 0, c_w,   0, sab_u.buf_w, b);
+      u3r_chop(0, 0, d_w, c_w, sab_u.buf_w, a);
+
+      return u3i_slab_moot(&sab_u);
     }
+
+    a_d = u3r_chub(0, a);
+    b_d = u3r_chub(0, b);
   }
 
+  b_d  &= ((c3_d)1 << c_w) - 1;
+  a_d <<= c_w;
+  a_d  ^= b_d;
+
+  return u3i_chub(a_d);
+}
+
+u3_noun
+u3wc_peg(u3_noun cor)
+{
+  u3_noun a, b;
+
+  if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_3, &b, 0)) ||
+       (c3n == u3ud(b)) ||
+       (c3n == u3ud(a) && b != 1) )
+  {
+    return u3m_bail(c3__exit);
+  }
+  else {
+    return u3qc_peg(a, b);
+  }
+}

pkg/noun/jets_tests.c

@@ -860,6 +860,71 @@ _test_ob(void)
   return ret_i;
 }
 
+static c3_i
+_test_mas(void)
+{
+  c3_i  ret_i = 1;
+  u3_atom res;
+
+  if ( 0x4000 != (res = u3qc_mas(0x8000)) ) {
+    fprintf(stderr, "test mas fail: (mas 0x8000) != 0x4000: 0x'%x'\r\n", res);
+    ret_i = 0;
+  }
+
+  if ( 0x20000000 != (res = u3qc_mas(0x40000000)) ) {
+    fprintf(stderr, "test mas fail: (mas 0x4000.0000) != 0x2000.0000: 0x%x\r\n", res);
+    ret_i = 0;
+  }
+
+  {
+    u3_atom sam, pro;
+
+    sam = u3qc_bex(36);
+    pro = u3qc_bex(35);
+    res = u3qc_mas(sam);
+
+    if ( c3n == u3r_sing(pro, res) ) {
+      c3_c* out_c;
+      u3s_etch_ux_c(res, &out_c);
+      fprintf(stderr, "test mas fail: (mas (bex 36)) != (bex 35): %s\r\n", out_c);
+      c3_free(out_c);
+      ret_i = 0;
+    }
+
+    u3z(res); u3z(sam); u3z(pro);
+
+    sam = u3qc_bex(64);
+    pro = u3qc_bex(63);
+    res = u3qc_mas(sam);
+
+    if ( c3n == u3r_sing(pro, res) ) {
+      c3_c* out_c;
+      u3s_etch_ux_c(res, &out_c);
+      fprintf(stderr, "test mas fail: (mas (bex 64)) != (bex 63): %s\r\n", out_c);
+      c3_free(out_c);
+      ret_i = 0;
+    }
+
+    u3z(res); u3z(sam); u3z(pro);
+
+    sam = u3qc_bex(65);
+    pro = u3qc_bex(64);
+    res = u3qc_mas(sam);
+
+    if ( c3n == u3r_sing(pro, res) ) {
+      c3_c* out_c;
+      u3s_etch_ux_c(res, &out_c);
+      fprintf(stderr, "test mas fail: (mas (bex 65)) != (bex 64): %s\r\n", out_c);
+      c3_free(out_c);
+      ret_i = 0;
+    }
+
+    u3z(res); u3z(sam); u3z(pro);
+  }
+
+  return ret_i;
+}
+
 static c3_i
 _test_jets(void)
 {
@@ -900,6 +965,11 @@ _test_jets(void)
     ret_i = 0;
   }
 
+  if ( !_test_mas() ) {
+    fprintf(stderr, "test jets: mas: failed\r\n");
+    ret_i = 0;
+  }
+
   return ret_i;
 }