ghc/compiler/yaccParser/printtree.c

   1 /**********************************************************************
   2 *                                                                     *
   3 *                                                                     *
   4 *      Syntax Tree Printing Routines                                  *
   5 *                                                                     *
   6 *                                                                     *
   7 **********************************************************************/
   8
   9
  10 #define COMPACT TRUE    /* No spaces in output -- #undef this for debugging */
  11
  12
  13 #include <stdio.h>
  14
  15 #include "hspincl.h"
  16 #include "constants.h"
  17 #include "utils.h"
  18
  19 /* fwd decls, necessary and otherwise */
  20 static void ptree   PROTO( (tree) );
  21 static void plist   PROTO( (void (*)(), list) );
  22 static void pid     PROTO( (id) );
  23 static void pstr    PROTO( (char *) );
  24 static void pbool   PROTO( (BOOLEAN) );
  25 static void prbind  PROTO( (binding) );
  26 static void pttype  PROTO( (ttype) );
  27 static void patype  PROTO( (atype) );
  28 static void pentid  PROTO( (entidt) );
  29 static void prename PROTO( (list) );
  30 static void pfixes  PROTO( (void) );
  31 static void ppbinding PROTO((pbinding));
  32 static void pgrhses PROTO( (list) );
  33 static void ppragma PROTO( (hpragma) );
  34 static void pcoresyn PROTO((coresyn));
  35
  36 extern char *fixop   PROTO((int));
  37 extern char *fixtype PROTO((int));
  38
  39 extern char *input_filename;
  40 extern BOOLEAN hashIds;
  41
  42 /*      How to print tags       */
  43
  44 #if COMPACT
  45 #define PUTTAG(c)       putchar(c);
  46 #define PUTTAGSTR(s)    printf("%s",(s));
  47 #else
  48 #define PUTTAG(c)       putchar(c); \
  49                         putchar(' ');
  50 #define PUTTAGSTR(s)    printf("%s",(s)); \
  51                         putchar(' ');
  52 #endif
  53
  54
  55 /*      Performs a post order walk of the tree
  56         to print it.
  57 */
  58
  59 void
  60 pprogram(t)
  61 tree t;
  62 {
  63   print_hash_table();
  64   ptree(t);
  65 }
  66
  67 /* print_string: we must escape \t and \\, as described in
  68    char/string lexer comments.  (WDP 94/11)
  69 */
  70 static void
  71 print_string(str)
  72   hstring str;
  73 {
  74     char *gs;
  75     char c;
  76     int i, str_length;
  77
  78     putchar('#');
  79     str_length = str->len;
  80     gs = str->bytes;
  81
  82     for (i = 0; i < str_length; i++) {
  83         c = gs[i];
  84         if ( c == '\t' ) {
  85             putchar('\\');
  86             putchar('t');
  87         } else if ( c == '\\' ) {
  88             putchar('\\');
  89             putchar('\\');
  90         } else {
  91             putchar(gs[i]);
  92         }
  93     }
  94     putchar('\t');
  95 }
  96
  97 static int
  98 get_character(str)
  99   hstring str;
 100 {
 101     int c = (int)((str->bytes)[0]);
 102
 103     if (str->len != 1) { /* ToDo: assert */
 104         fprintf(stderr, "get_character: length != 1? (%d: %s)\n", str->len, str->bytes);
 105     }
 106
 107     if (c < 0) {
 108         c += 256;       /* "This is not a hack" -- KH */
 109     }
 110
 111     return(c);
 112 }
 113
 114 static void
 115 pliteral(t)
 116    literal t;
 117 {
 118     switch(tliteral(t)) {
 119       case integer:
 120                       PUTTAG('4');
 121                       pstr(ginteger(t));
 122                       break;
 123       case intprim:
 124                       PUTTAG('H');
 125                       pstr(gintprim(t));
 126                       break;
 127       case floatr:
 128                       PUTTAG('F');
 129                       pstr(gfloatr(t));
 130                       break;
 131       case doubleprim:
 132                       PUTTAG('J');
 133                       pstr(gdoubleprim(t));
 134                       break;
 135       case floatprim:
 136                       PUTTAG('K');
 137                       pstr(gfloatprim(t));
 138                       break;
 139       case charr:
 140                       PUTTAG('C');
 141                       /* Changed %d to %u, since negative chars
 142                          make little sense -- KH @ 16/4/91
 143                       */
 144                       printf("#%u\t", get_character(gchar(t)));
 145                       break;
 146       case charprim:
 147                       PUTTAG('P');
 148                       printf("#%u\t", get_character(gcharprim(t)));
 149                       break;
 150       case string:
 151                       PUTTAG('S');
 152                       print_string(gstring(t));
 153                       break;
 154       case stringprim:
 155                       PUTTAG('V');
 156                       print_string(gstringprim(t));
 157                       break;
 158       case clitlit:
 159                       PUTTAG('Y');
 160                       pstr(gclitlit(t));
 161                       pstr(gclitlit_kind(t));
 162                       break;
 163
 164       case norepi:
 165                       PUTTAG('I');
 166                       pstr(gnorepi(t));
 167                       break;
 168       case norepr:
 169                       PUTTAG('R');
 170                       pstr(gnorepr_n(t));
 171                       pstr(gnorepr_d(t));
 172                       break;
 173       case noreps:
 174                       PUTTAG('s');
 175                       print_string(gnoreps(t));
 176                       break;
 177       default:
 178                       error("Bad pliteral");
 179     }
 180 }
 181
 182 static void
 183 ptree(t)
 184    tree t;
 185 {
 186 again:
 187     switch(ttree(t)) {
 188       case par:         t = gpare(t); goto again;
 189       case hmodule:
 190                       PUTTAG('M');
 191                       printf("#%u\t",ghmodline(t));
 192                       pid(ghname(t));
 193                       pstr(input_filename);
 194                       prbind(ghmodlist(t));
 195                       pfixes();
 196                       plist(prbind, ghimplist(t));
 197                       plist(pentid, ghexplist(t));
 198                       break;
 199       case ident:
 200                       PUTTAG('i');
 201                       pid(gident(t));
 202                       break;
 203       case lit:
 204                       PUTTAG('C');
 205                       pliteral(glit(t));
 206                       break;
 207
 208       case ap:
 209                       PUTTAG('a');
 210                       ptree(gfun(t));
 211                       ptree(garg(t));
 212                       break;
 213       case lsection:
 214                       PUTTAG('(');
 215                       ptree(glsexp(t));
 216                       pid(glsop(t));
 217                       break;
 218       case rsection:
 219                       PUTTAG(')');
 220                       pid(grsop(t));
 221                       ptree(grsexp(t));
 222                       break;
 223       case tinfixop:
 224                       PUTTAG('@');
 225                       ptree(ginarg1((struct Sap *)t));
 226                       pid(gident(ginfun((struct Sap *)t)));
 227                       ptree(ginarg2((struct Sap *)t));
 228                       break;
 229
 230       case lambda:
 231                       PUTTAG('l');
 232                       printf("#%u\t",glamline(t));
 233                       plist(ptree,glampats(t));
 234                       ptree(glamexpr(t));
 235                       break;
 236
 237       case let:
 238                       PUTTAG('E');
 239                       prbind(gletvdeflist(t));
 240                       ptree(gletvexpr(t));
 241                       break;
 242       case casee:
 243                       PUTTAG('c');
 244                       ptree(gcaseexpr(t));
 245                       plist(ppbinding, gcasebody(t));
 246                       break;
 247       case ife:
 248                       PUTTAG('b');
 249                       ptree(gifpred(t));
 250                       ptree(gifthen(t));
 251                       ptree(gifelse(t));
 252                       break;
 253       case tuple:
 254                       PUTTAG(',');
 255                       plist(ptree,gtuplelist(t));
 256                       break;
 257       case eenum:
 258                       PUTTAG('.');
 259                       ptree(gefrom(t));
 260                       plist(ptree,gestep(t));
 261                       plist(ptree,geto(t));
 262                       break;
 263       case llist:
 264                       PUTTAG(':');
 265                       plist(ptree,gllist(t));
 266                       break;
 267       case negate:
 268                       PUTTAG('-');
 269                       ptree(gnexp(t));
 270                       break;
 271       case comprh:
 272                       PUTTAG('Z');
 273                       ptree(gcexp(t));
 274                       plist(ptree,gcquals(t));
 275                       break;
 276       case qual:
 277                       PUTTAG('G');
 278                       ptree(gqpat(t));
 279                       ptree(gqexp(t));
 280                       break;
 281       case guard:
 282                       PUTTAG('g');
 283                       ptree(ggexp(t));
 284                       break;
 285       case def:
 286                       PUTTAG('=');
 287                       ptree(ggdef(t)); /* was: prbind (WDP 94/10) */
 288                       break;
 289       case as:
 290                       PUTTAG('s');
 291                       pid(gasid(t));
 292                       ptree(gase(t));
 293                       break;
 294       case lazyp:
 295                       PUTTAG('~');
 296                       ptree(glazyp(t));
 297                       break;
 298       case plusp:
 299                       PUTTAG('+');
 300                       ptree(gplusp(t));
 301                       pliteral(gplusi(t));
 302                       break;
 303       case wildp:
 304                       PUTTAG('_');
 305                       break;
 306       case restr:
 307                       PUTTAG('R');
 308                       ptree(grestre(t));
 309                       pttype(grestrt(t));
 310                       break;
 311       case ccall:
 312                       PUTTAG('j');
 313                       pstr(gccid(t));
 314                       pstr(gccinfo(t));
 315                       plist(ptree,gccargs(t));
 316                       break;
 317       case scc:
 318                       PUTTAG('k');
 319                       print_string(gsccid(t));
 320                       ptree(gsccexp(t));
 321                       break;
 322 #ifdef DPH
 323       case parzf:
 324                       PUTTAG('5');
 325                       ptree(gpzfexp(t));
 326                       plist(ptree,gpzfqual(t));
 327                       break;
 328       case pod:
 329                       PUTTAG('6');
 330                       plist(ptree,gpod(t));
 331                       break;
 332       case proc:
 333                       PUTTAG('O');
 334                       plist(ptree,gprocid(t));
 335                       ptree(gprocdata(t));
 336                       break;
 337       case pardgen:
 338                       PUTTAG('0');
 339                       ptree(gdproc(t));
 340                       ptree(gdexp(t));
 341                       break;
 342       case parigen:
 343                       PUTTAG('w');
 344                       ptree(giproc(t));
 345                       ptree(giexp(t));
 346                       break;
 347       case parfilt:
 348                       PUTTAG('I');
 349                       ptree(gpfilt(t));
 350                       break;
 351 #endif /* DPH */
 352
 353       default:
 354                       error("Bad ptree");
 355     }
 356 }
 357
 358 static void
 359 plist(fun, l)
 360   void (*fun)();
 361   list l;
 362 {
 363         if (tlist(l) == lcons) {
 364                 PUTTAG('L');
 365                 (*fun)(lhd(l));
 366                 plist(fun, ltl(l));
 367         } else  {
 368                 PUTTAG('N');
 369         }
 370 }
 371
 372 static void
 373 pid(i)
 374   id i;
 375 {
 376   if(hashIds)
 377         printf("!%u\t", hash_index(i));
 378   else
 379         printf("#%s\t", id_to_string(i));
 380 }
 381
 382 static void
 383 pstr(i)
 384   char *i;
 385 {
 386         printf("#%s\t", i);
 387 }
 388
 389 static void
 390 prbind(b)
 391   binding b;
 392 {
 393         switch(tbinding(b)) {
 394         case tbind:
 395                           PUTTAG('t');
 396                           printf("#%u\t",gtline(b));
 397                           plist(pttype, gtbindc(b));
 398                           plist(pid, gtbindd(b));
 399                           pttype(gtbindid(b));
 400                           plist(patype, gtbindl(b));
 401                           ppragma(gtpragma(b));
 402                           break;
 403         case nbind      :
 404                           PUTTAG('n');
 405                           printf("#%u\t",gnline(b));
 406                           pttype(gnbindid(b));
 407                           pttype(gnbindas(b));
 408                           ppragma(gnpragma(b));
 409                           break;
 410         case pbind      :
 411                           PUTTAG('p');
 412                           printf("#%u\t",gpline(b));
 413                           plist(ppbinding, gpbindl(b));
 414                           break;
 415         case fbind      :
 416                           PUTTAG('f');
 417                           printf("#%u\t",gfline(b));
 418                           plist(ppbinding, gfbindl(b));
 419                           break;
 420         case abind      :
 421                           PUTTAG('A');
 422                           prbind(gabindfst(b));
 423                           prbind(gabindsnd(b));
 424                           break;
 425         case cbind      :
 426                           PUTTAG('$');
 427                           printf("#%u\t",gcline(b));
 428                           plist(pttype,gcbindc(b));
 429                           pttype(gcbindid(b));
 430                           prbind(gcbindw(b));
 431                           ppragma(gcpragma(b));
 432                           break;
 433         case ibind      :
 434                           PUTTAG('%');
 435                           printf("#%u\t",giline(b));
 436                           plist(pttype,gibindc(b));
 437                           pid(gibindid(b));
 438                           pttype(gibindi(b));
 439                           prbind(gibindw(b));
 440                           ppragma(gipragma(b));
 441                           break;
 442         case dbind      :
 443                           PUTTAG('D');
 444                           printf("#%u\t",gdline(b));
 445                           plist(pttype,gdbindts(b));
 446                           break;
 447
 448         /* signature(-like) things, including user pragmas */
 449         case sbind      :
 450                           PUTTAGSTR("St");
 451                           printf("#%u\t",gsline(b));
 452                           plist(pid,gsbindids(b));
 453                           pttype(gsbindid(b));
 454                           ppragma(gspragma(b));
 455                           break;
 456
 457         case vspec_uprag:
 458                           PUTTAGSTR("Ss");
 459                           printf("#%u\t",gvspec_line(b));
 460                           pid(gvspec_id(b));
 461                           plist(pttype,gvspec_tys(b));
 462                           break;
 463         case ispec_uprag:
 464                           PUTTAGSTR("SS");
 465                           printf("#%u\t",gispec_line(b));
 466                           pid(gispec_clas(b));
 467                           pttype(gispec_ty(b));
 468                           break;
 469         case inline_uprag:
 470                           PUTTAGSTR("Si");
 471                           printf("#%u\t",ginline_line(b));
 472                           pid(ginline_id(b));
 473                           plist(pid,ginline_howto(b));
 474                           break;
 475         case deforest_uprag:
 476                           PUTTAGSTR("Sd");
 477                           printf("#%u\t",gdeforest_line(b));
 478                           pid(gdeforest_id(b));
 479                           break;
 480         case magicuf_uprag:
 481                           PUTTAGSTR("Su");
 482                           printf("#%u\t",gmagicuf_line(b));
 483                           pid(gmagicuf_id(b));
 484                           pid(gmagicuf_str(b));
 485                           break;
 486         case abstract_uprag:
 487                           PUTTAGSTR("Sa");
 488                           printf("#%u\t",gabstract_line(b));
 489                           pid(gabstract_id(b));
 490                           break;
 491         case dspec_uprag:
 492                           PUTTAGSTR("Sd");
 493                           printf("#%u\t",gdspec_line(b));
 494                           pid(gdspec_id(b));
 495                           plist(pttype,gdspec_tys(b));
 496                           break;
 497
 498         /* end of signature(-like) things */
 499
 500         case mbind:
 501                           PUTTAG('7');
 502                           printf("#%u\t",gmline(b));
 503                           pid(gmbindmodn(b));
 504                           plist(pentid,gmbindimp(b));
 505                           plist(prename,gmbindren(b));
 506                           break;
 507         case import:
 508                           PUTTAG('e');
 509                           printf("#%u\t",giebindline(b));
 510                           pstr(giebindfile(b));
 511                           pid(giebindmod(b));
 512                           plist(pentid,giebindexp(b));
 513                           plist(prename,giebindren(b));
 514                           prbind(giebinddef(b));
 515                           break;
 516         case hiding:
 517                           PUTTAG('h');
 518                           printf("#%u\t",gihbindline(b));
 519                           pstr(gihbindfile(b));
 520                           pid(gihbindmod(b));
 521                           plist(pentid,gihbindexp(b));
 522                           plist(prename,gihbindren(b));
 523                           prbind(gihbinddef(b));
 524                           break;
 525         case nullbind   :
 526                           PUTTAG('B');
 527                           break;
 528         default         : error("Bad prbind");
 529                           break;
 530         }
 531 }
 532
 533 static void
 534 pttype(t)
 535   ttype t;
 536 {
 537         switch (tttype(t)) {
 538         case tname      : PUTTAG('T');
 539                           pid(gtypeid(t));
 540                           plist(pttype, gtypel(t));
 541                           break;
 542         case namedtvar  : PUTTAG('y');
 543                           pid(gnamedtvar(t));
 544                           break;
 545         case tllist     : PUTTAG(':');
 546                           pttype(gtlist(t));
 547                           break;
 548         case ttuple     : PUTTAG(',');
 549                           plist(pttype,gttuple(t));
 550                           break;
 551         case tfun       : PUTTAG('>');
 552                           pttype(gtfun(t));
 553                           pttype(gtarg(t));
 554                           break;
 555         case context    : PUTTAG('3');
 556                           plist(pttype,gtcontextl(t));
 557                           pttype(gtcontextt(t));
 558                           break;
 559
 560         case unidict    : PUTTAGSTR("2A");
 561                           pid(gunidict_clas(t));
 562                           pttype(gunidict_ty(t));
 563                           break;
 564         case unityvartemplate : PUTTAGSTR("2B");
 565                           pid(gunityvartemplate(t));
 566                           break;
 567         case uniforall  : PUTTAGSTR("2C");
 568                           plist(pid,guniforall_tv(t));
 569                           pttype(guniforall_ty(t));
 570                           break;
 571
 572         case ty_maybe_nothing : PUTTAGSTR("2D");
 573                           break;
 574         case ty_maybe_just: PUTTAGSTR("2E");
 575                           pttype(gty_maybe(t));
 576                           break;
 577
 578 #ifdef DPH
 579         case tproc      :
 580                           PUTTAG('u');
 581                           plist(pttype,gtpid(t));
 582                           pttype(gtdata(t));
 583                           break;
 584         case tpod       :
 585                           PUTTAG('v');
 586                           pttype(gtpod(t));
 587                           break;
 588 #endif
 589         default         : error("bad pttype");
 590         }
 591 }
 592
 593 static void
 594 patype(a)
 595   atype a;
 596 {
 597         switch (tatype(a)) {
 598         case atc        :
 599                           PUTTAG('1');
 600                           printf("#%u\t",gatcline(a));
 601                           pid(gatcid(a));
 602                           plist(pttype, gatctypel(a));
 603                           break;
 604         default         : fprintf(stderr, "Bad tag in abstree %d\n", tatype(a));
 605                           exit(1);
 606         }
 607 }
 608
 609
 610 static void
 611 pentid(i)
 612   entidt i;
 613 {
 614         switch (tentidt(i)) {
 615         case entid      : PUTTAG('x');
 616                           pid(gentid(i));
 617                           break;
 618         case enttype    : PUTTAG('X');
 619                           pid(gitentid(i));
 620                           break;
 621         case enttypeall : PUTTAG('z');
 622                           pid(gatentid(i));
 623                           break;
 624         case entmod     : PUTTAG('m');
 625                           pid(gmentid(i));
 626                           break;
 627         case enttypecons: PUTTAG('8');
 628                           pid(gctentid(i));
 629                           plist(pid,gctentcons(i));
 630                           break;
 631         case entclass   : PUTTAG('9');
 632                           pid(gcentid(i));
 633                           plist(pid,gcentops(i));
 634                           break;
 635         default         :
 636                           error("Bad pentid");
 637         }
 638 }
 639
 640
 641 static void
 642 prename(l)
 643   list l;
 644 {
 645   pid(lhd(l));
 646   pid(lhd(ltl(l)));
 647 }
 648
 649
 650 static void
 651 pfixes()
 652 {
 653         int m = nfixes(), i;
 654         char *s;
 655
 656         for(i = 0; i < m; i++) {
 657                 s = fixtype(i);
 658                 if (s) {
 659                         PUTTAG('L');
 660                         pstr(fixop(i));
 661                         pstr(fixtype(i));
 662                         printf("#%u\t",precedence(i));
 663                 }
 664         }
 665         PUTTAG('N');
 666 }
 667
 668
 669 static void
 670 ppbinding(p)
 671   pbinding p;
 672 {
 673         switch(tpbinding(p)) {
 674         case pgrhs      : PUTTAG('W');
 675                           printf("#%u\t",ggline(p));
 676                           pid(ggfuncname(p));
 677                           ptree(ggpat(p));
 678                           plist(pgrhses,ggdexprs(p));
 679                           prbind(ggbind(p));
 680                           break;
 681         default         :
 682                           error("Bad pbinding");
 683         }
 684 }
 685
 686
 687 static void
 688 pgrhses(l)
 689   list l;
 690 {
 691   ptree(lhd(l));                /* Guard */
 692   ptree(lhd(ltl(l)));           /* Expression */
 693 }
 694
 695 static void
 696 ppragma(p)
 697   hpragma p;
 698 {
 699     switch(thpragma(p)) {
 700       case no_pragma:           PUTTAGSTR("PN");
 701                                 break;
 702       case idata_pragma:        PUTTAGSTR("Pd");
 703                                 plist(patype, gprag_data_constrs(p));
 704                                 plist(ppragma, gprag_data_specs(p));
 705                                 break;
 706       case itype_pragma:        PUTTAGSTR("Pt");
 707                                 break;
 708       case iclas_pragma:        PUTTAGSTR("Pc");
 709                                 plist(ppragma, gprag_clas(p));
 710                                 break;
 711       case iclasop_pragma:      PUTTAGSTR("Po");
 712                                 ppragma(gprag_dsel(p));
 713                                 ppragma(gprag_defm(p));
 714                                 break;
 715
 716       case iinst_simpl_pragma:  PUTTAGSTR("Pis");
 717                                 pid(gprag_imod_simpl(p));
 718                                 ppragma(gprag_dfun_simpl(p));
 719                                 break;
 720       case iinst_const_pragma:  PUTTAGSTR("Pic");
 721                                 pid(gprag_imod_const(p));
 722                                 ppragma(gprag_dfun_const(p));
 723                                 plist(ppragma, gprag_constms(p));
 724                                 break;
 725       case iinst_spec_pragma:   PUTTAGSTR("PiS");
 726                                 pid(gprag_imod_spec(p));
 727                                 ppragma(gprag_dfun_spec(p));
 728                                 plist(ppragma, gprag_inst_specs(p));
 729                                 break;
 730
 731       case igen_pragma:         PUTTAGSTR("Pg");
 732                                 ppragma(gprag_arity(p));
 733                                 ppragma(gprag_update(p));
 734                                 ppragma(gprag_deforest(p));
 735                                 ppragma(gprag_strictness(p));
 736                                 ppragma(gprag_unfolding(p));
 737                                 plist(ppragma, gprag_specs(p));
 738                                 break;
 739       case iarity_pragma:       PUTTAGSTR("PA");
 740                                 pid(gprag_arity_val(p));
 741                                 break;
 742       case iupdate_pragma:      PUTTAGSTR("Pu");
 743                                 pid(gprag_update_val(p));
 744                                 break;
 745       case ideforest_pragma:    PUTTAGSTR("PD");
 746                                 break;
 747       case istrictness_pragma:  PUTTAGSTR("PS");
 748                                 print_string(gprag_strict_spec(p));
 749                                 ppragma(gprag_strict_wrkr(p));
 750                                 break;
 751       case imagic_unfolding_pragma: PUTTAGSTR("PM");
 752                                 pid(gprag_magic_str(p));
 753                                 break;
 754
 755       case iunfolding_pragma:   PUTTAGSTR("PU");
 756                                 ppragma(gprag_unfold_guide(p));
 757                                 pcoresyn(gprag_unfold_core(p));
 758                                 break;
 759
 760       case iunfold_always:      PUTTAGSTR("Px");
 761                                 break;
 762       case iunfold_if_args:     PUTTAGSTR("Py");
 763                                 pid(gprag_unfold_if_t_args(p));
 764                                 pid(gprag_unfold_if_v_args(p));
 765                                 pid(gprag_unfold_if_con_args(p));
 766                                 pid(gprag_unfold_if_size(p));
 767                                 break;
 768
 769       case iname_pragma_pr:     PUTTAGSTR("P1");
 770                                 pid(gprag_name_pr1(p));
 771                                 ppragma(gprag_name_pr2(p));
 772                                 break;
 773       case itype_pragma_pr:     PUTTAGSTR("P2");
 774                                 plist(pttype, gprag_type_pr1(p));
 775                                 pid(gprag_type_pr2(p));
 776                                 ppragma(gprag_type_pr3(p));
 777                                 break;
 778       case iinst_pragma_3s:     PUTTAGSTR("P3");
 779                                 plist(pttype, gprag_inst_pt1(p));
 780                                 pid(gprag_inst_pt2(p));
 781                                 ppragma(gprag_inst_pt3(p));
 782                                 plist(ppragma,gprag_inst_pt4(p));
 783                                 break;
 784
 785       case idata_pragma_4s:     PUTTAGSTR("P4");
 786                                 plist(pttype, gprag_data_spec(p));
 787                                 break;
 788
 789       default:                  error("Bad Pragma");
 790       }
 791 }
 792
 793 static void
 794 pbool(b)
 795   BOOLEAN b;
 796 {
 797     if (b) {
 798       putchar('T');
 799     } else {
 800       putchar('F');
 801     }
 802 }
 803
 804 static void
 805 pcoresyn(p)
 806   coresyn p;
 807 {
 808     switch(tcoresyn(p)) {
 809       case cobinder:            PUTTAGSTR("Fa");
 810                                 pid(gcobinder_v(p));
 811                                 pttype(gcobinder_ty(p));
 812                                 break;
 813
 814       case colit:               PUTTAGSTR("Fb");
 815                                 pliteral(gcolit(p));
 816                                 break;
 817       case colocal:             PUTTAGSTR("Fc");
 818                                 pcoresyn(gcolocal_v(p));
 819                                 break;
 820
 821       case cononrec:            PUTTAGSTR("Fd");
 822                                 pcoresyn(gcononrec_b(p));
 823                                 pcoresyn(gcononrec_rhs(p));
 824                                 break;
 825       case corec:               PUTTAGSTR("Fe");
 826                                 plist(pcoresyn,gcorec(p));
 827                                 break;
 828       case corec_pair:          PUTTAGSTR("Ff");
 829                                 pcoresyn(gcorec_b(p));
 830                                 pcoresyn(gcorec_rhs(p));
 831                                 break;
 832
 833       case covar:               PUTTAGSTR("Fg");
 834                                 pcoresyn(gcovar(p));
 835                                 break;
 836       case coliteral:           PUTTAGSTR("Fh");
 837                                 pliteral(gcoliteral(p));
 838                                 break;
 839       case cocon:               PUTTAGSTR("Fi");
 840                                 pcoresyn(gcocon_con(p));
 841                                 plist(pttype, gcocon_tys(p));
 842                                 plist(pcoresyn, gcocon_args(p));
 843                                 break;
 844       case coprim:              PUTTAGSTR("Fj");
 845                                 pcoresyn(gcoprim_op(p));
 846                                 plist(pttype, gcoprim_tys(p));
 847                                 plist(pcoresyn, gcoprim_args(p));
 848                                 break;
 849       case colam:               PUTTAGSTR("Fk");
 850                                 plist(pcoresyn, gcolam_vars(p));
 851                                 pcoresyn(gcolam_body(p));
 852                                 break;
 853       case cotylam:             PUTTAGSTR("Fl");
 854                                 plist(pid, gcotylam_tvs(p));
 855                                 pcoresyn(gcotylam_body(p));
 856                                 break;
 857       case coapp:               PUTTAGSTR("Fm");
 858                                 pcoresyn(gcoapp_fun(p));
 859                                 plist(pcoresyn, gcoapp_args(p));
 860                                 break;
 861       case cotyapp:             PUTTAGSTR("Fn");
 862                                 pcoresyn(gcotyapp_e(p));
 863                                 pttype(gcotyapp_t(p));
 864                                 break;
 865       case cocase:              PUTTAGSTR("Fo");
 866                                 pcoresyn(gcocase_s(p));
 867                                 pcoresyn(gcocase_alts(p));
 868                                 break;
 869       case colet:               PUTTAGSTR("Fp");
 870                                 pcoresyn(gcolet_bind(p));
 871                                 pcoresyn(gcolet_body(p));
 872                                 break;
 873       case coscc:               PUTTAGSTR("Fz");        /* out of order! */
 874                                 pcoresyn(gcoscc_scc(p));
 875                                 pcoresyn(gcoscc_body(p));
 876                                 break;
 877
 878       case coalg_alts:          PUTTAGSTR("Fq");
 879                                 plist(pcoresyn, gcoalg_alts(p));
 880                                 pcoresyn(gcoalg_deflt(p));
 881                                 break;
 882       case coalg_alt:           PUTTAGSTR("Fr");
 883                                 pcoresyn(gcoalg_con(p));
 884                                 plist(pcoresyn, gcoalg_bs(p));
 885                                 pcoresyn(gcoalg_rhs(p));
 886                                 break;
 887       case coprim_alts:         PUTTAGSTR("Fs");
 888                                 plist(pcoresyn, gcoprim_alts(p));
 889                                 pcoresyn(gcoprim_deflt(p));
 890                                 break;
 891       case coprim_alt:          PUTTAGSTR("Ft");
 892                                 pliteral(gcoprim_lit(p));
 893                                 pcoresyn(gcoprim_rhs(p));
 894                                 break;
 895       case conodeflt:           PUTTAGSTR("Fu");
 896                                 break;
 897       case cobinddeflt:         PUTTAGSTR("Fv");
 898                                 pcoresyn(gcobinddeflt_v(p));
 899                                 pcoresyn(gcobinddeflt_rhs(p));
 900                                 break;
 901
 902       case co_primop:           PUTTAGSTR("Fw");
 903                                 pid(gco_primop(p));
 904                                 break;
 905       case co_ccall:            PUTTAGSTR("Fx");
 906                                 pbool(gco_ccall_may_gc(p));
 907                                 pid(gco_ccall(p));
 908                                 plist(pttype, gco_ccall_arg_tys(p));
 909                                 pttype(gco_ccall_res_ty(p));
 910                                 break;
 911       case co_casm:             PUTTAGSTR("Fy");
 912                                 pbool(gco_casm_may_gc(p));
 913                                 pliteral(gco_casm(p));
 914                                 plist(pttype, gco_casm_arg_tys(p));
 915                                 pttype(gco_casm_res_ty(p));
 916                                 break;
 917
 918         /* Cost-centre stuff */
 919       case co_preludedictscc:   PUTTAGSTR("F?a");
 920                                 pcoresyn(gco_preludedictscc_dupd(p));
 921                                 break;
 922       case co_alldictscc:       PUTTAGSTR("F?b");
 923                                 print_string(gco_alldictscc_m(p));
 924                                 print_string(gco_alldictscc_g(p));
 925                                 pcoresyn(gco_alldictscc_dupd(p));
 926                                 break;
 927       case co_usercc:           PUTTAGSTR("F?c");
 928                                 print_string(gco_usercc_n(p));
 929                                 print_string(gco_usercc_m(p));
 930                                 print_string(gco_usercc_g(p));
 931                                 pcoresyn(gco_usercc_dupd(p));
 932                                 pcoresyn(gco_usercc_cafd(p));
 933                                 break;
 934       case co_autocc:           PUTTAGSTR("F?d");
 935                                 pcoresyn(gco_autocc_i(p));
 936                                 print_string(gco_autocc_m(p));
 937                                 print_string(gco_autocc_g(p));
 938                                 pcoresyn(gco_autocc_dupd(p));
 939                                 pcoresyn(gco_autocc_cafd(p));
 940                                 break;
 941       case co_dictcc:           PUTTAGSTR("F?e");
 942                                 pcoresyn(gco_dictcc_i(p));
 943                                 print_string(gco_dictcc_m(p));
 944                                 print_string(gco_dictcc_g(p));
 945                                 pcoresyn(gco_dictcc_dupd(p));
 946                                 pcoresyn(gco_dictcc_cafd(p));
 947                                 break;
 948
 949       case co_scc_noncaf:       PUTTAGSTR("F?f");
 950                                 break;
 951       case co_scc_caf:          PUTTAGSTR("F?g");
 952                                 break;
 953       case co_scc_nondupd:      PUTTAGSTR("F?h");
 954                                 break;
 955       case co_scc_dupd:         PUTTAGSTR("F?i");
 956                                 break;
 957
 958         /* Id stuff */
 959       case co_id:               PUTTAGSTR("F1");
 960                                 pid(gco_id(p));
 961                                 break;
 962       case co_orig_id:          PUTTAGSTR("F9");
 963                                 pid(gco_orig_id_m(p));
 964                                 pid(gco_orig_id_n(p));
 965                                 break;
 966       case co_sdselid:          PUTTAGSTR("F2");
 967                                 pid(gco_sdselid_c(p));
 968                                 pid(gco_sdselid_sc(p));
 969                                 break;
 970       case co_classopid:        PUTTAGSTR("F3");
 971                                 pid(gco_classopid_c(p));
 972                                 pid(gco_classopid_o(p));
 973                                 break;
 974       case co_defmid:           PUTTAGSTR("F4");
 975                                 pid(gco_defmid_c(p));
 976                                 pid(gco_defmid_op(p));
 977                                 break;
 978       case co_dfunid:           PUTTAGSTR("F5");
 979                                 pid(gco_dfunid_c(p));
 980                                 pttype(gco_dfunid_ty(p));
 981                                 break;
 982       case co_constmid:         PUTTAGSTR("F6");
 983                                 pid(gco_constmid_c(p));
 984                                 pid(gco_constmid_op(p));
 985                                 pttype(gco_constmid_ty(p));
 986                                 break;
 987       case co_specid:           PUTTAGSTR("F7");
 988                                 pcoresyn(gco_specid_un(p));
 989                                 plist(pttype,gco_specid_tys(p));
 990                                 break;
 991       case co_wrkrid:           PUTTAGSTR("F8");
 992                                 pcoresyn(gco_wrkrid_un(p));
 993                                 break;
 994       /* more to come?? */
 995
 996       default :                 error("Bad Core syntax");
 997     }
 998 }