home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / b / b.lha / B / src / bint / b2dis.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-11-24  |  7.0 KB  |  333 lines
  1. /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
  2.  
  3. /*
  4.   $Header: b2dis.c,v 1.4 85/08/22 16:54:27 timo Exp $
  5. */
  6.  
  7. #include "b.h"
  8. #include "b1obj.h"
  9. #include "b2par.h"
  10. #include "b2nod.h"
  11.  
  12. FILE *d_file;
  13.  
  14. #define Indent    "    "
  15.  
  16. Hidden intlet ilevel= 0;
  17.  
  18. Hidden Procedure set_ilevel() {
  19.     intlet i;
  20.     for (i= 0; i<ilevel; i++) fprintf(d_file, Indent);
  21. }
  22.  
  23. Hidden bool new_line= Yes, in_comment= No;
  24.  
  25. Hidden Procedure put_char(c) char c; {
  26.     if (new_line && !in_comment) set_ilevel();
  27.     putc(c, d_file);
  28.     new_line= No;
  29. }
  30.  
  31. Hidden Procedure put_string(s) string s; {
  32.     if (new_line && !in_comment) set_ilevel();
  33.     fprintf(d_file, "%s", s);
  34.     new_line= No;
  35. }
  36.  
  37. Hidden Procedure put_newline() {
  38.     putc('\n', d_file);
  39.     new_line= Yes;
  40. }
  41.  
  42. #define Putspace    put_char(' ')
  43.  
  44. /* ******************************************************************** */
  45.  
  46. Hidden bool displ_one_line, stop_displ;
  47.  
  48. Visible Procedure display(f, v, one_line) FILE *f; parsetree v; bool one_line; {
  49.     d_file= f;
  50.     ilevel= 0;
  51.     displ_one_line= one_line;
  52.     stop_displ= No;
  53.     new_line= !one_line;
  54.     displ(v);
  55.     if (!new_line) put_newline();
  56. }
  57.  
  58. /* ******************************************************************** */
  59.  
  60. char *text[] = {
  61.     /* HOW_TO */        "HOW'TO #h1:#c2#b34",
  62.     /* YIELD */        "YIELD 2:#c3#b45",
  63.     /* TEST */        "TEST 2:#c3#b45",
  64.     /* REFINEMENT */    "0:#c1#b23",
  65.     /* SUITE */        "1#c23",
  66.  
  67.     /* PUT */        "PUT 0 IN 1",
  68.     /* INSERT */        "INSERT 0 IN 1",
  69.     /* REMOVE */        "REMOVE 0 FROM 1",
  70.     /* CHOOSE */        "CHOOSE 0 FROM 1",
  71.     /* DRAW */        "DRAW 0",
  72.     /* SET_RANDOM */    "SET'RANDOM 0",
  73.     /* DELETE */        "DELETE 0",
  74.     /* CHECK */        "CHECK 0",
  75.     /* SHARE */        "SHARE 0",
  76.  
  77.     /* WRITE */        "WRITE #j",
  78.     /* READ */        "READ 0 EG 1",
  79.     /* READ_RAW */        "READ 0 RAW",
  80.  
  81.     /* IF */        "IF 0:#c1#b2",
  82.     /* WHILE */        "WHILE 0:#c1#b2",
  83.     /* FOR */        "FOR 0 IN 1:#c2#b3",
  84.  
  85.     /* SELECT */        "SELECT:#c0#b1",
  86.     /* TEST_SUITE */    "1#d:#c2#b34",
  87.     /* ELSE */        "ELSE:#c1#b2",
  88.  
  89.     /* QUIT */        "QUIT",
  90.     /* RETURN */        "RETURN 0",
  91.     /* REPORT */        "REPORT 0",
  92.     /* SUCCEED */        "SUCCEED",
  93.     /* FAIL */        "FAIL",
  94.  
  95.     /* USER_COMMAND */    "#h1",
  96.     /* EXTENDED_COMMAND */    "0 ...",
  97.  
  98.     /* TAG */        "0",
  99.     /* COMPOUND */        "(0)",
  100.     /* COLLATERAL */    "#a0",
  101.     /* SELECTION */     "0[1]",
  102.     /* BEHEAD */        "0@1",
  103.     /* CURTAIL */        "0|1",
  104.     /* UNPARSED */        "1",
  105.     /* MONF */        "#l",
  106.     /* DYAF */        "#k",
  107.     /* NUMBER */        "1",
  108.     /* TEXT_DIS */        "#e",
  109.     /* TEXT_LIT */        "#f",
  110.     /* TEXT_CONV */     "`0`1",
  111.     /* ELT_DIS */        "{}",
  112.     /* LIST_DIS */        "{#i0}",
  113.     /* RANGE_DIS */     "{0..1}",
  114.     /* TAB_DIS */        "{#g0}",
  115.     /* AND */        "0 AND 1",
  116.     /* OR */        "0 OR 1",
  117.     /* NOT */        "NOT 0",
  118.     /* SOME_IN */        "SOME 0 IN 1 HAS 2",
  119.     /* EACH_IN */        "EACH 0 IN 1 HAS 2",
  120.     /* NO_IN */        "NO 0 IN 1 HAS 2",
  121.     /* SOME_PARSING */    "SOME 0 PARSING 1 HAS 2",
  122.     /* EACH_PARSING */    "EACH 0 PARSING 1 HAS 2",
  123.     /* NO_PARSING */    "NO 0 PARSING 1 HAS 2",
  124.     /* MONPRD */        "0 1",
  125.     /* DYAPRD */        "0 1 2",
  126.     /* LESS_THAN */     "0 < 1",
  127.     /* AT_MOST */        "0 <= 1",
  128.     /* GREATER_THAN */    "0 > 1",
  129.     /* AT_LEAST */        "0 >= 1",
  130.     /* EQUAL */        "0 = 1",
  131.     /* UNEQUAL */        "0 <> 1",
  132.     /* Nonode */        "",
  133.  
  134.     /* TAGformal */     "0",
  135.     /* TAGlocal */        "0",
  136.     /* TAGglobal */     "0",
  137.     /* TAGmystery */    "0",
  138.     /* TAGrefinement */    "0",
  139.     /* TAGzerfun */     "0",
  140.     /* TAGzerprd */     "0",
  141. };
  142.  
  143. #define Is_digit(d) ((d) >= '0' && (d) <= '9')
  144. #define Fld(v, t) *Branch(v, (*(t) - '0') + First_fieldnr)
  145.  
  146. Hidden Procedure displ(v) value v; {
  147.     if (Is_text(v)) put_string(strval(v));
  148.     else if (Is_parsetree(v)) {
  149.         string t= text[nodetype(v)];
  150.         while (*t) {
  151.             if (Is_digit(*t)) displ(Fld(v, t));
  152.             else if (*t == '#') {
  153.                 special(v, &t);
  154.                 if (stop_displ) return;
  155.             } else put_char(*t);
  156.             t++;
  157.         }
  158.     }
  159. }
  160.  
  161. Hidden Procedure special(v, t) parsetree v; string *t; {
  162.     (*t)++;
  163.     switch (**t) {
  164.         case 'a':       d_collateral(Fld(v, ++*t)); break;
  165.         case 'b':       indent(Fld(v, ++*t)); break;
  166.         case 'c':       d_comment(Fld(v, ++*t)); break;
  167.         case 'd':       /* test suite */
  168.                 (*t)++;
  169.                 if (!new_line) /* there was a command */
  170.                     put_char(**t);
  171.                 break;
  172.         case 'e':       d_textdis(v); break;
  173.         case 'f':       d_textlit(v); break;
  174.         case 'g':       d_tabdis(Fld(v, ++*t)); break;
  175.         case 'h':       d_actfor_compound(Fld(v, ++*t)); break;
  176.         case 'i':       d_listdis(Fld(v, ++*t)); break;
  177.         case 'j':       d_write(v); break;
  178.         case 'k':       d_dyaf(v); break;
  179.         case 'l':       d_monf(v); break;
  180.     }
  181. }
  182.  
  183. Hidden Procedure indent(v) parsetree v; {
  184.     if (displ_one_line) { stop_displ= Yes; return; }
  185.     ilevel++;
  186.     displ(v);
  187.     ilevel--;
  188. }
  189.  
  190. Hidden bool no_space_before_comment(v) value v; {
  191.     value c, t; bool b;
  192.     c= curtail(v, one); t= mk_text("\\");
  193.     b= compare(c, t) == 0;
  194.     release(c); release(t);
  195.     return b;
  196. }
  197.  
  198.  
  199. Hidden Procedure d_comment(v) value v; {
  200.     if ( v != Vnil) {
  201.         in_comment= Yes;
  202.         if (!new_line && no_space_before_comment(v)) Putspace;
  203.         displ(v);
  204.         in_comment= No;
  205.     }
  206.     if (!new_line) put_newline();
  207. }
  208.  
  209. Hidden value quote= Vnil;
  210.  
  211. Hidden Procedure d_textdis(v) parsetree v; {
  212.     value s_quote= quote;
  213.     quote= *Branch(v, XDIS_QUOTE);
  214.     displ(quote);
  215.     displ(*Branch(v, XDIS_NEXT));
  216.     displ(quote);
  217.     quote= s_quote;
  218. }
  219.  
  220. Hidden Procedure d_textlit(v) parsetree v; {
  221.     value w;
  222.     displ(w= *Branch(v, XLIT_TEXT));
  223.     if (character(w)) {
  224.         value c= mk_text("`");
  225.         if (compare(quote, w) == 0 || compare(c, w) == 0) displ(w);
  226.         release(c);
  227.     }
  228.     displ(*Branch(v, XLIT_NEXT));
  229. }
  230.  
  231. Hidden Procedure d_tabdis(v) value v; {
  232.     intlet k, len= Nfields(v);
  233.     k_Over_len {
  234.         if (k>0) put_string("; ");
  235.         put_char('[');
  236.         displ(*Field(v, k));
  237.         put_string("]: ");
  238.         displ(*Field(v, ++k));
  239.     }
  240. }
  241.  
  242. Hidden Procedure d_collateral(v) value v; {
  243.     intlet k, len= Nfields(v);
  244.     k_Over_len {
  245.         if (k>0) put_string(", ");
  246.         displ(*Field(v, k));
  247.     }
  248. }
  249.  
  250. Hidden Procedure d_listdis(v) value v; {
  251.     intlet k, len= Nfields(v);
  252.     k_Over_len {
  253.         if (k>0) put_string("; ");
  254.         displ(*Field(v, k));
  255.     }
  256. }
  257.  
  258. Hidden Procedure d_actfor_compound(v) value v; {
  259.     while (v != Vnil) {
  260.         displ(*Branch(v, ACT_KEYW));
  261.         if (*Branch(v, ACT_EXPR) != Vnil) {
  262.             Putspace;
  263.             displ(*Branch(v, ACT_EXPR));
  264.         }
  265.         v= *Branch(v, ACT_NEXT);
  266.         if (v != Vnil) Putspace;
  267.     }
  268. }
  269.  
  270. Hidden Procedure d_write(v) parsetree v; {
  271.     value l_lines, e, r_lines;
  272.     l_lines= *Branch(v, WRT_L_LINES);
  273.     e= *Branch(v, WRT_EXPR);
  274.     r_lines= *Branch(v, WRT_R_LINES);
  275.     displ(l_lines);
  276.     if (e != NilTree) {
  277.         value n= size(l_lines);
  278.         if (intval(n) > 0) Putspace;
  279.         release(n);
  280.         displ(e);
  281.         n= size(r_lines);
  282.         if (intval(n) > 0) Putspace;
  283.         release(n);
  284.     }
  285.     displ(r_lines);
  286. }
  287.  
  288. Hidden Procedure d_dyaf(v) parsetree v; {
  289.     parsetree l, r; value name;
  290.     l= *Branch(v, DYA_LEFT);
  291.     r= *Branch(v, DYA_RIGHT);
  292.     name= *Branch(v, DYA_NAME);
  293.     displ(l);
  294.     if (is_b_tag(name) || nodetype(r) == MONF) {
  295.         Putspace;
  296.         displ(name);
  297.         Putspace;
  298.     }
  299.     else displ(name);
  300.     displ(r);
  301. }
  302.  
  303. Hidden Procedure d_monf(v) parsetree v; {
  304.     parsetree r; value name;
  305.     name= *Branch(v, MON_NAME);
  306.     r= *Branch(v, MON_RIGHT);
  307.     displ(name);
  308.     if (is_b_tag(name)) {
  309.         switch (nodetype(r)) {
  310.             case MONF:
  311.                 if (!is_b_tag(*Branch(r, MON_NAME))) break;
  312.             case SELECTION:
  313.             case BEHEAD:
  314.             case CURTAIL:
  315.             case TAG:
  316.             case TAGformal:
  317.             case TAGlocal:
  318.             case TAGglobal:
  319.             case TAGmystery:
  320.             case TAGrefinement:
  321.             case TAGzerfun:
  322.             case TAGzerprd:
  323.             case NUMBER:
  324.             case TEXT_DIS:
  325.                 Putspace;
  326.                 break;
  327.             default:
  328.                 break;
  329.         }
  330.     }
  331.     displ(r);
  332. }
  333.