home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.pdx.edu / 2014.02.ftp.ee.pdx.edu.tar / ftp.ee.pdx.edu / pub / users / Harry / compilers / yapp / yapp.pcat < prev   
Text File  |  2003-05-23  |  56KB  |  2,110 lines
  1. (* YAPP - Yet Another PCAT Parser - An SLR parser generator
  2. **
  3. ** Harry Porter - 10/30/98
  4. **
  5. ** Overview
  6. **
  7. ** This program reads from the input two things.  First it reads in a
  8. ** context-free grammar, then it reads in an input string.  From the
  9. ** grammar it builds LR parsing tables and then it uses those parsing tables
  10. ** to parse the string.  It uses the SLR algorithm to construct the tables.
  11. **
  12. ** Input
  13. **
  14. ** The form of the input is somewhat encoded, due to PCAT's lack of ability
  15. ** to handle string and character data.  The input consists of a series of
  16. ** integer numbers.  Each grammar symbol (terminals and non-terminals) is
  17. ** assigned a number (from 1,2,3,...).  Consider the following assignment:
  18. **
  19. **    1  E
  20. **    2  T
  21. **    3  F
  22. **    4  (
  23. **    5  )
  24. **    6  +
  25. **    7  *
  26. **    8  id
  27. **    9  EOF
  28. **
  29. ** The non-terminals do not have to follow the terminals, although they
  30. ** happen to in this example.
  31. **
  32. ** The first number in the input is the number of the EOF symbol.
  33. **
  34. ** After that the rules are listed.  Each rule is given as the lefthand-side
  35. ** symbol, followed by zero or more righthand-sied symbols, followed by a
  36. ** zero to mark the end of the rule.
  37. **
  38. ** For example, the rule:
  39. **     F --> ( E )
  40. ** would be encoded as:
  41. **     3 4 1 5 0
  42. **
  43. ** The rule:
  44. **     F --> <epsilon>
  45. ** would be encoded as:
  46. **     3 0
  47. **
  48. ** Finally, to mark the end of the grammar, there is an additional 0.
  49. ** Normally, each rule would be on a different line, but this is only
  50. ** to make the grammar more readable by humans.
  51. ** 
  52. ** Any symbol that appears on the lefthad-side (LHS) of any rule is assumed
  53. ** to be a non-terminal; all other symbols are assumed to be terminals.
  54. ** 
  55. ** Next comes the input string to be parsed.  It may contain embedded
  56. ** negative numbers, which will be ignored during the parse.  These negative
  57. ** numbers are considered "line numbers" and will be printed out if a syntax
  58. ** error occurs.  The last symbol should be the EOF symbol.
  59. **
  60. ** For example, the following input (in human readable form):
  61. **
  62. **     EOF = 9
  63. **
  64. **     E --> E + T
  65. **     E --> T
  66. **     T --> T * F
  67. **     T --> F
  68. **     F --> ( E )
  69. **     F --> id
  70. **
  71. **     1:    ( id +
  72. **     2:    (id * id + id * id) *
  73. **     3:    (id + id * id) +
  74. **     4:    id )
  75. **
  76. ** would be encoded as:
  77. **
  78. **     9
  79. **     1 1 6 2 0
  80. **     1 2 0
  81. **     2 2 7 3 0
  82. **     2 3 0
  83. **     3 4 1 5 0
  84. **     3 8 0
  85. **     0
  86. **     -1 4 8 6
  87. **     -2 4 8 7 8 6 8 7 8 5 7
  88. **     -3 4 8 6 8 7 8 5 6
  89. **     -4 8 5 
  90. **     9
  91. **
  92. ** Of course, all these numbers could be placed on a single line.  This would
  93. ** be acceptable, but even harder for humans to read.
  94. **
  95. ** To make life easier, there is a C program called "pre" which takes input
  96. ** in human readable form and, using a lexical analyser, produces a file
  97. ** in the PCAT-readable form shown above.  The "pre" program expects its
  98. ** input to look like this:
  99. **
  100. **     E = E + T
  101. **     E = T
  102. **     T = T * F
  103. **     T = F
  104. **     F = ( E )
  105. **     F = id
  106. **
  107. **     ( x +
  108. **     (x * x + x * x) *
  109. **     (x + x * x) +
  110. **     x )
  111. **    
  112. ** Note that the equals sign is used in grammar rules; that there is at least
  113. ** one blank line between the grammar rules and the input; and that the EOF
  114. ** value is inserted automatically.
  115. **
  116. ** PCAT has a minimal ability to deal with character data.  In particular,
  117. ** it always adds a new-line after every WRITE statement.  To avoid this
  118. ** problem, the output from this program is passed through a post-processor
  119. ** called "post".  This C program eliminates all new-line characters and
  120. ** replaces all dollar characters ($) with a new-line.  Thus, when the PCAT
  121. ** program executes the following, it will all appear on one line after being
  122. ** run through "post".
  123. **
  124. **     WRITE ("i = ", i, "...");
  125. **     WRITE ("x = ", x, "...");
  126. **     WRITE ("$");
  127. **
  128. ** There is a shell script called "go" which may be used to run the YAPP
  129. ** program.  It can be run with the command line:
  130. **
  131. **     go grammar-file source-file
  132. **
  133. ** "Go" concatenates the grammar-file and the source-file and then feeds them
  134. ** first to "pre", then to "yapp".  Note that the grammar file must include
  135. ** a blank line at its end.  "Go" then runs the output through "post".
  136. **
  137. ** There are several constants that may need to be changed when larger
  138. ** grammars are processed.  They are:
  139. **
  140. **    MaxRuleListIndex      199    Max # rules is this + 1
  141. **    MAXSYMBOL             299    Legal symbols are 0 .. MAXSYMBOL
  142. **    MaxStackIndex        9999 
  143. **    MaxBufferIndex         99    Index ranges 0..MaxBufferIndex
  144. **    MaxColumns             10    Max number of table columns to print out.
  145. **
  146. ** The maximum number of rules that can be accomodated in the input
  147. ** grammar is governed by MaxRuleListIndex.  The maximum symbol value is
  148. ** governed by MAXSYMBOL.  The size of the stack used during the parsing
  149. ** phase is determined by MaxStackIndex.  The maximum number of symbols
  150. ** that may appear on the righthand-side of any rule is governed by
  151. ** MaxBufferIndex.  The values given are big enough to handle a grammar
  152. ** for the PCAT language (except for MaxColumns).
  153. **
  154. ** Symbols
  155. **
  156. ** Within this program, all symbols are named with numbers.  As the grammar
  157. ** is read in, these numbers are encountered.  These numbers may be anything
  158. ** as long as they fall within 0..MAXSYMBOL.  However, to make the printing
  159. ** of symbols clearer, there is a link between the "pre" program and "YAPP".
  160. ** In the printSymbol2() routine, each number is printed using a different
  161. ** string of characters.  The "pre" program recognizes a number of identifiers
  162. ** as keywords and prints the corresponfing number.  These numerical values
  163. ** are given in "lexer.h".
  164. **
  165. ** Output
  166. **
  167. ** YAPP contains a number of different output routines.  In general, it will
  168. ** begin by reading in the grammar, echoing as it is read in.  Then, it will
  169. ** print a listing of all symbols that were encountered in the grammar.
  170. ** Then, it will print out the grammar rules, as they have been stored.
  171. ** Then, it will compute the parse tables, printing out a trace of the
  172. ** DFA to recognize valid prefixes.  Finally, it will process the input
  173. ** source and attempt to parse it using the tables, printing a trace of the
  174. ** shifts and reduces as it goes.
  175. **
  176. ** If any errors arise, a message will be printed.  Unfortunately, it is
  177. ** not possible to execute an "abort" within PCAT; therefore YAPP will
  178. ** continue running after many errors arise.  For certain errors, YAPP may
  179. ** subsequently become confused (i.e., after printing out an error message).
  180. **
  181. ** Shift/Reduce and Reduce/Reduce Errors.
  182. **
  183. ** For some grammars, the SLR algorithm is not powerful enough to construct
  184. ** a parsing table (although perhaps the general LR(1) algorithm would have
  185. ** found one).  In such cases, a conflict arises when filling in entries of
  186. ** the table and an error is printed.
  187. **
  188. ** Parsing Output
  189. **
  190. ** During the parsing phase, a trace is produced showing the sequence of shifts
  191. ** and reduces.  For reduces, the rule used is printed.  These rules form
  192. ** a rightmost derivation, in reverse order.  The parsing terminates with
  193. ** either a message reporting success of reporting a syntax error.  In the
  194. ** case of a syntax error, the line number is also reported.
  195. *)
  196. program is
  197.  
  198. type IntArray is array of integer;
  199.      ItemArray is array of Item;
  200.      SymbolSetArray is array of SymbolSet;
  201.      EntryArray is array of Entry;
  202.      EntryArrayArray is array of EntryArray;
  203.      ItemSetArray is array of ItemSet;
  204.  
  205. type Item is
  206.   record
  207.     ruleNumber: integer;
  208.     lhs: integer;
  209.     rhsSize: integer;
  210.     rhs: IntArray;
  211.     dotPos: integer;
  212.   end;
  213.  
  214. type ItemSet is
  215.   record
  216.     size: integer;
  217.     firstItem: ItemSetRecord;
  218.     hashValue: integer;
  219.   end;
  220.  
  221. type ItemSetRecord is
  222.   record
  223.     item: Item;
  224.     next: ItemSetRecord;
  225.   end;
  226.  
  227. type SymbolSet is
  228.   record
  229.     firstSymbol: SymbolSetRecord;
  230.   end;
  231.  
  232. type SymbolSetRecord is
  233.   record
  234.     symbol: integer;
  235.     next: SymbolSetRecord;
  236.   end;
  237.  
  238. var ruleList: ItemArray := nil;       (* These are the grammar rules *)
  239.     nextRuleListIndex: integer := 0;  (* This is also = number of rules *)
  240.     MaxRuleListIndex: integer := 199; (* Max # rules is this + 1 *)
  241.  
  242.     MAXSYMBOL: integer := 299;        (* Legal symbols are 0 .. MAXSYMBOL *)
  243.                                       (* Symbol 0 is the dummy start symbol *)
  244.     MaxSymbol: integer := -1;         (* Largest symbol actually used *)
  245.     symbolStatus: IntArray := nil;    (* 1=term, 2=nonterm, 0=not a symbol *)
  246.  
  247.     EOFSYMBOL: integer := 0;          (* initialized from input *)
  248.  
  249.     symbolSetsChanged: boolean := false;
  250.     firstSets: SymbolSetArray := nil;
  251.     followSets: SymbolSetArray := nil;
  252.     actionTable: EntryArrayArray := nil;
  253.     MaxState: integer := 599;         (* States are numbered 0..MaxState *)
  254.     collection: ItemSetArray := nil;  (* Canonical collection of LR items *)
  255.     nextState: integer := -1;         (* next element to use in collection *)
  256.     eofEncountered: boolean := false; (* Used only in getToken *)
  257.     currentLine: integer := 0;
  258.  
  259. type Entry is                (* Each element of the action table is an Entry *)
  260.   record
  261.     typ: integer;
  262.     number: integer;
  263.   end;
  264.  
  265. var SHIFT  := 1;             (* These are the values for the "typ" field *)
  266.     REDUCE := 2;
  267.     ACCEPT := 3;
  268.     BLANK  := 4;
  269.     GOTO   := 5;
  270.  
  271. (* We need to buffer input tokens when reading in the RHS of a rule. *)
  272. var MaxBufferIndex := 99;    (* The index ranges from 0..MaxBufferIndex. *)
  273.     nextBufferIndex: integer := 0;
  274.     buffer: IntArray := IntArray [< MaxBufferIndex+1 of 0 >];
  275.  
  276. (* This stack will be used by the LR algorithm when we parse the input. *)
  277. var stack: IntArray := nil;
  278.     stackTop: integer := 0;
  279.     MaxStackIndex: integer := 9999;
  280.  
  281. var MaxColumns: integer := 13;
  282.  
  283.  
  284.  
  285. (* printSymbol (sym)
  286. **
  287. ** This routine is passed a symbol; it prints the corresponding string.
  288. *)
  289. procedure printSymbol (sym: integer) is
  290.   var t: integer := 0;
  291.   begin
  292.     t := printSymbol2 (sym);
  293.     return;
  294.   end;
  295.  
  296.  
  297.  
  298. (* printSymbol2 (sym)
  299. **
  300. ** This routine prints the symbol in human readable form and returns the
  301. ** number of characters printed.
  302. *)
  303. procedure printSymbol2 (sym: integer) : integer is
  304.   begin
  305.     if sym = 0 then
  306.       write ("S'");
  307.       return 2;
  308.     elseif sym = 1 then
  309.       write ("E");
  310.       return 1;
  311.     elseif sym = 2 then
  312.       write ("T");
  313.       return 1;
  314.     elseif sym = 3 then
  315.       write ("F");
  316.       return 1;
  317.     elseif sym = 4 then
  318.       write ("(");
  319.       return 1;
  320.     elseif sym = 5 then
  321.       write (")");
  322.       return 1;
  323.     elseif sym = 6 then
  324.       write ("+");
  325.       return 1;
  326.     elseif sym = 7 then
  327.       write ("*");
  328.       return 1;
  329.     elseif sym = 8 then
  330.       write ("id");
  331.       return 2;
  332.     elseif sym = 9 then
  333.       write ("EOF");
  334.       return 3;
  335.     elseif sym = 10 then
  336.       write ("E'");
  337.       return 2;
  338.     elseif sym = 11 then
  339.       write ("T'");
  340.       return 2;
  341.     elseif sym = 12 then
  342.       write ("stmt");
  343.       return 4;
  344.     elseif sym = 13 then
  345.       write ("varDecl");
  346.       return 7;
  347.     elseif sym = 14 then
  348.       write ("typeDecl");
  349.       return 8;
  350.     elseif sym = 15 then
  351.       write ("procDecl");
  352.       return 8;
  353.     elseif sym = 16 then
  354.       write ("idList");
  355.       return 6;
  356.     elseif sym = 17 then
  357.       write ("optionalType");
  358.       return 12;
  359.     elseif sym = 18 then
  360.       write ("expr");
  361.       return 4;
  362.     elseif sym = 19 then
  363.       write ("type");
  364.       return 4;
  365.     elseif sym = 20 then
  366.       write ("components");
  367.       return 10;
  368.     elseif sym = 21 then
  369.       write ("component");
  370.       return 9;
  371.     elseif sym = 22 then
  372.       write ("formalParams");
  373.       return 12;
  374.     elseif sym = 23 then
  375.       write ("fpSections");
  376.       return 10;
  377.     elseif sym = 24 then
  378.       write ("fpSection");
  379.       return 9;
  380.     elseif sym = 25 then
  381.       write ("lValues");
  382.       return 7;
  383.     elseif sym = 26 then
  384.       write ("lValue");
  385.       return 6;
  386.     elseif sym = 27 then
  387.       write ("actualParams");
  388.       return 12;
  389.     elseif sym = 28 then
  390.       write ("actuals");
  391.       return 7;
  392.     elseif sym = 29 then
  393.       write ("writeParams");
  394.       return 11;
  395.     elseif sym = 30 then
  396.       write ("writeExprs");
  397.       return 10;
  398.     elseif sym = 31 then
  399.       write ("writeExpr");
  400.       return 9;
  401.     elseif sym = 32 then
  402.       write ("elseIfs");
  403.       return 7;
  404.     elseif sym = 33 then
  405.       write ("optionalElse");
  406.       return 12;
  407.     elseif sym = 34 then
  408.       write ("optionalBy");
  409.       return 10;
  410.     elseif sym = 35 then
  411.       write ("optionalExpr");
  412.       return 12;
  413.     elseif sym = 36 then
  414.       write ("unaryOp");
  415.       return 7;
  416.     elseif sym = 37 then
  417.       write ("binaryOp2");
  418.       return 9;
  419.     elseif sym = 38 then
  420.       write ("compValues");
  421.       return 10;
  422.     elseif sym = 39 then
  423.       write ("moreCompValues");
  424.       return 14;
  425.  
  426.     elseif sym = 97 then
  427.       write ("arrayValues");
  428.       return 11;
  429.     elseif sym = 98 then
  430.       write ("moreArrayValues");
  431.       return 15;
  432.     elseif sym = 99 then
  433.       write ("optionalExpr");
  434.       return 12;
  435.     elseif sym = 100 then
  436.       write ("moreExpr2");
  437.       return 9;
  438.     elseif sym = 101 then
  439.       write ("moreExpr3");
  440.       return 9;
  441.     elseif sym = 102 then
  442.       write ("moreExpr4");
  443.       return 9;
  444.     elseif sym = 103 then
  445.       write ("binaryOp3");
  446.       return 9;
  447.     elseif sym = 104 then
  448.       write ("binaryOp4");
  449.       return 9;
  450.     elseif sym = 105 then
  451.       write ("expr2");
  452.       return 5;
  453.     elseif sym = 106 then
  454.       write ("expr3");
  455.       return 5;
  456.     elseif sym = 107 then
  457.       write ("expr4");
  458.       return 5;
  459.     elseif sym = 108 then
  460.       write ("expr5");
  461.       return 5;
  462.     elseif sym = 109 then
  463.       write ("prog");
  464.       return 7;
  465.     elseif sym = 110 then
  466.       write ("body");
  467.       return 4;
  468.     elseif sym = 111 then
  469.       write ("decls");
  470.       return 5;
  471.     elseif sym = 112 then
  472.       write ("stmts");
  473.       return 5;
  474.     elseif sym = 113 then
  475.       write ("varDecls");
  476.       return 8;
  477.     elseif sym = 114 then
  478.       write ("typeDecls");
  479.       return 9;
  480.     elseif sym = 115 then
  481.       write ("procDecls");
  482.       return 9;
  483.     elseif sym = 116 then
  484.       write ("decl");
  485.       return 4;
  486.     elseif sym = 117 then
  487.       write ("bexpr");
  488.       return 5;
  489.     elseif sym = 118 then
  490.       write ("bterm");
  491.       return 5;
  492.     elseif sym = 119 then
  493.       write ("bfactr");
  494.       return 6;
  495.     elseif sym = 120 then
  496.       write ("true");
  497.       return 4;
  498.     elseif sym = 121 then
  499.       write ("false");
  500.       return 5;
  501.     elseif sym = 65 then
  502.       write ("A");
  503.       return 1;
  504.     elseif sym = 66 then
  505.       write ("a");
  506.       return 1;
  507.     elseif sym = 67 then
  508.       write ("b");
  509.       return 1;
  510.     elseif sym = 68 then
  511.       write ("S");
  512.       return 1;
  513.  
  514.     elseif sym = 43 then
  515.       write ("+");
  516.       return 1;
  517.     elseif sym = 45 then
  518.       write ("-");
  519.       return 1;
  520.     elseif sym = 42 then
  521.       write ("*");
  522.       return 1;
  523.     elseif sym = 47 then
  524.       write ("/");
  525.       return 1;
  526.     elseif sym = 60 then
  527.       write ("<");
  528.       return 1;
  529.     elseif sym = 62 then
  530.       write (">");
  531.       return 1;
  532.     elseif sym = 61 then
  533.       write ("=");
  534.       return 1;
  535.     elseif sym = 58 then
  536.       write (":");
  537.       return 1;
  538.     elseif sym = 59 then
  539.       write (";");
  540.       return 1;
  541.     elseif sym = 44 then
  542.       write (",");
  543.       return 1;
  544.     elseif sym = 46 then
  545.       write (".");
  546.       return 1;
  547.     elseif sym = 40 then
  548.       write ("(");
  549.       return 1;
  550.     elseif sym = 41 then
  551.       write (")");
  552.       return 1;
  553.     elseif sym = 91 then
  554.       write ("[");
  555.       return 1;
  556.     elseif sym = 93 then
  557.       write ("]");
  558.       return 1;
  559.     elseif sym = 123 then
  560.       write ("{");
  561.       return 1;
  562.     elseif sym = 125 then
  563.       write ("}");
  564.       return 1;
  565.  
  566.     elseif sym = 257 then
  567.       write ("ID");
  568.       return 2;
  569.     elseif sym = 258 then
  570.       write ("INTEGER");
  571.       return 7;
  572.     elseif sym = 259 then
  573.       write ("REAL");
  574.       return 4;
  575.     elseif sym = 260 then
  576.       write ("STRING");
  577.       return 6;
  578.     elseif sym = 261 then
  579.       write (":=");
  580.       return 2;
  581.     elseif sym = 262 then
  582.       write ("<=");
  583.       return 2;
  584.     elseif sym = 263 then
  585.       write (">=");
  586.       return 2;
  587.     elseif sym = 264 then
  588.       write ("<>");
  589.       return 2;
  590.     elseif sym = 265 then
  591.       write ("[<");
  592.       return 2;
  593.     elseif sym = 266 then
  594.       write (">]");
  595.       return 2;
  596.     elseif sym = 267 then
  597.       write ("AND");
  598.       return 3;
  599.     elseif sym = 268 then
  600.       write ("ARRAY");
  601.       return 5;
  602.     elseif sym = 269 then
  603.       write ("BEGIN");
  604.       return 5;
  605.     elseif sym = 270 then
  606.       write ("BY");
  607.       return 2;
  608.     elseif sym = 271 then
  609.       write ("DIV");
  610.       return 3;
  611.     elseif sym = 272 then
  612.       write ("DO");
  613.       return 2;
  614.     elseif sym = 273 then
  615.       write ("ELSE");
  616.       return 4;
  617.     elseif sym = 274 then
  618.       write ("ELSIF");
  619.       return 5;
  620.     elseif sym = 275 then
  621.       write ("END");
  622.       return 3;
  623.     elseif sym = 276 then
  624.       write ("EXIT");
  625.       return 4;
  626.     elseif sym = 277 then
  627.       write ("FOR");
  628.       return 3;
  629.     elseif sym = 278 then
  630.       write ("IF");
  631.       return 2;
  632.     elseif sym = 279 then
  633.       write ("IS");
  634.       return 2;
  635.     elseif sym = 280 then
  636.       write ("LOOP");
  637.       return 4;
  638.     elseif sym = 281 then
  639.       write ("MOD");
  640.       return 3;
  641.     elseif sym = 282 then
  642.       write ("NOT");
  643.       return 3;
  644.     elseif sym = 283 then
  645.       write ("OF");
  646.       return 2;
  647.     elseif sym = 284 then
  648.       write ("OR");
  649.       return 2;
  650.     elseif sym = 285 then
  651.       write ("PROCEDURE");
  652.       return 9;
  653.     elseif sym = 286 then
  654.       write ("PROGRAM");
  655.       return 7;
  656.     elseif sym = 287 then
  657.       write ("READ");
  658.       return 4;
  659.     elseif sym = 288 then
  660.       write ("RECORD");
  661.       return 6;
  662.     elseif sym = 289 then
  663.       write ("RETURN");
  664.       return 6;
  665.     elseif sym = 290 then
  666.       write ("THEN");
  667.       return 4;
  668.     elseif sym = 291 then
  669.       write ("TO");
  670.       return 2;
  671.     elseif sym = 292 then
  672.       write ("TYPE");
  673.       return 4;
  674.     elseif sym = 293 then
  675.       write ("VAR");
  676.       return 3;
  677.     elseif sym = 294 then
  678.       write ("WHILE");
  679.       return 5;
  680.     elseif sym = 295 then
  681.       write ("WRITE");
  682.       return 5;
  683.  
  684.     elseif sym = 296 then
  685.       write ("EOF");
  686.       return 3;
  687.     else
  688.       write ("???");
  689.       return 3;
  690.     end;
  691.   end;
  692.  
  693.  
  694.  
  695. (* printSymbolPaddingTo (sym, len)
  696. **
  697. ** Prints the symbol followed by as many spaces as necessary to print a
  698. ** total of len characters.  If len is 0, no blanks are printed.
  699. *)
  700. printSymbolPaddingTo (sym, len: integer) is
  701.   var i: integer := len;
  702.   begin
  703.     len := len - printSymbol2 (sym);
  704.     for i := 1 to len do
  705.       write (" ");
  706.     end;
  707.     return;
  708.   end;
  709.  
  710.  
  711.  
  712. (* isTerminal (sym)
  713. **
  714. ** Returns TRUE if this symbol is a terminal.
  715. *)
  716. procedure isTerminal (sym: integer) : boolean is
  717.   begin
  718.     return symbolStatus [sym] = 1;
  719.   end;
  720.  
  721.  
  722.  
  723. (* isNonTerminal (sym)
  724. **
  725. ** Returns TRUE if this symbol is a non-terminal.
  726. *)
  727. procedure isNonTerminal (sym: integer) : boolean is
  728.   begin
  729.     return symbolStatus [sym] = 2;
  730.   end;
  731.  
  732.  
  733.  
  734. (* isSymbol (sym)
  735. **
  736. ** Returns TRUE if this symbol is a terminal or a non-terminal.
  737. *)
  738. procedure isSymbol (sym: integer) : boolean is
  739.   begin
  740.     return symbolStatus [sym] > 0;
  741.   end;
  742.  
  743.  
  744.  
  745. (* printAllSymbols ()
  746. **
  747. ** This routine prints a list of all terminals and non-terminals.
  748. *)
  749. procedure printAllSymbols () is
  750.   var i: integer := 0;
  751.   begin
  752.     write ("MaxSymbol = ", MaxSymbol, "$");
  753.     write ("Symbol   Terminals:    Non-Terminals:$");
  754.     for i := 0 to MaxSymbol do
  755.       if isNonTerminal (i) then
  756.         write ("  ");
  757.         printNumberPaddingTo (i, 21);
  758.         printSymbol (i);
  759.         write ("$");
  760.       elseif isTerminal (i) then
  761.         write ("  ");
  762.         printNumberPaddingTo (i, 7);
  763.         printSymbol (i);
  764.         write ("$");
  765.       else
  766.         (*  WRITE ("  ", i, "$");  *)
  767.       end;
  768.     end;
  769.     return;
  770.   end;
  771.  
  772.  
  773.  
  774. (* copyItem (item)
  775. **
  776. ** This routine makes a new item exactly like the argument and returns it.
  777. *)
  778. procedure copyItem (item: Item) : Item is
  779.   begin
  780.     return Item { ruleNumber := item.ruleNumber;
  781.                   lhs := item.lhs;
  782.                   rhsSize := item.rhsSize;
  783.                   rhs := item.rhs;
  784.                   dotPos := item.dotPos } ;
  785.   end;
  786.  
  787.  
  788.  
  789. (* printItem (item)
  790. **
  791. ** This routine is passed an item, which it prints, followed by newline.
  792. *)
  793. procedure printItem (item: Item) is
  794.   var i: integer := 0;
  795.       printedDot: boolean := false;
  796. begin
  797.   write (item.ruleNumber, ":  ");
  798.   printSymbolPaddingTo (item.lhs, 0);
  799.   write (" --> ");
  800.   if item.dotPos = 0 then
  801.     printedDot := true;
  802.     write (". ");
  803.   end;
  804.   for i := 0 to item.rhsSize-1 do
  805.     printSymbolPaddingTo (item.rhs[i], 0);
  806.     write (" ");
  807.     if item.dotPos = i+1 then
  808.       printedDot := true;
  809.       write (". ");
  810.     end;
  811.   end;
  812.   write ("$");
  813.   if not ((item.dotPos = -1) or printedDot) then
  814.     write ("$*****  Error: dotPos = ", item.dotPos, "  *****$$");
  815.   end;
  816.   return;
  817. end;
  818.  
  819.  
  820.  
  821. (* itemsEqual (item1, item2)
  822. **
  823. ** Returns TRUE iff these two items are equivalent.  Two items are
  824. ** equivalent if the use the same rules and the dot is in the same position.
  825. *)
  826. procedure itemsEqual (item1, item2: Item) : boolean is
  827.   begin
  828.     if (item1.ruleNumber = item2.ruleNumber) and
  829.        (item1.dotPos = item2.dotPos) then
  830.       return true;
  831.     else
  832.       return false;
  833.     end;
  834.   end;
  835.  
  836.  
  837.  
  838. (* clearBuffer ()
  839. **
  840. ** This routine resets nextBufferIndex to effectively empty the buffer.
  841. *)
  842. procedure clearBuffer () is
  843.   begin
  844.     nextBufferIndex := 0;
  845.     return;
  846.   end;
  847.  
  848.  
  849.  
  850. (* addToBuffer (i)
  851. **
  852. ** This routine adds i to the buffer, printing a message if overflow.
  853. *)
  854. procedure addToBuffer (i: integer) is
  855.   begin
  856.     if nextBufferIndex > MaxBufferIndex then
  857.       write ("$*****  MaxBufferIndex exceeded  ******$$");
  858.     else
  859.       buffer [ nextBufferIndex ] := i;
  860.       nextBufferIndex := nextBufferIndex + 1;
  861.     end;
  862.     return;
  863.   end;
  864.  
  865.  
  866.  
  867. (* bufferSize ()
  868. **
  869. ** This routine returns the number of symbols in the buffer.
  870. *)
  871. procedure bufferSize () : integer is
  872.   begin
  873.     return nextBufferIndex;
  874.   end;
  875.  
  876.  
  877.  
  878. (* newSymbolSet ()
  879. **
  880. ** This routine returns a new empty set of symbols.
  881. *)
  882. procedure newSymbolSet () : SymbolSet is
  883.   begin
  884.     return SymbolSet { firstSymbol := nil };
  885.   end;
  886.  
  887.  
  888.  
  889. (* addToSymbolSet (symbolSet, symbol)
  890. **
  891. ** This routine adds an symbol to the symbol set.
  892. *)
  893. procedure addToSymbolSet (symbolSet: SymbolSet; symbol: integer) is
  894.   var r: SymbolSetRecord := nil;
  895.   begin
  896.     if not symbolSetContains (symbolSet, symbol) then
  897.       r := SymbolSetRecord { symbol := symbol;
  898.                              next := symbolSet.firstSymbol };
  899.       symbolSet.firstSymbol := r;
  900.       symbolSetsChanged := true;
  901.     end;
  902.     return;
  903.   end;
  904.  
  905.  
  906.  
  907. (* addAllSymbolsToSet (set1, set2)
  908. **
  909. ** This routine add symbols in set1 to set2.
  910. *)
  911. procedure addAllSymbolsToSet (set1, set2: SymbolSet) is
  912.   var next: SymbolSetRecord := nil;
  913.   begin
  914.     next := set1.firstSymbol;
  915.     while next <> nil do
  916.       addToSymbolSet (set2, next.symbol);
  917.       next := next.next;
  918.     end;
  919.     return;
  920.   end;
  921.  
  922.  
  923.  
  924. (* addAllSymbolsButEofToSet (set1, set2)
  925. **
  926. ** This routine add all non-EOF symbols in set1 to set.
  927. *)
  928. procedure addAllSymbolsButEofToSet (set1, set2: SymbolSet) is
  929.   var next: SymbolSetRecord := nil;
  930.   begin
  931.     next := set1.firstSymbol;
  932.     while next <> nil do
  933.       if next.symbol <> EOFSYMBOL then
  934.         addToSymbolSet (set2, next.symbol);
  935.       end;
  936.       next := next.next;
  937.     end;
  938.     return;
  939.   end;
  940.  
  941.  
  942.  
  943. (* symbolSetContains (symbolSet, symbol)
  944. **
  945. ** This routine returns TRUE iff this set contains the given symbol.
  946. *)
  947. procedure symbolSetContains (symbolSet: SymbolSet; symbol: integer) : boolean is
  948.   var r: SymbolSetRecord := nil;
  949.   begin
  950.     r := symbolSet.firstSymbol;
  951.     while r <> nil do
  952.       if r.symbol = symbol then
  953.         return true;
  954.       end;
  955.       r := r.next;
  956.     end;
  957.     return false;
  958.   end;
  959.  
  960.  
  961.  
  962. (* printSymbolSet (symbolSet)
  963. **
  964. ** This routine prints all the symbols in this set, followed by a newline.
  965. *)
  966. procedure printSymbolSet (symbolSet: SymbolSet) is
  967.   var r: SymbolSetRecord := nil;
  968.   begin
  969.     write ("{ ");
  970.     r := symbolSet.firstSymbol;
  971.     while r <> nil do
  972.       printSymbol (r.symbol);
  973.       write (" ");
  974.       r := r.next;
  975.     end;
  976.     write ("}$");
  977.     return;
  978.   end;
  979.  
  980.  
  981.  
  982. (* initializeFirstSets ()
  983. **
  984. ** This routine initializes the FIRST sets for all terminal and non-terminal
  985. ** symbols.
  986. *)
  987. procedure initializeFirstSets () is
  988.   var i, j: integer := 0;
  989.       rule: Item := nil;
  990.       firstKNotContainingEpsilon: integer := 0;
  991.   begin
  992.     firstSets := SymbolSetArray [< MaxSymbol + 1 of nil >];
  993.     for i := 0 to MaxSymbol do
  994.       firstSets [i] := newSymbolSet ();
  995.       if isTerminal (i) then
  996.         addToSymbolSet (firstSets [i], i);
  997.       end;
  998.     end;
  999.     symbolSetsChanged := true;
  1000.     while symbolSetsChanged do
  1001.       symbolSetsChanged := false;
  1002.       for i := 0 to nextRuleListIndex - 1 do
  1003.         rule := ruleList [i];
  1004.         (*  WRITE ("Looking at rule ");  *)
  1005.         (*  printItem (rule);  *)
  1006.         if rule.rhsSize = 0 then
  1007.           addToSymbolSet ( firstSets [rule.lhs], EOFSYMBOL);
  1008.         else
  1009.           firstKNotContainingEpsilon := -1;
  1010.           for j := 0 to rule.rhsSize - 1 do
  1011.             (*  WRITE ("  Examining firstSets [ ");  *)
  1012.             (*  printSymbol (rule.rhs [j]);  *)
  1013.             (*  WRITE (" ] = ");  *)
  1014.             (*  printSymbolSet (firstSets [rule.rhs [j]]);  *)
  1015.             if symbolSetContains (firstSets [rule.rhs [j]], EOFSYMBOL) then
  1016.               (*  WRITE ("    contains epsilon$");  *)
  1017.             else
  1018.               (*  WRITE ("    does not contain epsilon$");  *)
  1019.               firstKNotContainingEpsilon := j;
  1020.               exit;
  1021.             end;
  1022.           end;
  1023.           (*  WRITE ("firstKNotContainingEpsilon = ",  *)
  1024.           (*          firstKNotContainingEpsilon, "$");  *)
  1025.           for j := 0 to rule.rhsSize - 1 do
  1026.             if firstKNotContainingEpsilon >= j then
  1027.               addAllSymbolsButEofToSet ( firstSets [rule.rhs [j]],
  1028.                                          firstSets [rule.lhs]);
  1029.             else
  1030.               exit;
  1031.             end;
  1032.           end;
  1033.           if firstKNotContainingEpsilon = -1 then
  1034.             addToSymbolSet ( firstSets [rule.lhs], EOFSYMBOL);
  1035.           end;
  1036.         end;
  1037.       end;
  1038.     end;
  1039.     return;
  1040.   end;
  1041.  
  1042.  
  1043.  
  1044. (* initializeFollowSets ()
  1045. **
  1046. ** This routine initializes the FOLLOW sets for all non-terminal
  1047. ** symbols.
  1048. *)
  1049. procedure initializeFollowSets () is
  1050.   var i, j, k: integer := 0;
  1051.       A, B, C: integer := 0;
  1052.       rule: Item := nil;
  1053.       firstOfBeta: SymbolSet := nil;
  1054.       saveSymbolSetsChanged: boolean := false;
  1055.       oneHadNoEpsilon: boolean := false;
  1056.   begin
  1057.     followSets := SymbolSetArray [< MaxSymbol + 1 of nil >];
  1058.     for i := 0 to MaxSymbol do
  1059.       if isNonTerminal (i) then
  1060.         followSets [i] := newSymbolSet ();
  1061.       end;
  1062.     end;
  1063.     addToSymbolSet (followSets [0], EOFSYMBOL);
  1064.     symbolSetsChanged := true;
  1065.     while symbolSetsChanged do
  1066.       symbolSetsChanged := false;
  1067.       for i := 0 to nextRuleListIndex - 1 do
  1068.         rule := ruleList [i];
  1069.         A := rule.lhs;
  1070.         (*  WRITE ("Looking at rule ");  *)
  1071.         (*  printItem (rule);  *)
  1072.         (*  WRITE ("  A = "); printSymbol (A); WRITE ("$");  *)
  1073.         if (rule.rhsSize > 0) and
  1074.            isNonTerminal (rule.rhs [rule.rhsSize-1]) then
  1075.           B := rule.rhs [rule.rhsSize-1];
  1076.           (*  WRITE ("  Last symbol is nonterminal, B = ");  *)
  1077.           (*  printSymbol (B); WRITE ("$");  *)
  1078.           (*  WRITE ("  FOLLOW("); printSymbol (A);  *)
  1079.           (*  WRITE (") = ");  printSymbolSet (followSets [A]);  *)
  1080.           (*  WRITE ("  FOLLOW("); printSymbol (B);  *)
  1081.           (*  WRITE (") = ");  printSymbolSet (followSets [B]);  *)
  1082.           (*  WRITE ("  Adding all symbols in FOLLOW("); printSymbol (A);  *)
  1083.           (*  WRITE (") to FOLLOW("); printSymbol (B); WRITE (")...$");  *)
  1084.           addAllSymbolsToSet (followSets [A], followSets [B]);
  1085.           (*  WRITE ("  FOLLOW("); printSymbol (A);  *)
  1086.           (*  WRITE (") = ");  printSymbolSet (followSets [A]);  *)
  1087.           (*  WRITE ("  FOLLOW("); printSymbol (B);  *)
  1088.           (*  WRITE (") = ");  printSymbolSet (followSets [B]);  *)
  1089.         end;
  1090.         for j := 0 to rule.rhsSize - 1 do
  1091.           B := rule.rhs [j];
  1092.           if isNonTerminal (B) then
  1093.             (*  WRITE ("Considering nonterminal B = ");  *)
  1094.             (*  printSymbol (B); WRITE ("$");  *)
  1095.             (* Now compute FIRST(beta); don't alter symbolSetsChanged. *)
  1096.             saveSymbolSetsChanged := symbolSetsChanged;
  1097.             (*  WRITE ("About to compute firstOfBeta...$");  *)
  1098.             firstOfBeta := newSymbolSet ();
  1099.             oneHadNoEpsilon := false;
  1100.             for k := j + 1 to rule.rhsSize - 1 do
  1101.               C := rule.rhs[k];
  1102.               (*  WRITE ("Considering symbol ");  *)
  1103.               (*  printSymbol (C); WRITE ("$");  *)
  1104.               (*  WRITE ("  FIRST("); printSymbol (C);  *)
  1105.               (*  WRITE (") = ");  printSymbolSet (firstSets [C]);  *)
  1106.               (*  WRITE ("  Adding all symbols but EOF from FIRST(");  *)
  1107.               (*  printSymbol (C);  *)
  1108.               (*  WRITE (") to firstOfBeta...$");  *)
  1109.               addAllSymbolsButEofToSet (firstSets [C], firstOfBeta);
  1110.               if not symbolSetContains (firstSets [C], EOFSYMBOL) then
  1111.                 oneHadNoEpsilon := true;
  1112.                 (*  WRITE ("This FIRST set had no epsilon; exiting loop$");  *)
  1113.                 exit;
  1114.               end;
  1115.             end;
  1116.             if not oneHadNoEpsilon then
  1117.             (*  WRITE ("  All contained eps; adding EOF to firstOfBeta$");  *)
  1118.               addToSymbolSet (firstOfBeta, EOFSYMBOL);
  1119.             end;
  1120.             (*  WRITE ("Done computing firstOfBeta = ");  *)
  1121.             (*  printSymbolSet (firstOfBeta);  *)
  1122.             symbolSetsChanged := saveSymbolSetsChanged;
  1123.             addAllSymbolsButEofToSet (firstOfBeta, followSets [B]);
  1124.             if symbolSetContains (firstOfBeta, EOFSYMBOL) then
  1125.               (*  WRITE ("FIRST(beta) contains EOF...$");  *)
  1126.               (*  WRITE ("  FOLLOW("); printSymbol (A);  *)
  1127.               (*  WRITE (") = ");  printSymbolSet (followSets [A]);  *)
  1128.               (*  WRITE ("  FOLLOW("); printSymbol (B);  *)
  1129.               (*  WRITE (") = ");  printSymbolSet (followSets [B]);  *)
  1130.               (*  WRITE ("  Adding all symbols in FOLLOW("); printSymbol (A); *)
  1131.               (*  WRITE (") to FOLLOW("); printSymbol (B); WRITE (")...$");  *)
  1132.               addAllSymbolsToSet (followSets [A], followSets [B]);
  1133.               (*  WRITE ("  FOLLOW("); printSymbol (A);  *)
  1134.               (*  WRITE (") = ");  printSymbolSet (followSets [A]);  *)
  1135.               (*  WRITE ("  FOLLOW("); printSymbol (B);  *)
  1136.               (*  WRITE (") = ");  printSymbolSet (followSets [B]);  *)
  1137.             end;
  1138.           end;
  1139.         end;
  1140.       end;
  1141.     end;
  1142.     return;
  1143.   end;
  1144.  
  1145.  
  1146.  
  1147. (* newItemSet ()
  1148. **
  1149. ** This routine returns a new empty item set.
  1150. *)
  1151. procedure newItemSet () : ItemSet is
  1152.   begin
  1153.     return ItemSet { size := 0;
  1154.                      firstItem := nil;
  1155.                      hashValue := -1 };
  1156.   end;
  1157.  
  1158.  
  1159.  
  1160. (* addToItemSet (itemSet, item)
  1161. **
  1162. ** This routine adds an item to the item set.
  1163. *)
  1164. procedure addToItemSet (itemSet: ItemSet; item: Item) is
  1165.   var r: ItemSetRecord := nil;
  1166.   begin
  1167.     if not itemSetContains (itemSet, item) then
  1168.       itemSet.size := itemSet.size + 1;
  1169.       itemSet.hashValue := -1;
  1170.       r := ItemSetRecord { item := item;
  1171.                            next := itemSet.firstItem };
  1172.       itemSet.firstItem := r;
  1173.     end;
  1174.     return;
  1175.   end;
  1176.  
  1177.  
  1178.  
  1179. (* itemSetContains (itemSet, item)
  1180. **
  1181. ** This routine returns TRUE iff this set contains the given item.
  1182. *)
  1183. procedure itemSetContains (itemSet: ItemSet; item: Item) : boolean is
  1184.   var r: ItemSetRecord := nil;
  1185.   begin
  1186.     r := itemSet.firstItem;
  1187.     while r <> nil do
  1188.       if itemsEqual ( r.item, item) then
  1189.         return true;
  1190.       end;
  1191.       r := r.next;
  1192.     end;
  1193.     return false;
  1194.   end;
  1195.  
  1196.  
  1197.  
  1198. (* printItemSet (itemSet)
  1199. **
  1200. ** This routine prints all the items in this set, followed by newline.
  1201. *)
  1202. procedure printItemSet (itemSet: ItemSet) is
  1203.   var r: ItemSetRecord := nil;
  1204.   begin
  1205.     r := itemSet.firstItem;
  1206.     while r <> nil do
  1207.       write ("  ");
  1208.       printItem (r.item);
  1209.       r := r.next;
  1210.     end;
  1211.     return;
  1212.   end;
  1213.  
  1214.  
  1215.  
  1216. (* copyItemSet (itemSet)
  1217. **
  1218. ** This routine makes a new set of items and initializes it by putting
  1219. ** all the items in "itemSet" into it.  It returns the new set.
  1220. *)
  1221. procedure copyItemSet (itemSet: ItemSet) : ItemSet is
  1222.   var resultSet: ItemSet := nil;
  1223.       next, prevRecord, nextRecord: ItemSetRecord := nil;
  1224.   begin
  1225.     resultSet := ItemSet {
  1226.                      size := itemSet.size;
  1227.                      firstItem := nil;
  1228.                      hashValue := itemSet.hashValue };
  1229.     next := itemSet.firstItem;
  1230.     while next <> nil do
  1231.       nextRecord := ItemSetRecord {
  1232.                             item := next.item;
  1233.                             next := prevRecord };
  1234.       prevRecord := nextRecord;
  1235.       next := next.next;
  1236.     end;
  1237.     resultSet.firstItem := prevRecord;
  1238.     return resultSet;
  1239.   end;
  1240.  
  1241.  
  1242.  
  1243. (* itemSetsEqual (set1, set2)
  1244. **
  1245. ** This routine returns TRUE iff both sets contain equal items.  This routine
  1246. ** assumes that no sets contain duplicate items.
  1247. *)
  1248. procedure itemSetsEqual (set1, set2: ItemSet) : boolean is
  1249.   var p1, p2: ItemSetRecord := nil;
  1250.       found: boolean := false;
  1251.   begin
  1252.     if set1.hashValue < 0 then
  1253.       set1.hashValue := itemSetHash (set1);
  1254.     end;
  1255.     if set2.hashValue < 0 then
  1256.       set2.hashValue := itemSetHash (set2);
  1257.     end;
  1258.     if set1.hashValue <> set2.hashValue then
  1259.       return false;
  1260.     end;
  1261.     p1 := set1.firstItem;
  1262.     while p1 <> nil do
  1263.       found := false;
  1264.       p2 := set2.firstItem;
  1265.       while p2 <> nil do
  1266.         if itemsEqual (p1.item, p2.item) then
  1267.           found := true;
  1268.           exit;
  1269.         end;
  1270.         p2 := p2.next;
  1271.       end;
  1272.       if not found then
  1273.         return false;
  1274.       end;
  1275.       p1 := p1.next;
  1276.     end;
  1277.     return true;
  1278.   end;
  1279.  
  1280.  
  1281.  
  1282. (* itemSetHash (itemSet)
  1283. **
  1284. ** This function computes and returns the itemSet's hash value.
  1285. *)
  1286. procedure itemSetHash (itemSet: ItemSet) : integer is
  1287.   var h: integer := 0;
  1288.       next: ItemSetRecord := nil;
  1289.   begin
  1290.     next := itemSet.firstItem;
  1291.     while next <> nil do
  1292.       h := (h + next.item.ruleNumber) mod 10000000;
  1293.       h := (h + next.item.dotPos) mod 10000000;
  1294.       next := next.next;
  1295.     end;
  1296.     return h;
  1297.   end;
  1298.  
  1299.  
  1300.  
  1301. (* getToken ()
  1302. **
  1303. ** This routine reads the next input symbol from the input and returns it.
  1304. ** It checks it for legality and only returns legal terminal symbols.  It
  1305. ** adjust currentLine when non-positive numbers are encountered.  If called
  1306. ** after EOF has been reached, it prints an error message.
  1307. *)
  1308. procedure getToken () : integer is
  1309.   var tok: integer := 0;
  1310.   begin
  1311.     if eofEncountered then
  1312.       write ("$*****  Error: getToken called after EOF  *****$$");
  1313.       return EOFSYMBOL;
  1314.     end;
  1315.     loop
  1316.       read (tok);
  1317.       if tok <= 0 then
  1318.         currentLine := -tok;
  1319.       elseif tok > MaxSymbol then
  1320.         write ("$*****  Error: Token ");
  1321.         printSymbol (tok);
  1322.         write (" (", tok, ") exceeds MaxSymbol (", MaxSymbol,
  1323.                ") in input on line ", currentLine, "  *****$$");
  1324.       elseif isNonTerminal (tok) then
  1325.         write ("$*****  Error: Nonterminal '");
  1326.         printSymbol (tok);
  1327.         write ("' (", tok, ") appeared in input on line ",
  1328.                                                currentLine, "  *****$$");
  1329.       elseif not isSymbol (tok) then
  1330.         write ("$*****  Error: Unknown symbol '");
  1331.         printSymbol (tok);
  1332.         write ("' (", tok, ") appeared in input on line ",
  1333.                                                currentLine, "  *****$$");
  1334.       elseif tok = EOFSYMBOL then
  1335.         eofEncountered := true;
  1336.         return tok;
  1337.       else
  1338.         return tok;
  1339.       end;
  1340.     end;
  1341.   end;
  1342.  
  1343.  
  1344.  
  1345. (* parseInput ()
  1346. **
  1347. ** This routine parses the remainder of the input tokens, using the LR
  1348. ** parsing algorithm with the action table previously computed.
  1349. *)
  1350. procedure parseInput () is
  1351.   var tok: integer := 0;
  1352.       state: integer := 0;
  1353.       entry: Entry := nil;
  1354.       i: integer := 0;
  1355.       rule: Item := nil;
  1356.   begin
  1357.     write ("Parsing input string...$");
  1358.     initializeStack ();
  1359.     push (0);
  1360.     tok := getToken ();
  1361.     loop
  1362.       state := top ();
  1363.       entry := actionTable [state] [tok];
  1364.       if entry.typ = SHIFT then
  1365.         write ("Shifting ");
  1366.         printSymbolPaddingTo (tok, 30);
  1367.         write ("$");
  1368.         push (tok);
  1369.         tok := getToken ();
  1370.         push (entry.number);
  1371.       elseif entry.typ = REDUCE then
  1372.         rule := ruleList [entry.number];
  1373.         write ("Reducing using rule ");
  1374.         printItem (rule);
  1375.         for i := 1 to rule.rhsSize do
  1376.           pop ();
  1377.           pop ();
  1378.         end;
  1379.         state := top ();
  1380.         push (rule.lhs);
  1381.         entry := actionTable [state] [rule.lhs];
  1382.         if entry.typ <> GOTO then
  1383.           write ("$*****  Error: expecting typ=goto in parseInput  *****$$");
  1384.         end;
  1385.         push (entry.number);
  1386.       elseif entry.typ = ACCEPT then
  1387.         write ("Accepting: The input is syntactically correct.$");
  1388.         exit;
  1389.       elseif entry.typ = BLANK then
  1390.         write ("$Syntax Error Detected!!!   (on line ", currentLine, ")$");
  1391.         exit;
  1392.       else
  1393.         write ("$*****  Error: unexpected typ in parseInput  *****$$");
  1394.       end;
  1395.     end;
  1396.     write ("$");
  1397.     return;
  1398.   end;
  1399.  
  1400.  
  1401.  
  1402. (* initializeGrammar ()
  1403. **
  1404. ** This routine reads in the grammar and initializes the data structures.
  1405. *)
  1406. procedure initializeGrammar () is
  1407.   var tok: integer := 0;
  1408.     item: Item := nil;
  1409.     i: integer := 0;
  1410.   begin
  1411.     read (EOFSYMBOL);
  1412.     if EOFSYMBOL > MAXSYMBOL then
  1413.       write ("$*****  Error: EOFSYMBOL exceeds MAXSYMBOL  *****$$");
  1414.     end;
  1415.     MaxSymbol := EOFSYMBOL;
  1416.     write ("EOF Symbol = ", EOFSYMBOL, "$");
  1417.     write ("Reading in grammar...$");
  1418.     ruleList := ItemArray [< MaxRuleListIndex + 1 of nil >];
  1419.     nextRuleListIndex := 1;  (* Zero is for dummy start rule *)
  1420.     symbolStatus := IntArray [< MAXSYMBOL+1 of 0 >];
  1421.     symbolStatus [0] := 2;
  1422.     symbolStatus [EOFSYMBOL] := 1;
  1423.     loop
  1424.       read (tok);
  1425.       if tok <= 0 then
  1426.         exit;
  1427.       elseif tok > MAXSYMBOL then
  1428.         write ("$*****  Error: MAXSYMBOL exceeded  *****$$");
  1429.         tok := 1;
  1430.       end;
  1431.       if tok > MaxSymbol then
  1432.         MaxSymbol := tok;
  1433.       end;
  1434.       write ("  ", nextRuleListIndex, ": ");
  1435.       printSymbolPaddingTo (tok, 5);
  1436.       symbolStatus [tok] := 2;
  1437.       item := Item {
  1438.                  ruleNumber := nextRuleListIndex;
  1439.                  lhs := tok;
  1440.                  rhsSize := 0;
  1441.                  rhs := nil;
  1442.          dotPos := -1 };
  1443.       clearBuffer ();
  1444.       write (" --> ");
  1445.       loop
  1446.         read (tok);
  1447.         if tok <= 0 then
  1448.       exit;
  1449.         elseif tok > MAXSYMBOL then
  1450.           write ("$*****  Error: MAXSYMBOL exceeded  *****$$");
  1451.           tok := 1;
  1452.         end;
  1453.         if tok > MaxSymbol then
  1454.           MaxSymbol := tok;
  1455.         end;
  1456.         if symbolStatus [tok] = 0 then
  1457.           symbolStatus [tok] := 1;
  1458.         end;
  1459.         addToBuffer (tok);
  1460.         printSymbol (tok);
  1461.         write (" ");
  1462.       end;
  1463.       write ("$");
  1464.       item.rhsSize := bufferSize ();
  1465.       item.rhs := IntArray [< item.rhsSize + 1 of 0 >];
  1466.       for i := 0 to nextBufferIndex - 1 do
  1467.         item.rhs [i] := buffer [i];
  1468.       end;
  1469.       (*  printItem (item);  *)
  1470.       if nextRuleListIndex > MaxRuleListIndex then
  1471.         write ("$*****  MaxRuleListIndex exceeded  *****$$");
  1472.       else
  1473.         ruleList [ nextRuleListIndex ] := item;
  1474.         nextRuleListIndex := nextRuleListIndex + 1;
  1475.       end;
  1476.     end;
  1477.     item := Item {
  1478.                  ruleNumber := 0;
  1479.              lhs := 0;
  1480.              rhsSize := 1;
  1481.              rhs := IntArray [< 1 of ruleList [1].lhs >];
  1482.              dotPos := -1 };
  1483.     ruleList [0] := item;
  1484.     return;
  1485.   end;
  1486.  
  1487.  
  1488.  
  1489. (* closure (itemSet)
  1490. ** This routine is passed a set of items.  It computes the closure of that
  1491. ** set and returns it.
  1492. *)
  1493. procedure closure (itemSet: ItemSet) : ItemSet is
  1494.   var resultSet: ItemSet := nil;
  1495.       changed: boolean := false;
  1496.       item, rule, newItem: Item := nil;
  1497.       next: ItemSetRecord := nil;
  1498.       nonTerminal, oldSize: integer := 0;
  1499.       restartFromBeginning: boolean := false;
  1500.   begin
  1501.     resultSet := copyItemSet (itemSet);
  1502.     (*  WRITE ("Here is result so far...$");  *)
  1503.     (*  printItemSet (resultSet);  *)
  1504.     loop
  1505.       changed := false;
  1506.         next := resultSet.firstItem;
  1507.         while next <> nil do
  1508.           (*  WRITE ("=====Considering this item from resultSet=====$");  *)
  1509.           (*  printItem (item);  *)
  1510.           item := next.item;
  1511.           (* IF dot is before B in item... *)
  1512.           if (item.dotPos >= 0) and
  1513.              (item.dotPos < item.rhsSize) and
  1514.              (isNonTerminal (item.rhs [item.dotPos] )) then
  1515.             (* ...THEN find all B rules and add to result set... *)
  1516.             nonTerminal := item.rhs [item.dotPos];
  1517.             (*  WRITE ("Dot is before nonterminal ");  *)
  1518.             (*  printSymbol (nonTerminal);  *)
  1519.             (*  WRITE ("$");  *)
  1520.             for i := 0 to nextRuleListIndex - 1 do
  1521.               rule := ruleList [i];
  1522.               (* WRITE ("Considering this rule...$");  *)
  1523.               (* printItem (rule);  *)
  1524.               if rule.lhs = nonTerminal then
  1525.                 newItem := copyItem (rule);
  1526.                 newItem.dotPos := 0;
  1527.                 (*  WRITE ("Adding this item to resultSet...$");  *)
  1528.                 (* printItem (newItem);  *)
  1529.                 oldSize := resultSet.size;
  1530.                 addToItemSet (resultSet, newItem);
  1531.                 if resultSet.size > oldSize then
  1532.                   changed := true;
  1533.                   restartFromBeginning := true;
  1534.                 end;
  1535.                 (*  WRITE ("Here is result so far...$");  *)
  1536.                 (*  printItemSet (resultSet);  *)
  1537.               end;
  1538.             end;
  1539.             (*  WRITE ("Done looking through rules$");  *)
  1540.           end;
  1541.           (*  WRITE ("Moving to next item in resultSet$");  *)
  1542.           if restartFromBeginning then
  1543.             next := resultSet.firstItem;
  1544.             restartFromBeginning := false;
  1545.           else
  1546.             next := next.next;
  1547.           end;
  1548.         end;
  1549.       if not (changed) then
  1550.         exit;
  1551.       end;
  1552.     end;
  1553.     return resultSet;
  1554.   end;
  1555.  
  1556.  
  1557.  
  1558. (* initializeActionTable ()
  1559. **
  1560. ** This routine initializes the actionTable to all BLANK entries.
  1561. *)
  1562. procedure initializeActionTable () is
  1563.   var state, symbol: integer := 0;
  1564.       entry: Entry := nil;
  1565.   begin
  1566.     actionTable := EntryArrayArray [< MaxState+1 of nil >];
  1567.     for state := 0 to MaxState do
  1568.       actionTable [state] := EntryArray [< MaxSymbol+1 of nil >];
  1569.       for symbol := 0 to MaxSymbol do
  1570.         entry := Entry { typ := BLANK;
  1571.                          number := 0 };
  1572.         actionTable [state] [symbol] := entry;
  1573.       end;
  1574.     end;
  1575.     return;
  1576.   end;
  1577.  
  1578.  
  1579.  
  1580. (* setAction (row, col, typ, number)
  1581. **
  1582. ** This routine simply sets the selected entry in the action table to
  1583. ** the desired type of action.
  1584. *)
  1585. procedure setAction (row, col, typ, number: integer) is
  1586.   var entry: Entry := nil;
  1587.   begin
  1588.     if (row < 0) or
  1589.        (row > MaxState) or
  1590.        (col < 0) or
  1591.        (col > MaxSymbol) then
  1592.       write ("$*****  Error: invalid args in setAction  *****$$");
  1593.       write ("row=", row, " col=", col, "$");
  1594.     else
  1595.       entry := actionTable [row] [col];
  1596.       if entry.typ <> BLANK then
  1597.         if (entry.typ = REDUCE) and
  1598.            (typ = REDUCE) then
  1599.           write ("$*****  Reduce-reduce conflict");
  1600.         elseif (entry.typ = REDUCE) and
  1601.               (typ = SHIFT) then
  1602.           write ("$*****  Shift-reduce conflict");
  1603.         elseif (entry.typ = SHIFT) and
  1604.               (typ = REDUCE) then
  1605.           write ("$*****  Shift-reduce conflict");
  1606.         else
  1607.           write ("$*****  Unexpected conflict");
  1608.         end;
  1609.         write (" (symbol = ");
  1610.         printSymbol (col);
  1611.         write (", state = ", row, ") *****$$");
  1612.       else
  1613.         entry.typ := typ;
  1614.         entry.number := number;
  1615.         if entry.typ = SHIFT then
  1616.           write ("row=", row, " col=");
  1617.           printSymbol (col);
  1618.           write (" - SHIFT ", number, "$");
  1619.         elseif entry.typ = REDUCE then
  1620.           write ("row=", row, " col=");
  1621.           printSymbol (col);
  1622.           write (" - REDUCE ", number, "$");
  1623.         elseif entry.typ = GOTO then
  1624.           write ("row=", row, " col=");
  1625.           printSymbol (col);
  1626.           write (" - GOTO ", number, "$");
  1627.         elseif entry.typ = ACCEPT then
  1628.           write ("row=", row, " col=");
  1629.           printSymbol (col);
  1630.           write (" - ACCEPT$");
  1631.         end;
  1632.       end;
  1633.     end;
  1634.     return;
  1635.   end;
  1636.  
  1637.  
  1638.  
  1639. (* printNumberPaddingTo (i, width)
  1640. **
  1641. ** This routine prints the number i followed by enough blanks to result
  1642. ** in a total of width characters being printed.
  1643. *)
  1644. procedure printNumberPaddingTo (i, width: integer) is
  1645.   var j,n: integer := 0;
  1646.   begin
  1647.     if i >= 0 then
  1648.       if i <= 9 then
  1649.         n := 1;
  1650.       elseif i <= 99 then
  1651.         n := 2;
  1652.       elseif i <= 999 then
  1653.         n := 3;
  1654.       elseif i <= 9999 then
  1655.         n := 4;
  1656.       elseif i <= 99999 then
  1657.         n := 5;
  1658.       else
  1659.         write ("$*****  Number out of range in printNumberPaddingTo  *****$$");
  1660.       end;
  1661.     else
  1662.       if i >= -9 then
  1663.         n := 2;
  1664.       elseif i >= -99 then
  1665.         n := 3;
  1666.       elseif i >= -999 then
  1667.         n := 4;
  1668.       elseif i >= -9999 then
  1669.         n := 5;
  1670.       elseif i >= -99999 then
  1671.         n := 6;
  1672.       else
  1673.         write ("$*****  Number out of range in printNumberPaddingTo  *****$$");
  1674.       end;
  1675.     end;
  1676.     write (i);
  1677.     for j := 1 to width - n do
  1678.       write (" ");
  1679.     end;
  1680.     return;
  1681.   end;
  1682.  
  1683.  
  1684.  
  1685. (* printFirstAndFollowSets ()
  1686. **
  1687. ** This routine displays the FIRST and FOLLOW sets.
  1688. *)
  1689. procedure printFirstAndFollowSets () is
  1690.   var i: integer := 0;
  1691.   begin
  1692.     initializeFirstSets ();
  1693.     for i := 0 to MaxSymbol do
  1694.       if isSymbol (i) then
  1695.         write ("FIRST ( ");
  1696.         printSymbol (i);
  1697.         write (" ) = ");
  1698.         printSymbolSet (firstSets [i]);
  1699.       end;
  1700.     end;
  1701.     initializeFollowSets ();
  1702.     for i := 0 to MaxSymbol do
  1703.       if isNonTerminal (i) then
  1704.         write ("FOLLOW ( ");
  1705.         printSymbol (i);
  1706.         write (" ) = ");
  1707.         printSymbolSet (followSets [i]);
  1708.       end;
  1709.     end;
  1710.     return;
  1711.   end;
  1712.  
  1713.  
  1714.  
  1715. (* printActionTable ()
  1716. **
  1717. ** This routine displays the actionTable.
  1718. *)
  1719. procedure printActionTable () is
  1720.   var state, symbol: integer := 0;
  1721.       entry: Entry := nil;
  1722.       nextCol: integer := 1;
  1723.   begin
  1724.     (* Print the upper-left corner of the action table, only *)
  1725. (*
  1726.     IF nextState > 20 THEN
  1727.       WRITE ("Too many rows in printTable; table display cancelled.$");
  1728.       RETURN;
  1729.     END;
  1730. *)
  1731.     write ("      ");
  1732.     nextCol := 1;
  1733.     for symbol := 1 to MaxSymbol do
  1734.       if isSymbol (symbol) and
  1735.          (nextCol <= MaxColumns) then
  1736.         nextCol := nextCol + 1;
  1737.         printSymbolPaddingTo (symbol, 6);
  1738.       end;
  1739.     end;
  1740.     write ("$");
  1741.     write ("    ");
  1742.     nextCol := 1;
  1743.     for symbol := 1 to MaxSymbol do
  1744.       if isSymbol (symbol) and
  1745.          (nextCol <= MaxColumns) then
  1746.         nextCol := nextCol + 1;
  1747.         write ("------");
  1748.       end;
  1749.     end;
  1750.     write ("-$");
  1751.     for state := 0 to nextState do
  1752.       printNumberPaddingTo (state, 4);
  1753.       write ("| ");
  1754.       nextCol := 1;
  1755.       for symbol := 1 to MaxSymbol do
  1756.         if isSymbol (symbol) and
  1757.            (nextCol <= MaxColumns) then
  1758.           nextCol := nextCol + 1;
  1759.           entry := actionTable [state] [symbol];
  1760.           if entry.typ = SHIFT then
  1761.             write ("S");
  1762.             printNumberPaddingTo (entry.number, 3);
  1763.           elseif entry.typ = REDUCE then
  1764.             write ("R");
  1765.             printNumberPaddingTo (entry.number, 3);
  1766.           elseif entry.typ = ACCEPT then
  1767.             write ("Acc ");
  1768.           elseif entry.typ = BLANK then
  1769.             write ("    ");
  1770.           elseif entry.typ = GOTO then
  1771.             write ("G");
  1772.             printNumberPaddingTo (entry.number, 3);
  1773.           else
  1774.             write ("$*****  Error: bad typ in actionTable  *****$$");
  1775.           end;
  1776.           write ("| ");
  1777.         end;
  1778.       end;
  1779.       write ("$");
  1780.     end;
  1781.     write ("    ");
  1782.     nextCol := 1;
  1783.     for symbol := 1 to MaxSymbol do
  1784.       if isSymbol (symbol) and
  1785.          (nextCol <= MaxColumns) then
  1786.         nextCol := nextCol + 1;
  1787.         write ("------");
  1788.       end;
  1789.     end;
  1790.     write ("-$");
  1791.     return;
  1792.   end;
  1793.  
  1794.  
  1795.  
  1796. (* initializeStack ()
  1797. **
  1798. ** This routine initializes the stack to be empty.
  1799. *)
  1800. procedure initializeStack () is
  1801.   begin
  1802.     stack := IntArray [< MaxStackIndex + 1 of 0 >];
  1803.     stackTop := -1;
  1804.     return;
  1805.   end;
  1806.  
  1807.  
  1808.  
  1809. (* top ()
  1810. **
  1811. ** This routine returns the integer on the top of the stack.
  1812. *)
  1813. procedure top () : integer is
  1814.   begin
  1815.     if (stackTop < 0) or (stackTop > MaxStackIndex) then
  1816.       write ("$*****  Error: stackIndex out of bounds in top()  *****$$");
  1817.       return 0;
  1818.     else
  1819.       return stack [stackTop];
  1820.     end;
  1821.   end;
  1822.  
  1823.  
  1824.  
  1825. (* push (i)
  1826. **
  1827. ** This routine pushes the integer i onto the stack.
  1828. *)
  1829. procedure push (i: integer) is
  1830.   begin
  1831.     if stackTop >= MaxStackIndex then
  1832.       write ("$*****  Error: stack overflow in push()  *****$$");
  1833.     else
  1834.       stackTop := stackTop + 1;
  1835.       stack [stackTop] := i;
  1836.     end;
  1837.     return;
  1838.   end;
  1839.  
  1840.  
  1841.  
  1842. (* pop ()
  1843. **
  1844. ** This routine pops the integer on the stack top.  It does NOT return it.
  1845. *)
  1846. procedure pop () is
  1847.   begin
  1848.     if stackTop < 0 then
  1849.       write ("$*****  Error: stack underflow in pop()  *****$$");
  1850.     else
  1851.       stackTop := stackTop - 1;
  1852.     end;
  1853.     return;
  1854.   end;
  1855.  
  1856.  
  1857.  
  1858. (* initializeCollection ()
  1859. **
  1860. ** This routine initializes the collection of ItemSets.
  1861. *)
  1862. procedure initializeCollection () is
  1863.   begin
  1864.     collection := ItemSetArray [< MaxState + 1 of nil >];
  1865.     nextState := 0;
  1866.     return;
  1867.   end;
  1868.  
  1869.  
  1870.  
  1871. (* printCollection ()
  1872. **
  1873. ** This routine prints the collection of ItemSets, followed by newline.
  1874. *)
  1875. procedure printCollection () is
  1876.   var i: integer := 0;
  1877.   begin
  1878.     for i := 0 to nextState - 1 do
  1879.       write ("State ", i, ":$");
  1880.       printItemSet (collection [i]);
  1881.     end;
  1882.     return;
  1883.   end;
  1884.  
  1885.  
  1886.  
  1887. (* addToCollection (itemSet)
  1888. **
  1889. ** This routine is passed an itemSet.  It adds it unconditionally to the
  1890. ** collection of itemSets.
  1891. *)
  1892. procedure addToCollection (itemSet: ItemSet) is
  1893.   begin
  1894.     if nextState > MaxState then
  1895.       write ("$*****  Error: MaxState exceeded when adding itemSet  *****$$");
  1896.     else
  1897.       collection [nextState] := itemSet;
  1898.       nextState := nextState + 1;
  1899.     end;
  1900.     return;
  1901.   end;
  1902.  
  1903.  
  1904.  
  1905. (* findInCollection (itemSet)
  1906. **
  1907. ** This routine determines whether the collection contains the given
  1908. ** itemSet.  If is, it returns the index into collection[]; otherwise
  1909. ** it returns -1.
  1910. *)
  1911. procedure findInCollection (itemSet: ItemSet) : integer is
  1912.   var i: integer := 0;
  1913.   begin
  1914.     for i := 0 to nextState - 1 do
  1915.       if itemSetsEqual (itemSet, collection [i]) then
  1916.         return i;
  1917.       end;
  1918.     end;
  1919.     return -1;
  1920.   end;
  1921.  
  1922.  
  1923.  
  1924. (* computeTable ()
  1925. **
  1926. ** This routine computes and fills in the action table.
  1927. *)
  1928. procedure computeTable () is
  1929.   var itemSet0, anotherItemSet: ItemSet := nil;
  1930.       item0, item1, item: Item := nil;
  1931.       i, j: integer := 0;
  1932.       symbolSet: SymbolSet := nil;
  1933.       X: integer := 0;
  1934.       next: SymbolSetRecord := nil;
  1935.       nextItem: ItemSetRecord := nil;
  1936.   begin
  1937.     initializeFirstSets ();
  1938.     initializeFollowSets ();
  1939.     initializeActionTable ();
  1940.     initializeCollection ();
  1941.     itemSet0 := newItemSet ();
  1942.     item0 := copyItem (ruleList [0]);
  1943.     item0.dotPos := 0;
  1944.     item1 := copyItem (ruleList [0]);
  1945.     item1.dotPos := 1;
  1946.     addToItemSet (itemSet0, item0);
  1947.     addToCollection (closure (itemSet0));
  1948.     i := 0;
  1949.     while i < nextState do
  1950.       (*  WRITE ("Considering state ", i, "...$");  *)
  1951.       (*  printItemSet (collection [i]);  *)
  1952.       symbolSet := symbolsAfterDot (collection [i]);
  1953.       (*  WRITE ("Symbols after the dot = ");  *)
  1954.       (*  printSymbolSet (symbolSet);  *)
  1955.       (*  WRITE ("$");  *)
  1956.       next := symbolSet.firstSymbol;
  1957.       while next <> nil do
  1958.         X := next.symbol;
  1959.         (*  WRITE ("Calling goto for symbol ");  *)
  1960.         (*  printSymbol (X);  *)
  1961.         (*  WRITE ("...$");  *)
  1962.         anotherItemSet := goto ( collection [i], X); 
  1963.         j := findInCollection (anotherItemSet);
  1964.         if j < 0 then
  1965.           j := nextState;
  1966.           (*  WRITE ("Creating state ", nextState, " with these items:$");  *)
  1967.           (*  printItemSet (anotherItemSet);  *)
  1968.           addToCollection (anotherItemSet);
  1969.         end;
  1970.         write ("State ", i, " =====");
  1971.         printSymbol (X);
  1972.         write ("=====> State ", j, "$");
  1973.         if isTerminal (X) then
  1974.           setAction (i, X, SHIFT, j);
  1975.         elseif isNonTerminal (X) then
  1976.           setAction (i, X, GOTO, j);
  1977.         end;
  1978.         next := next.next;
  1979.       end;
  1980.       if itemSetContains (collection [i], item1) then
  1981.         setAction (i, EOFSYMBOL, ACCEPT, 0);
  1982.       end;
  1983.       nextItem := collection [i].firstItem;
  1984.       while nextItem <> nil do
  1985.         item := nextItem.item;
  1986.         if (item.lhs <> 0) and
  1987.            (item.dotPos >= item.rhsSize) then
  1988.           (*  WRITE ("====  Found a candidate rule: "); printItem (item);  *)
  1989.           next := followSets [item.lhs].firstSymbol;
  1990.           while next <> nil do
  1991.             X := next.symbol;
  1992.             setAction (i, X, REDUCE, item.ruleNumber);
  1993.             next := next.next;
  1994.           end;
  1995.         end;
  1996.         nextItem := nextItem.next;
  1997.       end;
  1998.       i := i + 1;
  1999.     end;
  2000.     (*  WRITE ("Here is the collection of itemSets...$");  *)
  2001.     (*  printCollection ();  *)
  2002.     return;
  2003.   end;
  2004.  
  2005.  
  2006.  
  2007. (* symbolsAfterDot (itemSet)
  2008. **
  2009. ** This routine returns the set of symbols (possibly empty) appearing after
  2010. ** the dot in any of the items in this itemSet.
  2011. *)
  2012. procedure symbolsAfterDot (itemSet: ItemSet) : SymbolSet is
  2013.   var result: SymbolSet := newSymbolSet ();
  2014.       next: ItemSetRecord := nil;
  2015.       item: Item := nil;
  2016.   begin
  2017.     next := itemSet.firstItem;
  2018.     while next <> nil do
  2019.       item := next.item;
  2020.       if item.dotPos < item.rhsSize then
  2021.         addToSymbolSet (result, item.rhs [item.dotPos]);
  2022.       end;
  2023.       next := next.next;
  2024.     end;
  2025.     return result;
  2026.   end;
  2027.  
  2028.  
  2029.  
  2030. (* goto (I, X)
  2031. **
  2032. ** This routine is passed a set of items I and a grammar symbol X (either a
  2033. ** terminal or non-terminal).  It returns a set of items.
  2034. *)
  2035. procedure goto (I: ItemSet; X: integer) : ItemSet is
  2036.   var star: ItemSet := nil;
  2037.       next: ItemSetRecord := nil;
  2038.       item: Item := nil;
  2039.   begin
  2040.     (*  WRITE ("===== GOTO called =====$I =$");  *)
  2041.     (*  printItemSet (I);  *)
  2042.     (*  WRITE ("X = "); printSymbol (X); WRITE ("$");  *)
  2043.     star := newItemSet ();
  2044.     next := I.firstItem;
  2045.     while next <> nil do
  2046.       item := next.item;
  2047.       (*  WRITE ("Considering item: ");  printItem (item);  *)
  2048.       if (item.dotPos < item.rhsSize) and
  2049.          (item.rhs [item.dotPos] = X) then
  2050.         (*  WRITE ("The dot is before X$");  *)
  2051.         item := copyItem (item);
  2052.         item.dotPos := item.dotPos + 1;
  2053.         (*  WRITE ("Adding this item to star: "); printItem (item);  *)
  2054.         addToItemSet (star, item);
  2055.         (*  WRITE ("star = $");  printItemSet (star);  *)
  2056.       end;
  2057.       next := next.next;
  2058.     end;
  2059.     star := closure (star);
  2060.     (*  WRITE ("star = $");  printItemSet (star);  *)
  2061.     return star;
  2062.   end;
  2063.  
  2064.  
  2065.  
  2066. (* printStates ()
  2067. **
  2068. ** This routine prints all the states; that is, it prints all the items
  2069. ** in each of the sets in the canonical collection of sets of LR(0) items.
  2070. *)
  2071. procedure printStates () is
  2072.   var i: integer := 0;
  2073.   begin
  2074.     i := 0;
  2075.     while i < nextState do
  2076.       write ("=====  State ", i, "  =====$");
  2077.       printItemSet (collection [i]);
  2078.       i := i + 1;
  2079.     end;
  2080.     return;
  2081.   end;
  2082.  
  2083.  
  2084.  
  2085. (* Mainline  *)
  2086.  
  2087. var i0, i1, i2, i3: Item := nil;
  2088.   set1, set2, set3: ItemSet := nil;
  2089.   i: integer := 0;
  2090.   s1, s2: SymbolSet := nil;
  2091.  
  2092. begin
  2093.  
  2094.   initializeGrammar ();
  2095.   printAllSymbols ();
  2096.  
  2097.   write ("Here are the rules...$");
  2098.   for i := 0 to nextRuleListIndex - 1 do
  2099.     write ("  ");
  2100.     printItem (ruleList [i]);
  2101.   end;
  2102.  
  2103.   printFirstAndFollowSets ();
  2104.   computeTable ();
  2105.   printStates ();
  2106.   printActionTable ();
  2107.   parseInput ();
  2108.  
  2109. end;
  2110.