DNA. wyrm-assoc-hash Version. 1.0.9 Language. c Testbase. Test Script Test Report Import. Interface. wyrmwif wyrm-assoc Export. Implementation. wyrm-assoc-hash.c Interface. wyrm-assoc-hash.h Object. wyrm-assoc-hash.o	Associative Map in a Tcl HashTable
Sections. Compile Files Data Structures Code
Make. Object. compile -c -o [export object] [export implementation] -- -list [import interface] [export interface]

1 :: Implement unsorted associative maps with Tcl_HashTable.

Wyrmwif Tcl extensions. For non-profit uses only, provided this copyright is preserved on all copies, this work may be freely copied, modified, redistributed, compiled, and incorporated in other works. This work is distributed with no warranty of any kind; no author or distributor accepts any responsibility for the consequences of using it, or for whether it serves any particular purpose or works at all, unless he or she says so in writing.

2 wyrm-assoc-hash.h

3 wyrm-assoc-hash.c

Compile Files

top
2. wyrm-assoc-hash.h :: The only visible entry to this file is to initialise it. Thereafter everything is only seen through its declared type and the generic wyrm-assoc interface. #ifndef WYRM_ASSOC_HASH_H #define WYRM_ASSOC_HASH_H // wyrm-assoc-hash.dna - Copyright (C) 2002 SM Ryan. All rights reserved.' #include "wyrmwif.h" int wyrm_assocHashInit(Intr intr); #endif	^
Interface wyrm-assoc-hash.h

section top
3. wyrm-assoc-hash.c :: static const char COPYRIGHT[] = "wyrm-assoc-hash.dna - Copyright (C) 2002 SM Ryan. All rights reserved."; #define WYRM_ASSOC_H_IMPLEMENTORS #include "wyrm-assoc.h" #include "wyrm-assoc-hash.h" #include "wyrm-io.h" <Typedef declarations> <Static declarations> <WyrmAssocMapType for wyrm.assoc.hash> <Internal representation> <Tcl type operators> <Traversal> <Mapping allocation> <New hash table> <Dump hash table> <Mapping inquiries> <Hash table operator>	^
Implementation wyrm-assoc-hash.c

4 WyrmAssocMapType for wyrm.assoc.hash

6 Internal representation

7 Typedef declarations

Data Structures

4. WyrmAssocMapType for wyrm.assoc.hash :: Define the hash table mapping to the generic interface. For more information, see the associative mapping generic interface. Hash table are only accessible through the generic interface; no additional commands are provided.

proc int wyrm_assocHashInit—Declare hash table maps to the interface; returns TCL_OK or TCL_ERROR.

input WyrmAssocHashType—Hash map type.

output Intr intr—Receives error messages; may be NULL.

output wyrm-assoc—Hash table mapping declared.


static WyrmAssocMapType WyrmAssocHashType = {
	{
		"wyrm.assoc.hash",
		freeHashtable,
		duplicateHashtable,
		wyrm_assocUpdate,
		setHashtableInternalRepresentation
	},
	updateHashTable,
	internalHashTable,
	dumpHashtable,
	0,
	newHashTable,
	isHashtableEmpty,
	firstHashtable,
	firstHashtable,
	nextHashtable,
	nextHashtable,
	beginHashtable,
	enumerateHashtable,
	endHashtable,
	getHashtable,
	putHashtable,
	deleteHashtable,
};

int wyrm_assocHashInit(Intr intr) {
	Tcl_RegisterObjType((Tcl_ObjType*)(&WyrmAssocHashType));
	return TCL_OK;
}

5 :: The Tcl_HashTable is the internal representation of the mapping inside a Tcl object.

6. Internal representation :: The hash entries point to a HashValue which contains the data and flags. Currently the compression flags are ignored and cleared.

type struct HashValue

Obj data—Mapped to data.

int flags—Flags on that data.


struct HashValue {
	Obj data;
	int flags;
};

7. Typedef declarations ::

typedef struct HashValue HashValue;

8 Internal representation

9 Ensure the existence of a HashValue

10 Static declarations

11 Traversal

13 Mapping allocation

15 Tcl type operators

17 New hash table

18 Dump hash table

