1/* Parameterize subset_of code over the euqality predicate, so that
2   an eq variant (for small enough tables) can be marked as non-GCing */
3
4HAMT_NONGCING static int HAMT_ELEMENT_OF_COLLISION(Scheme_Object *key1, Scheme_Object *val1,
5                                                   Scheme_Hash_Tree *t2,
6                                                   int stype, void *eql_data)
7/* linear search for an element */
8{
9  int i;
10  Scheme_Object *key2;
11  HAMT_IF_VAL(Scheme_Object *val2, );
12
13  for (i = t2->count; i--; ) {
14    hamt_at_index(t2, i, &key2, HAMT_IF_VAL(&val2, NULL), NULL);
15    if (HAMT_EQUAL_ENTRIES(stype, eql_data,
16                           key1, val1,
17                           key2, HAMT_IF_VAL(val2, NULL)))
18      return 1;
19  }
20
21  return 0;
22}
23
24HAMT_NONGCING static int HAMT_ELEMENT_OF(Scheme_Object *key1, Scheme_Object *val1, uintptr_t code1,
25                                         Scheme_Hash_Tree *t2, int shift,
26                                         int stype, void *eql_data)
27/* search for one element in a subtree */
28{
29  int pos2;
30
31  t2 = hamt_assoc(t2, code1, &pos2, shift);
32  if (t2) {
33    if (HASHTR_COLLISIONP(t2->els[pos2]))
34      return HAMT_ELEMENT_OF_COLLISION(key1, val1, (Scheme_Hash_Tree *)t2->els[pos2], stype, eql_data);
35    else
36      return HAMT_EQUAL_ENTRIES(stype, eql_data,
37                                key1, val1,
38                                t2->els[pos2], HAMT_IF_VAL(mzHAMT_VAL(t2, pos2), NULL));
39  } else
40    return 0;
41}
42
43HAMT_NONGCING int HAMT_SUBSET_OF(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2, int shift,
44                                 int stype, void *eql_data)
45/* checks whether `t1` is a subset of `t2`; `t1` and `t2` must be of the same kind */
46{
47  hash_tree_bitmap_t i;
48  int pos1, pos2, index, popcount1, popcount2;
49  Scheme_Object *k1, *k2;
50
51  if ((t1->bitmap & t2->bitmap) != t1->bitmap)
52    return 0;
53
54  popcount1 = hamt_popcount(t1->bitmap);
55  popcount2 = hamt_popcount(t2->bitmap);
56
57  for (i = t1->bitmap, pos1 = 0, index = 0; i; ) {
58    if (i & 1) {
59      pos2 = hamt_popcount_below(t2->bitmap, index);
60      k1 = t1->els[pos1];
61      k2 = t2->els[pos2];
62      if (SAME_OBJ(k1, k2)) {
63        if (HAMT_IF_VAL(0, 1)
64            || HASHTR_SUBTREEP(k1)
65            || HASHTR_COLLISIONP(k1)) {
66          /* Shared element, subtree, or collision; no need to look further */
67        } else {
68          /* need to compare values */
69          if (!HAMT_EQUAL_ENTRIES(stype, eql_data,
70                                  k1, HAMT_IF_VAL(_mzHAMT_VAL(t1, pos1, popcount1), NULL),
71                                  k2, HAMT_IF_VAL(_mzHAMT_VAL(t2, pos2, popcount2), NULL)))
72            return 0;
73        }
74      } else if (HASHTR_SUBTREEP(k1)) {
75        /* Since a subtree always has at least two items with different
76           hashes, t2 must have a subtree in the same position */
77        if (HASHTR_SUBTREEP(k2)) {
78          if (!HAMT_SUBSET_OF((Scheme_Hash_Tree *)k1,
79                              (Scheme_Hash_Tree *)k2,
80                              shift + mzHAMT_LOG_WORD_SIZE,
81                              stype, eql_data))
82            return 0;
83        } else
84          return 0;
85      } else if (HASHTR_COLLISIONP(k1)) {
86        intptr_t i;
87        Scheme_Object *key;
88        HAMT_IF_VAL(Scheme_Object *val, );
89
90        if (HASHTR_SUBTREEP(k2)) {
91          /* check each element of collision */
92          uintptr_t code;
93          code = _mzHAMT_CODE(t1, pos1, popcount1);
94          for (i = ((Scheme_Hash_Tree *)k1)->count; i--; ) {
95            hamt_at_index(((Scheme_Hash_Tree *)k1), i, &key, HAMT_IF_VAL(&val, NULL), NULL);
96            if (!HAMT_ELEMENT_OF(key, HAMT_IF_VAL(val, NULL), code,
97                                 (Scheme_Hash_Tree *)k2,
98                                 shift + mzHAMT_LOG_WORD_SIZE,
99                                 stype, eql_data))
100              return 0;
101          }
102        } else if (HASHTR_COLLISIONP(k2)) {
103          /* hash codes of collisions must match */
104          if (_mzHAMT_CODE(t1, pos1, popcount1) != _mzHAMT_CODE(t2, pos2, popcount2))
105            return 0;
106          /* must check each element of t1 in t2 */
107          for (i = ((Scheme_Hash_Tree *)k1)->count; i--; ) {
108            hamt_at_index((Scheme_Hash_Tree *)k1, i, &key, HAMT_IF_VAL(&val, NULL), NULL);
109            if (!HAMT_ELEMENT_OF_COLLISION(key, HAMT_IF_VAL(val, NULL),
110                                           (Scheme_Hash_Tree *)k2,
111                                           stype, eql_data))
112              return 0;
113          }
114        } else {
115          /* A single element in t2 can't cover everything in the collision */
116          return 0;
117        }
118      } else {
119        if (HASHTR_SUBTREEP(k2)) {
120          if (!HAMT_ELEMENT_OF(k1, HAMT_IF_VAL(_mzHAMT_VAL(t1, pos1, popcount1), NULL),
121                               _mzHAMT_CODE(t1, pos1, popcount1),
122                               (Scheme_Hash_Tree *)k2,
123                               shift + mzHAMT_LOG_WORD_SIZE,
124                               stype, eql_data))
125            return 0;
126        } else {
127          /* two elements or an element and a collision;
128             hash codes much match either way */
129          if (_mzHAMT_CODE(t1, pos1, popcount1) != _mzHAMT_CODE(t2, pos2, popcount2))
130            return 0;
131          if (HASHTR_COLLISIONP(k2)) {
132            /* look for an individual value in t2: */
133            if (!HAMT_ELEMENT_OF_COLLISION(k1, HAMT_IF_VAL(_mzHAMT_VAL(t1, pos1, popcount1), NULL),
134                                           (Scheme_Hash_Tree *)k2,
135                                           stype, eql_data))
136              return 0;
137          } else {
138            if (!HAMT_EQUAL_ENTRIES(stype, eql_data,
139                                    k1, HAMT_IF_VAL(_mzHAMT_VAL(t1, pos1, popcount1), NULL),
140                                    k2, HAMT_IF_VAL(_mzHAMT_VAL(t2, pos2, popcount2), NULL)))
141              return 0;
142          }
143        }
144      }
145      pos1++;
146      HAMT_USE_FUEL(1);
147      i >>= 1;
148      index++;
149    } else if (i & 0xFF) {
150      i >>= 1;
151      index++;
152    } else {
153      i >>= 8;
154      index += 8;
155    }
156  }
157
158  return 1;
159}
160
161#undef HAMT_NONGCING
162#undef HAMT_SUBSET_OF
163#undef HAMT_ELEMENT_OF
164#undef HAMT_ELEMENT_OF_COLLISION
165#undef HAMT_EQUAL_ENTRIES
166#undef HAMT_IF_VAL
167#undef HAMT_USE_FUEL
168