[Commit] nickle compile.c,1.132,1.133 gram.y,1.116,1.117 type.c,1.53,1.54 value.h,1.82,1.83
Keith Packard
commit@keithp.com
Thu, 01 May 2003 17:23:40 -0700
Committed by: keithp
Update of /local/src/CVS/nickle
In directory home.keithp.com:/tmp/cvs-serv24496
Modified Files:
compile.c gram.y type.c value.h
Log Message:
Replace TypeCompatible with TypeIsSupertype and TypeIsOrdered (which is a lame name, but is easy to understand at least)
Index: compile.c
===================================================================
RCS file: /local/src/CVS/nickle/compile.c,v
retrieving revision 1.132
retrieving revision 1.133
diff -u -d -r1.132 -r1.133
--- compile.c 1 May 2003 19:00:18 -0000 1.132
+++ compile.c 2 May 2003 00:23:37 -0000 1.133
@@ -907,7 +907,7 @@
actual_type = TypeCombineArray (arg->tree.left->tree.left->base.type, 1, False);
else
actual_type = arg->tree.left->base.type;
- if (!TypeCompatible (argt->type, actual_type, True))
+ if (!TypeIsOrdered (argt->type, actual_type))
{
CompileError (obj, stat, "Incompatible types, formal '%T', actual '%T', for argument %d",
argt->type, arg->tree.left->base.type, i);
@@ -977,7 +977,9 @@
RETURN (obj);
}
expr->base.type = TypeCombineReturn (expr->tree.left->base.type);
- if (tail == TailAlways ||
+ if ((tail == TailAlways &&
+ !TypePoly (expr->base.type) &&
+ TypeIsSupertype (code->base.type, expr->base.type)) ||
(tail == TailVoid &&
TypeCanon (expr->base.type) == typePrim[rep_void]))
{
@@ -1111,9 +1113,8 @@
{
SetPush (obj);
obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
- if (!TypeCompatible (typePrim[rep_integer],
- expr->tree.left->base.type,
- True))
+ if (!TypeIsOrdered (typePrim[rep_integer],
+ expr->tree.left->base.type))
{
CompileError (obj, stat, "Incompatible type, index '%T', for array index %d",
expr->tree.left->base.type, ndim);
@@ -1839,7 +1840,7 @@
}
catch_type = NewTypeFunc (typePoly, catch->code.code->base.args);
- if (!TypeCompatible (exception->symbol.type, catch_type, True))
+ if (!TypeIsOrdered (exception->symbol.type, catch_type))
{
CompileError (obj, stat, "Incompatible types, formal '%T', actual '%T', for catch",
exception->symbol.type, catch_type);
@@ -2694,10 +2695,25 @@
RETURN (obj);
}
+/*
+ * Check if a return foo () can be turned into a tail call.
+ */
static Bool
_CompileCanTailCall (ObjPtr obj, CodePtr code)
{
- return !profiling && obj->nonLocal == 0 && (!code || code->base.func == code);
+ /* not in a function ("can't" happen) */
+ if (!code)
+ return False;
+ /* if profiling, disable tail calls to avoid losing information */
+ if (profiling)
+ return False;
+ /* Check for enclosing non-local branch targets */
+ if (obj->nonLocal != 0)
+ return False;
+ /* Check for compiling in a nested exception handler */
+ if (code->base.func != code)
+ return False;
+ return True;
}
ObjPtr
@@ -3250,8 +3266,9 @@
else
{
obj = _CompileExpr (obj, expr->tree.right, True, expr, code);
- obj = _CompileNonLocal (obj, BranchModReturn, expr, code);
}
+ if (ObjCode (obj, ObjLast (obj))->base.opCode != OpTailCall)
+ obj = _CompileNonLocal (obj, BranchModReturn, expr, code);
expr->base.type = expr->tree.right->base.type;
}
else
Index: gram.y
===================================================================
RCS file: /local/src/CVS/nickle/gram.y,v
retrieving revision 1.116
retrieving revision 1.117
diff -u -d -r1.116 -r1.117
--- gram.y 1 May 2003 19:00:18 -0000 1.116
+++ gram.y 2 May 2003 00:23:38 -0000 1.117
@@ -761,8 +761,7 @@
symbol = NamespaceFindName (CurrentNamespace, $1.decl->name, True);
if (symbol && symbol->symbol.forward)
{
- if (!TypeCompatible (symbol->symbol.type, type,
- True))
+ if (!TypeIsSupertype (symbol->symbol.type, type))
{
ParseError ("%A redefinition with different type",
$1.decl->name);
Index: type.c
===================================================================
RCS file: /local/src/CVS/nickle/type.c,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- type.c 17 Mar 2003 05:51:33 -0000 1.53
+++ type.c 2 May 2003 00:23:38 -0000 1.54
@@ -261,139 +261,141 @@
StackObject *TypeCheckStack;
int TypeCheckLevel;
+/*
+ * Return True if sup is a super type of sub
+ */
+
Bool
-TypeCompatible (Type *a, Type *b, Bool contains)
+TypeIsSupertype (Type *super, Type *sub)
{
int n;
- int adim, bdim;
Bool ret;
- StructType *st;
-
- if (a == b)
+ StructType *super_st;
+ StructType *sub_st;
+ int super_dim;
+ int sub_dim;
+
+ if (super == sub)
return True;
- if (!a || !b)
+ if (!super || !sub)
return False;
- if (a->base.tag == type_name)
- return TypeCompatible (TypeNameType(a), b, contains);
- if (b->base.tag == type_name)
- return TypeCompatible (a, TypeNameType(b), contains);
-
- if (a->base.tag == type_types)
+ /* resolve typedefs */
+ if (super->base.tag == type_name)
+ return TypeIsSupertype (TypeNameType (super), sub);
+ if (sub->base.tag == type_name)
+ return TypeIsSupertype (super, TypeNameType (sub));
+
+ /* check bogus internal union types */
+ if (super->base.tag == type_types)
{
TypeElt *elt;
- for (elt = a->types.elt; elt; elt = elt->next)
- if (TypeCompatible (elt->type, b, contains))
+
+ for (elt = super->types.elt; elt; elt = elt->next)
+ if (TypeIsSupertype (elt->type, sub))
return True;
return False;
}
- if (b->base.tag == type_types)
+ if (sub->base.tag == type_types)
{
TypeElt *elt;
- for (elt = b->types.elt; elt; elt = elt->next)
- if (TypeCompatible (a, elt->type, contains))
+
+ for (elt = sub->types.elt; elt; elt = elt->next)
+ if (TypeIsSupertype (super, elt->type))
return True;
return False;
}
-
- if (TypePoly (a))
- return True;
- if (/* !contains && */ TypePoly (b))
+ /* poly is a supertype of all types */
+ if (TypePoly (super))
return True;
- if (a->base.tag != b->base.tag)
+ if (super->base.tag != sub->base.tag)
return False;
- switch (a->base.tag) {
+
+ switch (super->base.tag) {
case type_prim:
- if (a->prim.prim == b->prim.prim)
- return True;
- if (TypeNumeric (a) && TypeNumeric (b))
+ if (super->prim.prim == sub->prim.prim)
return True;
- break;
+ if (Numericp (super->prim.prim) && Numericp (sub->prim.prim))
+ return super->prim.prim >= sub->prim.prim;
+ 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)
+ if (STACK_ELT(TypeCheckStack, n) == super)
return True;
- STACK_PUSH (TypeCheckStack, a);
+ STACK_PUSH (TypeCheckStack, super);
++TypeCheckLevel;
- ret = TypeCompatible (a->ref.ref, b->ref.ref, contains);
+ /* XXX is this right? */
+ ret = TypeIsSupertype (super->ref.ref, sub->ref.ref);
STACK_POP (TypeCheckStack);
--TypeCheckLevel;
return ret;
case type_func:
- if (TypeCompatible (a->func.ret, b->func.ret, contains))
+ if (TypeIsSupertype (super->func.ret, sub->func.ret))
{
- ArgType *aarg = a->func.args, *barg = b->func.args;
+ ArgType *super_arg = super->func.args;
+ ArgType *sub_arg = sub->func.args;
- while (aarg || barg)
+ while (super_arg || sub_arg)
{
- if (!barg || !aarg)
+ if (!super_arg || !sub_arg)
return False;
- if (barg->varargs != aarg->varargs)
+ if (super_arg->varargs != sub_arg->varargs)
return False;
- if (!TypeCompatible (barg->type, aarg->type, contains))
+ if (!TypeIsSupertype (sub_arg->type, super_arg->type))
return False;
- aarg = aarg->next;
- barg = barg->next;
+ super_arg = super_arg->next;
+ sub_arg = sub_arg->next;
}
return True;
}
- break;
+ return False;
case type_array:
- adim = TypeCountDimensions (a->array.dimensions);
- bdim = TypeCountDimensions (b->array.dimensions);
- if (adim == 0 || bdim == 0 || adim == bdim)
- return TypeCompatible (a->array.type, b->array.type, contains);
- break;
+ super_dim = TypeCountDimensions (super->array.dimensions);
+ sub_dim = TypeCountDimensions (sub->array.dimensions);
+ if (super_dim == 0 || sub_dim == 0 || super_dim == sub_dim)
+ return TypeIsSupertype (super->array.type, sub->array.type);
+ return False;
case type_struct:
case type_union:
- if (!contains && a->structs.structs->nelements != b->structs.structs->nelements)
- break;
- /*
- * Is 'b' a subtype of 'a'?
- */
- st = a->structs.structs;
- for (n = 0; n < st->nelements; n++)
+ super_st = super->structs.structs;
+ sub_st = sub->structs.structs;
+ for (n = 0; n < super_st->nelements; n++)
{
- Type *bt;
+ Type *sub_mem;
- bt = StructMemType (b->structs.structs, StructTypeAtoms(st)[n]);
- if (!bt)
- break;
- if (!TypeCompatible (BoxTypesElements(st->types)[n], bt, contains))
- break;
- }
- if (n != a->structs.structs->nelements)
- {
- /*
- * is 'a' a subtype of 'b'?
+ /*
+ * Structs (or unions) are subtypes if they contain all
+ * of the super type members and those members are subtypes
*/
- st = b->structs.structs;
- for (n = 0; n < st->nelements; n++)
- {
- Type *at;
-
- at = StructMemType (a->structs.structs, StructTypeAtoms(st)[n]);
- if (!at)
- break;
- if (!TypeCompatible (at, BoxTypesElements(st->types)[n], contains))
- break;
- }
- /* nope, neither are subtypes */
- if (n != b->structs.structs->nelements)
+ sub_mem = StructMemType (sub_st, StructTypeAtoms(super_st)[n]);
+ if (!sub_mem)
+ return False;
+ if (!TypeIsSupertype (BoxTypesElements(super_st->types)[n],
+ sub_mem))
return False;
}
return True;
- default:
- break;
+ case type_name:
+ case type_types:
+ abort ();
}
return False;
-
+}
+
+/*
+ * Return True if a is a super or subtype of b
+ */
+
+Bool
+TypeIsOrdered (Type *a, Type *b)
+{
+ return TypeIsSupertype (a, b) || TypeIsSupertype (b, a);
}
/*
@@ -548,7 +550,7 @@
if (TypePoly (bref))
bref = typeRefPoly;
if (aref->base.tag == type_ref && bref->base.tag == type_ref)
- if (TypeCompatible (aref->ref.ref, bref->ref.ref, False))
+ if (TypeIsOrdered (aref->ref.ref, bref->ref.ref))
return typePrim[rep_integer];
return 0;
}
@@ -740,7 +742,7 @@
}
else switch (tag) {
case ASSIGN:
- if (TypeCompatible (left, right, True))
+ if (TypeIsOrdered (left, right))
{
if (TypePoly (left))
ret = TypeAdd (ret, right);
@@ -801,14 +803,10 @@
case COLON:
if (TypePoly (left) || TypePoly (right))
ret = TypeAdd (ret, typePoly);
- else if (TypeCompatible (left, right, False))
- {
- if (TypeNumeric (left) && TypeNumeric (right) &&
- left->prim.prim < right->prim.prim)
- ret = TypeAdd (ret, right);
- else
- ret = TypeAdd (ret, left);
- }
+ else if (TypeIsSupertype (left, right))
+ ret = TypeAdd (ret, left);
+ else if (TypeIsSupertype (right, left))
+ ret = TypeAdd (ret, right);
break;
case AND:
case OR:
@@ -821,7 +819,7 @@
case GT:
case LE:
case GE:
- if (TypeCompatible (left, right, False))
+ if (TypeIsOrdered (left, right))
ret = TypeAdd (ret, typePrim[rep_bool]);
break;
}
@@ -1018,14 +1016,13 @@
if (RefValueGet (b))
return TypeCompatibleAssign (a->ref.ref, RefValueGet (b));
else
- return TypeCompatible (a->ref.ref, RefType (b), True);
+ return TypeIsOrdered (a->ref.ref, RefType (b));
}
break;
case type_func:
if (ValueIsFunc(b))
{
- if (TypeCompatible (a->func.ret,
- b->func.code->base.type, True))
+ if (TypeIsOrdered (a->func.ret, b->func.code->base.type))
{
ArgType *aarg = a->func.args, *barg = b->func.code->base.args;
@@ -1035,7 +1032,7 @@
return False;
if (barg->varargs != aarg->varargs)
return False;
- if (!TypeCompatible (barg->type, aarg->type, True))
+ if (!TypeIsOrdered (barg->type, aarg->type))
return False;
aarg = aarg->next;
barg = barg->next;
@@ -1068,8 +1065,7 @@
return True;
}
else
- return TypeCompatible (a->array.type,
- ArrayType(&b->array), True);
+ return TypeIsOrdered (a->array.type, ArrayType(&b->array));
}
}
break;
@@ -1086,7 +1082,7 @@
bt = StructMemType (b->structs.type, StructTypeAtoms(st)[n]);
if (!bt)
break;
- if (!TypeCompatible (BoxTypesElements(st->types)[n], bt, True))
+ if (!TypeIsOrdered (BoxTypesElements(st->types)[n], bt))
break;
}
if (n == st->nelements)
Index: value.h
===================================================================
RCS file: /local/src/CVS/nickle/value.h,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- value.h 23 Apr 2003 03:11:28 -0000 1.82
+++ value.h 2 May 2003 00:23:38 -0000 1.83
@@ -441,8 +441,12 @@
Type *TypeCombineReturn (Type *type);
Type *TypeCombineFunction (Type *type);
Type *TypeCombineArray (Type *array, int ndim, Bool lvalue);
+/* can assign value 'v' to variable of type 'dest' */
Bool TypeCompatibleAssign (Type *dest, Value v);
-Bool TypeCompatible (Type *a, Type *b, Bool contains);
+/* super is a supertype of sub */
+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);
#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)