20 Mapping inquiries

22 Hash table operator

23 Test base

Code

8. Internal representation :: These routines are only called from the interface after ensuring the type of the object is set correctly (mostly because they vector through the type). This means type checks are superfluous, and thus jump right to the heart of the matter.

#define Tcl_HashTable* internal—The hash table internal representation.

input Obj mapping—The object with the representation

	
#define internal(mapping) ((Tcl_HashTable*)((mapping)->internalRep.otherValuePtr))

9. Ensure the existence of a HashValue :: Each hash table entry must have a HashValue definition. If not, the table is damaged, and abort.


*v = Tcl_GetHashValue(*e);
if (!*v) {
	Tcl_Panic("hash associative mapping: internal damage (null hashvalue) :%s",Tcl_GetHashKey(internal(mapping),*e));
}

10. Static declarations ::

static void first(Obj mapping,Tcl_HashSearch **S,Tcl_HashEntry **e,HashValue **v);
static void next(Obj mapping,Tcl_HashSearch **S,Tcl_HashEntry **e,HashValue **v);
static void seek(Obj mapping,chars key,Tcl_HashEntry **e,HashValue **v,int *new);

11. Traversal :: Many of the operators traverse the whole mapping; these abstract some of the details.


static void first(Obj mapping,Tcl_HashSearch **S,Tcl_HashEntry **e,HashValue **v) {
	*S = heap(Tcl_HashSearch);
	*e = Tcl_FirstHashEntry(internal(mapping),*S);
	if (*e) {
		<Ensure the existence of a HashValue>
	}
}

static void next(Obj mapping,Tcl_HashSearch **S,Tcl_HashEntry **e,HashValue **v) {
	*e = Tcl_NextHashEntry(*S);
	if (*e) {
		<Ensure the existence of a HashValue>
	}else {
		dispose(*S); *S = 0;
	}
}

static void seek(Obj mapping,chars key,Tcl_HashEntry **e,HashValue **v,int *new) {
	if (new) {
		*e = Tcl_CreateHashEntry(internal(mapping),key,new);
		if (*new) {
			*v = heap(HashValue); (*v)->data = 0; (*v)->flags = 0;
			Tcl_SetHashValue(*e,*v);
		}else {
			<Ensure the existence of a HashValue>
		}
	}else {
		*e = Tcl_FindHashEntry(internal(mapping),key);
		if (*e) {
			<Ensure the existence of a HashValue>
		}
	}
}

12. Static declarations ::

static Tcl_HashTable *createmapping(void);
static void deletemapping(Obj mapping);

13. Mapping allocation :: Utility abstractions for allocating and deallocating the overall internal mapping.

	
static Tcl_HashTable *createmapping(void) {
	Tcl_HashTable *mapping = heap(Tcl_HashTable);
	Tcl_InitHashTable(mapping,TCL_STRING_KEYS);
	return mapping;
}

static void deletemapping(Obj mapping) {
	Tcl_HashEntry *e; HashValue *v; Tcl_HashSearch *S;
	for (first(mapping,&S,&e,&v); e; next(mapping,&S,&e,&v)) {
		decr(v->data); dispose(v);
	}
	Tcl_DeleteHashTable(internal(mapping));
	dispose(internal(mapping));
}

14. Static declarations ::

static void freeHashtable(Obj mapping);
static void duplicateHashtable(Obj mapping,Obj newmapping);
static void updateHashTable(Obj obj,Tcl_DString *D);
static int setHashtableInternalRepresentation(Intr intr,Obj mapping);
static int internalHashTable(Intr intr,Obj obj,ptr cookie,ptr*);

15. Tcl type operators ::


static void freeHashtable(Obj mapping) {
	deletemapping(mapping);
	mapping->typePtr = 0;
}

