X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fpreds.c;h=7c5a7a848bf75bd70502ceed2cb645eef0b0cae0;hb=9aa6d18bd696e8861fb8c3e065e49a989d2d67ac;hp=c41ed5cf3a6ee1a5969b66c9fb5520cf7718897b;hpb=333e9b497dd063a37af367abd937d2f6454ae84c;p=ghc-hetmet.git

diff --git a/ghc/interpreter/preds.c b/ghc/interpreter/preds.c
index c41ed5c..7c5a7a8 100644
--- a/ghc/interpreter/preds.c
+++ b/ghc/interpreter/preds.c
@@ -9,51 +9,51 @@
  * included in the distribution.
  *
  * $RCSfile: preds.c,v $
- * $Revision: 1.9 $
- * $Date: 1999/11/17 16:57:43 $
+ * $Revision: 1.11 $
+ * $Date: 2000/03/13 11:37:16 $
  * ------------------------------------------------------------------------*/
 
 /* --------------------------------------------------------------------------
  * Local function prototypes:
  * ------------------------------------------------------------------------*/
 
-static Cell   local assumeEvid        Args((Cell,Int));
+static Cell   local assumeEvid        ( Cell,Int );
 #if IPARAM
-static Cell   local findIPEvid	      Args((Text));
-static Void   local removeIPEvid      Args((Text));
+static Cell   local findIPEvid	      ( Text );
+static Void   local removeIPEvid      ( Text );
 #endif
-static List   local makePredAss       Args((List,Int));
-static List   local copyPreds         Args((List));
-static Void   local qualify           Args((List,Cell));
-static Void   local qualifyBinding    Args((List,Cell));
-static Cell   local qualifyExpr       Args((Int,List,Cell));
-static Void   local overEvid          Args((Cell,Cell));
-
-static Void   local cutoffExceeded    Args((Cell,Int,List));
-static Cell   local scFind            Args((Cell,Cell,Int,Cell,Int,Int));
-static Cell   local scEntail          Args((List,Cell,Int,Int));
-static Cell   local entail            Args((List,Cell,Int,Int));
-static Cell   local inEntail          Args((List,Cell,Int,Int));
+static List   local makePredAss       ( List,Int );
+static List   local copyPreds         ( List );
+static Void   local qualify           ( List,Cell );
+static Void   local qualifyBinding    ( List,Cell );
+static Cell   local qualifyExpr       ( Int,List,Cell );
+static Void   local overEvid          ( Cell,Cell );
+
+static Void   local cutoffExceeded    ( Cell,Int,List );
+static Cell   local scFind            ( Cell,Cell,Int,Cell,Int,Int );
+static Cell   local scEntail          ( List,Cell,Int,Int );
+static Cell   local entail            ( List,Cell,Int,Int );
+static Cell   local inEntail          ( List,Cell,Int,Int );
 #if MULTI_INST
-static Cell   local inEntails	      Args((List,Cell,Int,Int));
-static Bool   local instCompare	      Args((Inst, Inst));
+static Cell   local inEntails	      ( List,Cell,Int,Int );
+static Bool   local instCompare	      ( Inst, Inst );
 #endif
 #if TREX
-static Cell   local lacksNorm         Args((Type,Int,Cell));
+static Cell   local lacksNorm         ( Type,Int,Cell );
 #endif
 
-static List   local scSimplify        Args((List));
-static Void   local elimTauts         Args((Void));
-static Bool   local anyGenerics       Args((Type,Int));
-static List   local elimOuterPreds    Args((List));
-static List   local elimPredsUsing    Args((List,List));
-static Void   local reducePreds       Args((Void));
-static Void   local normPreds         Args((Int));
+static List   local scSimplify        ( List );
+static Void   local elimTauts         ( Void );
+static Bool   local anyGenerics       ( Type,Int );
+static List   local elimOuterPreds    ( List );
+static List   local elimPredsUsing    ( List,List );
+static Void   local reducePreds       ( Void );
+static Void   local normPreds         ( Int );
 
-static Bool   local resolveDefs       Args((List));
-static Bool   local resolveVar        Args((Int));
-static Class  local classConstraining Args((Int,Cell,Int));
-static Bool   local instComp_         Args((Inst,Inst));
+static Bool   local resolveDefs       ( List );
+static Bool   local resolveVar        ( Int );
+static Class  local classConstraining ( Int,Cell,Int );
+static Bool   local instComp_         ( Inst,Inst );
 
 /* --------------------------------------------------------------------------
  * Predicate assignments:
@@ -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;
         }