[Commit] nickle hash.c, NONE, 1.1 Makefile.am, 1.35, 1.36 array.c,
1.20, 1.21 compile.c, 1.139, 1.140 execute.c, 1.82,
1.83 file.c, 1.50, 1.51 gram.y, 1.124, 1.125 int.c, 1.19,
1.20 integer.c, 1.16, 1.17 natural.c, 1.21, 1.22 nickle.h,
1.105, 1.106 opcode.h, 1.24, 1.25 pretty.c, 1.62,
1.63 rational.c, 1.26, 1.27 string.c, 1.14, 1.15 struct.c,
1.21, 1.22 type.c, 1.55, 1.56 value.c, 1.43, 1.44 value.h,
1.88, 1.89
Keith Packard
commit at keithp.com
Mon Jul 21 16:22:13 PDT 2003
Committed by: keithp
Update of /local/src/CVS/nickle
In directory home.keithp.com:/tmp/cvs-serv7368
Modified Files:
Makefile.am array.c compile.c execute.c file.c gram.y int.c
integer.c natural.c nickle.h opcode.h pretty.c rational.c
string.c struct.c type.c value.c value.h
Added Files:
hash.c
Log Message:
Add hashes, fix subscript type printing
--- NEW FILE: hash.c ---
(This appears to be a binary file; contents omitted.)
Index: Makefile.am
===================================================================
RCS file: /local/src/CVS/nickle/Makefile.am,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -d -r1.35 -r1.36
--- Makefile.am 29 Jun 2003 18:16:19 -0000 1.35
+++ Makefile.am 21 Jul 2003 22:22:10 -0000 1.36
@@ -26,7 +26,7 @@
nickle_SOURCES = alarm.c array.c atom.c avl.c box.c \
compile.c debug.c divide.c edit.c \
error.c execute.c expr.c file.c float.c frame.c func.c \
- gcd.c int.c integer.c io.c main.c mem.c \
+ gcd.c hash.c int.c integer.c io.c main.c mem.c \
natural.c pretty.c profile.c rational.c ref.c refer.c \
sched.c scope.c stack.c string.c struct.c \
symbol.c sync.c type.c union.c util.c value.c \
@@ -43,7 +43,7 @@
AM_CFLAGS = -Wall -Wpointer-arith -Wstrict-prototypes \
-Wmissing-prototypes -Wmissing-declarations \
- -Wnested-externs
+ -Wnested-externs -fno-strict-aliasing
$(nickle_OBJECTS): avl.h gram.h memp.h opcode.h stack.h \
config.h mem.h nickle.h ref.h value.h
Index: array.c
===================================================================
RCS file: /local/src/CVS/nickle/array.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- array.c 30 Jun 2003 04:53:42 -0000 1.20
+++ array.c 21 Jul 2003 22:22:10 -0000 1.21
@@ -8,15 +8,9 @@
#include "nickle.h"
-Value Empty;
-
int
ArrayInit (void)
{
- ENTER ();
- Empty = NewArray (True, False, typePoly, 0, 0);
- MemAddRoot (Empty);
- EXIT ();
return 1;
}
@@ -99,7 +93,7 @@
FilePuts (f, "(");
if (!TypePoly (ArrayType(a)))
{
- FilePutType (f, ArrayType (a), False);
+ FilePutBaseType (f, ArrayType (a), False);
FilePuts (f, " ");
}
FilePuts (f, "[");
@@ -109,7 +103,12 @@
if (i)
FilePuts (f, ",");
}
- FilePuts (f, "]) ");
+ FilePuts (f, "]");
+ if (!TypePoly (ArrayType(a)))
+ {
+ FilePutSubscriptType (f, ArrayType (a), False);
+ }
+ FilePuts (f, ") ");
for (i = 0; i < a->ndim; i++)
FileOutput (f, '{');
}
@@ -152,21 +151,19 @@
return True;
}
-#define MAX_HASH 1024
-
-#define irot(i) (((i) << 1) | ((i) >> (sizeof (int) * 8 - 1)))
+#define hrot(i) (((i) << 1) | ((i) >> (sizeof (HashValue) * 8 - 1)))
-static Value
+static HashValue
ArrayHash (Value av)
{
- Array *a = &av->array;
- int i;
- int h = 0;
- int limit = ArrayLimit (av);
+ Array *a = &av->array;
+ int i;
+ HashValue h = 0;
+ int limit = ArrayLimit (av);
for (i = 0; i < limit; i = ArrayNextI (a, i))
- h = irot(h) ^ ValueInt (ValueHash (BoxValueGet (a->values, i)));
- return NewInt (h);
+ h = hrot(h) ^ ValueInt (ValueHash (BoxValueGet (a->values, i)));
+ return h;
}
static void
Index: compile.c
===================================================================
RCS file: /local/src/CVS/nickle/compile.c,v
retrieving revision 1.139
retrieving revision 1.140
diff -u -d -r1.139 -r1.140
--- compile.c 11 Jun 2003 05:01:55 -0000 1.139
+++ compile.c 21 Jul 2003 22:22:10 -0000 1.140
@@ -42,6 +42,9 @@
case OpBuildArray:
MemReference (inst->array.type);
break;
+ case OpBuildHash:
+ MemReference (inst->hash.type);
+ break;
case OpConst:
MemReference (inst->constant.constant);
break;
@@ -217,7 +220,7 @@
ObjPtr CompileAssign (ObjPtr obj, ExprPtr expr, Bool initialize, ExprPtr stat, CodePtr code);
ObjPtr CompileAssignOp (ObjPtr obj, ExprPtr expr, BinaryOp op, ExprPtr stat, CodePtr code);
ObjPtr CompileAssignFunc (ObjPtr obj, ExprPtr expr, BinaryFunc func, ExprPtr stat, CodePtr code, char *name);
-ObjPtr CompileArrayIndex (ObjPtr obj, ExprPtr expr, ExprPtr stat, CodePtr code, int *ndimp);
+ObjPtr CompileArrayIndex (ObjPtr obj, ExprPtr expr, TypePtr indexType, ExprPtr stat, CodePtr code, int *ndimp);
ObjPtr CompileCall (ObjPtr obj, ExprPtr expr, Tail tail, ExprPtr stat, CodePtr code);
ObjPtr _CompileExpr (ObjPtr obj, ExprPtr expr, Bool evaluate, ExprPtr stat, CodePtr code);
ObjPtr _CompileBoolExpr (ObjPtr obj, ExprPtr expr, Bool evaluate, ExprPtr stat, CodePtr code);
@@ -378,6 +381,27 @@
return 0;
}
+static TypePtr
+CompileIndexType (ExprPtr expr)
+{
+ TypePtr type = expr->base.type, indexType = typePoly;
+
+ if (type)
+ {
+ switch (type->base.tag) {
+ case type_array:
+ indexType = typePrim[rep_integer];
+ break;
+ case type_hash:
+ indexType = type->hash.keyType;
+ break;
+ default:
+ break;
+ }
+ }
+ return indexType;
+}
+
/*
* Compile the left side of an assignment statement.
* The result is a 'ref' left in the value register
@@ -519,14 +543,23 @@
break;
case OS:
obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
+
obj = CompileArrayIndex (obj, expr->tree.right,
+ CompileIndexType (expr->tree.left),
stat, code, &ndim);
+
+ if (!ndim)
+ {
+ expr->base.type = typePoly;
+ break;
+ }
+
expr->base.type = TypeCombineArray (expr->tree.left->base.type,
ndim,
True);
if (!expr->base.type)
{
- CompileError (obj, stat, "Incompatible type, array '%T', for %d dimension operation",
+ CompileError (obj, stat, "Incompatible type '%T', for %d dimension operation",
expr->tree.left->base.type, ndim);
expr->base.type = typePoly;
break;
@@ -1111,13 +1144,11 @@
}
/*
- * Return an expression that will build an
- * initializer for a fully specified composite
- * type
+ * Compile an array index expression tree
*/
ObjPtr
-CompileArrayIndex (ObjPtr obj, ExprPtr expr,
+CompileArrayIndex (ObjPtr obj, ExprPtr expr, TypePtr indexType,
ExprPtr stat, CodePtr code, int *ndimp)
{
ENTER ();
@@ -1128,11 +1159,11 @@
{
SetPush (obj);
obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
- if (!TypeIsOrdered (typePrim[rep_integer],
+ if (!TypeIsOrdered (indexType,
expr->tree.left->base.type))
{
- CompileError (obj, stat, "Incompatible type, index '%T', for array index %d",
- expr->tree.left->base.type, ndim);
+ CompileError (obj, stat, "Incompatible expression type '%T', for index %d type '%T'",
+ expr->tree.left->base.type, ndim, indexType);
break;
}
expr = expr->tree.right;
@@ -1143,6 +1174,12 @@
}
/*
+ * Return an expression that will build an
+ * initializer for a fully specified composite
+ * type
+ */
+
+/*
* Calculate the number of dimensions in an array by looking at
* the initializers
*/
@@ -1307,6 +1344,10 @@
ExprPtr stat, CodePtr code);
static ObjPtr
+CompileHashInit (ObjPtr obj, ExprPtr expr, Type *type,
+ ExprPtr stat, CodePtr code);
+
+static ObjPtr
CompileStructUnionInit (ObjPtr obj, ExprPtr expr, Type *type,
ExprPtr stat, CodePtr code);
@@ -1327,6 +1368,9 @@
case type_array:
obj = CompileArrayInit (obj, 0, type, stat, code);
break;
+ case type_hash:
+ obj = CompileHashInit (obj, 0, type, stat, code);
+ break;
case type_struct:
obj = CompileStructUnionInit (obj, 0, type, stat, code);
break;
@@ -1345,6 +1389,13 @@
else
obj = CompileArrayInit (obj, expr, type, stat, code);
break;
+ case HASH:
+ if (type->base.tag != type_hash)
+ CompileError (obj, stat, "Hash initializer type mismatch, type '%T'",
+ type);
+ else
+ obj = CompileHashInit (obj, expr, type, stat, code);
+ break;
case STRUCT:
if (type->base.tag != type_struct && type->base.tag != type_union)
CompileError (obj, stat, "Struct/union initializer type mismatch, type '%T'",
@@ -1650,6 +1701,61 @@
RETURN (obj);
}
+static ObjPtr
+CompileHashInit (ObjPtr obj, ExprPtr expr, Type *type,
+ ExprPtr stat, CodePtr code)
+{
+ ENTER ();
+ InstPtr inst;
+ ExprPtr inits = expr ? expr->tree.left : 0;
+ ExprPtr init;
+
+ if (type->base.tag == type_hash)
+ {
+ BuildInst (obj, OpBuildHash, inst, stat);
+ inst->hash.type = type;
+ if (expr)
+ expr->base.type = type;
+
+ /*
+ * Initialize any elements given values
+ */
+ for (init = inits; init; init = init->tree.right)
+ {
+ ExprPtr key = init->tree.left->tree.left;
+ ExprPtr value = init->tree.left->tree.right;
+
+ 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))
+ {
+ 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
+ */
+ obj = CompileInit (obj, value, type->hash.type, stat, code);
+
+ /*
+ * Store the pair
+ */
+ BuildInst (obj, OpInitHash, inst, stat);
+ }
+ }
+ RETURN (obj);
+}
+
+
static ExprPtr
CompileImplicitInit (Type *type)
{
@@ -1688,6 +1794,9 @@
init = NewExprTree (ANONINIT, 0, 0);
}
break;
+ case type_hash:
+ init = NewExprTree (HASH, 0, 0);
+ break;
case type_struct:
structs = type->structs.structs;
types = BoxTypesElements (structs->types);
@@ -2124,14 +2233,24 @@
break;
case OS:
obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
- obj = CompileArrayIndex (obj, expr->tree.right,
+
+ obj = CompileArrayIndex (obj, expr->tree.right,
+ CompileIndexType (expr->tree.left),
stat, code, &ndim);
+
+ if (!ndim)
+ {
+ expr->base.type = typePoly;
+ break;
+ }
+
expr->base.type = TypeCombineArray (expr->tree.left->base.type,
ndim,
False);
+
if (!expr->base.type)
{
- CompileError (obj, stat, "Incompatible type, array '%T', for %d dimension operation",
+ CompileError (obj, stat, "Incompatible type '%T', for %d dimension operation",
expr->tree.left->base.type, ndim);
expr->base.type = typePoly;
break;
@@ -3507,6 +3626,60 @@
}
/*
+ * Compile a type. This consists only of compiling array dimension expressions
+ * so those values can be used later
+ */
+
+static ObjPtr
+CompileArrayType (ObjPtr obj, ExprPtr decls, TypePtr type, ExprPtr stat, CodePtr code)
+{
+ return obj;
+}
+
+static ObjPtr
+CompileType (ObjPtr obj, ExprPtr decls, TypePtr type, ExprPtr stat, CodePtr code)
+{
+ ENTER();
+ ArgType *at;
+ StructType *st;
+ TypeElt *et;
+ int i;
+
+ switch (type->base.tag) {
+ case type_prim:
+ break;
+ case type_name:
+ break;
+ case type_ref:
+ obj = CompileType (obj, decls, type->ref.ref, stat, code);
+ case type_func:
+ obj = CompileType (obj, decls, type->func.ret, stat, code);
+ for (at = type->func.args; at; at = at->next)
+ obj = CompileType (obj, decls, at->type, stat, code);
+ break;
+ case type_array:
+ obj = CompileArrayType (obj, decls, type, stat, code);
+ break;
+ case type_hash:
+ obj = CompileType (obj, decls, type->hash.type, stat, code);
+ obj = CompileType (obj, decls, type->hash.keyType, stat, code);
+ break;
+ case type_struct:
+ case type_union:
+ st = type->structs.structs;
+ for (i = 0; i < st->nelements; i++)
+ obj = CompileType (obj, decls, BoxTypesElements(st->types)[i], stat, code);
+ break;
+ case type_types:
+ for (et = type->types.elt; et; et = et->next)
+ obj = CompileType (obj, decls, et->type, stat, code);
+ break;
+ }
+ RETURN (obj);
+
+}
+
+/*
* Compile a declaration expression. Allocate storage for the symbol,
* Typecheck and compile initializers, make sure a needed value
* is left in the accumulator
@@ -3567,10 +3740,13 @@
decls->base.type = typePoly;
RETURN (obj);
}
+ if (decls->base.type)
+ obj = CompileType (obj, decls, decls->base.type, stat, code);
for (decl = decls->decl.decl; decl; decl = decl->next) {
ExprPtr init;
- CompileStorage (obj, decls, decl->symbol, code);
+
s = decl->symbol;
+ CompileStorage (obj, decls, s, code);
/*
* Automatically build initializers for composite types
* which fully specify the storage
@@ -3704,6 +3880,8 @@
"Const",
"BuildArray",
"InitArray",
+ "BuildHash",
+ "InitHash",
"BuildStruct",
"InitStruct",
"BuildUnion",
Index: execute.c
===================================================================
RCS file: /local/src/CVS/nickle/execute.c,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- execute.c 30 Jun 2003 04:53:42 -0000 1.82
+++ execute.c 21 Jul 2003 22:22:10 -0000 1.83
@@ -732,7 +732,7 @@
{
RaiseStandardException (exception_invalid_binop_values,
"Strings have only 1 dimension",
- 2, NewInt (stack), value);
+ 2, NewInt (stack), v);
break;
}
i = IntPart (value, "Invalid string index");
@@ -767,6 +767,19 @@
value = NewRef (v->array.values, i);
}
break;
+ case rep_hash:
+ if (stack != 1)
+ {
+ RaiseStandardException (exception_invalid_binop_values,
+ "Hashes have only one dimension",
+ 2, NewInt (stack), v);
+ break;
+ }
+ if (fetch)
+ value = HashGet (v, value);
+ else
+ value = HashRef (v, value);
+ break;
default:
RaiseStandardException (exception_invalid_unop_value,
"Not an array",
@@ -1084,6 +1097,17 @@
stack = 0;
value = ThreadArrayInit (thread, value, inst->ainit.mode,
inst->ainit.dim, &stack, &next);
+ break;
+ case OpBuildHash:
+ value = NewHash (False, inst->hash.type->hash.keyType,
+ inst->hash.type->hash.type);
+ break;
+ case OpInitHash:
+ w = CStack (1);
+ v = CStack (0);
+ stack = 2;
+ HashSet (w, v, value);
+ value = w;
break;
case OpBuildStruct:
value = NewStruct (inst->structs.structs, False);
Index: file.c
===================================================================
RCS file: /local/src/CVS/nickle/file.c,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -d -r1.50 -r1.51
--- file.c 26 Jun 2003 08:59:09 -0000 1.50
+++ file.c 21 Jul 2003 22:22:10 -0000 1.51
@@ -1451,6 +1451,50 @@
}
void
+FilePutBaseType (Value f, Type *t, Bool minimal)
+{
+ switch (t->base.tag) {
+ case type_func:
+ FilePutBaseType (f, t->func.ret, minimal);
+ break;
+ case type_array:
+ FilePutBaseType (f, t->array.type, minimal);
+ break;
+ case type_hash:
+ FilePutBaseType (f, t->hash.type, minimal);
+ break;
+ default:
+ FilePutType (f, t, minimal);
+ break;
+ }
+}
+
+void
+FilePutSubscriptType (Value f, Type *t, Bool minimal)
+{
+ switch (t->base.tag) {
+ case type_func:
+ FilePutArgType (f, t->func.args);
+ FilePutSubscriptType (f, t->func.ret, minimal);
+ break;
+ case type_array:
+ FilePuts (f, "[");
+ FilePutDimensions (f, t->array.dimensions);
+ FilePuts (f, "]");
+ FilePutSubscriptType (f, t->array.type, minimal);
+ break;
+ case type_hash:
+ FilePuts (f, "[");
+ FilePutType (f, t->hash.keyType, False);
+ FilePuts (f, "]");
+ FilePutSubscriptType (f, t->hash.type, minimal);
+ break;
+ default:
+ break;
+ }
+}
+
+void
FilePutType (Value f, Type *t, Bool minimal)
{
int i;
@@ -1481,14 +1525,10 @@
FilePutType (f, t->ref.ref, False);
break;
case type_func:
- FilePutType (f, t->func.ret, False);
- FilePutArgType (f, t->func.args);
- break;
case type_array:
- FilePutType (f, t->array.type, False);
- FilePuts (f, "[");
- FilePutDimensions (f, t->array.dimensions);
- FilePuts (f, "]");
+ case type_hash:
+ FilePutBaseType (f, t, False);
+ FilePutSubscriptType (f, t, False);
break;
case type_struct:
case type_union:
Index: gram.y
===================================================================
RCS file: /local/src/CVS/nickle/gram.y,v
retrieving revision 1.124
retrieving revision 1.125
diff -u -d -r1.124 -r1.125
--- gram.y 30 Jun 2003 04:53:42 -0000 1.124
+++ gram.y 21 Jul 2003 22:22:10 -0000 1.125
@@ -118,7 +118,7 @@
%type <type> opt_type type subscripts subtype
%type <expr> opt_stars stars
%type <type> basetype
-%type <expr> dims types
+%type <expr> dims
%type <memList> struct_members union_members
%type <class> class
%type <publish> opt_publish publish publish_extend
@@ -136,10 +136,11 @@
%type <ints> assignop
%type <value> opt_integer integer
%type <expr> opt_arrayinit arrayinit arrayelts arrayelt
+%type <expr> opt_hashinit hashinit hashelts hashelt hashvalue
%type <expr> structinit structelts structelt
%type <expr> init
-%token VAR EXPR ARRAY STRUCT UNION ENUM COMP
+%token VAR EXPR ARRAY STRUCT UNION ENUM COMP HASH
%token NL SEMI MOD OC CC DOLLAR DOTS
%token <class> GLOBAL AUTO STATIC CONST
@@ -827,8 +828,8 @@
{ $$ = NewTypeArray ($4, $2); }
| OS dims CS subscripts
{ $$ = NewTypeArray ($4, $2); }
- | OS types CS subscripts
- { $$ = NewTypeArray ($4, $2); }
+ | OS type CS subscripts
+ { $$ = NewTypeHash ($4, $2); }
|
{ $$ = 0; }
;
@@ -848,6 +849,9 @@
case type_array:
bot = &t->array.type;
break;
+ case type_hash:
+ bot = &t->hash.type;
+ break;
case type_func:
bot = &t->func.ret;
break;
@@ -972,11 +976,6 @@
| simpleexpr
{ $$ = NewExprTree (COMMA, $1, 0); }
;
-types : type COMMA types
- { $$ = 0; }
- | type
- { $$ = 0; }
- ;
/*
* Structure member declarations
*/
@@ -1318,6 +1317,13 @@
$$ = NewExprTree (NEW, $7, 0);
$$->base.type = $7->base.type;
}
+ | OP OS type CS CP namespace_start opt_hashinit namespace_end
+ {
+ $7->base.type = NewTypeHash (typePoly, $3);
+ ParseCanonType ($7->base.type, False);
+ $$ = NewExprTree (NEW, $7, 0);
+ $$->base.type = $7->base.type;
+ }
| type DOT NAME %prec UNIONCAST
{
ParseCanonType ($1, False);
@@ -1426,6 +1432,32 @@
| init
;
+/*
+ * Hash initializers
+ */
+opt_hashinit : hashinit
+ | OC CC
+ { $$ = 0; }
+ |
+ { $$ = 0; }
+ ;
+hashinit : OC hashelts opt_comma CC
+ {
+ ExprPtr elts = $2 ? ExprRehang ($2, 0) : 0;
+ $$ = NewExprTree (HASH, elts, 0);
+ }
+ ;
+hashelts : hashelts COMMA hashelt
+ { $$ = NewExprTree (COMMA, $1, $3); }
+ | hashelt
+ { $$ = NewExprTree (COMMA, 0, $1); }
+ ;
+hashelt : hashvalue COLON hashvalue
+ { $$ = NewExprTree (COLON, $1, $3); }
+ ;
+hashvalue : simpleexpr
+ | init
+ ;
/*
* Structure initializers
*/
@@ -1445,6 +1477,7 @@
init : arrayinit
| structinit
+ | hashinit
| OC CC
{ $$ = NewExprTree (ANONINIT, 0, 0); }
;
@@ -1773,6 +1806,12 @@
break;
case type_array:
ret = ParseCanonType (type->array.type, forwardAllowed);
+ break;
+ case type_hash:
+ ret = ParseCanonType (type->hash.type, forwardAllowed);
+ t = ParseCanonType (type->hash.keyType, forwardAllowed);
+ if (t < ret)
+ ret = t;
break;
case type_struct:
for (n = 0; n < type->structs.structs->nelements; n++)
Index: int.c
===================================================================
RCS file: /local/src/CVS/nickle/int.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- int.c 16 Mar 2003 22:49:26 -0000 1.19
+++ int.c 21 Jul 2003 22:22:10 -0000 1.20
@@ -320,10 +320,10 @@
return True;
}
-static Value
+static HashValue
IntHash (Value av)
{
- return av;
+ return (HashValue) ValueInt (av);;
}
ValueRep IntRep = {
Index: integer.c
===================================================================
RCS file: /local/src/CVS/nickle/integer.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- integer.c 16 Mar 2003 22:49:26 -0000 1.16
+++ integer.c 21 Jul 2003 22:22:10 -0000 1.17
@@ -382,10 +382,10 @@
return result != 0;
}
-static Value
+static HashValue
IntegerHash (Value iv)
{
- return NewInt (NaturalHash (IntegerMag(iv)) ^ IntegerSign(iv));
+ return NaturalHash (IntegerMag(iv)) ^ IntegerSign(iv);
}
static void
Index: natural.c
===================================================================
RCS file: /local/src/CVS/nickle/natural.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- natural.c 16 Mar 2003 22:49:26 -0000 1.21
+++ natural.c 21 Jul 2003 22:22:10 -0000 1.22
@@ -1410,20 +1410,20 @@
return True;
}
-#define rotDigit(x) (((x) >> 1) | ((x) << (DIGITBITS-1)))
+#define hrot(i) (((i) << 1) | ((i) >> (sizeof (HashValue) * 8 - 1)))
-int
+HashValue
NaturalHash (Natural *a)
{
- digit h = 0;
- digit *at;
- int index;
+ HashValue h = 0;
+ digit *at;
+ int index;
at = NaturalDigits (a);
index = a->length;
while (index--)
- h = rotDigit(h) ^ *at++;
- return (int) h;
+ h = hrot(h) ^ (HashValue) *at++;
+ return h;
}
int
Index: nickle.h
===================================================================
RCS file: /local/src/CVS/nickle/nickle.h,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -d -r1.105 -r1.106
--- nickle.h 30 Jun 2003 04:53:43 -0000 1.105
+++ nickle.h 21 Jul 2003 22:22:10 -0000 1.106
@@ -409,6 +409,11 @@
AInitMode mode;
} InstAInit;
+typedef struct _instHash {
+ InstBase inst;
+ TypePtr type;
+} InstHash;
+
typedef struct _instCode {
InstBase inst;
CodePtr code;
@@ -500,6 +505,7 @@
InstStruct structs;
InstArray array;
InstAInit ainit;
+ InstHash hash;
InstCode code;
InstBranch branch;
InstBinOp binop;
@@ -1043,3 +1049,9 @@
/* two argument non-local builtins */
Value do_longjmp (InstPtr *, Value, Value);
+/* hash builtins (for testing) */
+Value do_hash_new (void);
+Value do_hash_get (Value, Value);
+Value do_hash_del (Value, Value);
+Value do_hash_test (Value, Value);
+Value do_hash_set (Value, Value, Value);
Index: opcode.h
===================================================================
RCS file: /local/src/CVS/nickle/opcode.h,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- opcode.h 5 Jun 2003 23:51:23 -0000 1.24
+++ opcode.h 21 Jul 2003 22:22:10 -0000 1.25
@@ -49,6 +49,8 @@
OpConst,
OpBuildArray,
OpInitArray,
+ OpBuildHash,
+ OpInitHash,
OpBuildStruct,
OpInitStruct,
OpBuildUnion,
Index: pretty.c
===================================================================
RCS file: /local/src/CVS/nickle/pretty.c,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -d -r1.62 -r1.63
--- pretty.c 5 Jun 2003 15:03:34 -0000 1.62
+++ pretty.c 21 Jul 2003 22:22:10 -0000 1.63
@@ -201,6 +201,20 @@
}
static void
+PrettyHashInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
+{
+ while (e)
+ {
+ PrettyExpr (f, e->tree.left->tree.left, -1, level, nest, pd);
+ FilePuts (f, " : ");
+ PrettyExpr (f, e->tree.left->tree.right, -1, level, nest, pd);
+ e = e->tree.right;
+ if (e)
+ FilePuts (f, ", ");
+ }
+}
+
+static void
PrettyStructInit (Value f, Expr *e, int level, Bool nest, ProfileData *pd)
{
while (e)
@@ -360,6 +374,11 @@
FilePuts (f, "= ");
PrettyExpr (f, e->tree.right, selfPrec, level, nest, pd);
}
+ FilePuts (f, " }");
+ break;
+ case HASH:
+ FilePuts (f, "{ ");
+ PrettyHashInit (f, e->tree.left, level, nest, pd);
FilePuts (f, " }");
break;
case ANONINIT:
Index: rational.c
===================================================================
RCS file: /local/src/CVS/nickle/rational.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- rational.c 16 Mar 2003 22:49:26 -0000 1.26
+++ rational.c 21 Jul 2003 22:22:10 -0000 1.27
@@ -300,12 +300,12 @@
RETURN (av);
}
-static Value
+static HashValue
RationalHash (Value av)
{
Rational *a = &av->rational;
- return NewInt (NaturalHash (a->den) ^ NaturalHash(a->num) ^ a->sign);
+ return NaturalHash (a->den) ^ NaturalHash(a->num) ^ a->sign;
}
extern ValueRep IntegerRep;
Index: string.c
===================================================================
RCS file: /local/src/CVS/nickle/string.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- string.c 16 Mar 2003 22:49:26 -0000 1.14
+++ string.c 21 Jul 2003 22:22:10 -0000 1.15
@@ -164,18 +164,18 @@
else return 0;
}
-#define irot(i) (((i) << 1) | ((i) >> (sizeof (int) * 8 - 1)))
+#define hrot(i) (((i) << 1) | ((i) >> (sizeof (HashValue) * 8 - 1)))
-static Value
+static HashValue
StringHash (Value av)
{
- char *string = StringChars (&av->string);
- char c;
- int i = 0;
+ char *string = StringChars (&av->string);
+ char c;
+ HashValue h = 0;
while ((c = *string++))
- i = irot(i) ^ c;
- return NewInt(i);
+ h = hrot(h) ^ (HashValue) c;
+ return h;
}
ValueRep StringRep = {
Index: struct.c
===================================================================
RCS file: /local/src/CVS/nickle/struct.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- struct.c 17 Jun 2003 17:15:46 -0000 1.21
+++ struct.c 21 Jul 2003 22:22:10 -0000 1.22
@@ -101,17 +101,17 @@
return TrueVal;
}
-static Value
+static HashValue
StructHash (Value a)
{
Struct *s = &a->structs;
StructType *at = s->type;
- int h = 0;
- int i;
+ HashValue h = 0;
+ int i;
for (i = 0; i < at->nelements; i++)
h = h ^ ValueInt (ValueHash (BoxValue (a->structs.values, i)));
- return NewInt (h);
+ return h;
}
ValueRep StructRep = {
Index: type.c
===================================================================
RCS file: /local/src/CVS/nickle/type.c,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -d -r1.55 -r1.56
--- type.c 30 Jun 2003 04:53:43 -0000 1.55
+++ type.c 21 Jul 2003 22:22:10 -0000 1.56
@@ -65,6 +65,15 @@
}
static void
+TypeHashMark (void *object)
+{
+ TypeHash *th = object;
+
+ MemReference (th->type);
+ MemReference (th->keyType);
+}
+
+static void
TypeStructMark (void *object)
{
TypeStruct *ts = object;
@@ -85,6 +94,7 @@
DataType ArgTypeType = { ArgTypeMark, 0, "ArgTypeType" };
DataType TypeFuncType = { TypeFuncMark, 0, "TypeFuncType" };
DataType TypeArrayType = { TypeArrayMark, 0, "TypeArrayType" };
+DataType TypeHashType = { TypeHashMark, 0, "TypeHashType" };
DataType TypeStructType = { TypeStructMark, 0, "TypeStructType" };
DataType TypeUnitType = { 0, 0, "TypeUnitType" };
DataType TypeTypesType = { TypeTypesMark, 0, "TypeTypesType" };
@@ -171,6 +181,19 @@
}
Type *
+NewTypeHash (Type *type, Type *keyType)
+{
+ ENTER ();
+ Type *t;
+
+ t = ALLOCATE (&TypeHashType, sizeof (TypeHash));
+ t->base.tag = type_hash;
+ t->hash.type = type;
+ t->hash.keyType = keyType;
+ RETURN (t);
+}
+
+Type *
NewTypeStruct (StructType *structs)
{
ENTER ();
@@ -361,6 +384,10 @@
if (super_dim == 0 || sub_dim == 0 || super_dim == sub_dim)
return TypeIsSupertype (super->array.type, sub->array.type);
return False;
+ case type_hash:
+ /* contravariant */
+ return (TypeIsSupertype (super->hash.type, sub->hash.type) &&
+ TypeIsSupertype (sub->hash.keyType, super->hash.keyType));
case type_struct:
case type_union:
super_st = super->structs.structs;
@@ -602,7 +629,7 @@
}
/*
- * Type of an array reference
+ * Type of an array or hash reference
*/
static Type *
TypeUnaryArray (Type *type)
@@ -611,6 +638,8 @@
return typePoly;
if (type->base.tag == type_array)
return type->array.type;
+ if (type->base.tag == type_hash)
+ return type->hash.type;
return 0;
}
@@ -913,6 +942,11 @@
if (n == 0 || n == ndim)
ret = TypeAdd (ret, type->array.type);
}
+ else if (type->base.tag == type_hash)
+ {
+ if (ndim == 1)
+ ret = TypeAdd (ret, type->hash.type);
+ }
}
RETURN (TypeCombineFlatten (ret));
}
@@ -1069,6 +1103,36 @@
}
}
break;
+ case type_hash:
+ if (ValueIsHash (b))
+ {
+ if (TypePoly (a->hash.type))
+ return True;
+ if (TypePoly (b->hash.type))
+ {
+ HashValue h;
+ Value *e = BoxElements (b->hash.elts);
+
+ for (h = 0; h < b->hash.hashSet->size; h++)
+ {
+ if (!TypeCompatibleAssign (a->hash.type,
+ HashEltValue(e)))
+ {
+ return False;
+ }
+ if (!TypeCompatibleAssign (a->hash.keyType,
+ HashEltKey (e)))
+ {
+ return False;
+ }
+ HashEltStep (e);
+ }
+ return True;
+ }
+ else
+ return (TypeIsOrdered (a->hash.type, b->hash.type) &&
+ TypeIsOrdered (a->hash.keyType, b->hash.keyType));
+ }
case type_struct:
case type_union:
if ((ValueIsStruct(b) && a->base.tag == type_struct) ||
Index: value.c
===================================================================
RCS file: /local/src/CVS/nickle/value.c,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- value.c 30 Jun 2003 04:53:43 -0000 1.43
+++ value.c 21 Jul 2003 22:22:10 -0000 1.44
@@ -607,6 +607,8 @@
nbox = nv->unions.value;
n = 1;
break;
+ case rep_hash:
+ RETURN (HashCopy (v));
default:
RETURN (v);
}
@@ -637,11 +639,11 @@
ValueRep *rep;
if (!v)
- return Zero;
+ return 0;
rep = ValueRep(v);
if (!rep->hash)
- return Zero;
- return (*rep->hash) (v);
+ return 0;
+ return NewInt ((*rep->hash) (v) & MAX_NICKLE_INT);
}
#ifndef HAVE_C_INLINE
@@ -781,6 +783,8 @@
if (!ArrayInit ())
return 0;
if (!FileInit ())
+ return 0;
+ if (!HashInit ())
return 0;
if (!IntInit ())
return 0;
Index: value.h
===================================================================
RCS file: /local/src/CVS/nickle/value.h,v
retrieving revision 1.88
retrieving revision 1.89
diff -u -d -r1.88 -r1.89
--- value.h 30 Jun 2003 04:53:43 -0000 1.88
+++ value.h 21 Jul 2003 22:22:10 -0000 1.89
@@ -161,6 +161,10 @@
#define ModBase(t) ((t) & (((double_digit) 1 << LBASE2) - 1))
#define DivBase(t) ((t) >> LBASE2)
+/* HashValues are stored in rep_int */
+
+typedef int HashValue;
+
/*
* Natural numbers form the basis for both the Integers and Rationals,
* but needn't ever be exposed to the user
@@ -213,7 +217,7 @@
digit DigitBmod (digit u, digit v, int s);
int IntWidth (int i);
int DoubleDigitWidth (double_digit i);
-int NaturalHash (Natural *a);
+HashValue NaturalHash (Natural *a);
extern Natural *max_int_natural;
extern Natural *zero_natural;
@@ -270,7 +274,8 @@
/* mutable type */
rep_array = 13,
rep_struct = 14,
- rep_union = 15
+ rep_union = 15,
+ rep_hash = 16
} Rep;
/* because rep_undef is -1, using (unsigned) makes these a single compare */
@@ -280,7 +285,8 @@
extern ValueRep IntRep, IntegerRep, RationalRep, FloatRep;
extern ValueRep StringRep, ArrayRep, FileRep;
-extern ValueRep RefRep, StructRep, UnionRep, FuncRep, ThreadRep;
+extern ValueRep RefRep, StructRep, UnionRep, HashRep;
+extern ValueRep FuncRep, ThreadRep;
extern ValueRep SemaphoreRep, ContinuationRep, UnitRep, BoolRep;
#define NewInt(i) ((Value) (((i) << 1) | 1))
@@ -310,6 +316,7 @@
#define ValueIsRef(v) (ValueRep(v) == &RefRep)
#define ValueIsStruct(v) (ValueRep(v) == &StructRep)
#define ValueIsUnion(v) (ValueRep(v) == &UnionRep)
+#define ValueIsHash(v) (ValueRep(v) == &HashRep)
#define ValueIsFunc(v) (ValueRep(v) == &FuncRep)
#define ValueIsThread(v) (ValueRep(v) == &ThreadRep)
#define ValueIsSemaphore(v) (ValueRep(v) == &SemaphoreRep)
@@ -334,7 +341,7 @@
typedef enum _typeTag {
type_prim, type_name, type_ref, type_func, type_array,
- type_struct, type_union, type_types
+ type_struct, type_union, type_types, type_hash
} TypeTag;
typedef struct _typeBase {
@@ -373,6 +380,12 @@
ExprPtr dimensions;
} TypeArray;
+typedef struct _typeHash {
+ TypeBase base;
+ TypePtr type;
+ TypePtr keyType;
+} TypeHash;
+
typedef struct _typeStruct {
TypeBase base;
StructTypePtr structs;
@@ -397,6 +410,7 @@
TypeRef ref;
TypeFunc func;
TypeArray array;
+ TypeHash hash;
TypeStruct structs;
TypeTypes types;
} Type;
@@ -423,6 +437,7 @@
Type *NewTypePointer (Type *ref);
Type *NewTypeFunc (Type *ret, ArgType *args);
Type *NewTypeArray (Type *type, ExprPtr dimensions);
+Type *NewTypeHash (Type *type, Type *keyType);
Type *NewTypeStruct (StructTypePtr structs);
Type *NewTypeUnion (StructTypePtr structs, Bool enumeration);
Type *NewTypeTypes (TypeElt *elt);
@@ -710,6 +725,55 @@
void ContinuationTrace (char *where, Value continuation);
#endif
+/*
+ * Hash tables. Indexed by multiple typed values
+ */
+
+typedef const struct _HashSet {
+ HashValue entries;
+ HashValue size;
+ HashValue rehash;
+} HashSetRec, *HashSetPtr;
+
+/*
+ * Hash elements are stored in boxes, with three elements
+ * for each element (hash, key, value)
+ *
+ * Hash element states:
+ *
+ * key value
+ * 0 0 empty
+ * v 0 reference to uninitialized element
+ * 0 v deleted
+ * v v valid entry
+ *
+ * So:
+ * key != 0 -> count includes
+ * value != 0 -> hash chain includes
+ * value != 0 && key != 0 -> hash table includes
+ */
+
+#define HashEltHash(e) ((e)[0])
+#define HashEltKey(e) ((e)[1])
+#define HashEltValue(e) ((e)[2])
+#define HashEltSize 3
+#define HashEltStep(e) ((e) += HashEltSize)
+#define HashEltCopy(d,s) (((d)[0] = (s)[0]), \
+ ((d)[1] = (s)[1]), \
+ ((d)[2] = (s)[2]))
+#define HashEltCounted(e) (HashEltKey(e) != 0)
+#define HashEltChained(e) (HashEltValue(e) != 0)
+#define HashEltValid(e) (HashEltKey(e) != 0 && HashEltValue(e) != 0)
+
+typedef struct _hashTable {
+ BaseValue base;
+ HashSetRec *hashSet;
+ HashValue count;
+ TypePtr type;
+ TypePtr keyType;
+ BoxPtr elts;
+} HashTable, *HashTablePtr;
+
typedef union _value {
BaseValue value;
Integer integer;
@@ -725,6 +789,7 @@
Thread thread;
Semaphore semaphore;
Continuation continuation;
+ HashTable hash;
} ValueRec;
typedef Value (*Binary) (Value, Value, int);
@@ -735,7 +800,7 @@
typedef Value (*Coerce) (Value);
-typedef Value (*Hash) (Value);
+typedef int (*Hash) (Value);
#define DEFAULT_OUTPUT_PRECISION -1
#define INFINITE_OUTPUT_PRECISION -2
@@ -746,7 +811,7 @@
struct _valueType {
DataType data;
- Rep tag;
+ Rep tag;
Binary binary[NumBinaryOp];
Unary unary[NumUnaryOp];
Promote promote;
@@ -829,6 +894,14 @@
Value NewArray (Bool constant, Bool resizable, TypePtr type, int ndim, int *dims);
void ArrayResize (Value av, int dim, int size);
void ArraySetDimensions (Value av, int *dims);
+Value NewHash (Bool constant, TypePtr keyType, TypePtr valueType);
+Value HashGet (Value hv, Value key);
+void HashSet (Value hv, Value key, Value value);
+Value HashRef (Value hv, Value key);
+Value HashTest (Value hv, Value key);
+void HashDelete (Value hv, Value key);
+Value HashCopy (Value hv);
+
Value NewFile (int fd);
Value NewRefReal (BoxPtr box, int element, Value *re);
char *StringNextChar (char *src, unsigned *dst);
@@ -872,7 +945,7 @@
# define OK_TRUNC 1
-extern Value Blank, Empty, Elementless, Void, TrueVal, FalseVal;
+extern Value Blank, Elementless, Void, TrueVal, FalseVal;
# define True(v) ((v) == TrueVal)
# define False(v) ((v) != TrueVal)
@@ -902,6 +975,8 @@
void FilePutClass (Value f, Class storage, Bool minimal);
void FilePutPublish (Value f, Publish publish, Bool minimal);
void FilePutType (Value f, Type *t, Bool minimal);
+void FilePutBaseType (Value f, Type *t, Bool minimal);
+void FilePutSubscriptType (Value f, Type *t, Bool minimal);
Value FileFopen (char *name, char *mode, int *errp);
Value FileReopen (char *name, char *mode, Value file, int *errp);
void FilePutArgType (Value f, ArgType *at);
@@ -1040,6 +1115,7 @@
int AtomInit (void);
int FileInit (void);
int IntInit (void);
+int HashInit (void);
int NaturalInit (void);
int IntegerInit (void);
int RationalInit (void);
More information about the Commit
mailing list