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                           printf("#%lu\t",gibindsource(b)); /* 1 -- from source */
 506                           pmaybe(pid, gibindas(b));
 507                           pmaybe(pconstr, gibindspec(b));
 508                           /* plist(pentid,giebindexp(b)); ??? */
 509                           /* prbind(giebinddef(b)); ???? */
 510                           break;
 511
 512          /* User pragmas till the end */
 513
 514         case vspec_uprag:
 515                           PUTTAGSTR("Ss");
 516                           plineno(gvspec_line(b));
 517                           pqid(gvspec_id(b));
 518                           plist(pttype,gvspec_tys(b));
 519                           break;
 520         case vspec_ty_and_id:
 521                           PUTTAGSTR("St");
 522                           pttype(gvspec_ty(b));
 523                           pmaybe(pttype,gvspec_tyid(b));
 524                           break;
 525
 526         case ispec_uprag:
 527                           PUTTAGSTR("SS");
 528                           plineno(gispec_line(b));
 529                           pqid(gispec_clas(b));
 530                           pttype(gispec_ty(b));
 531                           break;
 532         case inline_uprag:
 533                           PUTTAGSTR("Si");
 534                           plineno(ginline_line(b));
 535                           pqid(ginline_id(b));
 536                           break;
 537         case deforest_uprag:
 538                           PUTTAGSTR("Sd");
 539                           plineno(gdeforest_line(b));
 540                           pqid(gdeforest_id(b));
 541                           break;
 542         case magicuf_uprag:
 543                           PUTTAGSTR("Su");
 544                           plineno(gmagicuf_line(b));
 545                           pqid(gmagicuf_id(b));
 546                           pid(gmagicuf_str(b));
 547                           break;
 548         case dspec_uprag:
 549                           PUTTAGSTR("Sd");
 550                           plineno(gdspec_line(b));
 551                           pqid(gdspec_id(b));
 552                           plist(pttype,gdspec_tys(b));
 553                           break;
 554
 555         /* end of signature(-like) things */
 556 /* not used:
 557         case mbind:
 558                           PUTTAG('7');
 559                           plineno(gmline(b));
 560                           pid(gmbindmodn(b));
 561                           plist(pentid,gmbindimp(b));
 562                           break;
 563 */
 564         default         : error("Bad prbind");
 565                           break;
 566         }
 567 }
 568
 569 static void
 570 pttype(t)
 571   ttype t;
 572 {
 573         switch (tttype(t)) {
 574         case tname      : PUTTAG('T');
 575                           pqid(gtypeid(t));
 576                           break;
 577         case namedtvar  : PUTTAG('y');
 578                           pqid(gnamedtvar(t));
 579                           break;
 580         case tllist     : PUTTAG(':');
 581                           pttype(gtlist(t));
 582                           break;
 583         case ttuple     : PUTTAG(',');
 584                           plist(pttype,gttuple(t));
 585                           break;
 586         case tfun       : PUTTAG('>');
 587                           pttype(gtin(t));
 588                           pttype(gtout(t));
 589                           break;
 590         case tapp       : PUTTAG('@');
 591                           pttype(gtapp(t));
 592                           pttype(gtarg(t));
 593                           break;
 594         case tbang      : PUTTAG('!');
 595                           pttype(gtbang(t));
 596                           break;
 597         case context    : PUTTAG('3');
 598                           plist(pttype,gtcontextl(t));
 599                           pttype(gtcontextt(t));
 600                           break;
 601         default         : error("bad pttype");
 602         }
 603 }
 604
 605 static void
 606 pconstr(a)
 607   constr a;
 608 {
 609         switch (tconstr(a)) {
 610         case constrpre  :
 611                           PUTTAG('1');
 612                           plineno(gconcline(a));
 613                           pqid(gconcid(a));
 614                           plist(pttype, gconctypel(a));
 615                           break;
 616         case constrinf  :
 617                           PUTTAG('2');
 618                           plineno(gconiline(a));
 619                           pqid(gconiop(a));
 620                           pttype(gconity1(a));
 621                           pttype(gconity2(a));
 622                           break;
 623
 624         case constrrec  :
 625                           PUTTAG('u');
 626                           plineno(gconrline(a));
 627                           pqid(gconrid(a));
 628                           plist(pqid,gconrfieldl(a));
 629                           break;
 630         case constrnew  :
 631                           PUTTAG('v');
 632                           plineno(gconnline(a));
 633                           pqid(gconnid(a));
 634                           pttype(gconnty(a));
 635                           break;
 636         case field      :
 637                           PUTTAG('5');
 638                           plist(pqid,gfieldn(a));
 639                           pttype(gfieldt(a));
 640                           break;
 641         default         : fprintf(stderr, "Bad tag in abstree %d\n", tconstr(a));
 642                           exit(1);
 643         }
 644 }
 645
 646
 647 static void
 648 pentid(i)
 649   entidt i;
 650 {
 651         switch (tentidt(i)) {
 652         case entid      : PUTTAG('x');
 653                           pqid(gentid(i));
 654                           break;
 655         case enttype    : PUTTAG('X');
 656                           pqid(gtentid(i));
 657                           break;
 658         case enttypeall : PUTTAG('z');
 659                           pqid(gaentid(i));
 660                           break;
 661         case enttypenamed:PUTTAG('8');
 662                           pqid(gnentid(i));
 663                           plist(pqid,gnentnames(i));
 664                           break;
 665         case entmod     : PUTTAG('m');
 666                           pid(gmentid(i));
 667                           break;
 668         default         :
 669                           error("Bad pentid");
 670         }
 671 }
 672
 673
 674 static void
 675 ppbinding(p)
 676   pbinding p;
 677 {
 678         switch(tpbinding(p)) {
 679         case pgrhs      : PUTTAG('W');
 680                           plineno(ggline(p));
 681                           pqid(ggfuncname(p));
 682                           ptree(ggpat(p));
 683                           ppbinding(ggdexprs(p));
 684                           prbind(ggbind(p));
 685                           break;
 686         case pnoguards  :
 687                           PUTTAG('6');
 688                           ptree(gpnoguard(p));
 689                           break;
 690         case pguards    :
 691                           PUTTAG('9');
 692                           plist(ptree, gpguards(p));
 693                           break;
 694         case pgdexp     :
 695                           PUTTAG('&');
 696                           plist(ptree, gpguard(p)); /* Experimental: pattern guards */
 697                           ptree(gpexp(p));
 698                           break;
 699         default         :
 700                           error("Bad pbinding");
 701         }
 702 }
 703
 704
 705 static void
 706 pgrhses(l)
 707   list l;
 708 {
 709   ptree(lhd(l));                /* Guard */
 710   ptree(lhd(ltl(l)));           /* Expression */
 711 }
 712 /*
 713 static void
 714 ppragma(p)
 715   hpragma p;
 716 {
 717     switch(thpragma(p)) {
 718       case no_pragma:           PUTTAGSTR("PN");
 719                                 break;
 720       case idata_pragma:        PUTTAGSTR("Pd");
 721                                 plist(pconstr, gprag_data_constrs(p));
 722                                 plist(ppragma, gprag_data_specs(p));
 723                                 break;
 724       case itype_pragma:        PUTTAGSTR("Pt");
 725                                 break;
 726       case iclas_pragma:        PUTTAGSTR("Pc");
 727                                 plist(ppragma, gprag_clas(p));
 728                                 break;
 729       case iclasop_pragma:      PUTTAGSTR("Po");
 730                                 ppragma(gprag_dsel(p));
 731                                 ppragma(gprag_defm(p));
 732                                 break;
 733
 734       case iinst_simpl_pragma:  PUTTAGSTR("Pis");
 735 / *                             pid(gprag_imod_simpl(p));
 736 * /                             ppragma(gprag_dfun_simpl(p));
 737                                 break;
 738       case iinst_const_pragma:  PUTTAGSTR("Pic");
 739 / *                             pid(gprag_imod_const(p));
 740 * /                             ppragma(gprag_dfun_const(p));
 741                                 plist(ppragma, gprag_constms(p));
 742                                 break;
 743
 744       case igen_pragma:         PUTTAGSTR("Pg");
 745                                 ppragma(gprag_arity(p));
 746                                 ppragma(gprag_update(p));
 747                                 ppragma(gprag_deforest(p));
 748                                 ppragma(gprag_strictness(p));
 749                                 ppragma(gprag_unfolding(p));
 750                                 plist(ppragma, gprag_specs(p));
 751                                 break;
 752       case iarity_pragma:       PUTTAGSTR("PA");
 753                                 pid(gprag_arity_val(p));
 754                                 break;
 755       case iupdate_pragma:      PUTTAGSTR("Pu");
 756                                 pid(gprag_update_val(p));
 757                                 break;
 758       case ideforest_pragma:    PUTTAGSTR("PD");
 759                                 break;
 760       case istrictness_pragma:  PUTTAGSTR("PS");
 761                                 print_string(gprag_strict_spec(p));
 762                                 ppragma(gprag_strict_wrkr(p));
 763                                 break;
 764       case imagic_unfolding_pragma: PUTTAGSTR("PM");
 765                                 pid(gprag_magic_str(p));
 766                                 break;
 767
 768       case iunfolding_pragma:   PUTTAGSTR("PU");
 769                                 ppragma(gprag_unfold_guide(p));
 770                                 pcoresyn(gprag_unfold_core(p));
 771                                 break;
 772
 773       case iunfold_always:      PUTTAGSTR("Px");
 774                                 break;
 775       case iunfold_if_args:     PUTTAGSTR("Py");
 776                                 pid(gprag_unfold_if_t_args(p));
 777                                 pid(gprag_unfold_if_v_args(p));
 778                                 pid(gprag_unfold_if_con_args(p));
 779                                 pid(gprag_unfold_if_size(p));
 780                                 break;
 781
 782       case iname_pragma_pr:     PUTTAGSTR("P1");
 783                                 pid(gprag_name_pr1(p));
 784                                 ppragma(gprag_name_pr2(p));
 785                                 break;
 786       case itype_pragma_pr:     PUTTAGSTR("P2");
 787                                 plist(pttype, gprag_type_pr1(p));
 788                                 pid(gprag_type_pr2(p));
 789                                 ppragma(gprag_type_pr3(p));
 790                                 break;
 791
 792       case idata_pragma_4s:     PUTTAGSTR("P4");
 793                                 plist(pttype, gprag_data_spec(p));
 794                                 break;
 795
 796       default:                  error("Bad Pragma");
 797       }
 798 }
 799 */
 800
 801 static void
 802 pbool(b)
 803   BOOLEAN b;
 804 {
 805     if (b) {
 806       putchar('T');
 807     } else {
 808       putchar('F');
 809     }
 810 }
 811