up_vip.c (3945B)
1 #include "all.h" 2 3 u3_noun 4 u3qdu_vip(u3_noun a, u3_noun k, u3_atom p, u3_noun v) 5 { 6 if (u3_nul == a) { 7 return u3nc(u3_nul, 8 u3nq(c3__tip, u3k(k), u3k(p), u3nc(u3k(v), u3_nul))); 9 } 10 11 u3_atom hoc = u3h(a); 12 13 if (c3n == u3ud(hoc)) { 14 return u3m_bail(c3__exit); 15 } 16 else switch ( hoc) { 17 default: 18 return u3m_bail(c3__exit); 19 20 case c3__tip: { 21 u3_noun ka, pa, va; 22 u3x_trel(u3t(a), &ka, &pa, &va); 23 24 u3_noun vva, tva; 25 u3x_cell(va, &vva, &tva); 26 27 u3_atom mk = u3r_mug(k); 28 u3_atom mka = u3r_mug(ka); 29 30 if (c3y == u3r_sing(mk, mka)) { 31 if (c3y == u3r_sing(k, ka)) { 32 return u3nc(u3nt(u3_nul, u3k(pa), u3k(vva)), 33 u3nc(c3__tip, u3qdu_qor_sink(tva, k, p, v))); 34 } 35 else { 36 u3_noun got = u3qdu_qor_get(tva, k); 37 u3_noun buc = u3nc(u3k(vva), u3qdu_qor_put(tva, k, p, v)); 38 u3_noun pro = u3nc(u3k(got), 39 u3nq(c3__tip, u3k(ka), u3k(pa), u3k(buc))); 40 41 u3z(got); 42 u3z(buc); 43 return pro; 44 } 45 } 46 else { 47 u3_noun lef = u3nq(c3__tip, u3k(k), u3k(p), u3nc(u3k(v), u3_nul)); 48 u3_noun pro = u3nc(u3_nul, u3qdu_rule(ka, pa, va, lef, u3_nul)); 49 50 u3z(lef); 51 return pro; 52 } 53 } 54 55 case c3__bin: { 56 u3_noun ka, pa, va, ta, ma, la, ra; 57 u3x_qual(u3t(a), &ka, &pa, &va, &ta); 58 u3x_trel(ta, &ma, &la, &ra); 59 60 if (c3y == u3qdu_feud(ma, k, ka)) { 61 u3_noun lef = u3nq(c3__tip, u3k(k), u3k(p), u3nc(u3k(v), u3_nul)); 62 u3_noun rye = u3qdu_fuse(ma, la, ra); 63 64 u3_noun pro = u3nc(u3_nul, u3qdu_rule(ka, pa, va, lef, rye)); 65 66 u3z(lef); 67 u3z(rye); 68 69 return pro; 70 } 71 72 u3_noun mk = u3r_mug(k); 73 u3_noun mka = u3r_mug(ka); 74 75 if (c3y == u3r_sing(mk, mka)) { 76 77 u3_noun vva, tva; 78 u3x_cell(va, &vva, &tva); 79 80 if (c3y == u3r_sing(k, ka)) { 81 u3_noun val = u3qdu_qor_sink(tva, k, p, v); 82 83 u3_noun pv, qv, rv; 84 u3x_trel(val, &pv, &qv, &rv); 85 86 if (c3y == u3qdu_zero(ma, pv)) { 87 u3_noun lef = u3qdu_qat_raw(la, pv, qv, rv); 88 u3_noun pro = u3nc(u3nt(u3_nul, u3k(pa), u3k(vva)), 89 u3qdu_fuse(ma, lef, ra)); 90 91 u3z(val); 92 u3z(lef); 93 94 return pro; 95 } 96 else { 97 u3_noun rye = u3qdu_qat_raw(ra, pv, qv, rv); 98 u3_noun pro = u3nc(u3nt(u3_nul, u3k(pa), u3k(vva)), 99 u3qdu_fuse(ma, la, rye)); 100 101 u3z(val); 102 u3z(rye); 103 104 return pro; 105 } 106 } 107 else { 108 u3_noun got = u3qdu_qor_get(tva, k); 109 u3_noun buc = u3nc(u3k(vva), u3qdu_qor_put(tva, k, p, v)); 110 u3_noun pro = u3nc(u3k(got), 111 u3nq(c3__bin, u3k(ka), u3k(pa), 112 u3nq(u3k(buc), u3k(ma), u3k(la), u3k(ra)))); 113 114 u3z(got); 115 u3z(buc); 116 117 return pro; 118 } 119 120 } 121 else if (c3y == u3qdu_zero(ma, k)) { 122 u3_noun val = u3qdu_vip(la, k, p, v); 123 u3_noun pro = u3nc(u3k(u3h(val)), 124 u3nq(c3__bin, u3k(ka), u3k(pa), 125 u3nq(u3k(va), u3k(ma), u3k(u3t(val)), u3k(ra)))); 126 127 u3z(val); 128 129 return pro; 130 } 131 else { 132 u3_noun val = u3qdu_vip(ra, k, p, v); 133 u3_noun pro = u3nc(u3k(u3h(val)), 134 u3nq(c3__bin, u3k(ka), u3k(pa), 135 u3nq(u3k(va), u3k(ma), u3k(la), u3k(u3t(val))))); 136 137 u3z(val); 138 139 return pro; 140 } 141 } 142 } 143 } 144 145 u3_noun 146 u3wdu_vip(u3_noun cor) 147 { 148 u3_noun a, k, p, v; 149 150 if ( (c3n == u3r_mean(cor, u3x_sam_2, &a, u3x_sam_6, &k, u3x_sam_14, &p, 151 u3x_sam_15, &v, 0)) || 152 (c3n == u3ud(p)) ) 153 { 154 return u3m_bail(c3__exit); 155 } else { 156 return u3qdu_vip(a, k, p, v); 157 } 158 } 159 160