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 static void plineno PROTO( (long) );
  37
  38 extern char *input_filename;
  39 extern BOOLEAN hashIds;
  40
  41 /*      How to print tags       */
  42
  43 #if COMPACT
  44 #define PUTTAG(c)       putchar(c);
  45 #define PUTTAGSTR(s)    printf("%s",(s));
  46 #else
  47 #define PUTTAG(c)       putchar(c); \
  48                         putchar(' ');
  49 #define PUTTAGSTR(s)    printf("%s",(s)); \
  50                         putchar(' ');
  51 #endif
  52
  53
  54 /*      Performs a post order walk of the tree
  55         to print it.
  56 */
  57
  58 void
  59 pprogram(t)
  60   tree t;
  61 {
  62     print_hash_table();
  63     ptree(t);
  64 }
  65
  66 /* print_string: we must escape \t and \\, as described in
  67    char/string lexer comments.  (WDP 94/11)
  68 */
  69 static void
  70 print_string(hstring str)
  71 {
  72     char *gs;
  73     char c;
  74     int i, str_length;
  75
  76     putchar('#');
  77     str_length = str->len;
  78     gs = str->bytes;
  79
  80     for (i = 0; i < str_length; i++) {
  81         c = gs[i];
  82         if ( c == '\t' ) {
  83             putchar('\\');
  84             putchar('t');
  85         } else if ( c == '\\' ) {
  86             putchar('\\');
  87             putchar('\\');
  88         } else {
  89             putchar(gs[i]);
  90         }
  91     }
  92     putchar('\t');
  93 }
  94
  95 static void
  96 plineno (l)
  97 long l;
  98 {
  99  printf("#%lu\t",l);
 100  return;
 101 }
 102
 103
 104 static int
 105 get_character(hstring str)
 106 {
 107     int c = (int)((str->bytes)[0]);
 108
 109     if (str->len != 1) { /* ToDo: assert */
 110         fprintf(stderr, "get_character: length != 1? (%ld: %s)\n", str->len, str->bytes);
 111     }
 112
 113     if (c < 0) {
 114         c += 256;       /* "This is not a hack" -- KH */
 115     }
 116
 117     return(c);
 118 }
 119
 120 static void
 121 pliteral(literal t)
 122 {
 123     switch(tliteral(t)) {
 124       case integer:
 125                       PUTTAG('4');
 126                       pstr(ginteger(t));
 127                       break;
 128       case intprim:
 129                       PUTTAG('H');
 130                       pstr(gintprim(t));
 131                       break;
 132       case floatr:
 133                       PUTTAG('F');
 134                       pstr(gfloatr(t));
 135                       break;
 136       case doubleprim:
 137                       PUTTAG('J');
 138                       pstr(gdoubleprim(t));
 139                       break;
 140       case floatprim:
 141                       PUTTAG('K');
 142                       pstr(gfloatprim(t));
 143                       break;
 144       case charr:
 145                       PUTTAG('C');
 146                       /* Changed %d to %u, since negative chars
 147                          make little sense -- KH @ 16/4/91
 148                       */
 149                       printf("#%u\t", get_character(gchar(t)));
 150                       break;
 151       case charprim:
 152                       PUTTAG('P');
 153                       printf("#%u\t", get_character(gcharprim(t)));
 154                       break;
 155       case string:
 156                       PUTTAG('S');
 157                       print_string(gstring(t));
 158                       break;
 159       case stringprim:
 160                       PUTTAG('V');
 161                       print_string(gstringprim(t));
 162                       break;
 163       case clitlit:
 164                       PUTTAG('Y');
 165                       pstr(gclitlit(t));
 166                       /* pstr(gclitlit_kind(t)); */
 167                       break;
 168       default:
 169                       error("Bad pliteral");
 170     }
 171 }
 172
 173 static void
 174 ptree(t)
 175   tree t;
 176 {
 177 again:
 178     switch(ttree(t)) {
 179       case hmodule:
 180                       PUTTAG('M');
 181                       plineno(ghmodline(t));
 182                       pid(ghname(t));
 183                       printf("#%lu\t",ghversion(t));
 184                       pstr(input_filename);
 185                       prbind(ghmodlist(t));
 186                       /* pfixes(); */
 187                       plist(prbind, ghimplist(t));
 188                       pmaybe_list(pentid, ghexplist(t));
 189                       break;
 190       case fixop:
 191                       PUTTAG('I');
 192                       pqid(gfixop(t));
 193                       printf("%lu\t%lu",gfixinfx(t),gfixprec(t));
 194                       break;
 195       case ident:
 196                       PUTTAG('i');
 197                       pqid(gident(t));
 198                       break;
 199       case lit:
 200                       PUTTAG('C');
 201                       pliteral(glit(t));
 202                       break;
 203
 204       case ap:
 205                       PUTTAG('a');
 206                       ptree(gfun(t));
 207                       ptree(garg(t));
 208                       break;
 209       case infixap:
 210                       PUTTAG('@');
 211                       pqid(ginffun(t));
 212                       ptree(ginfarg1(t));
 213                       ptree(ginfarg2(t));
 214                       break;
 215       case negate:
 216                       PUTTAG('-');
 217                       ptree(gnexp(t));
 218                       break;
 219       case lambda:
 220                       PUTTAG('l');
 221                       plineno(glamline(t));
 222                       plist(ptree,glampats(t));
 223                       ptree(glamexpr(t));
 224                       break;
 225
 226       case let:
 227                       PUTTAG('E');
 228                       prbind(gletvdefs(t));
 229                       ptree(gletvexpr(t));
 230                       break;
 231       case casee:
 232                       PUTTAG('c');
 233                       plineno(gcaseline(t));
 234                       ptree(gcaseexpr(t));
 235                       plist(ppbinding, gcasebody(t));
 236                       break;
 237       case ife:
 238                       PUTTAG('b');
 239                       ptree(gifpred(t));
 240                       ptree(gifthen(t));
 241                       ptree(gifelse(t));
 242                       break;
 243       case doe:
 244                       PUTTAG('O');
 245                       plineno(gdoline(t));
 246                       plist(ptree, gdo(t));
 247                       break;
 248       case dobind:
 249                       PUTTAG('Q');
 250                       plineno(gdobindline(t));
 251                       ptree(gdobindpat(t));
 252                       ptree(gdobindexp(t));
 253                       break;
 254       case doexp:
 255                       PUTTAG('R');
 256                       plineno(gdoexpline(t));
 257                       ptree(gdoexp(t));
 258                       break;
 259       case seqlet:
 260                       PUTTAG('U');
 261                       prbind(gseqlet(t));
 262                       break;
 263       case record:
 264                       PUTTAG('d');
 265                       pqid(grcon(t));
 266                       plist(prbind,grbinds(t));
 267                       break;
 268
 269       case rupdate:
 270                       PUTTAG('h');
 271                       ptree(gupdexp(t));
 272                       plist(prbind,gupdbinds(t));
 273                       break;
 274
 275       case rbind:
 276                       PUTTAG('o');
 277                       pqid(grbindvar(t));
 278                       pmaybe(ptree,grbindexp(t));
 279                       break;
 280
 281       case par:       t = gpare(t); goto again;
 282
 283       case as:
 284                       PUTTAG('s');
 285                       pqid(gasid(t));
 286                       ptree(gase(t));
 287                       break;
 288       case lazyp:
 289                       PUTTAG('~');
 290                       ptree(glazyp(t));
 291                       break;
 292       case wildp:
 293                       PUTTAG('_');
 294                       break;
 295
 296       case restr:
 297                       PUTTAG('R');
 298                       ptree(grestre(t));
 299                       pttype(grestrt(t));
 300                       break;
 301       case tuple:
 302                       PUTTAG(',');
 303                       plist(ptree,gtuplelist(t));
 304                       break;
 305       case llist:
 306                       PUTTAG(':');
 307                       plist(ptree,gllist(t));
 308                       break;
 309       case eenum:
 310                       PUTTAG('.');
 311                       ptree(gefrom(t));
 312                       pmaybe(ptree,gestep(t));
 313                       pmaybe(ptree,geto(t));
 314                       break;
 315       case comprh:
 316                       PUTTAG('Z');
 317                       ptree(gcexp(t));
 318                       plist(ptree,gcquals(t));
 319                       break;
 320       case qual:
 321                       PUTTAG('G');
 322                       ptree(gqpat(t));
 323                       ptree(gqexp(t));
 324                       break;
 325       case guard:
 326                       PUTTAG('g');
 327                       ptree(ggexp(t));
 328                       break;
 329       case lsection:
 330                       PUTTAG('(');
 331                       ptree(glsexp(t));
 332                       pqid(glsop(t));
 333                       break;
 334       case rsection:
 335                       PUTTAG(')');
 336                       pqid(grsop(t));
 337                       ptree(grsexp(t));
 338                       break;
 339       case ccall:
 340                       PUTTAG('j');
 341                       pstr(gccid(t));
 342                       pstr(gccinfo(t));
 343                       plist(ptree,gccargs(t));
 344                       break;
 345       case scc:
 346                       PUTTAG('k');
 347                       print_string(gsccid(t));
 348                       ptree(gsccexp(t));
 349                       break;
 350       default:
 351                       error("Bad ptree");
 352     }
 353 }
 354
 355 static void
 356 plist(fun, l)
 357   void (*fun)(/* NOT WORTH IT: void * */);
 358   list l;
 359 {
 360     if (tlist(l) == lnil) {
 361         PUTTAG('N');
 362     } else  {
 363         PUTTAG('L');
 364         (*fun)(lhd(l));
 365         plist(fun, ltl(l));
 366     }
 367 }
 368
 369 static void
 370 pmaybe(fun, m)
 371   void (*fun)(/* NOT WORTH IT: void * */);
 372   maybe m;
 373 {
 374     if (tmaybe(m) == nothing) {
 375         PUTTAG('N');
 376     } else  {
 377         PUTTAG('J');
 378         (*fun)(gthing(m));
 379     }
 380 }
 381
 382 static void
 383 pmaybe_list(fun, m)
 384   void (*fun)(/* NOT WORTH IT: void * */);
 385   maybe m;
 386 {
 387     if (tmaybe(m) == nothing) {
 388         PUTTAG('N');
 389     } else  {
 390         PUTTAG('J');
 391         plist(fun, gthing(m));
 392     }
 393 }
 394
 395 static void
 396 pid(i)
 397   id i;
 398 {
 399   if(hashIds)
 400         printf("!%lu\t", hash_index(i));
 401   else
 402         printf("#%s\t", id_to_string(i));
 403 }
 404
 405 static void
 406 pqid(i)
 407   qid i;
 408 {
 409   if(hashIds)
 410         printf("!%lu\t", hash_index(qid_to_id(i)));
 411   else
 412         printf("#%s\t", qid_to_string(i));
 413 }
 414
 415 static void
 416 pstr(i)
 417   char *i;
 418 {
 419         printf("#%s\t", i);
 420 }
 421
 422 static void
 423 prbind(b)
 424   binding b;
 425 {
 426         switch(tbinding(b)) {
 427         case tbind:
 428                           PUTTAG('t');
 429                           plineno(gtline(b));
 430                           plist(pttype, gtbindc(b));
 431                           pmaybe_list(pid, gtbindd(b));
 432                           pttype(gtbindid(b));
 433                           plist(pconstr, gtbindl(b));
 434                           break;
 435         case ntbind:
 436                           PUTTAG('q');
 437                           plineno(gntline(b));
 438                           plist(pttype,gntbindcty(b));
 439                           pmaybe_list(pid, gntbindd(b));
 440                           pttype(gntbindid(b));
 441                           plist(pconstr, gntbindcty(b));
 442                           break;
 443         case nbind      :
 444                           PUTTAG('n');
 445                           plineno(gnline(b));
 446                           pttype(gnbindid(b));
 447                           pttype(gnbindas(b));
 448                           break;
 449         case pbind      :
 450                           PUTTAG('p');
 451                           plineno(gpline(b));
 452                           plist(ppbinding, gpbindl(b));
 453                           break;
 454         case fbind      :
 455                           PUTTAG('f');
 456                           plineno(gfline(b));
 457                           plist(ppbinding, gfbindl(b));
 458                           break;
 459         case abind      :
 460                           PUTTAG('A');
 461                           prbind(gabindfst(b));
 462                           prbind(gabindsnd(b));
 463                           break;
 464         case ibind      :
 465                           PUTTAG('%');
 466                           plineno(giline(b));
 467                           plist(pttype,gibindc(b));
 468                           pqid(gibindid(b));
 469                           pttype(gibindi(b));
 470                           prbind(gibindw(b));
 471                           /* ppragma(gipragma(b)); */
 472                           break;
 473         case dbind      :
 474                           PUTTAG('D');
 475                           plineno(gdline(b));
 476                           plist(pttype,gdbindts(b));
 477                           break;
 478
 479         case cbind      :
 480                           PUTTAG('$');
 481                           plineno(gcline(b));
 482                           plist(pttype,gcbindc(b));
 483                           pttype(gcbindid(b));
 484                           prbind(gcbindw(b));
 485                           break;
 486
 487         /* signature(-like) things, including user pragmas */
 488         case sbind      :
 489                           PUTTAG('r');
 490                           plineno(gsline(b));
 491                           plist(pqid,gsbindids(b));
 492                           pttype(gsbindid(b));
 493                           break;
 494
 495         case nullbind   :
 496                           PUTTAG('B');
 497                           break;
 498
 499         case import:
 500                           PUTTAG('e');
 501                           plineno(gibindline(b));
 502                           /* pid(gibindfile(b)); */
 503                           pid(gibindimod(b));
 504                           printf("#%lu\t",gibindqual(b)); /* 1 -- qualified */
 505                           pmaybe(pid, gibindas(b));
 506                           pmaybe(pconstr, gibindspec(b));
 507                           /* plist(pentid,giebindexp(b)); ??? */
 508                           /* prbind(giebinddef(b)); ???? */
 509                           break;
 510
 511          /* User pragmas till the end */
 512
 513         case vspec_uprag:
 514                           PUTTAGSTR("Ss");
 515                           plineno(gvspec_line(b));
 516                           pqid(gvspec_id(b));
 517                           plist(pttype,gvspec_tys(b));
 518                           break;
 519         case vspec_ty_and_id:
 520                           PUTTAGSTR("St");
 521                           pttype(gvspec_ty(b));
 522                           pmaybe(pttype,gvspec_tyid(b));
 523                           break;
 524
 525         case ispec_uprag:
 526                           PUTTAGSTR("SS");
 527                           plineno(gispec_line(b));
 528                           pqid(gispec_clas(b));
 529                           pttype(gispec_ty(b));
 530                           break;
 531         case inline_uprag:
 532                           PUTTAGSTR("Si");
 533                           plineno(ginline_line(b));
 534                           pqid(ginline_id(b));
 535                           break;
 536         case deforest_uprag:
 537                           PUTTAGSTR("Sd");
 538                           plineno(gdeforest_line(b));
 539                           pqid(gdeforest_id(b));
 540                           break;
 541         case magicuf_uprag:
 542                           PUTTAGSTR("Su");
 543                           plineno(gmagicuf_line(b));
 544                           pqid(gmagicuf_id(b));
 545                           pid(gmagicuf_str(b));
 546                           break;
 547         case dspec_uprag:
 548                           PUTTAGSTR("Sd");
 549                           plineno(gdspec_line(b));
 550                           pqid(gdspec_id(b));
 551                           plist(pttype,gdspec_tys(b));
 552                           break;
 553
 554         /* end of signature(-like) things */
 555 /* not used:
 556         case mbind:
 557                           PUTTAG('7');
 558                           plineno(gmline(b));
 559                           pid(gmbindmodn(b));
 560                           plist(pentid,gmbindimp(b));
 561                           break;
 562 */
 563         default         : error("Bad prbind");
 564                           break;
 565         }
 566 }
 567
 568 static void
 569 pttype(t)
 570   ttype t;
 571 {
 572         switch (tttype(t)) {
 573         case tname      : PUTTAG('T');
 574                           pqid(gtypeid(t));
 575                           break;
 576         case namedtvar  : PUTTAG('y');
 577                           pqid(gnamedtvar(t));
 578                           break;
 579         case tllist     : PUTTAG(':');
 580                           pttype(gtlist(t));
 581                           break;
 582         case ttuple     : PUTTAG(',');
 583                           plist(pttype,gttuple(t));
 584                           break;
 585         case tfun       : PUTTAG('>');
 586                           pttype(gtin(t));
 587                           pttype(gtout(t));
 588                           break;
 589         case tapp       : PUTTAG('@');
 590                           pttype(gtapp(t));
 591                           pttype(gtarg(t));
 592                           break;
 593         case tbang      : PUTTAG('!');
 594                           pttype(gtbang(t));
 595                           break;
 596         case context    : PUTTAG('3');
 597                           plist(pttype,gtcontextl(t));
 598                           pttype(gtcontextt(t));
 599                           break;
 600         default         : error("bad pttype");
 601         }
 602 }
 603
 604 static void
 605 pconstr(a)
 606   constr a;
 607 {
 608         switch (tconstr(a)) {
 609         case constrpre  :
 610                           PUTTAG('1');
 611                           plineno(gconcline(a));
 612                           pqid(gconcid(a));
 613                           plist(pttype, gconctypel(a));
 614                           break;
 615         case constrinf  :
 616                           PUTTAG('2');
 617                           plineno(gconiline(a));
 618                           pqid(gconiop(a));
 619                           pttype(gconity1(a));
 620                           pttype(gconity2(a));
 621                           break;
 622
 623         case constrrec  :
 624                           PUTTAG('u');
 625                           plineno(gconrline(a));
 626                           pqid(gconrid(a));
 627                           plist(pqid,gconrfieldl(a));
 628                           break;
 629         case constrnew  :
 630                           PUTTAG('v');
 631                           plineno(gconnline(a));
 632                           pqid(gconnid(a));
 633                           pttype(gconnty(a));
 634                           break;
 635         case field      :
 636                           PUTTAG('5');
 637                           plist(pqid,gfieldn(a));
 638                           pttype(gfieldt(a));
 639                           break;
 640         default         : fprintf(stderr, "Bad tag in abstree %d\n", tconstr(a));
 641                           exit(1);
 642         }
 643 }
 644
 645
 646 static void
 647 pentid(i)
 648   entidt i;
 649 {
 650         switch (tentidt(i)) {
 651         case entid      : PUTTAG('x');
 652                           pqid(gentid(i));
 653                           break;
 654         case enttype    : PUTTAG('X');
 655                           pqid(gtentid(i));
 656                           break;
 657         case enttypeall : PUTTAG('z');
 658                           pqid(gaentid(i));
 659                           break;
 660         case enttypenamed:PUTTAG('8');
 661                           pqid(gnentid(i));
 662                           plist(pqid,gnentnames(i));
 663                           break;
 664         case entmod     : PUTTAG('m');
 665                           pid(gmentid(i));
 666                           break;
 667         default         :
 668                           error("Bad pentid");
 669         }
 670 }
 671
 672
 673 static void
 674 ppbinding(p)
 675   pbinding p;
 676 {
 677         switch(tpbinding(p)) {
 678         case pgrhs      : PUTTAG('W');
 679                           plineno(ggline(p));
 680                           pqid(ggfuncname(p));
 681                           ptree(ggpat(p));
 682                           ppbinding(ggdexprs(p));
 683                           prbind(ggbind(p));
 684                           break;
 685         case pnoguards  :
 686                           PUTTAG('6');
 687                           ptree(gpnoguard(p));
 688                           break;
 689         case pguards    :
 690                           PUTTAG('9');
 691                           plist(ptree, gpguards(p));
 692                           break;
 693         case pgdexp     :
 694                           PUTTAG('&');
 695                           ptree(gpguard(p));
 696                           ptree(gpexp(p));
 697                           break;
 698         default         :
 699                           error("Bad pbinding");
 700         }
 701 }
 702
 703
 704 static void
 705 pgrhses(l)
 706   list l;
 707 {
 708   ptree(lhd(l));                /* Guard */
 709   ptree(lhd(ltl(l)));           /* Expression */
 710 }
 711 /*
 712 static void
 713 ppragma(p)
 714   hpragma p;
 715 {
 716     switch(thpragma(p)) {
 717       case no_pragma:           PUTTAGSTR("PN");
 718                                 break;
 719       case idata_pragma:        PUTTAGSTR("Pd");
 720                                 plist(pconstr, gprag_data_constrs(p));
 721                                 plist(ppragma, gprag_data_specs(p));
 722                                 break;
 723       case itype_pragma:        PUTTAGSTR("Pt");
 724                                 break;
 725       case iclas_pragma:        PUTTAGSTR("Pc");
 726                                 plist(ppragma, gprag_clas(p));
 727                                 break;
 728       case iclasop_pragma:      PUTTAGSTR("Po");
 729                                 ppragma(gprag_dsel(p));
 730                                 ppragma(gprag_defm(p));
 731                                 break;
 732
 733       case iinst_simpl_pragma:  PUTTAGSTR("Pis");
 734 / *                             pid(gprag_imod_simpl(p));
 735 * /                             ppragma(gprag_dfun_simpl(p));
 736                                 break;
 737       case iinst_const_pragma:  PUTTAGSTR("Pic");
 738 / *                             pid(gprag_imod_const(p));
 739 * /                             ppragma(gprag_dfun_const(p));
 740                                 plist(ppragma, gprag_constms(p));
 741                                 break;
 742
 743       case igen_pragma:         PUTTAGSTR("Pg");
 744                                 ppragma(gprag_arity(p));
 745                                 ppragma(gprag_update(p));
 746                                 ppragma(gprag_deforest(p));
 747                                 ppragma(gprag_strictness(p));
 748                                 ppragma(gprag_unfolding(p));
 749                                 plist(ppragma, gprag_specs(p));
 750                                 break;
 751       case iarity_pragma:       PUTTAGSTR("PA");
 752                                 pid(gprag_arity_val(p));
 753                                 break;
 754       case iupdate_pragma:      PUTTAGSTR("Pu");
 755                                 pid(gprag_update_val(p));
 756                                 break;
 757       case ideforest_pragma:    PUTTAGSTR("PD");
 758                                 break;
 759       case istrictness_pragma:  PUTTAGSTR("PS");
 760                                 print_string(gprag_strict_spec(p));
 761                                 ppragma(gprag_strict_wrkr(p));
 762                                 break;
 763       case imagic_unfolding_pragma: PUTTAGSTR("PM");
 764                                 pid(gprag_magic_str(p));
 765                                 break;
 766
 767       case iunfolding_pragma:   PUTTAGSTR("PU");
 768                                 ppragma(gprag_unfold_guide(p));
 769                                 pcoresyn(gprag_unfold_core(p));
 770                                 break;
 771
 772       case iunfold_always:      PUTTAGSTR("Px");
 773                                 break;
 774       case iunfold_if_args:     PUTTAGSTR("Py");
 775                                 pid(gprag_unfold_if_t_args(p));
 776                                 pid(gprag_unfold_if_v_args(p));
 777                                 pid(gprag_unfold_if_con_args(p));
 778                                 pid(gprag_unfold_if_size(p));
 779                                 break;
 780
 781       case iname_pragma_pr:     PUTTAGSTR("P1");
 782                                 pid(gprag_name_pr1(p));
 783                                 ppragma(gprag_name_pr2(p));
 784                                 break;
 785       case itype_pragma_pr:     PUTTAGSTR("P2");
 786                                 plist(pttype, gprag_type_pr1(p));
 787                                 pid(gprag_type_pr2(p));
 788                                 ppragma(gprag_type_pr3(p));
 789                                 break;
 790
 791       case idata_pragma_4s:     PUTTAGSTR("P4");
 792                                 plist(pttype, gprag_data_spec(p));
 793                                 break;
 794
 795       default:                  error("Bad Pragma");
 796       }
 797 }
 798 */
 799
 800 static void
 801 pbool(b)
 802   BOOLEAN b;
 803 {
 804     if (b) {
 805       putchar('T');
 806     } else {
 807       putchar('F');
 808     }
 809 }
 810