From 8e01a7198ab0e0d15621af77cb9d5f38f25577b5 Mon Sep 17 00:00:00 2001 From: andy Date: Mon, 6 Mar 2000 08:38:05 +0000 Subject: [PATCH] [project @ 2000-03-06 08:38:04 by andy] Adding the Feb00 changed from Classic Hugs into STG Hugs. --- ghc/interpreter/preds.c | 26 +++++++++++++++----------- ghc/interpreter/static.c | 15 +++++++++++---- ghc/interpreter/subst.c | 6 ++++-- ghc/interpreter/type.c | 41 ++++++++++++++++++++++++++++------------- ghc/interpreter/version.h | 4 ++-- 5 files changed, 60 insertions(+), 32 deletions(-) diff --git a/ghc/interpreter/preds.c b/ghc/interpreter/preds.c index c41ed5c..5da4940 100644 --- a/ghc/interpreter/preds.c +++ b/ghc/interpreter/preds.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: preds.c,v $ - * $Revision: 1.9 $ - * $Date: 1999/11/17 16:57:43 $ + * $Revision: 1.10 $ + * $Date: 2000/03/06 08:38:04 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- @@ -448,24 +448,25 @@ Int d; { if (nonNull(in)) { Int beta = typeOff; Cell e = inst(in).builder; - Cell es = inst(in).specifics; + List es = inst(in).specifics; + List fs = NIL; + for (; nonNull(es); es=tl(es)) + fs = cons(triple(hd(es),mkInt(beta),NIL),fs); + fs = rev(fs); + improve(0,ps,fs); #if EXPLAIN_INSTANCE_RESOLUTION if (showInstRes) { for (i = 0; i < d; i++) fputc(' ', stdout); fputs("try ", stdout); - printContext(stdout, es); + printContext(stdout, copyPreds(fs)); fputs(" => ", stdout); - printPred(stdout, inst(in).head); + printPred(stdout, copyPred(inst(in).head,beta)); fputc('\n', stdout); } #endif - /* would need to lift es to triples, so be lazy, and just - use improve1 in the loop */ - /* improve(0,ps,es); */ - for (; nonNull(es); es=tl(es)) { + for (es=inst(in).specifics; nonNull(es); es=tl(es)) { Cell ev; - improve1(0,ps,hd(es),beta); ev = entail(ps,hd(es),beta,d); if (nonNull(ev)) e = ap(e,ev); @@ -827,7 +828,10 @@ List sps; { /* context ps. sps = savePreds. */ if (nonNull(ev)) { /* Discharge if ps ||- (pi,o) */ overEvid(thd3(hd(p)),ev); - } else if (!isAp(pi) || isIP(fun(pi)) || !anyGenerics(pi,o)) { + } else if (isIP(fun(pi))) { + tl(p) = rems; + rems = p; + } else if (!isAp(pi) || !anyGenerics(pi,o)) { tl(p) = sps; /* Defer if no generics */ sps = p; } diff --git a/ghc/interpreter/static.c b/ghc/interpreter/static.c index adbe90d..46af0ac 100644 --- a/ghc/interpreter/static.c +++ b/ghc/interpreter/static.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: static.c,v $ - * $Revision: 1.23 $ - * $Date: 2000/02/04 13:41:00 $ + * $Revision: 1.24 $ + * $Date: 2000/03/06 08:38:04 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -3027,7 +3027,6 @@ Inst in; { /* of the context for a derived */ ps = tl(ps); if (its++ >= factor*cutoff) { Cell bpi = inst(in).head; - Cell pi = copyPred(fun(p),intOf(snd(p))); ERRMSG(inst(in).line) "\n*** Cannot derive " ETHEN ERRPRED(bpi); ERRTEXT " after %d iterations.", its-1 ETHEN ERRTEXT @@ -5037,15 +5036,23 @@ Void checkDefns() { /* Top level static analysis */ } mapProc(checkImportList, unqualImports); + /* Note: there's a lot of side-effecting going on here, so + don't monkey about with the order of operations here unless + you know what you are doing */ if (!combined) linkPreludeTC(); /* Get prelude tycons and classes */ mapProc(checkTyconDefn,tyconDefns); /* validate tycon definitions */ checkSynonyms(tyconDefns); /* check synonym definitions */ mapProc(checkClassDefn,classDefns); /* process class definitions */ mapProc(kindTCGroup,tcscc(tyconDefns,classDefns)); /* attach kinds */ + mapProc(visitClass,classDefns); /* check class hierarchy */ mapProc(extendFundeps,classDefns); /* finish class definitions */ + /* (convenient if we do this after */ + /* calling `visitClass' so that we */ + /* know the class hierarchy is */ + /* acyclic) */ + mapProc(addMembers,classDefns); /* add definitions for member funs */ - mapProc(visitClass,classDefns); /* check class hierarchy */ if (!combined) linkPreludeCM(); /* Get prelude cfuns and mfuns */ diff --git a/ghc/interpreter/subst.c b/ghc/interpreter/subst.c index 4ca1715..3ca1ed4 100644 --- a/ghc/interpreter/subst.c +++ b/ghc/interpreter/subst.c @@ -10,8 +10,8 @@ * included in the distribution. * * $RCSfile: subst.c,v $ - * $Revision: 1.10 $ - * $Date: 1999/12/10 15:59:55 $ + * $Revision: 1.11 $ + * $Date: 2000/03/06 08:38:04 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -1530,6 +1530,8 @@ Int o; { } return improved; } +/* should emulate findInsts behavior of shorting out if the + predicate would match a more general signature... */ Bool instImprove(line,c,pi,o) Int line; diff --git a/ghc/interpreter/type.c b/ghc/interpreter/type.c index c46657b..fec44e1 100644 --- a/ghc/interpreter/type.c +++ b/ghc/interpreter/type.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: type.c,v $ - * $Revision: 1.23 $ - * $Date: 2000/02/03 13:55:22 $ + * $Revision: 1.24 $ + * $Date: 2000/03/06 08:38:05 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -1114,15 +1114,18 @@ Cell e; List qs; { static String boolQual = "boolean qualifier"; static String genQual = "generator"; +#if IPARAM + List svPreds; +#endif STACK_CHECK - if (isNull(qs)) /* no qualifiers left */ - fst(e) = typeExpr(l,fst(e)); - else { + if (isNull(qs)) { /* no qualifiers left */ + spTypeExpr(l,fst(e)); + } else { Cell q = hd(qs); List qs1 = tl(qs); switch (whatIs(q)) { - case BOOLQUAL : check(l,snd(q),NIL,boolQual,typeBool,0); + case BOOLQUAL : spCheck(l,snd(q),NIL,boolQual,typeBool,0); typeComp(l,m,e,qs1); break; @@ -1136,7 +1139,7 @@ List qs; { case FROMQUAL : { Int beta = newTyvars(1); saveVarsAss(); - check(l,snd(snd(q)),NIL,genQual,m,beta); + spCheck(l,snd(snd(q)),NIL,genQual,m,beta); enterSkolVars(); fst(snd(q)) = typeFreshPat(l,patBtyvs(fst(snd(q)))); @@ -1148,7 +1151,7 @@ List qs; { } break; - case DOQUAL : check(l,snd(q),NIL,genQual,m,newTyvars(1)); + case DOQUAL : spCheck(l,snd(q),NIL,genQual,m,newTyvars(1)); typeComp(l,m,e,qs1); break; } @@ -1199,6 +1202,9 @@ Cell e; { Int to; Int tf; Int i; +#if IPARAM + List svPreds; +#endif instantiate(name(c).type); for (; nonNull(predsAre); predsAre=tl(predsAre)) @@ -1217,7 +1223,7 @@ Cell e; { if (isPolyOrQualType(t)) snd(hd(fs)) = typeExpected(l,conExpr,snd(hd(fs)),t,to,tf,TRUE); else { - check(l,snd(hd(fs)),e,conExpr,t,to); + spCheck(l,snd(hd(fs)),e,conExpr,t,to); } } for (i=name(c).arity; i>0; i--) @@ -1236,10 +1242,13 @@ Cell e; { /* bizarre manner for the benefit */ Int alpha = newTyvars(2+n); Int i; List fs1; +#if IPARAM + List svPreds; +#endif /* Calculate type and translation for each expr in the field list */ for (fs1=fs, i=alpha+2; nonNull(fs1); fs1=tl(fs1), i++) { - snd(hd(fs1)) = typeExpr(line,snd(hd(fs1))); + spTypeExpr(line,snd(hd(fs1))); bindTv(i,typeIs,typeOff); } @@ -1256,7 +1265,7 @@ Cell e; { /* bizarre manner for the benefit */ ts = rev(ts); /* Type check expression to be updated */ - fst3(snd(e)) = typeExpr(line,fst3(snd(e))); + spTypeExpr(line,fst3(snd(e))); bindTv(alpha,typeIs,typeOff); for (; nonNull(cs); cs=tl(cs)) { /* Loop through constrs */ @@ -1861,8 +1870,11 @@ Inst in; { /* member functions for instance in*/ Int beta = newKindedVars(inst(in).kinds); List params = makePredAss(inst(in).specifics,beta); Cell d = inventDictVar(); + /* List evids = cons(triple(inst(in).head,mkInt(beta),d), appendOnto(dupList(params),supers)); + */ + List evids = dupList(params); List imps = inst(in).implements; Cell l = mkInt(inst(in).line); @@ -2158,10 +2170,13 @@ Cell gded; { /* ex :: (var,beta) */ static String guarded = "guarded expression"; static String guard = "guard"; Int line = intOf(fst(gded)); +#if IPARAM + List svPreds; +#endif gded = snd(gded); - check(line,fst(gded),NIL,guard,typeBool,0); - check(line,snd(gded),NIL,guarded,aVar,beta); + spCheck(line,fst(gded),NIL,guard,typeBool,0); + spCheck(line,snd(gded),NIL,guarded,aVar,beta); } Cell rhsExpr(rhs) /* find first expression on a rhs */ diff --git a/ghc/interpreter/version.h b/ghc/interpreter/version.h index ee04810..60e874a 100644 --- a/ghc/interpreter/version.h +++ b/ghc/interpreter/version.h @@ -11,8 +11,8 @@ #define MAJOR_RELEASE 0 #if MAJOR_RELEASE -#define HUGS_VERSION "November 1999 " +#define HUGS_VERSION "March 2000 " #else -#define HUGS_VERSION "STGHugs-991129" +#define HUGS_VERSION "STGHugs-000306" #endif -- 1.7.10.4