static void duplicateHashtable(Obj mapping,Obj newmapping) {
	Tcl_HashSearch *S; Tcl_HashEntry *e; HashValue *v;
	if ((newmapping)->typePtr && (newmapping)->typePtr->freeIntRepProc)
		(newmapping)->typePtr->freeIntRepProc((newmapping));
	(newmapping)->typePtr = (Tcl_ObjType*)(&WyrmAssocHashType);
	newmapping->internalRep.otherValuePtr = createmapping();
	for (first(mapping,&S,&e,&v); e; next(mapping,&S,&e,&v)) {
		Tcl_HashEntry *ne; HashValue *nv; int nw;
		seek(newmapping,Tcl_GetHashKey(internal(mapping),e),&ne,&nv,&nw);
		decr(nv->data); nv->data = incr(v->data?v->data:Tcl_NewObj()); nv->flags = v->flags;
	}
}

static void updateHashTable(Obj mapping,Tcl_DString *D) {
	Tcl_HashSearch *S; Tcl_HashEntry *e; HashValue *v;
	for (first(mapping,&S,&e,&v); e; next(mapping,&S,&e,&v)) {
		chars key = Tcl_GetHashKey(internal(mapping),e);
		wyrm_assocUpdateEntry(D,key,v->data,v->flags);
	}
}

static int setHashtableInternalRepresentation(Intr intr,Obj mapping) {
	return wyrm_assocInternal(intr,mapping,(Tcl_ObjType*)&WyrmAssocHashType);
}
static int internalHashTable(Intr intr,Obj obj,ptr cookie,ptr *x) {
	Obj key,data; int flags; Tcl_Obj T;
	T.internalRep.otherValuePtr = createmapping();
	while (wyrm_assocInternalEntry(cookie,&key,&data,&flags)) {
		int new; Tcl_HashEntry *e; HashValue *v;
		seek(&T,Tcl_GetString(key),&e,&v,&new);
		decr(v->data); v->data = data; v->flags = flags;
		decr(key);
	}
	*x = T.internalRep.otherValuePtr;
	return x ? TCL_OK : TCL_ERROR;
}

16. Static declarations ::

static Obj newHashTable(Intr intr,Obj base,int N,Obj *P);
static Obj dumpHashtable(Intr intr,Obj mapping,int N,Obj *P);

17. New hash table :: The hash table mapping new makes a map from a key-value pair list. It accepts no parameters.


static Obj newHashTable(Intr intr,Obj base,int N,Obj *P) {
	if (N>0) {
		rprintf(intr,"hash associative mapping new: no parameters allowed");
		return 0;
	}else if (Tcl_ConvertToType(intr,base,(Tcl_ObjType*)&WyrmAssocHashType)==TCL_OK) {
		return incr(base);
	}else {
		return 0;
	}
}

18. Dump hash table :: The hash table mapping dump lists the keys, data, and flags in an unordered list.

If the parameter -stats is given, instead the the hash table statistics are returned.


static Obj dumpHashtable(Intr intr,Obj mapping,int N,Obj *P) {
	if (N>=1 && streq(Tcl_GetString(*P),"-stats")) {
		chars s = Tcl_HashStats(internal(mapping));
		Obj r = incr(Tcl_NewStringObj(s,-1));
		ckfree(s); return r;
	}else {
		Tcl_HashSearch *S; Tcl_HashEntry *e; HashValue *v; Tcl_DString D; Obj r;
		Tcl_DStringInit(&D);
		for (first(mapping,&S,&e,&v); e; next(mapping,&S,&e,&v)) {
			if (v) {
				chars key = Tcl_GetHashKey(internal(mapping),e); char B[20];
				Tcl_DStringAppendElement(&D,key);
				Tcl_DStringAppendElement(&D,v->data ? Tcl_GetString(v->data) : "<NULL>");
				sprintf(B,"%d",v->flags);
				Tcl_DStringAppendElement(&D,B);
			}
		}
		r = incr(Tcl_NewStringObj(Tcl_DStringValue(&D),Tcl_DStringLength(&D)));
		Tcl_DStringFree(&D); return r;
	}
}

19. Static declarations ::

static int isHashtableEmpty(Intr intr,Obj mapping);
static Obj cloneHashtable(Intr intr,Obj mapping);

20. Mapping inquiries ::


static int isHashtableEmpty(Intr intr,Obj mapping) {
	Tcl_HashSearch *S; Tcl_HashEntry *e; HashValue *v;
	first(mapping,&S,&e,&v);
	return e==0 ? TCL_OK : TCL_BREAK;
}

21. Static declarations ::

