[Commit] nickle ChangeLog, 1.22, 1.23 compile.c, 1.145, 1.146 execute.c, 1.86, 1.87 gram.y, 1.127, 1.128 hash.c, 1.3, 1.4 opcode.h, 1.27, 1.28 type.c, 1.59, 1.60 value.h, 1.98, 1.99

[Keith Packard]

Committed by: keithp

Update of /local/src/CVS/nickle
In directory home.keithp.com:/tmp/cvs-serv32138

Modified Files:
	ChangeLog compile.c execute.c gram.y hash.c opcode.h type.c 
	value.h 
Log Message:
2004-04-10  Keith Packard  <keithp at keithp.com>

	reviewed by: <delete if not using a buddy>

	* compile.c: (CompileHashInit):
	* execute.c: (ThreadsRun):
	* gram.y:
	* hash.c: (HashPrint), (HashMark), (NewHash), (HashGet),
	(HashSetDef), (HashRef), (HashCopy):
	* opcode.h:
	* value.h:
	Add default hash table values, and initializes for same.

	* type.c: (TypeUnaryRef):
	Oops.  Poly couldn't be a ref


Index: ChangeLog
===================================================================
RCS file: /local/src/CVS/nickle/ChangeLog,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- a/ChangeLog	2 Apr 2004 07:18:59 -0000	1.22
+++ b/ChangeLog	11 Apr 2004 02:30:21 -0000	1.23
@@ -1,3 +1,19 @@
+2004-04-10  Keith Packard  <keithp at keithp.com>
+
+	reviewed by: <delete if not using a buddy>
+
+	* compile.c: (CompileHashInit):
+	* execute.c: (ThreadsRun):
+	* gram.y:
+	* hash.c: (HashPrint), (HashMark), (NewHash), (HashGet),
+	(HashSetDef), (HashRef), (HashCopy):
+	* opcode.h:
+	* value.h:
+	Add default hash table values, and initializes for same.
+
+	* type.c: (TypeUnaryRef):
+	Oops.  Poly couldn't be a ref
+
 2004-04-01  Keith Packard  <keithp at keithp.com>
 
 	* debian/changelog:

Index: compile.c
===================================================================
RCS file: /local/src/CVS/nickle/compile.c,v
retrieving revision 1.145
retrieving revision 1.146
diff -u -d -r1.145 -r1.146
--- a/compile.c	27 Feb 2004 03:50:15 -0000	1.145
+++ b/compile.c	11 Apr 2004 02:30:21 -0000	1.146
@@ -1784,19 +1784,22 @@
 
 	    SetPush (obj);	/* push the hash */
 
-	    /*
-	     * Compute the key
-	     */
-	    obj = CompileInit (obj, key, type->hash.keyType, stat, code);
-
-	    if (!TypeIsOrdered (type->hash.keyType, key->base.type))
+	    if (key)
 	    {
-		CompileError (obj, stat, "Incompatible expression type '%T', for hash index type '%T'",
-			      key->base.type, type->hash.keyType);
-		RETURN (obj);
-	    }
+		/*
+		 * Compute the key
+		 */
+		obj = CompileInit (obj, key, type->hash.keyType, stat, code);
 
-	    SetPush (obj);	/* push the key */
+		if (!TypeIsOrdered (type->hash.keyType, key->base.type))
+		{
+		    CompileError (obj, stat, "Incompatible expression type '%T', for hash index type '%T'",
+				  key->base.type, type->hash.keyType);
+		    RETURN (obj);
+		}
+
+		SetPush (obj);	/* push the key */
+	    }
 
 	    /*
 	     * Compute the value
@@ -1806,7 +1809,7 @@
 	    /*
 	     * Store the pair
 	     */
-	    BuildInst (obj, OpInitHash, inst, stat);
+	    BuildInst (obj, key ? OpInitHash : OpInitHashDef, inst, stat);
 	}
     }
     RETURN (obj);
@@ -4115,6 +4118,7 @@
     "InitArray",
     "BuildHash",
     "InitHash",
+    "InitHashDef",
     "BuildStruct",
     "InitStruct",
     "BuildUnion",

Index: execute.c
===================================================================
RCS file: /local/src/CVS/nickle/execute.c,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -d -r1.86 -r1.87
--- a/execute.c	27 Feb 2004 03:50:16 -0000	1.86
+++ b/execute.c	11 Apr 2004 02:30:21 -0000	1.87
@@ -1128,6 +1128,12 @@
 		    HashSet (w, v, value);
 		    value = w;
 		    break;
+		case OpInitHashDef:
+		    v = CStack (0);
+		    stack = 1;
+		    HashSetDef (v, value);
+		    value = v;
+		    break;
 		case OpBuildStruct:
 		    value = NewStruct (inst->structs.structs, False);
 		    break;

