[project @ 1999-06-01 16:15:42 by simonmar]

[ghc-hetmet.git] / ghc / compiler / parser / printtree.c

diff --git a/ghc/compiler/parser/printtree.c b/ghc/compiler/parser/printtree.c
index 3484387..15e7e6e 100644 (file)
--- a/ghc/compiler/parser/printtree.c
+++ b/ghc/compiler/parser/printtree.c
@@ -26,12 +26,14 @@ static void pid         PROTO( (id) );
 static void plist   PROTO( (void (*)(/*NOT WORTH IT: void * */), list) );
 static void pmaybe  PROTO( (void (*)(), maybe) );
 static void pmaybe_list  PROTO( (void (*)(), maybe) );
-static void ppbinding PROTO((pbinding));
 /* static void ppragma PROTO( (hpragma) ); */
 static void pqid    PROTO( (qid) );
 static void prbind  PROTO( (binding) );
 static void pstr    PROTO( (char *) );
 static void ptree   PROTO( (tree) );
+static void ppgdexp  PROTO( (gdexp) );
+static void pgrhsb  PROTO( (grhsb) );
+static void ppmatch  PROTO( (match) );
 static void pttype  PROTO( (ttype) );
 static void plineno PROTO( (long) );
 
@@ -187,11 +189,6 @@ again:
                      plist(prbind, ghimplist(t));
                      pmaybe_list(pentid, ghexplist(t));
                      break;
-      case fixop:     
-                     PUTTAG('I');
-                     pqid(gfixop(t));
-                     printf("%lu\t%lu",gfixinfx(t),gfixprec(t));
-                     break;
       case ident: 
                      PUTTAG('i');
                      pqid(gident(t));
@@ -218,9 +215,7 @@ again:
                      break;
       case lambda: 
                      PUTTAG('l');
-                     plineno(glamline(t));
-                     plist(ptree,glampats(t));
-                     ptree(glamexpr(t));
+                     ppmatch(glammatch(t));
                      break;
 
       case let: 
@@ -232,7 +227,7 @@ again:
                      PUTTAG('c');
                      plineno(gcaseline(t));
                      ptree(gcaseexpr(t));
-                     plist(ppbinding, gcasebody(t));
+                     plist(ppmatch, gcasebody(t));
                      break;
       case ife:
                      PUTTAG('b');
@@ -448,13 +443,14 @@ prbind(b)
                          break;
        case pbind      : 
                          PUTTAG('p');
+                         ptree( gpbindl(b) );
+                         pgrhsb( gpbindr(b) );
                          plineno(gpline(b));
-                         plist(ppbinding, gpbindl(b));
                          break;
        case fbind      : 
                          PUTTAG('f');
+                         plist(ppmatch, gfbindm(b));
                          plineno(gfline(b));
-                         plist(ppbinding, gfbindl(b));
                          break;
        case abind      : 
                          PUTTAG('A');
@@ -494,6 +490,12 @@ prbind(b)
                          PUTTAG('B');
                          break;
 
+        case fixd:     
+                     PUTTAG('I');
+                     pqid(gfixop(b));
+                     printf("%lu\t%lu",gfixinfx(b),gfixprec(b));
+                     break;
+
        case import:      
                          PUTTAG('e');
                          plineno(gibindline(b));
@@ -524,7 +526,6 @@ prbind(b)
        case ispec_uprag:
                          PUTTAGSTR("SS");
                          plineno(gispec_line(b));
-                         pqid(gispec_clas(b));
                          pttype(gispec_ty(b));
                          break;
        case inline_uprag:
@@ -568,7 +569,7 @@ pttype(t)
                          pqid(gtypeid(t));
                          break;
        case namedtvar  : PUTTAG('y');
-                         pqid(gnamedtvar(t));
+                         pstr(gnamedtvar(t));
                          break;
        case tllist     : PUTTAG(':');
                          pttype(gtlist(t));
@@ -587,9 +588,10 @@ pttype(t)
        case tbang      : PUTTAG('!');
                          pttype(gtbang(t));
                          break;
-       case context    : PUTTAG('3');
-                         plist(pttype,gtcontextl(t));
-                         pttype(gtcontextt(t));
+       case forall     : PUTTAG('3');
+                         plist(pstr, gtforalltv(t));
+                         plist(pttype,gtforallctxt(t));
+                         pttype(gtforallt(t));
                          break;
        default         : error("bad pttype");
        }
@@ -664,36 +666,9 @@ pentid(i)
 }
 
 
-static void
-ppbinding(p)
-  pbinding p;
-{
-       switch(tpbinding(p)) {
-       case pgrhs      : PUTTAG('W');
-                         plineno(ggline(p));
-                         pqid(ggfuncname(p));
-                         ptree(ggpat(p));
-                         ppbinding(ggdexprs(p));
-                         prbind(ggbind(p));
-                         break;
-        case pnoguards  :
-                         PUTTAG('6');
-                         ptree(gpnoguard(p));
-                         break;
-       case pguards    :
-                         PUTTAG('9');
-                         plist(ptree, gpguards(p));
-                         break;
-       case pgdexp     : 
-                         PUTTAG('&');
-                         plist(ptree, gpguard(p)); /* Experimental: pattern guards */
-                         ptree(gpexp(p));
-                         break;
-       default         :
-                         error("Bad pbinding");
-       }
-}
-
+static void ppmatch(l) match l; { fprintf( stderr, "printtree.c: ppmatch" ); }
+static void ppgdexp(l) gdexp l; { fprintf( stderr, "printtree.c: ppgdexp" ); }
+static void pgrhsb(l) grhsb l; { fprintf( stderr, "printtree.c: pgrhsb" ); }
 
 static void
 pgrhses(l)