X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fsubst.c;h=812a31c97deab848df836f587b2da0d7fc201c02;hb=6e0892adec42702e7879a23587d2c7210c55a078;hp=3ca1ed4324381534122e8385e4ff1a8cbe567569;hpb=8e01a7198ab0e0d15621af77cb9d5f38f25577b5;p=ghc-hetmet.git diff --git a/ghc/interpreter/subst.c b/ghc/interpreter/subst.c index 3ca1ed4..812a31c 100644 --- a/ghc/interpreter/subst.c +++ b/ghc/interpreter/subst.c @@ -10,16 +10,15 @@ * included in the distribution. * * $RCSfile: subst.c,v $ - * $Revision: 1.11 $ - * $Date: 2000/03/06 08:38:04 $ + * $Revision: 1.17 $ + * $Date: 2000/03/23 14:54:21 $ * ------------------------------------------------------------------------*/ -#include "prelude.h" +#include "hugsbasictypes.h" #include "storage.h" #include "connect.h" #include "errors.h" -#include "link.h" -#include "subst.h" + /*#define DEBUG_TYPES*/ @@ -27,11 +26,7 @@ static Int numTyvars; /* no. type vars currently in use */ static Int maxTyvars = 0; static Int nextGeneric; /* number of generics found so far */ -#if FIXED_SUBST -Tyvar tyvars[NUM_TYVARS]; /* storage for type variables */ -#else Tyvar *tyvars = 0; /* storage for type variables */ -#endif Int typeOff; /* offset of result type */ Type typeIs; /* skeleton of result type */ Int typeFree; /* freedom in instantiated type */ @@ -43,38 +38,38 @@ List btyvars = NIL; /* explicitly scoped type vars */ * local function prototypes: * ------------------------------------------------------------------------*/ -static Void local expandSubst Args((Int)); -static Int local findBtyvsInt Args((Text)); -static Type local makeTupleType Args((Int)); -static Kind local makeSimpleKind Args((Int)); -static Kind local makeVarKind Args((Int)); -static Void local expandSyn1 Args((Tycon, Type *, Int *)); -static List local listTyvar Args((Int,List)); -static List local listTyvars Args((Type,Int,List)); -static Cell local dupTyvar Args((Int,List)); -static Cell local dupTyvars Args((Cell,Int,List)); -static Pair local copyNoMark Args((Cell,Int)); -static Type local dropRank1Body Args((Type,Int,Int)); -static Type local liftRank1Body Args((Type,Int)); -static Bool local matchTypeAbove Args((Type,Int,Type,Int,Int)); - -static Bool local varToVarBind Args((Tyvar *,Tyvar *)); -static Bool local varToTypeBind Args((Tyvar *,Type,Int)); +static Void local expandSubst ( Int ); +static Int local findBtyvsInt ( Text ); +static Type local makeTupleType ( Int ); +static Kind local makeSimpleKind ( Int ); +static Kind local makeVarKind ( Int ); +static Void local expandSyn1 ( Tycon, Type *, Int * ); +static List local listTyvar ( Int,List ); +static List local listTyvars ( Type,Int,List ); +static Cell local dupTyvar ( Int,List ); +static Cell local dupTyvars ( Cell,Int,List ); +static Pair local copyNoMark ( Cell,Int ); +static Type local dropRank1Body ( Type,Int,Int ); +static Type local liftRank1Body ( Type,Int ); +static Bool local matchTypeAbove ( Type,Int,Type,Int,Int ); + +static Bool local varToVarBind ( Tyvar *,Tyvar * ); +static Bool local varToTypeBind ( Tyvar *,Type,Int ); #if TREX -static Bool local inserter Args((Type,Int,Type,Int)); -static Int local remover Args((Text,Type,Int)); -static Int local tailVar Args((Type,Int)); +static Bool local inserter ( Type,Int,Type,Int ); +static Int local remover ( Text,Type,Int ); +static Int local tailVar ( Type,Int ); #endif -static Bool local improveAgainst Args((Int,List,Cell,Int)); -static Bool local instImprove Args((Int,Class,Cell,Int)); -static Bool local pairImprove Args((Int,Class,Cell,Int,Cell,Int,Int)); +static Bool local improveAgainst ( Int,List,Cell,Int ); +static Bool local instImprove ( Int,Class,Cell,Int ); +static Bool local pairImprove ( Int,Class,Cell,Int,Cell,Int,Int ); #if IPARAM -static Bool local ipImprove Args((Int,Cell,Int,Cell,Int)); +static Bool local ipImprove ( Int,Cell,Int,Cell,Int ); #endif -static Bool local kvarToVarBind Args((Tyvar *,Tyvar *)); -static Bool local kvarToTypeBind Args((Tyvar *,Type,Int)); +static Bool local kvarToVarBind ( Tyvar *,Tyvar * ); +static Bool local kvarToTypeBind ( Tyvar *,Type,Int ); /* -------------------------------------------------------------------------- * The substitution, types, and kinds: @@ -117,7 +112,6 @@ static Bool local kvarToTypeBind Args((Tyvar *,Type,Int)); Void emptySubstitution() { /* clear current substitution */ numTyvars = 0; -#if !FIXED_SUBST if (maxTyvars!=NUM_TYVARS) { maxTyvars = 0; if (tyvars) { @@ -125,7 +119,6 @@ Void emptySubstitution() { /* clear current substitution */ tyvars = 0; } } -#endif nextGeneric = 0; genericVars = NIL; typeIs = NIL; @@ -135,12 +128,6 @@ Void emptySubstitution() { /* clear current substitution */ static Void local expandSubst(n) /* add further n type variables to */ Int n; { /* current substituion */ -#if FIXED_SUBST - if (numTyvars+n>NUM_TYVARS) { - ERRMSG(0) "Too many type variables in type checker" - EEND; - } -#else if (numTyvars+n>maxTyvars) { /* need to expand substitution */ Int newMax = maxTyvars+NUM_TYVARS; Tyvar *newTvs; @@ -174,7 +161,6 @@ Int n; { /* current substituion */ tyvars = newTvs; maxTyvars = newMax; } -#endif } Int newTyvars(n) /* allocate new type variables */ @@ -515,7 +501,7 @@ Int vn; { /* type bound to given type var */ case FIXED_TYVAR : return mkInt(vn); case UNUSED_GENERIC : (tyv->offs) = GENERIC + nextGeneric++; - if (nextGeneric>=NUM_OFFSETS) { + if (nextGeneric>=(OFF_MAX-OFF_MIN+1)) { ERRMSG(0) "Too many quantified type variables" EEND; @@ -1350,9 +1336,15 @@ Cell pi1; /* Assumes preds are kind correct */ Int o1; /* with the same class. */ Cell pi; Int o; { - for (; isAp(pi1); pi1=fun(pi1), pi=fun(pi)) - if (!unify(arg(pi1),o1,arg(pi),o)) - return FALSE; + for (; isAp(pi1); pi1=fun(pi1), pi=fun(pi)) { + if (!isAp(pi) || !unify(arg(pi1),o1,arg(pi),o)) + return FALSE; + } + /* pi1 has exhausted its argument chain, we also need to check that + pi has no remaining arguments. However, under this condition, + the pi1 == pi will always return FALSE, giving the desired + result. */ + #if IPARAM if (isIP(pi1) && isIP(pi)) return textOf(pi1)==textOf(pi);