Index: gram.y
===================================================================
RCS file: /local/src/CVS/nickle/gram.y,v
retrieving revision 1.127
retrieving revision 1.128
diff -u -d -r1.127 -r1.128
--- a/gram.y	27 Feb 2004 03:50:16 -0000	1.127
+++ b/gram.y	11 Apr 2004 02:30:22 -0000	1.128
@@ -1453,8 +1453,10 @@
 		| hashelt
 		    { $$ = NewExprTree (COMMA, 0, $1); }
 		;
-hashelt		: hashvalue DARROW hashvalue
+hashelt		: simpleexpr DARROW hashvalue
 		    { $$ = NewExprTree (DARROW, $1, $3); }
+		| DARROW hashvalue
+		    { $$ = NewExprTree (DARROW, 0, $2); }
 		;
 hashvalue	: simpleexpr
 		| init

Index: hash.c
===================================================================
RCS file: /local/src/CVS/nickle/hash.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- a/hash.c	25 Jul 2003 23:47:54 -0000	1.3
+++ b/hash.c	11 Apr 2004 02:30:22 -0000	1.4
@@ -216,6 +216,14 @@
     }
     if (pretty)
     {
+	if (ht->def)
+	{
+	    if (!first)
+		FilePuts (f, ",");
+	    FilePuts (f, " => ");
+	    Print (f, ht->def, format, base, width, prec, fill);
+	    first = False;
+	}
 	if (!first)
 	    FilePuts (f, " ");
 	FilePuts (f, "}");
@@ -249,6 +257,7 @@
     MemReference (ht->type);
     MemReference (ht->keyType);
     MemReference (ht->elts);
+    MemReference (ht->def);
 }
 
 ValueRep    HashRep = { 
@@ -286,6 +295,7 @@
     ret->hash.type = type;
     ret->hash.keyType = keyType;
     ret->hash.elts = 0;
+    ret->hash.def = 0;
     Resize (&ret->hash, &hashSets[0]);
     RETURN (ret);
 }
@@ -300,6 +310,8 @@
     he = Find (ht, hash, key);
     if (!HashEltValid (he))
     {
+	if (ht->def)
+	    return ht->def;
 	RaiseStandardException (exception_uninitialized_value,
 				"uninitialized hash element", 0);
 	return (Void);
@@ -327,6 +339,14 @@
     HashEltValue (he) = value;
 }
 
+void
+HashSetDef (Value hv, Value def)
+{
+    HashTablePtr    ht = &hv->hash;
+
+    ht->def = def;
+}
+
 Value
 HashRef (Value hv, Value key)
 {
@@ -346,6 +366,8 @@
 	ht->count++;
 	HashEltHash (he) = hash;
 	HashEltKey (he) = key;
+	if (ht->def)
+	    HashEltValue (he) = ht->def;
     }
     RETURN (NewRef (ht->elts, 
 		    &HashEltValue(he) - BoxElements (ht->elts)));
@@ -410,6 +432,7 @@
 {
     ENTER ();
     Value   new = NewHash (False, hv->hash.keyType, hv->hash.type);
+    new->hash.def = hv->hash.def;
     Resize (&new->hash, hv->hash.hashSet);
     Rehash (hv->hash.elts, &new->hash);
     RETURN (new);

Index: opcode.h
===================================================================
RCS file: /local/src/CVS/nickle/opcode.h,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- a/opcode.h	27 Feb 2004 03:50:16 -0000	1.27
+++ b/opcode.h	11 Apr 2004 02:30:22 -0000	1.28
@@ -53,6 +53,7 @@
     OpInitArray,
     OpBuildHash,
     OpInitHash,
+    OpInitHashDef,
     OpBuildStruct,
     OpInitStruct,
     OpBuildUnion,

Index: type.c
===================================================================
RCS file: /local/src/CVS/nickle/type.c,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -d -r1.59 -r1.60
--- a/type.c	27 Feb 2004 03:50:16 -0000	1.59
+++ b/type.c	11 Apr 2004 02:30:22 -0000	1.60
@@ -600,7 +600,7 @@
 TypeUnaryRef (Type *ref)
 {
     if (TypePoly (ref))
-	ref = typePoly;
+	return typePoly;
     if (ref->base.tag == type_ref)
 	return ref->ref.ref;
     return 0;

Index: value.h
===================================================================
RCS file: /local/src/CVS/nickle/value.h,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -d -r1.98 -r1.99
--- a/value.h	1 Apr 2004 19:47:39 -0000	1.98
+++ b/value.h	11 Apr 2004 02:30:22 -0000	1.99
@@ -796,6 +796,7 @@
     TypePtr	type;
     TypePtr	keyType;
     BoxPtr	elts;
+    Value	def;
 } HashTable, *HashTablePtr;
 
 typedef union _value {
@@ -921,6 +922,7 @@
 Value	NewHash (Bool constant, TypePtr keyType, TypePtr valueType);
 Value	HashGet (Value hv, Value key);
 void	HashSet (Value hv, Value key, Value value);
+void	HashSetDef (Value hv, Value def);
 Value	HashKeys (Value hv);
 Value	HashRef (Value hv, Value key);
 Value	HashTest (Value hv, Value key);