[Commit] nickle ChangeLog, 1.65, 1.66 abort.5c, 1.6, 1.7 arc4.5c, 1.6, 1.7 builtin-namespaces.h, 1.3, 1.4 builtin.c, 1.19, 1.20 file.5c, 1.3, 1.4 math.5c, 1.39, 1.40 type.c, 1.63, 1.64 value.h, 1.105, 1.106

Keith Packard commit at keithp.com
Sun Jun 13 23:43:35 PDT 2004 

Committed by: keithp

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

Modified Files:
	ChangeLog abort.5c arc4.5c builtin-namespaces.h builtin.c 
	file.5c math.5c type.c value.h 
Log Message:
2004-06-13  Keith Packard  <keithp at keithp.com>

	* abort.5c:
	* arc4.5c:
	* builtin-namespaces.h:
	Add CVS Header and Copyright
	
	* file.5c:
	Clean up function doc comments
	
	* math.5c:
	Use 0.{3} for 1/3

	* builtin.c: (BuiltinType):
	* type.c: (TypeNumeric), (TypeIntegral), (TypeIsCotype),
	* value.h:
	(TypeBinaryGroup), (TypeBinaryField), (TypeUnaryGroup), (TypeInit):
	Remove typeGroup/typeField
	Add (#if 0'd out) TypeIsCotype while we figure out how its supposed
	to work.


Index: ChangeLog
===================================================================
RCS file: /local/src/CVS/nickle/ChangeLog,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -d -r1.65 -r1.66
--- a/ChangeLog	8 Jun 2004 09:30:53 -0000	1.65
+++ b/ChangeLog	14 Jun 2004 06:43:33 -0000	1.66
@@ -1,3 +1,24 @@
+2004-06-13  Keith Packard  <keithp at keithp.com>
+
+	* abort.5c:
+	* arc4.5c:
+	* builtin-namespaces.h:
+	Add CVS Header and Copyright
+	
+	* file.5c:
+	Clean up function doc comments
+	
+	* math.5c:
+	Use 0.{3} for 1/3
+
+	* builtin.c: (BuiltinType):
+	* type.c: (TypeNumeric), (TypeIntegral), (TypeIsCotype),
+	* value.h:
+	(TypeBinaryGroup), (TypeBinaryField), (TypeUnaryGroup), (TypeInit):
+	Remove typeGroup/typeField
+	Add (#if 0'd out) TypeIsCotype while we figure out how its supposed
+	to work.
+	
 2004-06-08  Keith Packard  <keithp at keithp.com>
 version 2.40
 

Index: abort.5c
===================================================================
RCS file: /local/src/CVS/nickle/abort.5c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- a/abort.5c	8 Jun 2004 09:30:53 -0000	1.6
+++ b/abort.5c	14 Jun 2004 06:43:33 -0000	1.7
@@ -1,12 +1,17 @@
+/* $Header$ */
+/*
+ * Copyright © 2004 Keith Packard and Bart Massey.
+ * All Rights Reserved.  See the file COPYING in this directory
+ * for licensing information.
+ */
+
 namespace Abort {
     public int trace_depth = 20;
 
     public exception aborting(string);
 
     public void abort(string reason, args ...) 
-	/*
-	 * Print a stack trace and raise aborting (vsprintf (reason, args))
-	 */
+	/* Print a stack trace and raise aborting (vsprintf (reason, args)) */
     {
 	Debug::trace(Thread::current(), trace_depth);
 	string reasonmsg = File::vsprintf(reason, args);
@@ -14,9 +19,7 @@
     }
 
     public void assert(bool ok, string failure, args ...) 
-	/*
-	 * If 'ok' is false, abort (failure, args ...);
-	 */
+	/* If 'ok' is false, abort (failure, args ...); */
     {
 	if (!ok)
 	    abort(failure, args ...);
@@ -25,9 +28,7 @@
     public bool do_debug = true;
 
     public void debug(string fmt, args ...) 
-	/*
-	 * Print to stderr, controlled by 'do_debug' global
-	 */
+	/* Print to stderr, controlled by 'do_debug' global */
     {
 	if (do_debug)
 	    File::vfprintf(stderr, fmt + "\n", args);

Index: arc4.5c
===================================================================
RCS file: /local/src/CVS/nickle/arc4.5c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- a/arc4.5c	8 Jun 2004 09:30:53 -0000	1.6
+++ b/arc4.5c	14 Jun 2004 06:43:33 -0000	1.7
@@ -1,3 +1,10 @@
+/* $Header$ */
+/*
+ * Copyright © 1999 Bart Massey.
+ * All Rights Reserved.  See the file COPYING in this directory
+ * for licensing information.
+ */
+
 /*
  * Implementation of Alleged RC4
  *

Index: builtin-namespaces.h
===================================================================
RCS file: /local/src/CVS/nickle/builtin-namespaces.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- a/builtin-namespaces.h	11 Jun 2003 05:01:56 -0000	1.3
+++ b/builtin-namespaces.h	14 Jun 2004 06:43:33 -0000	1.4
@@ -1,3 +1,10 @@
+/* $Header$ */
+/*
+ * Copyright © 1988-2004 Keith Packard and Bart Massey.
+ * All Rights Reserved.  See the file COPYING in this directory
+ * for licensing information.
+ */
+
 extern void import_Toplevel_namespace(void);
 extern void import_Debug_namespace(void);
 extern void import_File_namespace(void);

Index: builtin.c
===================================================================
RCS file: /local/src/CVS/nickle/builtin.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- a/builtin.c	8 Jun 2004 09:30:53 -0000	1.19
+++ b/builtin.c	14 Jun 2004 06:43:33 -0000	1.20
@@ -177,8 +177,8 @@
     }
     switch (*format++) {
     case 'p': t = typePoly; break;
-    case 'n': t = typeGroup; break;
-    case 'N': t = typeField; break;
+    case 'n': t = typePrim[rep_float]; break;
+    case 'N': t = typePrim[rep_float]; break;
     case 'E': t = typeFileError; break;
     case 'R': t = typePrim[rep_float]; break;
     case 'r': t = typePrim[rep_rational]; break;

Index: file.5c
===================================================================
RCS file: /local/src/CVS/nickle/file.5c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- a/file.5c	8 Jun 2004 09:30:54 -0000	1.3
+++ b/file.5c	14 Jun 2004 06:43:33 -0000	1.4
@@ -14,10 +14,10 @@
 	file error;
     } childfd;
 
-    /* this is what happens when you fork() */
     public int mkchild(string path, string[*] argv, childfd fds ...) 
 	/*
-	 * Call filter transforming 'fds' into an array of three files
+	 * Call filter transforming 'fds' into an array of three files.
+	 * This is what happens when you fork()
 	 */
     {
 	file[3] filter_fds = { stdnull, ... };
@@ -34,41 +34,31 @@
     public namespace FileGlobals {
 
 	public int getchar ()
-	    /*
-	     * return getc (stdin);
-	     */
+	    /* return getc (stdin); */
 	{
 	    return File::getc (stdin);
 	}
 
 	public void ungetchar (int ch)
-	    /*
-	     * return ungetc (ch, stdin);
-	     */
+	    /* ungetc (ch, stdin); */
 	{
 	    File::ungetc (ch, stdin);
 	}
 
 	public void putchar (int c)
-	    /*
-	     * return putc (c, stdout)
-	     */
+	    /* putc (c, stdout) */
 	{
 	    putc (c, stdout);
 	}
 
 	public int getbyte ()
-	    /*
-	     * return getb (stdin);
-	     */
+	    /* return getb (stdin) */
 	{
 	    return File::getb (stdin);
 	}
 
 	public void putbyte (int b)
-	    /*
-	     * return putb (b, stdout);
-	     */
+	    /* putb (b, stdout) */
 	{
 	    File::putb (b, stdout);
 	}
@@ -97,9 +87,7 @@
 	}
 
 	public string gets ()
-	    /*
-	     * return fgets (stdin);
-	     */
+	    /* return fgets (stdin); */
 	{
 	    return fgets (stdin);
 	}

Index: math.5c
===================================================================
RCS file: /local/src/CVS/nickle/math.5c,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- a/math.5c	8 Jun 2004 09:30:54 -0000	1.39
+++ b/math.5c	14 Jun 2004 06:43:33 -0000	1.40
@@ -890,7 +890,7 @@
 	case .5:
 	    result = sqrt (a);
 	    break;
-	case 1/3:
+	case .{3}:
 	    result = cbrt (a);
 	    break;
 	default:

Index: type.c
===================================================================
RCS file: /local/src/CVS/nickle/type.c,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -d -r1.63 -r1.64
--- a/type.c	26 May 2004 08:59:23 -0000	1.63
+++ b/type.c	14 Jun 2004 06:43:33 -0000	1.64
@@ -16,8 +16,6 @@
 #include	"gram.h"
 
 Type		*typePoly;
-Type		*typeGroup;
-Type		*typeField;
 Type		*typeRefPoly;
 Type		*typeArrayInt;
 Type		*typePrim[rep_void + 1];
@@ -262,8 +260,6 @@
 Bool
 TypeNumeric (Type *t)
 {
-    if (t == typeGroup)
-	return True;
     if (t->base.tag != type_prim)
 	return False;
     if (Numericp (t->prim.prim))
@@ -274,8 +270,6 @@
 Bool
 TypeIntegral (Type *t)
 {
-    if (t == typeGroup)
-	return True;
     if (t->base.tag != type_prim)
 	return False;
     if (Integralp (t->prim.prim))
@@ -438,6 +432,150 @@
     return TypeIsSupertype (a, b) || TypeIsSupertype (b, a);
 }
 
+#if 0
+
+/*
+ * The above relationship isn't quite right --
+ *
+ *	real(real) x = int func(int a) { return a + 1; };
+ *
+ * fails as int(int) is neither supertype nor subtype of real(real)
+ *
+ * We're trying to figure out what the right answer is, and for everything
+ * aside from structures, it looks pretty easy.  Structs are "hard"...
+ */
+
+/* 
+ * Return True if a is a "co-type" of b
+ */
+
+Bool
+TypeIsCotype (Type *a, Type *b)
+{
+    int		n;
+    Bool	ret;
+    StructType	*a_st;
+    StructType	*b_st;
+    int		a_dim;
+    int		b_dim;
+
+    if (a == b)
+	return True;
+    if (!a || !b)
+	return False;
+
+    /* resolve typedefs */
+    if (a->base.tag == type_name)
+	return TypeIsCotype (TypeNameType (a), b);
+    if (b->base.tag ==  type_name)
+	return TypeIsCotype (a, TypeNameType (b));
+
+    /* check bogus internal union types */
+    if (a->base.tag == type_types)
+    {
+	TypeElt	*elt;
+
+	for (elt = a->types.elt; elt; elt = elt->next)
+	    if (TypeIsCotype (elt->type, b))
+		return True;
+	return False;
+    }
+
+    if (b->base.tag == type_types)
+    {
+	TypeElt	*elt;
+
+	for (elt = b->types.elt; elt; elt = elt->next)
+	    if (TypeIsCotype (a, elt->type))
+		return True;
+	return False;
+    }
+
+    /* poly is a supertype of all types */
+    if (TypePoly (a) || TypePoly (b))
+	return True;
+
+    if (a->base.tag != b->base.tag)
+	return False;
+
+    switch (a->base.tag) {
+    case type_prim:
+	if (a->prim.prim == b->prim.prim)
+	    return True;
+	if (Numericp (a->prim.prim) && Numericp (b->prim.prim))
+	    return True;
+	return False;
+    case type_ref:
+	/*
+	 * Avoid the infinite recursion, but don't unify type yet
+	 */
+	for (n = 0; n < TypeCheckLevel; n++)
+	    if (STACK_ELT(TypeCheckStack, n) == a)
+		return True;
+	STACK_PUSH (TypeCheckStack, a);
+	++TypeCheckLevel;
+	/* XXX is this right? */
+	ret = TypeIsCotype (a->ref.ref, b->ref.ref);
+	STACK_POP (TypeCheckStack);
+	--TypeCheckLevel;
+	return ret;
+    case type_func:
+	if (TypeIsCotype (a->func.ret, b->func.ret))
+	{
+	    ArgType *a_arg = a->func.args;
+	    ArgType *b_arg = b->func.args;
+
+	    while (a_arg || b_arg)
+	    {
+		if (!a_arg || !b_arg)
+		    return False;
+		if (a_arg->varargs != b_arg->varargs)
+		    return False;
+		if (!TypeIsCotype (b_arg->type, a_arg->type))
+		    return False;
+		a_arg = a_arg->next;
+		b_arg = b_arg->next;
+	    }
+	    return True;
+	}
+	return False;
+    case type_array:
+	a_dim = TypeCountDimensions (a->array.dimensions);
+	b_dim = TypeCountDimensions (b->array.dimensions);
+	if (a_dim == 0 || b_dim == 0 || a_dim == b_dim)
+	    return TypeIsCotype (a->array.type, b->array.type);
+	return False;
+    case type_hash:
+	return (TypeIsCotype (a->hash.type, b->hash.type) &&
+		TypeIsCotype (a->hash.keyType, b->hash.keyType));
+    case type_struct:
+    case type_union:
+        a_st = a->structs.structs;
+	b_st = b->structs.structs;
+	for (n = 0; n < a_st->nelements; n++)
+	{
+	    Type	    *b_mem;
+
+	    /* 
+	     * Structs (or unions) are subtypes if they contain all
+	     * of the a type members and those members are subtypes
+	     */
+	    b_mem = StructMemType (b_st, StructTypeAtoms(a_st)[n]);
+	    if (!b_mem)
+		return False;
+	    if (!TypeIsCotype (BoxTypesElements(a_st->types)[n],
+				  b_mem))
+		return False;
+	}
+	return True;
+    case type_name:
+    case type_types:
+	abort ();
+    }
+    return False;
+}
+#endif
+
 /*
  * return the combined type for an operation
  * on a numeric type which is a group
@@ -448,12 +586,12 @@
     if (TypePoly (left))
     {
 	if (TypePoly (right) || TypeNumeric (right))
-	    return typeGroup;
+	    return typePrim[rep_float];
     }
     else if (TypePoly (right))
     {
 	if (TypeNumeric (left))
-	    return typeGroup;
+	    return typePrim[rep_float];
     }
     else if (TypeNumeric (left) &&  TypeNumeric (right))
     {
@@ -493,12 +631,12 @@
     if (TypePoly (left))
     {
 	if (TypePoly (right) || TypeNumeric (right))
-	    return typeField;
+	    return typePrim[rep_float];
     }
     else if (TypePoly (right))
     {
 	if (TypeNumeric (left))
-	    return typeField;
+	    return typePrim[rep_float];
     }
     else if (TypeNumeric (left) && TypeNumeric (right))
     {
@@ -612,7 +750,7 @@
 TypeUnaryGroup (Type *type)
 {
     if (TypePoly (type))
-	return typeGroup;
+	return typePrim[rep_float];
     else if (TypeNumeric (type))
 	return type;
     return 0;
@@ -1197,15 +1335,6 @@
     typeRefPoly = NewTypeRef (typePoly, True);
     MemAddRoot (typeRefPoly);
     
-    typeGroup = NewTypeTypes (NewTypeElt (typePrim[rep_integer],
-					  NewTypeElt (typePrim[rep_rational],
-						      NewTypeElt (typePrim[rep_float], 0))));
-    MemAddRoot (typeGroup);
-    
-    typeField = NewTypeTypes (NewTypeElt (typePrim[rep_rational],
-					  NewTypeElt (typePrim[rep_float], 0)));
-    MemAddRoot (typeField);
-    
     typeArrayInt = NewTypeArray (typePrim[rep_integer], 0, False);
     MemAddRoot (typeArrayInt);
 

Index: value.h
===================================================================
RCS file: /local/src/CVS/nickle/value.h,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -d -r1.105 -r1.106
--- a/value.h	8 Jun 2004 09:30:54 -0000	1.105
+++ b/value.h	14 Jun 2004 06:43:33 -0000	1.106
@@ -471,8 +471,6 @@
 } ArgList;
 
 extern Type	    *typePoly;
-extern Type	    *typeGroup;
-extern Type	    *typeField;
 extern Type	    *typeRefPoly;
 extern Type	    *typeFileError;
 extern Type	    *typeArrayInt;
@@ -508,6 +506,8 @@
 Bool	TypeIsSupertype (Type *super, Type *sub);
 /* a is a supertype of b or b is a supertype of a */
 Bool	TypeIsOrdered (Type *a, Type *b);
+/* a and b are 'cotypes' */
+Bool	TypeIsCotype (Type *a, Type *b);
 
 #define TypePoly(t)	((t)->base.tag == type_prim && (t)->prim.prim == rep_undef)
 #define TypeBool(t)	((t)->base.tag == type_prim && (t)->prim.prim == rep_bool)

More information about the Commit mailing list