static Obj firstHashtable(Intr intr,Obj mapping);
static Obj nextHashtable(Intr intr,Obj mapping,Obj key);
static ptr beginHashtable(Intr intr,Obj mapping,Obj firstHint,bool *sorted);
static int enumerateHashtable(Intr intr,Obj mapping,ptr cookie,Obj *key,Obj *data,int *flags);
static int endHashtable(Intr intr,Obj mapping,ptr cookie);
static int getHashtable(Intr intr,Obj mapping,Obj seek,Obj *key,Obj *data,int *flags);
static int putHashtable(Intr intr,Obj mapping,Obj key,Obj data,int flags);
static int deleteHashtable(Intr intr,Obj mapping,Obj key);

22. Hash table operator ::


static Obj firstHashtable(Intr intr,Obj mapping) {
	rprintf(intr,"hash table is an unsorted  mapping");
	return 0;
}

static Obj nextHashtable(Intr intr,Obj mapping,Obj key) {
	rprintf(intr,"hash table is an unsorted  mapping");
	return 0;
}

typedef struct {
	Tcl_HashSearch *S; Tcl_HashEntry *e; HashValue *v;
} HashEnumerator;

ptr beginHashtable(Intr intr,Obj mapping,Obj firstHint,bool *sorted) {
	HashEnumerator *h = heap(HashEnumerator);
	first(mapping,&(h->S),&(h->e),&(h->v));
	*sorted = false;
	return h;
}
int enumerateHashtable(Intr intr,Obj mapping,ptr cookie,Obj *key,Obj *data,int *flags) {
	HashEnumerator *h = cookie;
	*key = *data = 0; *flags = -1;
	if (h->e) {
		*key = incr(Tcl_NewStringObj(Tcl_GetHashKey(internal(mapping),h->e),-1));
		*data = incr( h->v->data? h->v->data:Tcl_NewObj());
		*flags = h->v->flags;
		next(mapping,&(h->S),&(h->e),&(h->v));
		return TCL_OK;
	}else {
		return TCL_BREAK;
	}
}
int endHashtable(Intr intr,Obj mapping,ptr cookie) {
	HashEnumerator *h = cookie;
	dispose(h->S); dispose(h);
	return TCL_OK;
}

static int getHashtable(Intr intr,Obj mapping,Obj seekkey,Obj *key,Obj *data,int *flags) {
	Tcl_HashEntry *e; HashValue *v;
	seek(mapping,Tcl_GetString(seekkey),&e,&v,0);
	if (e) {
		if (key) *key = incr(Tcl_NewStringObj(Tcl_GetHashKey(internal(mapping),e),-1));
		if (data) *data = incr(v->data);
		if (flags) *flags = v->flags;
		return TCL_OK;
	}else {
		rprintf(intr,"missing: %{y}s",seekkey);
		if (key) *key = 0;
		if (data) *data = 0;
		if (flags) *flags = -1;
		return TCL_ERROR;
	}
}

static int putHashtable(Intr intr,Obj mapping,Obj key,Obj data,int flags) {
	Tcl_HashEntry *e; HashValue *v; int new;
	flags &= ~(wyrm_assocFlagCompressKey|wyrm_assocFlagCompressData);
	seek(mapping,Tcl_GetString(key),&e,&v,&new);
	if (data) {
		incr(data); decr(v->data); v->data = data;
	}else if (new) {
		v->data = incr(Tcl_NewObj());
	}
	if (flags>=0) {
		v->flags = flags;
	}else if (new) {
		v->flags = 0;
	}
	Tcl_InvalidateStringRep(mapping);
	return TCL_OK;
}

static int deleteHashtable(Intr intr,Obj mapping,Obj key) {
	Tcl_HashEntry *e; HashValue *v; int new;
	seek(mapping,Tcl_GetString(key),&e,&v,0);
	if (e) {
		HashValue *v = Tcl_GetHashValue(e);
		if (v) {decr(v->data); dispose(v);}
		Tcl_DeleteHashEntry(e);
		Tcl_InvalidateStringRep(mapping);
		return TCL_OK;
	}else {
		rprintf(intr,"missing: %{y}s",key);
		return TCL_ERROR;
	}
}