1/* struct::set - critcl - layer 0 declarations
2 * Tcl_ObjType 'set'.
3 */
4
5#include <string.h>
6#include "s.h"
7
8/* .................................................. */
9
10static void free_rep   (Tcl_Obj* obj);
11static void dup_rep    (Tcl_Obj* obj, Tcl_Obj* dup);
12static void string_rep (Tcl_Obj* obj);
13static int  from_any   (Tcl_Interp* ip, Tcl_Obj* obj);
14
15static
16Tcl_ObjType s_type = {
17    "tcllib::struct::set/critcl::set",
18    free_rep,
19    dup_rep,
20    string_rep,
21    from_any
22};
23
24/* .................................................. */
25
26int
27s_get (Tcl_Interp* interp, Tcl_Obj* o, SPtr* sStar)
28{
29    if (o->typePtr != &s_type) {
30	int res = from_any (interp, o);
31	if (res != TCL_OK) {
32	    return res;
33	}
34    }
35
36    *sStar = (SPtr) o->internalRep.otherValuePtr;
37    return TCL_OK;
38}
39
40Tcl_Obj*
41s_new (SPtr s)
42{
43    Tcl_Obj* o = Tcl_NewObj();
44    Tcl_InvalidateStringRep(o);
45
46    o->internalRep.otherValuePtr = s;
47    o->typePtr                   = &s_type;
48    return o;
49}
50
51Tcl_ObjType*
52s_stype (void)
53{
54    return &s_type;
55}
56
57Tcl_ObjType*
58s_ltype (void)
59{
60    static Tcl_ObjType* l;
61    if (l == NULL) {
62	l = Tcl_GetObjType ("list");
63    }
64    return l;
65}
66
67/* .................................................. */
68
69static void
70free_rep (Tcl_Obj* o)
71{
72    s_free ((SPtr) o->internalRep.otherValuePtr);
73    o->internalRep.otherValuePtr = NULL;
74}
75
76static void
77dup_rep (Tcl_Obj* obj, Tcl_Obj* dup)
78{
79    SPtr s = s_dup ((SPtr) obj->internalRep.otherValuePtr);
80
81    dup->internalRep.otherValuePtr = s;
82    dup->typePtr	           = &s_type;
83}
84
85static void
86string_rep (Tcl_Obj* obj)
87{
88    SPtr s        = (SPtr) obj->internalRep.otherValuePtr;
89    int  numElems = s->el.numEntries;
90
91    /* iterate hash table and generate list-like string rep */
92
93#   define LOCAL_SIZE 20
94    int localFlags[LOCAL_SIZE], *flagPtr;
95    int localLen  [LOCAL_SIZE], *lenPtr;
96    register int i;
97    char *elem, *dst;
98    int length;
99
100    Tcl_HashSearch hs;
101    Tcl_HashEntry* he;
102
103    /*
104     * Convert each key of the hash to string form and then convert it to
105     * proper list element form, adding it to the result buffer.  */
106
107    /*
108     * Pass 1: estimate space, gather flags.
109     */
110
111    if (numElems <= LOCAL_SIZE) {
112	flagPtr = localFlags;
113	lenPtr  = localLen;
114    } else {
115	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
116	lenPtr  = (int *) ckalloc((unsigned) numElems*sizeof(int));
117    }
118    obj->length = 1;
119
120    for(i = 0, he = Tcl_FirstHashEntry(&s->el, &hs);
121	he != NULL;
122	he = Tcl_NextHashEntry(&hs), i++) {
123
124	elem       = Tcl_GetHashKey (&s->el, he);
125	lenPtr [i] = strlen (elem);
126
127	obj->length += Tcl_ScanCountedElement(elem, lenPtr[i],
128					&flagPtr[i]) + 1;
129    }
130
131    /*
132     * Pass 2: copy into string rep buffer.
133     */
134
135    obj->bytes = ckalloc((unsigned) obj->length);
136    dst = obj->bytes;
137
138    for(i = 0, he = Tcl_FirstHashEntry(&s->el, &hs);
139	he != NULL;
140	he = Tcl_NextHashEntry(&hs), i++) {
141
142	elem = Tcl_GetHashKey (&s->el, he);
143
144	dst += Tcl_ConvertCountedElement(elem, lenPtr[i],
145					 dst, flagPtr[i]);
146	*dst = ' ';
147	dst++;
148    }
149    if (flagPtr != localFlags) {
150	ckfree((char *) flagPtr);
151	ckfree((char *) lenPtr);
152    }
153    if (dst == obj->bytes) {
154	*dst = 0;
155    } else {
156	dst--;
157	*dst = 0;
158    }
159    obj->length = dst - obj->bytes;
160}
161
162static int
163from_any (Tcl_Interp* ip, Tcl_Obj* obj)
164{
165    /* Go through an intermediate list rep.
166     */
167
168    int          lc, i, new;
169    Tcl_Obj**    lv;
170    Tcl_ObjType* oldTypePtr;
171    SPtr         s;
172
173    if (Tcl_ListObjGetElements (ip, obj, &lc, &lv) != TCL_OK) {
174	return TCL_ERROR;
175    }
176
177    /*
178     * Remember the old type after the conversion to list, or we will try to
179     * free a list intrep using the free-proc of whatever type the word had
180     * before. For example 'parsedvarname'. That would be bad. Segfault like
181     * bad.
182     */
183
184    oldTypePtr = obj->typePtr;
185
186    /* Now, if the value was pure we forcibly generate the string-rep, to
187     * capture the existing semantics of the value. Because we now enter the
188     * realm of unordered, and the actual value may not be. If so, then not
189     * having the string-rep will later cause the generation of an arbitrarily
190     * ordered string-rep when the value is shimmered to some other type. This
191     * is most visible for lists, which are ordered. A shimmer list->set->list
192     * may reorder the elements if we do not capture their order in the
193     * string-rep.
194     *
195     * See test case -15.0 in sets.testsuite demonstrating this.
196     * Disable the Tcl_GetString below and see the test fail.
197     */
198
199     Tcl_GetString (obj);
200
201    /* Gen hash table from list */
202
203    s = (SPtr) ckalloc (sizeof (S));
204    Tcl_InitHashTable(&s->el, TCL_STRING_KEYS);
205
206    for (i=0; i < lc; i++) {
207	(void) Tcl_CreateHashEntry(&s->el,
208		 Tcl_GetString (lv[i]), &new);
209    }
210
211    /*
212     * Free the old internalRep before setting the new one. We do this as
213     * late as possible to allow the conversion code, in particular
214     * Tcl_ListObjGetElements, to use that old internalRep.
215     */
216
217    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
218	oldTypePtr->freeIntRepProc(obj);
219    }
220
221    obj->internalRep.otherValuePtr = s;
222    obj->typePtr                   = &s_type;
223    return TCL_OK;
224}
225
226/* .................................................. */
227
228int
229s_size (SPtr a)
230{
231    return a->el.numEntries;
232}
233
234int
235s_empty (SPtr a)
236{
237    return (a->el.numEntries == 0);
238}
239
240void
241s_free (SPtr a)
242{
243    Tcl_DeleteHashTable(&a->el);
244    ckfree ((char*) a);
245}
246
247SPtr
248s_dup (SPtr a)
249{
250    SPtr s = (SPtr) ckalloc (sizeof (S));
251    Tcl_InitHashTable(&s->el, TCL_STRING_KEYS);
252
253    if (!a) return s;
254    s_add (s, a, NULL);
255    return s;
256}
257
258int
259s_contains (SPtr a, const char* item)
260{
261    return Tcl_FindHashEntry (&a->el, item) != NULL;
262}
263
264SPtr
265s_difference (SPtr a, SPtr b)
266{
267    int            new;
268    Tcl_HashSearch hs;
269    Tcl_HashEntry* he;
270    CONST char*    key;
271    SPtr           s;
272
273    /* a - nothing = a. Just duplicate */
274
275    if (!b->el.numEntries) {
276	return s_dup (a);
277    }
278
279    s = (SPtr) ckalloc (sizeof (S));
280    Tcl_InitHashTable(&s->el, TCL_STRING_KEYS);
281
282    /* nothing - b = nothing */
283
284    if (!a->el.numEntries) return s;
285
286    /* Have to get it the hard way, no shortcut */
287
288    for(he = Tcl_FirstHashEntry(&a->el, &hs);
289	he != NULL;
290	he = Tcl_NextHashEntry(&hs)) {
291	key = Tcl_GetHashKey (&a->el, he);
292
293	if (Tcl_FindHashEntry (&b->el, key) != NULL) continue;
294	/* key is in a, not in b <=> in (a-b) */
295
296	(void*) Tcl_CreateHashEntry(&s->el, key, &new);
297    }
298
299    return s;
300}
301
302SPtr
303s_intersect (SPtr a, SPtr b)
304{
305    int            new;
306    Tcl_HashSearch hs;
307    Tcl_HashEntry* he;
308    CONST char*    key;
309
310    SPtr s = (SPtr) ckalloc (sizeof (S));
311    Tcl_InitHashTable(&s->el, TCL_STRING_KEYS);
312
313    /* Shortcut when we know that the result is empty */
314
315    if (!a->el.numEntries) return s;
316    if (!b->el.numEntries) return s;
317
318    /* Ensure that we iterate over the smaller of the two sets */
319
320    if (b->el.numEntries < a->el.numEntries) {
321	SPtr t = a ; a = b ; b = t;
322    }
323
324    for(he = Tcl_FirstHashEntry(&a->el, &hs);
325	he != NULL;
326	he = Tcl_NextHashEntry(&hs)) {
327	key = Tcl_GetHashKey (&a->el, he);
328
329	if (Tcl_FindHashEntry (&b->el, key) == NULL) continue;
330	/* key is in a, in b <=> in (a*b) */
331
332	(void*) Tcl_CreateHashEntry(&s->el, key, &new);
333    }
334
335    return s;
336}
337
338SPtr
339s_union (SPtr a, SPtr b)
340{
341    int            new;
342    Tcl_HashSearch hs;
343    Tcl_HashEntry* he;
344    CONST char*    key;
345
346    SPtr s = (SPtr) ckalloc (sizeof (S));
347    Tcl_InitHashTable(&s->el, TCL_STRING_KEYS);
348
349    s_add (s, a, NULL);
350    s_add (s, b, NULL);
351
352    return s;
353}
354
355void
356s_add (SPtr a, SPtr b, int* newPtr)
357{
358    int            new, nx = 0;
359    Tcl_HashSearch hs;
360    Tcl_HashEntry* he;
361    CONST char*    key;
362
363    if (b->el.numEntries) {
364	for(he = Tcl_FirstHashEntry(&b->el, &hs);
365	    he != NULL;
366	    he = Tcl_NextHashEntry(&hs)) {
367	    key = Tcl_GetHashKey (&b->el, he);
368	    (void*) Tcl_CreateHashEntry(&a->el, key, &new);
369	    if (new) {nx = 1;}
370	}
371    }
372    if(newPtr) {*newPtr = nx;}
373}
374
375void
376s_add1 (SPtr a, const char* item)
377{
378    int new;
379
380    (void*) Tcl_CreateHashEntry(&a->el, item, &new);
381}
382
383void
384s_subtract (SPtr a, SPtr b, int* delPtr)
385{
386    int            new;
387    Tcl_HashSearch hs;
388    Tcl_HashEntry* he, *dhe;
389    CONST char*    key;
390    int            dx = 0;
391
392    if (b->el.numEntries) {
393	for(he = Tcl_FirstHashEntry(&b->el, &hs);
394	    he != NULL;
395	    he = Tcl_NextHashEntry(&hs)) {
396	    key = Tcl_GetHashKey (&b->el, he);
397	    dhe = Tcl_FindHashEntry(&a->el, key);
398	    if (!dhe) continue;
399	    /* Key is known, to be removed */
400	    dx = 1;
401	    Tcl_DeleteHashEntry (dhe);
402	}
403    }
404    if(delPtr) {*delPtr = dx;}
405}
406
407void
408s_subtract1 (SPtr a, const char* item)
409{
410    Tcl_HashEntry* he;
411
412    he = Tcl_FindHashEntry(&a->el, item);
413    if (!he) return;
414    Tcl_DeleteHashEntry (he);
415}
416
417int
418s_equal (SPtr a, SPtr b)
419{
420    /* (a == b) <=> (|a| == |b| && (a-b) = {})
421     */
422
423    int res = 0;
424
425    if (s_size (a) == s_size(b)) {
426	SPtr t = s_difference (a, b);
427	res    = s_empty (t);
428	s_free (t);
429    }
430    return res;
431}
432
433int
434s_subsetof (SPtr a, SPtr b)
435{
436    /* (a <= b) <=> (|a| <= |b| && (a-b) = {})
437     */
438
439    int res = 0;
440
441    if (s_size (a) <= s_size(b)) {
442	SPtr t = s_difference (a, b);
443	res    = s_empty (t);
444	s_free (t);
445    }
446    return res;
447}
448
449/* .................................................. */
450
451
452/*
453 * Local Variables:
454 * mode: c
455 * c-basic-offset: 4
456 * fill-column: 78
457 * End:
458 */
459