From: sewardj Date: Thu, 6 Apr 2000 15:05:30 +0000 (+0000) Subject: [project @ 2000-04-06 15:05:30 by sewardj] X-Git-Tag: Approximately_9120_patches~4790 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c78b1aa635719e66b98136e8e0f015c69f428e21;p=ghc-hetmet.git [project @ 2000-04-06 15:05:30 by sewardj] More constructors-with-context fixes: * Don't inline bytecode constructor calls if constructor has a context * Fix bug in startGHCDataDecl which caused loss of context in iface constructor types. --- diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c index 8cb7e24..45e5936 100644 --- a/ghc/interpreter/interface.c +++ b/ghc/interpreter/interface.c @@ -7,8 +7,8 @@ * Hugs version 1.4, December 1997 * * $RCSfile: interface.c,v $ - * $Revision: 1.46 $ - * $Date: 2000/04/05 10:25:08 $ + * $Revision: 1.47 $ + * $Date: 2000/04/06 15:05:30 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -1692,7 +1692,7 @@ List constrs0; /* [((ConId,[((Type,VarId,Int))]))] */ for (ctx=ctx0; nonNull(ctx); ctx=tl(ctx)) { ctxElem = hd(ctx); /* ctxElem :: ((QConId,VarId)) */ - if (nonNull(cellIsMember(textOf(zsnd(ctxElem)),tyvarsMentioned))) + if (nonNull(varIsMember(textOf(zsnd(ctxElem)),tyvarsMentioned))) ctx2 = cons(ctxElem, ctx2); } if (nonNull(ctx2)) diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index 39e68ea..b044a2f 100644 --- a/ghc/interpreter/storage.c +++ b/ghc/interpreter/storage.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: storage.c,v $ - * $Revision: 1.65 $ - * $Date: 2000/04/06 14:23:55 $ + * $Revision: 1.66 $ + * $Date: 2000/04/06 15:05:30 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -2686,6 +2686,7 @@ QualId qualidIsMember ( QualId q, List xs ) Cell varIsMember(t,xs) /* Test if variable is a member of */ Text t; /* given list of variables */ List xs; { + assert(isText(t) || isInventedVar(t) || isInventedDictVar(t)); for (; nonNull(xs); xs=tl(xs)) if (t==textOf(hd(xs))) return hd(xs); diff --git a/ghc/interpreter/translate.c b/ghc/interpreter/translate.c index eee6260..d20fd7b 100644 --- a/ghc/interpreter/translate.c +++ b/ghc/interpreter/translate.c @@ -10,8 +10,8 @@ * included in the distribution. * * $RCSfile: translate.c,v $ - * $Revision: 1.32 $ - * $Date: 2000/04/06 14:23:55 $ + * $Revision: 1.33 $ + * $Date: 2000/04/06 15:05:30 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -410,7 +410,8 @@ StgExpr failExpr; if ( (isName(e) && isCfun(e) && name(e).arity > 0 && name(e).arity == length_args - && !name(e).hasStrict) + && !name(e).hasStrict + && numQualifiers(name(e).type) == 0) || (isTuple(e) && tycon(e).tuple == length_args) ) {