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