Squashed 'taccle/' content from commit a601073a

git-subtree-dir: taccle
git-subtree-split: a601073ac352942bce396a6d6d9812c971c033db

17 files changed, 2520 insertions, 0 deletions

diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..d60c31a
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,340 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year  name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..e9728f1
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,48 @@
+2005-03-17  J. Tang  <tang@jtang.org>
+
+	* Added infinite recursion detection.  It should work.
+
+2004-10-29  J. Tang  <tang@jtang.org>
+
+	* Added more comments; upped version to 1.0.
+
+2004-09-29  J. Tang  <tang@jtang.org>
+
+	* Added --version flag to display taccle version.
+	
+	* Added infix_calc.tac as example of how to do precedence.
+	
+	* Added operator precedence (%left, %right, %nonassoc, and
+	%prec).  Seems to work, at least with the example from the bison
+	info manual.
+
+2004-09-28  J. Tang  <tang@jtang.org>
+
+	* Discovered obscure error when calculating FIRST and FOLLOW sets
+	given a rule of the form:  x -> A x A
+	(i.e., when the rule recurses with a terminal following the lhs
+	token)
+
+	* Added -w to enable warnings display.
+
+2004-09-27  J. Tang  <tang@jtang.org>
+
+	* Added write_array procedure to better format state transition
+	tables.  Thanks to jcw for suggestion.
+
+2004-09-08  J. Tang  <tang@jtang.org>
+
+	* As a result of working epsilons, added embedded actions.
+
+	* Fixed epsilon transitions by adding FOLLOW sets.  Double Woot!
+
+2004-08-18  J. Tang  <tang@jtang.org>
+
+	* Added epsilon transitions.  Woot!
+
+	* Renamed synthesized attributes to just $1, $2... Renamed $yy_
+	to $_.  (Yup, $_ like in Perl.)  Thanks to Matt Newman for
+	suggestion.	
+
+	* Added error terminal and error recovery (though no yyerrok).
+	See interactive_calculator.tac example.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..fd10f40
--- /dev/null
+++ b/README.md
@@ -0,0 +1,122 @@
+Copyright
+---------
+taccle itself is protected by the GNU General Public License.  See the
+file COPYING for details.  Of course, any code you generate using
+taccle is subject to whatever restrictions you place on it.
+
+
+Availability
+------------
+A wiki page for taccle may be found at http://mini.net/tcl/taccle.
+An archive of taccle files are available at http://tcl.jtang.org/taccle.
+
+
+taccle README
+-------------
+taccle is another compiler compiler for the Tcl language.  It takes as
+input a "taccle specification file"; from this taccle generates a Tcl
+file that implements an LALR(1) parser.  The program brings to the Tcl
+language what yacc and bison do for C and C++.
+
+This release of taccle implements nearly all features of yacc:
+ - %token and %start declarations
+ - %define parse.error verbose declaration
+ - epsilon transitions (i.e., "empty" rules)
+ - embedded (mid-rule) actions
+ - literal tokens
+ - symbol values and synthesized attributes
+ - the error token and error recovery
+ - shift/reduce and reduce/reduce conflict notification
+ - operator precedence with %left, %right, %nonassoc, and %prec
+ - functions yyerror, YYABORT, YYACCEPT, and yyclearin
+ - infinite recursion detection
+
+Features currently missing in taccle are:
+ - inherited attributes
+ 
+Because taccle uses the lset command it requires Tcl 8.4 or greater.
+
+Be aware of the following differences between taccle and yacc:
+
+1. taccle (and Tcl) has no concept of variable types.  Thus %union and
+   %type declarations are no longer needed.
+
+2. yacc uses variables $1, $2, etc for symbol values; it uses $$ for
+   the synthesized attribute.  Although both $1 and $$ are legal
+   variable references in Tcl the latter is more awkward; the
+   expression `set $ foo' is not legal.  Instead of $$ use the name
+   '_', as in `set _ foo'.  These variables' scopes are valid only
+   within the context of an action.  See
+   examples/simple_calculator.tac for an example.
+
+   (The astute observer notes that using $_ for synthesized values is
+   similar to Perl's use of the auto-variable $_.)
+
+3. taccle has error handling just like bison.  It always declares the
+   terminal `error' that is pushed onto the stack whenever it detects
+   a syntax error.  Although yyclearin is implemented neither
+   YYRECOVERING nor yyerrok are.  The example
+   interactive_calculator.tac implements error handling.
+
+4. Like yacc, taccle requires a token generator.  The examples use
+   fickle (http://mini.net/tcl/fickle), though others are welcome.
+
+5. taccle calls a global function yylex to fetch the next token.  This
+   yylex function is expected to return the next token in the input
+   stream, either a string or a number.  Normally this poses no
+   problem except for the case of a literal zero.  Tcl makes no
+   distinction between the integer zero and the string zero.  Because
+   zero is reserved for the end of input marker, taccle will refuse
+   grammars that employ literal zeros.  You can get around this by
+   declaring `%token ZERO' and using that instead.
+
+6. Another literal that causes all sorts of problems is the open brace
+   '{'.  Because most things are represented internally as lists the
+   presence of the brace breaks everything.  Thus taccle will refuse
+   to parse grammars with this literal; you'll have to use a %token
+   instead.
+
+   
+Using the Examples
+------------------
+Execute taccle as if it were yacc:
+
+  $ tclsh ./taccle.tcl -d some_spec_file.tac
+
+This will generate two files, some_spec_file.tcl and
+some_spec_file.tab.tcl.  The first contains the actual parser code;
+execute it by calling yyparse.  The latter file is file to be sourced
+by the lexer, much akin to yacc's y.tab.h file.
+
+The Makefile in the examples subdirectory will generate two simple
+calculator programs.  You will need a copy of fickle (available at
+http://mini.net/tcl/fickle) and may need to modify its location on
+line 4 of the Makefile.  After filtering simple_calculator through
+ficcle and taccle execute it like so:
+
+  $ echo "6*9" | tclsh simple_calculator.tcl
+
+If all goes well the program displays:
+
+  Result is 54
+
+A more interesting example is interactive_calculator.tcl.  This one is
+designed to handle any arbitrary number of commands.  Upon errornous
+equations it recovers by discarding the rest of the buffer.  Here is
+an example session of it:
+
+  $ tclsh interactive_calculator.tcl
+  6*9
+   = 54
+  1++2++3
+   = error
+  1 + 2 + 3
+   = 6
+
+The final example, infix_calc.tcl, shows how to use operator
+precedence to resolve shift/reduce conflicts.  It understands both
+left associative operators (addition et al) as well as right
+associative (exponentation).  Here is an example use:
+
+  $ echo "2^2^2 - 10 * 2 + 6 / 3" | tclsh infix_calc.tcl
+          -2
diff --git a/examples/Makefile b/examples/Makefile
new file mode 100644
index 0000000..7235aea
--- /dev/null
+++ b/examples/Makefile
@@ -0,0 +1,17 @@
+# $Id: Makefile,v 1.2 2004/09/29 16:23:28 tang Exp $
+
+TCL=tclsh
+FICKLE=~/fickle/fickle.tcl
+TACCLE=../taccle.tcl
+EXAMPLES=interactive_calculator.tcl simple_calculator.tcl infix_calc.tcl
+
+all: $(EXAMPLES) simple_scanner.tcl
+
+%.tcl: %.fcl
+	$(TCL) $(FICKLE) $<
+
+%.tcl: %.tac
+	$(TCL) $(TACCLE) -d -v -w $<
+
+clean:
+	-rm -f *tcl *output
diff --git a/examples/if_then_else.tac b/examples/if_then_else.tac
new file mode 100644
index 0000000..eee631a
--- /dev/null
+++ b/examples/if_then_else.tac
@@ -0,0 +1,18 @@
+# $Id: if_then_else.tac,v 1.1 2004/08/18 23:53:42 tang Exp $
+
+# The classical if/then/else ambiguity.  taccle resolves this by
+# giving higher precedence to shifting else.
+#
+# References:
+#   Dragon book, page 250
+#   lex & yacc, pages 233-235
+
+%token IF ELSE TERMINAL
+
+%%
+
+stmt: IF '(' cond ')' stmt
+ | IF '(' cond ')' stmt ELSE stmt
+ | TERMINAL;
+
+cond: TERMINAL;
diff --git a/examples/infix_calc.tac b/examples/infix_calc.tac
new file mode 100644
index 0000000..95ef2ee
--- /dev/null
+++ b/examples/infix_calc.tac
@@ -0,0 +1,35 @@
+# $Id: infix_calc.tac,v 1.1 2004/09/29 16:23:28 tang Exp $
+
+# This example demonstrates how taccle handles operator precedence.
+# The code is shamelessly borrowed from the GNU Bison info manual.
+
+# taccle Declarations
+%token ID NEWLINE
+%left '-' '+'
+%left '*' '/'
+%left NEG       # negation--unary minus
+%right '^'      # exponentiation
+
+# Grammar follows
+%%
+input:    # empty string
+        | input line
+;
+
+line:     NEWLINE
+        | exp NEWLINE        { puts [format "\t%.10g" $1] }
+;
+
+exp:      ID                 { set _ $1                   }
+        | exp '+' exp        { set _ [expr {$1 + $3}]     }
+        | exp '-' exp        { set _ [expr {$1 - $3}]     }
+        | exp '*' exp        { set _ [expr {$1 * $3}]     }
+        | exp '/' exp        { set _ [expr {$1 / $3}]     }
+        | '-' exp  %prec NEG { set _ [expr {-1.0 * $2}]   }
+        | exp '^' exp        { set _ [expr {pow($1, $3)}] }
+        | '(' exp ')'        { set _ $2                   }
+;
+%%
+
+source simple_scanner.tcl
+yyparse
diff --git a/examples/interactive_calculator.tac b/examples/interactive_calculator.tac
new file mode 100644
index 0000000..ac8a3ba
--- /dev/null
+++ b/examples/interactive_calculator.tac
@@ -0,0 +1,42 @@
+# $Id: interactive_calculator.tac,v 1.2 2004/09/08 21:38:44 tang Exp $
+
+# This example expands the simple calculator to be interactive from
+# the command line.  Note the use of an empty rule (i.e., epsilon
+# transition).  Also featured are the error token and error recovery.
+
+%{
+#!/usr/bin/tclsh
+
+%}
+
+%token ID NEWLINE
+
+%%
+
+start: line NEWLINE start
+ | line
+ ;
+
+line: E       { puts " = $1" }
+ | error      { puts " -- error" }
+ |   # empty
+ ;
+ 
+E: E '+' T    { set _ [expr {$1 + $3}] }
+ | E '-' T    { set _ [expr {$1 - $3}] }
+ | T
+ ;
+
+T: T '*' F    { set _ [expr {$1 * $3}] }
+ | T '/' F    { set _ [expr {$1 / $3}] }
+ | F
+ ;
+ 
+F: '(' E ')'  { set _ $2 }
+ | ID         { set _ $::yylval }
+ ;
+ 
+%%
+
+source simple_scanner.tcl
+yyparse
diff --git a/examples/lalr_reduce_reduce.tac b/examples/lalr_reduce_reduce.tac
new file mode 100644
index 0000000..fb7e493
--- /dev/null
+++ b/examples/lalr_reduce_reduce.tac
@@ -0,0 +1,18 @@
+# $Id: lalr_reduce_reduce.tac,v 1.1 2004/08/18 23:53:42 tang Exp $
+
+# Below illustrates a grammar that is ambiguous by an LALR(1) parser
+# but not an LR(1).  There is a reduce/reduce conflict given a viable
+# prefix ac.  taccle resolves this by giving precedence to the first
+# listed rule (A -> c).
+#
+# Reference:
+#   Dragon book, page 238
+
+%token a b c d e
+
+%%
+
+S: a A d | b B d | a B e | b A e ;
+
+A: c ;
+B: c ;
diff --git a/examples/reduce_reduce.tac b/examples/reduce_reduce.tac
new file mode 100644
index 0000000..4de6556
--- /dev/null
+++ b/examples/reduce_reduce.tac
@@ -0,0 +1,20 @@
+# $Id: reduce_reduce.tac,v 1.1 2004/08/18 23:53:43 tang Exp $
+
+# This is an example of where a lookahead of just one symbol is
+# insufficient.  taccle finds a reduce/reduce conflict and resolves it
+# by giving precedence to the first rule (cart_animal -> horse).
+#
+# Reference:
+#   lex & yacc, page 55
+
+%token and cart plow horse goat ox
+
+%%
+
+phrase: cart_animal and cart
+ | work_animal and plow
+ ;
+
+cart_animal: horse | goat ;
+
+work_animal: horse | ox ;
diff --git a/examples/reduce_reduce2.tac b/examples/reduce_reduce2.tac
new file mode 100644
index 0000000..53c6d3b
--- /dev/null
+++ b/examples/reduce_reduce2.tac
@@ -0,0 +1,15 @@
+# $Id: reduce_reduce2.tac,v 1.1 2004/08/18 23:53:43 tang Exp $
+
+# Here is another reduce/reduce conflict.
+#
+# Reference:
+#   lex & yacc, page 225
+
+%token A B C Z
+
+%%
+
+start: A B x Z  | y Z;
+
+x: C;
+y: A B C;
diff --git a/examples/shift_reduce.tac b/examples/shift_reduce.tac
new file mode 100644
index 0000000..8905e26
--- /dev/null
+++ b/examples/shift_reduce.tac
@@ -0,0 +1,17 @@
+# $Id: shift_reduce.tac,v 1.1 2004/08/18 23:53:43 tang Exp $
+
+# This is an example of a shift/reduce conflict.  Eventually I will
+# add operator precedence and associativity, but for now taccle simply
+# gives higher precedence to shifts.
+#
+# Reference:
+#   lex & yacc, pages 229-230 and 236
+
+%token TERMINAL
+
+%%
+
+expr: TERMINAL
+    | expr '+' expr
+    | expr '-' expr
+    | expr '*' expr ;
diff --git a/examples/shift_reduce2.tac b/examples/shift_reduce2.tac
new file mode 100644
index 0000000..c3ad0d3
--- /dev/null
+++ b/examples/shift_reduce2.tac
@@ -0,0 +1,20 @@
+# $Id: shift_reduce2.tac,v 1.1 2004/08/18 23:53:43 tang Exp $
+
+# Here is one final shift/reduce conflict.  taccles resolves the
+# problem by giving precedence to a shift.
+#
+# Reference:
+#   lex & yacc, pages 226-227
+
+%token A R
+
+%%
+
+start: x1
+  |    x2
+  |    y R;
+
+x1: A R;
+x2: A z;
+y:  A;
+z:  R;
diff --git a/examples/simple_calculator.tac b/examples/simple_calculator.tac
new file mode 100644
index 0000000..ea104aa
--- /dev/null
+++ b/examples/simple_calculator.tac
@@ -0,0 +1,36 @@
+# $Id: simple_calculator.tac,v 1.1 2004/08/18 23:53:43 tang Exp $
+
+# This example demonstrates symbol and synthesized values.
+
+%{
+#!/usr/bin/tclsh
+
+%}
+
+%token ID NEWLINE
+%start start
+
+%%
+
+start: E NEWLINE  { puts "Result is $1" }
+ | E              { puts "Result is $1" }
+ ;
+
+E: E '+' T    { set _ [expr {$1 + $3}] }
+ | E '-' T    { set _ [expr {$1 - $3}] }
+ | T
+ ;
+
+T: T '*' F    { set _ [expr {$1 * $3}] }
+ | T '/' F    { set _ [expr {$1 / $3}] }
+ | F
+ ;
+ 
+F: '(' E ')'  { set _ $2 }
+ | ID         { set _ $::yylval }
+ ;
+ 
+%%
+
+source simple_scanner.tcl
+yyparse
diff --git a/examples/simple_expressions.tac b/examples/simple_expressions.tac
new file mode 100644
index 0000000..7cc1f58
--- /dev/null
+++ b/examples/simple_expressions.tac
@@ -0,0 +1,30 @@
+# $Id: simple_expressions.tac,v 1.1 2004/08/18 23:53:43 tang Exp $
+
+# This examples takes simple_grammar and adds actions to each rule.
+
+%{
+#!/usr/bin/tclsh
+
+%}
+
+%token ID
+%start E
+
+%%
+
+E: E '+' T    { puts "E + T" }
+ | T          { puts "T" }
+ ;
+
+T: T '*' F    { puts "T * F" }
+ | F          { puts "F" }
+ ;
+ 
+F: '(' E ')'  { puts "(E)" }
+ | ID         { puts "id" }
+ ;
+ 
+%%
+
+source simple_scanner.tcl
+yyparse
diff --git a/examples/simple_grammar.tac b/examples/simple_grammar.tac
new file mode 100644
index 0000000..ea354d9
--- /dev/null
+++ b/examples/simple_grammar.tac
@@ -0,0 +1,27 @@
+# $Id: simple_grammar.tac,v 1.1 2004/08/18 23:53:43 tang Exp $
+
+%{
+
+source simple_scanner.tcl
+
+%}
+
+%token ID
+
+%%
+
+E: E '+' T
+ | T
+ ;
+
+T: T '*' F 
+ | F
+ ;
+ 
+F: '(' E ')'
+ | ID
+ ;
+ 
+%%
+
+yyparse
diff --git a/examples/simple_scanner.fcl b/examples/simple_scanner.fcl
new file mode 100644
index 0000000..99ff67f
--- /dev/null
+++ b/examples/simple_scanner.fcl
@@ -0,0 +1,16 @@
+# $Id: simple_scanner.fcl,v 1.2 2004/08/18 23:55:31 tang Exp $
+
+%{
+source "simple_calculator.tab.tcl"
+%}
+
+%option interactive
+
+number  [0-9]+
+
+%%
+
+{number}  { set ::yylval $yytext; return $::ID }
+\n        { return $::NEWLINE }
+\s        # ignore whitespace
+.         { set ::yylval $yytext; return $yytext }
diff --git a/taccle.tcl b/taccle.tcl
new file mode 100644
index 0000000..db41038
--- /dev/null
+++ b/taccle.tcl
@@ -0,0 +1,1699 @@
+#!/usr/bin/tclsh
+
+# $Id: taccle.tcl,v 1.6 2005/03/17 20:42:21 tang Exp $
+
+set TACCLE_VERSION 1.3
+
+# no yydebug
+# no YYDEBUG
+# no yyerrok
+# no YYERROR
+# no YYRECOVERING
+# add %define parse.error verbose
+
+#//#
+# Taccle is another compiler compiler written in pure Tcl.  reads a
+# <em>taccle specification file</em> to generate pure Tcl code that
+# implements an LALR(1) parser.  See the {@link README} file for
+# complete instructions.  Additional information may be found at
+# {@link http://mini.net/tcl/taccle}.
+#
+# @author Jason Tang (tang@jtang.org)
+#//#
+
+# Process a definition on a single line, either a literal block or a
+# <code>%</code> directive.
+#
+# @param line text of a definition
+proc handle_defs {line} {
+    # trim whitespace and remove any comments
+    set line [strip_comments [string trim $line]]
+    if {$line == ""} {
+        return
+    }
+    if {$line == "%\{"} {
+        handle_literal_block
+    } else {
+        # extract the keyword to the left of the first space and the
+        # arguments (if any) to the right
+        if {[regexp -line {^(\S+)\s+(.*)} $line foo keyword args] == 0} {
+            set keyword $line
+            set args ""
+        }
+        switch -- $keyword {
+            "%token" {
+                foreach token_name [split $args] {
+                    if {$token_name != ""} {
+                        # add the terminal token to the table
+                        add_token $token_name $::TERMINAL 0 0 nonassoc
+                    }
+                }
+            }
+            "%left" -
+            "%right" -
+            "%nonassoc" {
+                handle_precedence $::next_precedence [string range $keyword 1 end] $args
+                incr ::next_precedence
+            }
+            "%start" {
+                if {$args == ""} {
+                    taccle_error "Must supply a token with %start" $::PARAM_ERROR
+                }
+                set ::start_symbol $args
+            }
+	    "%define" {
+		if {$args == {parse.error verbose}} {
+		    set ::parse_error 1
+		}
+	    }
+            default {
+                taccle_error "Unknown declaration \"$keyword\"" $::SYNTAX_ERROR
+            }
+        }
+    }
+}
+
+# Start reading from the source file and copy everything between ^%\{$
+# to ^%\}$ to the destination file.
+proc handle_literal_block {} {
+    set end_defs 0
+    set lines_in_block 0
+    while {$end_defs == 0} {
+        if {[gets $::src line] < 0} {
+            taccle_error "No terminator to verbatim section found " $::SYNTAX_ERROR
+        } elseif {[string trim $line] == "%\}"} {
+            set end_defs 1
+        } else {
+            puts $::dest $line
+        }
+        incr lines_in_block
+    }
+    incr ::line_count $lines_in_block
+}
+
+# Assigns operator precedence to each token in $tokens.  Adds the
+# token as a TERMINAL to the token table.
+#
+# @param level integer value for token precedence
+# @param direction direction of precedence, either <var>left</var>,
+# <var>right</var>, or <var>nonassoc</var>
+# @param tokens list of terminals to which assign precedence
+proc handle_precedence {level direction tokens} {
+    foreach token $tokens {
+        if {[regexp -- {\A\'(.)\'\Z} $token foo c]} {
+            add_token $c $::TERMINAL 1 $level $direction
+        } else {
+            add_token $token $::TERMINAL 0 $level $direction
+        }
+    }
+}
+
+# The nine steps to actually building a parser, given a string buffer
+# containing all of the rules.
+#
+# @param rules_buf a very large string consisting of all of the
+# grammar's rules
+proc build_parser {rules_buf} {
+    # setp 0: parse the entire rules buffer into separate productions
+    handle_rules_buf $rules_buf
+
+    # step 1: rewrite the grammar, then augment it
+    rewrite_grammar
+
+    # step 2: determine which non-terminals are nullable
+    generate_nullable_table
+    
+    # step 3: generate FIRST table for each element in the token table
+    generate_first_table
+
+    # step 4: now generate FOLLOW table for each element
+    generate_follow_table
+
+    # step 5: build canonical LR(1) table
+    generate_lr1
+
+    # step 6: combine cores into LALR(1) table
+    generate_lalr1
+
+    # step 7: wherever there exists a shift/reduce conflict, choose to
+    # reduce wherever the precedence table dictates such
+    resolve_precedences
+
+    # step 8: check for infinite recursions
+    check_recursions
+    
+    # step 9: finally take LALR(1) table and generate a state
+    # transition matrix
+    generate_lalr1_parse_table
+}
+
+# Parses the rules buffer, extracting each rule and adding
+# pseudo-rules wherever embedded actions exist.
+#
+# @param rules_buf remaining rules to handle
+proc handle_rules_buf {rules_buf} {
+    # counts number of rules in the grammar
+    # rule number 0 is reserved for the special augmentation S' -> S
+    set ::rule_count 1
+    set prev_lhs ""
+
+    # keep track of pseudo-rules (used for embedded actions)
+    set pseudo_count 1
+
+    # add the special end marker
+    set ::token_table("\$",t) $::TERMINAL
+    set ::token_table("\$") 0
+    set ::token_id_table(0) "\$"
+    set ::token_id_table(0,t) $::TERMINAL
+    set ::prec_table(0) 0
+    set ::prec_table(0,dir) nonassoc
+
+    # add the special error token
+    add_token error $::TERMINAL 1 0 nonassoc
+
+    while {[string length $rules_buf] > 0} {
+        # consume blank lines
+        if {[regexp -line -- {\A([[:blank:]]*\n)} $rules_buf foo blanks]} {
+            set rules_buf [string range $rules_buf [string length $blanks] end]
+            incr ::line_count
+            continue
+        }
+        # extract left hand side
+        if {[regexp -line -- {\A\s*(\w+)\s*:} $rules_buf foo lhs]} {
+            add_token $lhs $::NONTERMINAL 0 0 nonassoc
+            set prev_lhs $lhs
+        } elseif {[regexp -line -- {\A\s*\|} $rules_buf foo]} {
+            if {$prev_lhs == ""} {
+                taccle_error "No previously declared left hand side" $::SYNTAX_ERROR
+            }
+            set lhs $prev_lhs
+        } elseif {[regexp -line -- {\A\s*\Z} $rules_buf]} {
+            # only whitespace left
+            break
+        } else {
+            taccle_error "No left hand side found" $::SYNTAX_ERROR
+        }
+        set rules_buf [string range $rules_buf [string length $foo] end]
+        
+        # read the rule derivation, which is everything up to a bar or
+        # semicolon
+        set rhs ""
+        set action ""
+        set done_deriv 0
+        set num_lines 0
+        while {$rules_buf != "" && $done_deriv != 1} {
+            switch -- [string index $rules_buf 0] {
+                |    { set done_deriv 1 }
+                ;    {
+                    set done_deriv 1
+                    set prev_lhs ""
+                    set rules_buf [string range $rules_buf 1 end]
+                }
+                "\n" {
+                    incr num_lines
+                    append rhs " "
+                    set rules_buf [string range $rules_buf 1 end]
+                }
+                '  {
+                    append rhs [string range $rules_buf 0 2]
+                    set rules_buf [string range $rules_buf 3 end]
+                }
+                \{   {
+                    # keep scanning until end of action found
+                    set a ""
+                    set rp 1
+                    set found_end 0
+                    while {!$found_end && $rp < [string length $rules_buf]} {
+                        set c [string index $rules_buf $rp]
+                        if {$c == "\}"} {
+                            if {[info complete $a]} {
+                                set found_end 1
+                            } else {
+                                append a "\}"
+                            }
+                        } elseif {$c == "\n"} {
+                            append a $c
+                            incr num_lines
+                        } else {
+                            append a $c
+                        }
+                        incr rp
+                    }
+                    if {!$found_end} {
+                        taccle_error "Unmatched `\{'" $::SYNTAX_ERROR
+                    }
+                    set action $a
+                    set rules_buf [string range $rules_buf $rp end]
+                }
+                default {
+                    set c [string index $rules_buf 0]
+                    if {$action != "" && ![string is space $c]} {
+                        # embedded action found; add a special rule for it
+                        set pseudo_name "@PSEUDO$pseudo_count"
+                        add_token $pseudo_name $::NONTERMINAL 0 0 nonassoc
+                        set ::rule_table($::rule_count,l) $pseudo_name
+                        set ::rule_table($::rule_count,d) ""
+                        set ::rule_table($::rule_count,dc) 0
+                        set ::rule_table($::rule_count,a) $action
+                        set ::rule_table($::rule_count,e) 0
+                        set ::rule_table($::rule_count,line) $::line_count
+                        append rhs "$pseudo_name "
+                        set action ""
+                        incr pseudo_count
+                        incr ::rule_count
+                    } else {
+                        append rhs $c
+                        set rules_buf [string range $rules_buf 1 end]
+                    }
+                }
+            }
+        }
+        if {$rules_buf == "" && $done_deriv == 0} {
+            taccle_error "Rule does not terminate" $::SYNTAX_ERROR
+        }
+        set derivation [string trim $rhs]
+        set deriv_list ""
+        set deriv_count 0
+        set prec_next 0
+        foreach token [split $derivation] {
+            if {$prec_next} {
+                # check that argument to %prec is a terminal symbol
+                if {![info exists ::token_table($token)] || \
+                        $::token_table($token,t) != $::TERMINAL} {
+                    taccle_error "Argument to %prec is not a terminal symbol" $::GRAMMAR_ERROR
+                }
+                set ::rule_table($::rule_count,prec) $::token_table($token)
+                set prec_next 0
+                continue
+            }
+            if {$token == "%prec"} {
+                set prec_next 1
+                continue
+            }
+            if {[regexp -- {\A\'(.)\'\Z} $token foo c]} {
+                add_token $c $::TERMINAL 1 0 nonassoc
+                set token $c
+            }
+            if {$token != ""} {
+                if {[string range $token 0 6] == "@PSEUDO"} {
+                    set ::rule_table([expr {$::rule_count - 1}],e) $deriv_count
+                }
+                
+                lappend deriv_list $token
+                incr deriv_count
+            }
+        }
+        if {$prec_next} {
+            taccle_error "%prec modifier has no associated terminal symbol" $::PARAM_ERROR
+        }
+        incr ::line_count $num_lines
+        set ::rule_table($::rule_count,l) $lhs
+        set ::rule_table($::rule_count,d) $deriv_list
+        set ::rule_table($::rule_count,dc) [llength $deriv_list]
+        set ::rule_table($::rule_count,a) $action
+        set ::rule_table($::rule_count,line) $::line_count
+        incr ::rule_count
+    }
+}
+
+# Post-process the grammar by augmenting it and and replacing all
+# tokens with their id values.
+proc rewrite_grammar {} {
+    set ::rule_table(0,l) "start'"    
+    if {[info exists ::start_symbol]} {
+        if {![info exists ::token_table($::start_symbol)]} {
+            taccle_error "Token given by %start does not exist" $::PARAM_ERROR
+        }
+        if {$::token_table($::start_symbol,t) == $::TERMINAL} {
+            taccle_error "Token given by %start is a terminal." $::PARAM_ERROR
+        }
+        set ::rule_table(0,d) $::start_symbol
+    } else {
+        set ::rule_table(0,d) $::rule_table(1,l)
+    }
+    set ::rule_table(0,dc) 1
+    set ::rule_table(0,prec) 0
+    set ::start_token_id [add_token "start'" $::NONTERMINAL 0 0 nonassoc]
+    set ::token_list [lsort -command tokid_compare $::token_list]
+
+    # now go through grammar and replace all token names with their id
+    # number
+    for {set i 0} {$i < $::rule_count} {incr i} {
+        set ::rule_table($i,l) $::token_table($::rule_table($i,l))
+        set new_deriv_list ""
+        foreach deriv $::rule_table($i,d) {
+            if {![info exists ::token_table($deriv)]} {
+                taccle_error "Symbol $deriv used, but is not defined as a token and has no rules." $::GRAMMAR_ERROR
+            }
+            lappend new_deriv_list $::token_table($deriv)
+        }
+        set ::rule_table($i,d) $new_deriv_list
+        # set the rule's precedence only if it was not already specified
+        if {![info exist ::rule_table($i,prec)]} {
+            set ::rule_table($i,prec) [get_prec $new_deriv_list]
+        }
+    }
+    
+    # check for unused tokens
+    set used_list [concat "error" [recurse_dfs $::start_token_id ""]]
+    foreach tok_id $::token_list {
+        if {[lsearch -exact $used_list $tok_id] == -1} {
+            taccle_warn "Token $::token_id_table($tok_id) unused."
+        } else {
+            lappend ::used_token_list $tok_id
+        }
+    }
+    # add to the used token list {$} but /not/ start'
+    set ::used_token_list [concat [lrange $::used_token_list 0 end-1] \
+                               $::token_table("\$")]
+}
+
+# Determine which non-terminals are nullable.  Any terminal which can
+# be simplified to just an epsilon transition is nullable.
+proc generate_nullable_table {} {
+    set nullable_found 1
+    while {$nullable_found} {
+        set nullable_found 0
+        foreach tok_id $::token_list {
+            if {[info exist ::nullable_table($tok_id)]} {
+                continue
+            }
+            if {$::token_id_table($tok_id,t) == $::TERMINAL} {
+                set ::nullable_table($tok_id) 0
+                continue
+            }            
+            for {set i 0} {$i < $::rule_count} {incr i} {
+                set lhs $::rule_table($i,l)
+                if {$lhs != $tok_id} {
+                    continue
+                }
+                set rhs [lindex $::rule_table($i,d) 0]
+                if {$rhs == ""} {
+                    set ::nullable_table($lhs) 1
+                    set nullable_found 1
+                } else {
+                    set nullable 0
+                    foreach r $rhs {
+                        if {[info exists ::nullable_table($r)]} {
+                            set nullable $::nullable_table($r)
+                            break
+                        }
+                    }
+                    if {$nullable} {
+                        set ::nullable_table($lhs) 1
+                        set nullable_found 1
+                    }
+                }
+            }
+        }
+    }
+    foreach tok_id $::token_list {
+        if {![info exist ::nullable_table($tok_id)]} {
+            set ::nullable_table($tok_id) 0
+        }
+    }
+}
+
+# Generate the table of FIRST symbols for the grammar.
+proc generate_first_table {} {
+    foreach tok_id $::token_list {
+        generate_first_recurse $tok_id ""
+    }
+}
+
+# Recursively calculates the FIRST set for a given token, handling
+# nullable terminals as well.
+#
+# @param tok_id id of token to generate FIRST set
+# @param history list of tokens already examined
+# @return list of tokens (including -1 for epsilon) in tok_id's FIRST set
+proc generate_first_recurse {tok_id history} {
+    if {[lsearch -exact $history $tok_id] >= 0} {
+        return ""
+    }
+    if {[info exists ::first_table($tok_id)]} {
+        return $::first_table($tok_id)
+    }
+    if {$::token_id_table($tok_id,t) == $::TERMINAL} {
+        set ::first_table($tok_id) $tok_id
+        return $tok_id
+    }
+    # FIRST = union of all first non-terminals on rhs.  if a
+    # non-terminal is nullable, then add FIRST of the following
+    # terminal to the FIRST set.  keep repeating while nullable.
+    set first_union ""
+    for {set i 0} {$i < $::rule_count} {incr i} {
+        set lhs $::rule_table($i,l)
+        if {$lhs != $tok_id} {
+            continue
+        }
+        if {$::rule_table($i,dc) == 0} {
+            # empty rule, so add the special epsilon marker -1 to the FIRST set
+            lappend first_union -1
+        } else {
+            foreach r $::rule_table($i,d) {
+                lconcat first_union [generate_first_recurse $r [concat $history $tok_id]]
+                if {$::nullable_table($r) == 0} {
+                    break
+                }
+            }
+        }
+    }
+    set ::first_table($tok_id) [lsort -increasing -unique $first_union]
+    return $first_union
+}
+
+# Generate the table of FOLLOW symbols for the grammar.
+proc generate_follow_table {} {
+    set ::follow_table($::token_table(start')) $::token_table("\$")
+    foreach tok_id $::token_list {
+        generate_follow_recurse $tok_id ""
+    }
+}
+
+# Recursively calculates the FOLLOW set for a given token, handling
+# nullable terminals as well.
+#
+# @param tok_id id of token to generate FOLLOW set
+# @param history list of tokens already examined
+# @return list of tokens in tok_id's FOLLOW set
+proc generate_follow_recurse {tok_id history} {
+    if {[lsearch -exact $history $tok_id] >= 0} {
+        return ""
+    }
+    if {[info exists ::follow_table($tok_id)]} {
+        return $::follow_table($tok_id)
+    }
+    set follow_union ""
+    for {set i 0} {$i < $::rule_count} {incr i} {
+        # if the token is on the rhs of the rule then FOLLOW includes
+        # the FIRST of the token following it; if at end of rule (or
+        # can be derived to end of rule) then FOLLOW includes the
+        # FOLLOW of the lhs
+        set rhs $::rule_table($i,d)
+        for {set j [expr {$::rule_table($i,dc) - 1}]} {$j >= 0} {incr j -1} {
+            set r [lindex $rhs $j]
+            if {$r != $tok_id} {
+                continue
+            }
+            set k [expr {$j + 1}]
+            set gamma [lindex $rhs $k]
+            if {$gamma != ""} {
+                lconcat follow_union [all_but_eps $::first_table($gamma)]
+            }
+            set at_end_of_list 1
+            while {$k < $::rule_table($i,dc)} {
+                if {![has_eps $::first_table([lindex $rhs $k])]} {
+                    set at_end_of_list 0
+                    break
+                }
+                incr k
+            }
+            if {$at_end_of_list} {
+                set lhs $::rule_table($i,l)
+                lconcat follow_union [generate_follow_recurse $lhs [concat $history $tok_id]]
+            }
+        }
+    }
+    set ::follow_table($tok_id) [lsort -increasing -unique $follow_union]
+    return $follow_union
+}
+
+# Construct a canonical LR(1) by taking the start rule (rule 0) and
+# successively adding closures/states until no more new states.
+proc generate_lr1 {} {
+    # first add start rule to the closure list
+    set first_item [list [list 0 $::token_table("\$") 0]]
+    set first_closure [add_closure $first_item 0 1]
+    set ::lr1_table(0) [concat $first_item $first_closure]
+    
+    # used to keep count of total number of states produced by LR(1)
+    set ::next_lr1_state 1
+    
+    # keep generating items until none remain
+    for {set state_pointer 0} {$state_pointer < $::next_lr1_state} {incr state_pointer} {        
+        # iterate through each token, adding transitions to new state(s)
+        set trans_list ""
+        set oldclosure_list $::lr1_table($state_pointer)
+        foreach tok_id $::token_list {
+            set todo_list ""
+            set working_list ""
+            foreach item $oldclosure_list {
+                foreach {rule lookahead position} $item {}
+                if {$position >= $::rule_table($rule,dc)} {
+                    # at end of rule; don't expand (and remove it
+                    # from the list)
+                    continue
+                }
+                set nexttoken [lindex $::rule_table($rule,d) $position]
+                if {$nexttoken == $tok_id} {
+                    # item's next token matches the one currently
+                    # saught; add it to the working list
+                    lappend working_list $item
+                } else {
+                    # item was not used yet -- add it back to the
+                    # todo list
+                    lappend todo_list $item
+                }
+            }
+            set oldclosure_list $todo_list
+            if {$working_list != ""} {
+                set new_closure ""
+                foreach item $working_list {
+                    # move pointer ahead to the next position
+                    foreach {rule lookahead position} $item {}
+                    incr position
+                    set newitem [list $rule $lookahead $position]
+                    lappend new_closure $newitem
+                }
+                set new_closure [concat $new_closure \
+                                     [add_closure $new_closure 0 [llength $working_list]]]
+                # add a transition out of this state -- to a
+                # previously examined state if possible, or else
+                # create a new state with my new closure
+                set next_state -1
+                for {set i 0} {$i < $::next_lr1_state} {incr i} {
+                    if {[lsort $::lr1_table($i)] == [lsort $new_closure]} {
+                        set next_state $i
+                        break
+                    }
+                }
+                if {$next_state == -1} {
+                    # create a new state
+                    set ::lr1_table($::next_lr1_state) $new_closure
+                    lappend trans_list [list $tok_id $::next_lr1_state]
+                    incr ::next_lr1_state
+                } else {
+                    # reuse existing state
+                    lappend trans_list [list $tok_id $next_state]
+                }
+
+            }
+        }
+        set ::lr1_table($state_pointer,trans) [lsort -command tokid_compare -index 0 $trans_list]
+    }
+}
+
+# Successively add closures from LR(1) table to LALR(1) table merging
+# kernels with similar cores.
+proc generate_lalr1 {} {
+    for {set i 0} {$i < $::next_lr1_state} {incr i} {
+        # as matching closures are found change their mapping here
+        set state_mapping_table($i) $i
+    }
+    # go through all elements of LR(1) table and generate their cores.
+    # this will make future comparisons easier.
+    for {set i 0} {$i < $::next_lr1_state} {incr i} {
+        set core ""
+        foreach item $::lr1_table($i) {
+            lappend core [list [lindex $item 0] [lindex $item 2]]
+        }
+        set core_table($i) [lsort $core]
+    }
+    lappend new_lalr_states(0) 0
+    for {set i 1} {$i < $::next_lr1_state} {incr i} {
+        set found_matching 0
+        for {set j 0} {$j < $i} {incr j} {
+            if {$core_table($i) == $core_table($j)} {
+                # found a matching core -- change its mapping
+                set state_mapping_table($i) $state_mapping_table($j)
+                # because this state is being eliminated, shuffle all
+                # future states down one
+                for {set k [expr {$i + 1}]} {$k < $::next_lr1_state} {incr k} {
+                    incr state_mapping_table($k) -1
+                }
+                # merge state $i into state $j
+                lappend new_lalr_states($j) $i
+                set found_matching 1
+                break
+            }
+        }
+        if {!$found_matching} {
+            lappend new_lalr_states($i) $i
+        }
+    }
+    # now copy items from LR(1) table to LALR(1) table
+    set ::next_lalr1_state 0
+    for {set i 0} {$i < $::next_lr1_state} {incr i} {
+        if {![info exists new_lalr_states($i)]} {
+            # state no longer exists (it got merged into another one)
+            continue
+        }
+        # first merge together all lookaheads
+        set ::lalr1_table($::next_lalr1_state) $::lr1_table([lindex $new_lalr_states($i) 0])
+        foreach state [lrange $new_lalr_states($i) 1 end] {
+          set ::lalr1_table($::next_lalr1_state) \
+              [merge_closures $::lalr1_table($::next_lalr1_state) $::lr1_table($state)]
+        }
+        # now rewrite the transition table
+        foreach trans $::lr1_table($i,trans) {
+            foreach {symbol new_state} $trans {}
+            lappend ::lalr1_table($::next_lalr1_state,trans) \
+                [list $symbol $state_mapping_table($new_state)]
+        }
+        incr ::next_lalr1_state
+    }
+}
+
+# Takes the LALR(1) table and resolves precedence issues by removing
+# transitions whenever the precedence values indicate a reduce instead
+# of a shift.
+proc resolve_precedences {} {
+    for {set i 0} {$i < $::next_lalr1_state} {incr i} {
+        # scan through all kernel items that are at the end of their
+        # rule.  for those, use the precedence table to decide to keep
+        # a transition (a shift) or not (a reduce)
+        foreach item $::lalr1_table($i) {
+            foreach {rule lookahead position} $item {}
+            if {$position < $::rule_table($rule,dc) || \
+                    ![info exist ::lalr1_table($i,trans)]} {
+                continue
+            }
+            set rule_prec_tok $::rule_table($rule,prec)
+            set rule_prec_level $::prec_table($rule_prec_tok)
+            set rule_prec_dir $::prec_table($rule_prec_tok,dir)
+            set new_trans ""
+            foreach trans $::lalr1_table($i,trans) {
+                set trans_tok [lindex $trans 0]
+                if {[lsearch $lookahead $trans_tok] == -1} {
+                    lappend new_trans $trans
+                    continue
+                }
+                set trans_tok_level $::prec_table($trans_tok)
+                set trans_tok_dir $::prec_table($trans_tok,dir)
+                if {$rule_prec_dir == "nonassoc" || \
+                        $trans_tok_dir == "nonassoc" || \
+                        $rule_prec_level < $trans_tok_level || \
+                        ($rule_prec_level == $trans_tok_level && $rule_prec_dir == "right")} {
+                    # precedence says to shift, so keep this transition
+                    lappend new_trans $trans
+                } else {
+                    taccle_warn "Conflict in state $i between rule $rule and token \"$trans_tok\", resolved as reduce."
+                }
+            }
+            set ::lalr1_table($i,trans) $new_trans
+        }
+    }
+}
+
+# Check if the grammar contains any infinite recursions.
+proc check_recursions {} {
+    set cleared ""
+    for {set i 0} {$i < $::next_lalr1_state} {incr i} {
+        if {[lsearch -exact $cleared $i] >= 0} {
+            continue
+        }
+        set cleared [get_cleared $i {} $cleared]
+    }
+}
+
+# Recursively performs a DFS search through the LALR(1) table to check
+# for cycles.  In each node check if the position is at the end of any
+# rule; this marks the node is "reducible" and it is added to the
+# 'cleared' list.  Otherwise recurse on each terminal transitioning
+# out of this state.  If a state and all of its transitions are not
+# reducible then abort with an error.
+#
+# @param state which state within the LALR(1) table to examine
+# @param history a list of states so far examined on this pass
+# @param cleared a list of states which have already been verified as reducible
+#
+# @return a new cleared list, or an empty list of this state is not reducible
+proc get_cleared {state history cleared} {
+    if {[lsearch -exact $cleared $state] >= 0} {
+        return $cleared
+    }
+    if {[lsearch -exact $history $state] >= 0} {
+        return {}
+    }
+    # check if any items in this closure are reducible; if so then
+    # this state passes
+    set token -1
+    foreach item $::lalr1_table($state) {
+        foreach {rule lookahead position} $item {}
+        if {$position == $::rule_table($rule,dc)} {
+            return [concat $cleared $state]
+        }
+        if {$position == 0} {
+            set token $::rule_table($rule,l)
+        }
+    }
+    # recursively check all terminals transitioning out of this state;
+    # if none of the new states eventually reduce then report this as
+    # a cycle
+    foreach trans $::lalr1_table($state,trans) {
+        foreach {tok_id nextstate} $trans {}
+        if {$::token_id_table($tok_id,t) == $::TERMINAL} {
+            set retval [get_cleared $nextstate [concat $history $state] $cleared]
+            if {[llength $retval] > 0} {
+                return [concat $retval $state]
+            }
+        }
+    }
+    if {$token == -1} {
+        puts stderr "OOPS: should not have gotten here!"
+        exit -1
+    }
+    set ::line_count $::rule_table($rule,line)
+    taccle_error "Token $::token_id_table($token) appears to recurse infinitely" $::GRAMMAR_ERROR
+}
+
+# Takes the LALR(1) table and generates the LALR(1) transition table.
+# For terminals do a shift to the new state.  For non-terminals reduce
+# when the next token is a lookahead.  Detect shift/reduce conflicts;
+# resolve by giving precedence to shifting.  Detect reduce/reduce
+# conflicts and resolve by reducing to the first rule found.
+proc generate_lalr1_parse_table {} {
+    for {set i 0} {$i < $::next_lalr1_state} {incr i} {        
+        foreach item $::lalr1_table($i) {
+            foreach {rule lookahead position} $item {}
+            if {$position >= $::rule_table($rule,dc)} {
+                if {$rule == 0} {
+                    set command "accept"
+                } else {
+                    set command "reduce"
+                }
+                set token_list $lookahead
+                # target for a reduce/accept is which rule to use
+                # while accepting
+                set target $rule
+            } else {
+                set token [lindex $::rule_table($rule,d) $position]
+                if {$::token_id_table($token,t) == $::TERMINAL} {
+                    set command "shift"
+                } else {
+                    set command "goto"
+                }
+                set token_list [list $token]
+                # target for a shift/goto is the new state to move to
+                set target ""
+                foreach trans $::lalr1_table($i,trans) {
+                    foreach {tok_id nextstate} $trans {}
+                    if {$tok_id == $token} {
+                        set target $nextstate
+                        break
+                    }
+                }
+                # this token must have been consumed by shift/reduce
+                # conflict resolution through the precedence table
+                # (above)
+                if {$target == ""} {
+                    continue
+                }
+            }
+
+            foreach token $token_list {
+                # check for shift/reduce conflicts
+                if {[info exists ::lalr1_parse($i:$token)] && \
+                        $::lalr1_parse($i:$token) != $command} {
+                    # shifting takes precedence, so overwrite table
+                    # entry if needed
+                    if {$::lalr1_parse($i:$token) == "shift"} {
+                        taccle_warn "Shift/Reduce error in state $i, token \"$::token_id_table($token)\", resolved by keeping shift."
+                        break
+                    }
+                    taccle_warn "Shift/Reduce error in state $i between rule $::lalr1_parse($i:$token,target) and token \"$::token_id_table($token)\", resolved as shift."
+                    unset ::lalr1_parse($i:$token,target)
+                }
+                set ::lalr1_parse($i:$token) $command
+                # check for reduce/reduce conflicts
+                # (theoretically it is impossible to have a shift/shift error)
+                if {[info exists ::lalr1_parse($i:$token,target)] && \
+                        $::lalr1_parse($i:$token,target) != $target} {
+                    taccle_warn "Reduce/Reduce error in state $i, token \"$::token_id_table($token)\", resolved by reduce to rule $::lalr1_parse($i:$token,target)."
+                    break
+                }
+                set ::lalr1_parse($i:$token,target) $target
+            }
+            
+        }
+    }
+}
+
+######################################################################
+# utility routines that actually handle writing parser to output files
+
+# Writes to the destination file utility functions called by yyparse
+# as well as by user-supplied actions.
+proc write_parser_utils {} {
+    puts $::dest "
+######
+# Begin autogenerated taccle (version $::TACCLE_VERSION) routines.
+# Although taccle itself is protected by the GNU Public License (GPL)
+# all user-supplied functions are protected by their respective
+# author's license.  See http://mini.net/tcl/taccle for other details.
+######
+
+namespace eval ${::p} \{
+    variable yylval {}
+    variable table
+    variable rules
+    variable token {}
+    variable yycnt 0
+
+    namespace export yylex
+\}
+
+proc ${::p}::YYABORT \{\} \{
+    return -code return 1
+\}
+
+proc ${::p}::YYACCEPT \{\} \{
+    return -code return 0
+\}
+
+proc ${::p}::yyclearin \{\} \{
+    variable token
+    variable yycnt
+    set token {}
+    incr yycnt -1
+\}
+
+proc ${::p}::yyerror \{s\} \{
+    puts stderr \$s
+\}
+
+proc ${::p}::setupvalues \{stack pointer numsyms\} \{
+    upvar 1 1 y
+    set y \{\}
+    for \{set i 1\} \{\$i <= \$numsyms\} \{incr i\} \{
+        upvar 1 \$i y
+        set y \[lindex \$stack \$pointer\]
+        incr pointer
+    \}
+\}
+
+proc ${::p}::unsetupvalues \{numsyms\} \{
+    for \{set i 1\} \{\$i <= \$numsyms\} \{incr i\} \{
+        upvar 1 \$i y
+        unset y
+    \}
+\}"
+}
+
+# Writes to the destination file the actual parser including LALR(1)
+# table.
+proc write_parser {} {
+    write_array $::dest ${::p}::table [array get ::lalr1_parse]
+    write_array $::dest ${::p}::rules [array get ::rule_table *l]
+    write_array $::dest ${::p}::rules [array get ::rule_table *dc]
+    write_array $::dest ${::p}::rules [array get ::rule_table *e]
+    if {$::parse_error} {
+	write_array $::dest ${::p}::lr1_table [array get ::lr1_table]
+	write_array $::dest ${::p}::token_id_table [array get ::token_id_table]
+    }
+    
+    puts $::dest "\nproc ${::p}::yyparse {} {
+    variable yylval
+    variable table
+    variable rules
+    variable token
+    variable yycnt
+    variable lr1_table
+    variable token_id_table
+
+    set yycnt 0
+    set state_stack {0}
+    set value_stack {{}}
+    set token \"\"
+    set accepted 0
+
+    while {\$accepted == 0} {
+        set state \[lindex \$state_stack end\]
+        if {\$token == \"\"} {
+            set yylval \"\"
+            set token \[yylex\]
+            set buflval \$yylval
+	    if {\$token>0} {
+	        incr yycnt
+            }
+        }
+        if {!\[info exists table(\$state:\$token)\]} {
+	    set save_state \$state
+            \# pop off states until error token accepted
+            while {\[llength \$state_stack\] > 0 && \\
+                       !\[info exists table(\$state:error)]} {
+                set state_stack \[lrange \$state_stack 0 end-1\]
+                set value_stack \[lrange \$value_stack 0 \\
+                                       \[expr {\[llength \$state_stack\] - 1}\]\]
+                set state \[lindex \$state_stack end\]
+            }
+            if {\[llength \$state_stack\] == 0} {"
+    if {$::parse_error} {
+puts $::dest " 
+	        set rr { }
+                if {\[info exists lr1_table(\$save_state,trans)\] && \[llength \$lr1_table(\$save_state,trans)\] >= 1} {
+                    foreach trans \$lr1_table(\$save_state,trans) {
+                        foreach {tok_id nextstate} \$trans {
+			    set ss \$token_id_table(\$tok_id)
+			    set ss \[string trimright \$ss {_}\]
+			    if {\[string is upper \$ss\]} {
+			        append rr \"\$ss, \"
+                            }
+                        }
+                    }
+                }
+		set rr \[string trimleft \$rr { }\]
+		set rr \[string trimright \$rr {, }\]
+                yyerror \"parse error, expecting: \$rr\"
+"
+    } else {
+puts $::dest " 
+                yyerror \"parse error\"
+"
+    }
+puts $::dest "
+                return 1
+            }
+            lappend state_stack \[set state \$table(\$state:error,target)\]
+            lappend value_stack {}
+            \# consume tokens until it finds an acceptable one
+            while {!\[info exists table(\$state:\$token)]} {
+                if {\$token == 0} {
+                    yyerror \"end of file while recovering from error\"
+                    return 1
+                }
+                set yylval {}
+                set token \[yylex\]
+                set buflval \$yylval
+            }
+            continue
+        }
+        switch -- \$table(\$state:\$token) {
+            shift {
+                lappend state_stack \$table(\$state:\$token,target)
+                lappend value_stack \$buflval
+                set token \"\"
+            }
+            reduce {
+                set rule \$table(\$state:\$token,target)
+                set ll \$rules(\$rule,l)
+                if \{\[info exists rules(\$rule,e)\]\} \{
+                    set dc \$rules(\$rule,e)
+                \} else \{
+                    set dc \$rules(\$rule,dc)
+                \}
+                set stackpointer \[expr {\[llength \$state_stack\]-\$dc}\]
+                setupvalues \$value_stack \$stackpointer \$dc
+                set _ \$1
+                set yylval \[lindex \$value_stack end\]
+                switch -- \$rule {"
+    for {set i 0} {$i < $::rule_count} {incr i} {
+        if {[info exists ::rule_table($i,a)] && [string trim $::rule_table($i,a)] != ""} {
+            puts $::dest "                    $i { $::rule_table($i,a) }"
+        }
+    }
+
+    puts $::dest "                }
+                unsetupvalues \$dc
+                # pop off tokens from the stack if normal rule
+                if \{!\[info exists rules(\$rule,e)\]\} \{
+                    incr stackpointer -1
+                    set state_stack \[lrange \$state_stack 0 \$stackpointer\]
+                    set value_stack \[lrange \$value_stack 0 \$stackpointer\]
+                \}
+                # now do the goto transition
+                lappend state_stack \$table(\[lindex \$state_stack end\]:\$ll,target)
+                lappend value_stack \$_
+            }
+            accept {
+                set accepted 1
+            }
+            goto -
+            default {
+                puts stderr \"Internal parser error: illegal command \$table(\$state:\$token)\"
+                return 2
+            }
+        }
+    }
+    return 0
+}
+
+######
+# end autogenerated taccle functions
+######
+"
+}
+
+# Pretty-prints an array to a file descriptor.  Code contributed by
+# jcw.
+#
+# @param fd file descriptor to which write the array
+# @param name name of array to declare within the file
+# @param values list of 2-ple values
+proc write_array {fd name values} {
+    puts $fd "\narray set $name {"
+    foreach {x y} $values {
+        puts $fd "  [list $x $y]"
+    }
+    puts $fd "}"
+}
+
+# Writes a header file that should be [source]d by the lexer.
+proc write_header_file {} {
+    # scan through token_table and write out all non-implicit terminals
+    foreach tok_id $::token_list {
+        if {$::token_id_table($tok_id,t) == $::TERMINAL && \
+                [string is integer $tok_id] && $tok_id >= 256} {
+            set token $::token_id_table($tok_id)
+            puts $::header "set ${token} $tok_id"
+        }
+    }
+}
+
+######################################################################
+# utility functions
+
+# Adds a token to the token table, checking that it does not already
+# exist.  Returns the ID for the token (either old one if token
+# already exists or the newly assigned id value).
+#
+# @param token_name name of token to add
+# @param type type of token, either $::TERMINAL or $::NON_TERMINAL
+# @param implicit for $::TERMINAL tokens, 1 if the token is implicitly
+# declared
+# @param prec_level precedence level for token
+# @param prec_dir direction of precedence, either <var>left</var>,
+# <var>right</var>, or <var>nonassoc</var>
+# @return id value for this token
+proc add_token {token_name type implicit prec_level prec_dir} {
+    if {$token_name == "\$"} {
+        taccle_error "The token '$' is reserved and may not be used in productions." $::SYNTAX_ERROR
+    }
+    if {$token_name == "\{" || $token_name == 0} {
+        taccle_error "Literal value $token_name not allowed; define a %token instead" $::SYNTAX_ERROR
+    }
+    if [info exists ::token_table($token_name)] {
+        set id $::token_table($token_name)
+        if {$::token_table($token_name,t) == $type} {
+            # token already exists; modify its precedence level if necessary
+            if {$::prec_table($id) < $prec_level} {
+                taccle_warn "Redefining precedence of $token_name"
+                set ::prec_table($id) $prec_level
+                set ::prec_table($id,dir) $prec_dir
+            }
+            set ::token_id_table($id,line) $::line_count
+            return $id
+        }
+        set old_type [expr {$::token_table($token_name,t) == 1 ? "non-" : ""}]terminal
+        taccle_error "Token $token_name already declared as a $old_type" $::GRAMMAR_ERROR
+    }
+    if $implicit {
+        set ::token_table($token_name) $token_name
+        set id $token_name
+    } else {
+        set ::token_table($token_name) $::next_token_id
+        set id $::next_token_id
+        incr ::next_token_id
+    }
+    set ::token_table($token_name,t) $type
+    set ::token_id_table($id) $token_name
+    set ::token_id_table($id,t) $type
+    set ::token_id_table($id,line) $::line_count
+    lappend ::token_list $id
+    set ::prec_table($id) $prec_level
+    set ::prec_table($id,dir) $prec_dir
+    return $id
+}
+
+# Adds closures to each item on $closure_list, starting from the index
+# $closure_pointer.  Keeps adding closures until no more are added.
+#
+# @param closure_list list of closures to process
+# @param closure_pointer index into $closure_list to which start
+# @param original_length original size of $closure_list
+# @return list of closures added
+proc add_closure {closure_list closure_pointer original_length} {
+    set orig_closure_pointer [expr {$closure_pointer + $original_length}]
+    # keep adding items to the closure list until no more
+    while {$closure_pointer < [llength $closure_list]} {
+        set item [lindex $closure_list $closure_pointer]
+        incr closure_pointer
+        foreach {rule lookahead position} $item {}
+        set mylength $::rule_table($rule,dc)
+        if {$position < $mylength} {
+            set nexttoken [lindex $::rule_table($rule,d) $position]
+            if {$::token_id_table($nexttoken,t) == $::TERMINAL} {
+                continue
+            }
+            # the lookahead is the FIRST of the rule /after/
+            # nexttoken, or the current lookahead if at the end of
+            # rule.  if the next token is NULLABLE then the lookahead
+            # includes that which FOLLOWS it
+            set beta_pos [expr {$position + 1}]
+            if {$beta_pos >= $mylength} {
+                set nextfirst $lookahead
+            } else {
+                set n [lindex $::rule_table($rule,d) $beta_pos]
+                set nextfirst [all_but_eps $::first_table($n)]
+                if {$::nullable_table($n)} {
+                    set nextfirst [lsort -unique [concat $nextfirst $::follow_table($n)]]
+                }
+            }
+            for {set rule_num 0} {$rule_num < $::rule_count} {incr rule_num} {
+                if {$::rule_table($rule_num,l) != $nexttoken} {
+                    continue
+                }
+                set newitem [list $rule_num $nextfirst 0]
+                set closure_list [merge_closures $closure_list [list $newitem]]
+            }
+        }
+    }
+    return [lrange $closure_list $orig_closure_pointer end]
+}
+
+# Recurses through all productions, recording which tokens are
+# actually used by the grammar.  Tokens used to indicate a rule's
+# precedence are also added.  Returns a list of tokens used; note that
+# this list can (and probably will) include duplicates.
+#
+# @param tok_id id of token to start
+# @param history list of tok_id's already examined
+# @return list of tokens used
+proc recurse_dfs {tok_id history} {
+    if {[lsearch -exact $history $tok_id] >= 0} {
+        return $history
+    }
+    if {$::token_id_table($tok_id,t) == $::TERMINAL} {
+        return [concat $history $tok_id]
+    }
+    lappend history $tok_id
+    for {set i 0} {$i < $::rule_count} {incr i} {
+        set lhs $::rule_table($i,l)
+        if {$lhs == $tok_id} {
+            foreach deriv $::rule_table($i,d) {
+                set history [recurse_dfs $deriv $history]
+            }
+            lconcat history $::rule_table($i,prec)
+        }
+    }
+    return $history
+}
+
+# Given a line, returns a new line with any comments removed.
+#
+# @param line string with a possible comment
+# @return line with any commens removed
+proc strip_comments {line} {
+    regexp -- {\A([^\#]*)} $line foo line
+    return $line
+}
+
+# Combines unique elements of the two closures, also merging lookahead
+# symbols, and returns the new closure.
+#
+# @param closure1 first closure to merge
+# @param closure2 second closure to merge
+# @return $closure1 and $closure2 merged together, with duplicated removed
+proc merge_closures {closure1 closure2} {
+    foreach item2 $closure2 {
+        foreach {rule2 lookahead2 pos2} $item2 {}
+        set found_match 0
+        for {set i 0} {$i < [llength $closure1]} {incr i} {
+            foreach {rule1 lookahead1 pos1} [lindex $closure1 $i] {}
+            if {$rule2 == $rule1 && $pos2 == $pos1} {
+                set lookahead1 [lsort -uniq [concat $lookahead1 $lookahead2]]
+                lset closure1 $i [list $rule1 $lookahead1 $pos1]
+                set found_match 1
+                break
+            }
+        }
+        if {!$found_match} {
+            lappend closure1 $item2
+        }
+    }
+    return $closure1
+}
+
+# Compares two token id values.  If the two are integers then uses
+# their values for comparison; otherwise performs a string comparison.
+# Integer values are always "greater than" strings.
+#
+# @param a first token id
+# @param b second token id
+# @return -1 if <var>a</var> is less than <var>b</var>, 1 if
+# <var>a</var> is greater, otherwise 0
+proc tokid_compare {a b} {
+    if {[string is integer $a] && [string is integer $b]} {
+        if {$a < $b} {
+            return -1
+        } else {
+            return 1
+        }
+    }
+    if [string is integer $a] {
+        return 1
+    }
+    if [string is integer $b] {
+        return -1
+    }
+    return [string compare $a $b]
+}
+
+# Given a list, returns all everything in it except for any elements
+# of value "-1", which corresponds with the epsilon symbol.
+#
+# @param first_list list of tokens (presumably a FIRST set)
+# @return new list with all -1 values removed
+proc all_but_eps {first_list} {
+    set new_list ""
+    foreach tok $first_list {
+        if {$tok != -1} {
+            lappend new_list $tok
+        }
+    }
+    return $new_list
+}
+
+# Returns truth if the element value "-1", corresponding with the
+# epsilon symbol, resides within the first list $first_list.
+#
+# @param first_list list of tokens (presumably a FIRST set)
+# @return 1 if $first_list has the element -1, 0 otherwise
+proc has_eps {first_list} {
+    foreach tok $first_list {
+        if {$tok == -1} {
+            return 1
+        }
+    }
+    return 0
+}
+
+# Given a list of tokens, returns the token with highest precedence
+# level.
+#
+# @param tok_list list of token ids
+# @return token with highest precedence; in case of tie returns first
+# one found
+proc get_prec {tok_list} {
+    set prec_token 0
+    foreach tok $tok_list {
+        if {$::prec_table($tok) > $::prec_table($prec_token)} {
+            set prec_token $tok
+        }
+    }
+    return $prec_token
+}
+
+# Appends the first list a flattened version of the second, but only
+# if the second is non-empty.
+#
+# @param list first list
+# @param lists list of lists to append
+# @return new list
+proc lconcat {list lists} {
+    upvar $list l
+    if {$lists != ""} {
+        set l [concat $l $lists]
+    } else {
+        return $l
+    }
+}
+
+# Retrives a parameter from the options list.  If no parameter exists
+# then abort with an error very reminisicent of C's
+# <code>getopt</code> function; otherwise increment
+# <code>param_num</code> by one.
+#
+# @param param_list list of parameters from the command line
+# @param param_num index into <code>param_list</code> to retrieve
+# @param param_name name of the parameter, used when reporting an error
+# @return the <code>$param_num</code>'th element into <code>$param_list</code>
+proc get_param {param_list param_num param_name} {
+    upvar $param_num pn
+    incr pn
+    if {$pn >= [llength $param_list]} {
+        puts stderr "taccle: option requires an argument -- $param_name"
+        exit $::PARAM_ERROR
+    }
+    return [lindex $param_list $pn]
+}
+
+# Display to standard error a message, then abort the program.
+proc taccle_error {message returnvalue} {
+    if {$::verbose != ""} {
+        puts $::verbose "$message (line $::line_count)"
+    } 
+    puts stderr "$message (line $::line_count)"
+    exit $returnvalue
+}
+
+# Display a message to standard error if warnings enabled.  Write to
+# the verbose output file if verbose is enabled.
+proc taccle_warn {message} {
+    if {$::show_warnings} {
+        puts stderr $message
+    }
+    if {$::verbose != ""} {
+        puts $::verbose "$message"
+    }
+}
+
+# Print to a particular channel a brief summary of taccle command line
+# options.
+proc print_taccle_help {chan} {
+    puts $chan "taccle: a Tcl compiler compiler
+Usage: taccle \[options\] file
+  file     a taccle grammar specification file
+
+Options:
+  -h          print this help message and quit
+  -d          write extra output file containing Tcl code to be
+              \[source\]d by yylex
+  -o FILE     specify name to write parser
+  -v          write extra output file containing descriptions of all
+              parser states and extended information about conflicts
+  -w          display all warnings to standard error
+  -p PREFIX   change default yy prefix to PREFIX
+  --version   print taccle version and quit
+
+For more information see http://mini.net/tcl/taccle"
+}
+
+# Displays to standard out the taccle version, then exits program.
+proc print_taccle_version {} {
+    puts "taccle version $::TACCLE_VERSION"
+    exit 0
+}
+
+######################################################################
+# internal debugging routines
+
+proc print_symbol_table {} {
+    puts $::verbose "token table:"
+    puts $::verbose [format "%-5s %-10s %s" "id" "token" "type"]
+    foreach tok_id $::token_list {
+        set token $::token_id_table($tok_id)
+        if {$::token_id_table($tok_id,t) == $::TERMINAL} {
+            set type "terminal"
+        } else {
+            set type "non-terminal"
+        }
+        puts $::verbose [format "%-5s %-10s %s" $tok_id $token $type]
+    }
+}
+
+proc print_rule_table {} {
+    puts $::verbose "rule table:"
+    for {set i 0} {$i < $::rule_count} {incr i} {
+        set lhs $::token_id_table($::rule_table($i,l))
+        set deriv_list ""
+        foreach deriv $::rule_table($i,d) {
+            lappend deriv_list $::token_id_table($deriv)
+        }
+        if {$deriv_list == ""} {
+            set deriv_list "\#\# empty \#\#"
+        }
+        puts $::verbose [format "%3d:  %-10s -> %s" $i $lhs $deriv_list]
+    }
+}
+
+proc print_first_table {} {
+    puts $::verbose "first table:"
+    foreach tok_id $::token_list {
+        if {$tok_id == -1} {
+            continue
+        }
+        set token $::token_id_table($tok_id)
+        set first_list ""
+        foreach first $::first_table($tok_id) {
+            if {$first >= 0} {
+                lappend first_list $::token_id_table($first)
+            }
+        }
+        puts $::verbose [format "%-10s => %s" $token $first_list]
+    }
+}
+
+proc print_closure {closure_list indent dest} {
+    foreach item $closure_list {
+        foreach {rule lookahead position} $item {}
+        set lhs $::token_id_table($::rule_table($rule,l))
+        set deriv_list ""
+        set i 0
+        foreach deriv $::rule_table($rule,d) {
+            if {$i == $position} {
+                lappend deriv_list "."
+            }
+            lappend deriv_list $::token_id_table($deriv)
+            incr i
+        }
+        if {$position == $::rule_table($rule,dc)} {
+            lappend deriv_list "."
+        }
+        set lookahead_list ""
+        foreach la $lookahead {
+            lappend lookahead_list $::token_id_table($la)
+        }
+        puts $dest \
+            [format "%*s %-10s -> %s, %s" $indent "" $lhs $deriv_list $lookahead_list]
+    }
+}
+
+proc print_lr_table {table_name num_entries} {
+    upvar $table_name table
+    for {set i 0} {$i < $num_entries} {incr i} {
+        puts $::verbose "state $i:"
+        print_closure $table($i) 2 $::verbose
+        if {[info exists table($i,trans)] && [llength $table($i,trans)] >= 1} {
+            puts -nonewline $::verbose [format "%*s transitions:" 2 ""]
+            foreach trans $table($i,trans) {
+                foreach {tok_id nextstate} $trans {}
+                puts -nonewline $::verbose "  $::token_id_table($tok_id) => s$nextstate"
+            }
+            puts $::verbose ""
+        }
+        puts $::verbose ""
+    }
+}
+
+proc print_lr1_table {} {
+    puts $::verbose "lr(1) table:"
+    print_lr_table ::lr1_table $::next_lr1_state
+}
+
+proc print_lalr1_table {} {
+    puts $::verbose "lalr(1) table:"
+    print_lr_table ::lalr1_table $::next_lalr1_state
+}
+
+proc print_lalr1_parse {} {
+    puts $::verbose "generated lalr(1) parse table:"
+    puts -nonewline $::verbose "state "
+    foreach tok_id $::used_token_list {
+        set token [string range $::token_id_table($tok_id) 0 4]
+        puts -nonewline $::verbose [format " %-5s" $token]
+    }
+    puts $::verbose ""
+    for {set i 0} {$i < $::next_lalr1_state} {incr i} {
+        puts -nonewline $::verbose [format "%4s  " $i]
+        foreach tok_id $::used_token_list {
+            if [info exists ::lalr1_parse($i:$tok_id)] {
+                switch -- $::lalr1_parse($i:$tok_id) {
+                    shift  { set s "sh" }
+                    goto   { set s "go" }
+                    reduce { set s "re" }
+                    accept { set s "accept" }
+                }
+                if {$s != "accept"} {
+                    append s $::lalr1_parse($i:$tok_id,target)
+                }
+                puts -nonewline $::verbose [format " %-5s" $s]
+            } else {
+                puts -nonewline $::verbose "      "
+            }
+        }
+        puts $::verbose ""
+    }
+}
+
+######################################################################
+# other taccle functions
+
+# Parse the taccle command line.
+proc taccle_args {argv} {
+    set argvp 0
+    set write_defs_file 0
+    set write_verbose_file 0
+    set ::parse_error 0
+    set out_filename ""
+    set ::p "yy"
+    set ::show_warnings 0
+    while {$argvp < [llength $argv]} {
+        set arg [lindex $argv $argvp]
+        switch -- $arg {
+            "-d" { set write_defs_file 1 }
+            "-h" -
+            "--help" { print_taccle_help stdout; exit 0 }
+            "-o" { set out_filename [get_param $argv argvp "o"] }
+            "-v" - "--verbose" { set write_verbose_file 1 }
+            "-w" { set ::show_warnings 1 }
+            "-p" {
+                set prefix [get_param $argv argvp "p"]
+                set ::p [string tolower $prefix]
+            }
+            "--version" { print_taccle_version }
+            default {
+                if {[string index $arg 0] != "-"} {
+                    break
+                } else {
+                    puts stderr "taccle: unknown option $arg"
+                    print_taccle_help stderr
+                    exit $::PARAM_ERROR
+                }
+            }
+        }
+        incr argvp
+    }
+    if {$argvp >= [llength $argv]} {
+        puts stderr "taccle: no grammar file given"
+        print_taccle_help stderr
+        exit $::IO_ERROR
+    }
+    set ::in_filename [lindex $argv $argvp]
+    set ::in_dir [file dirname $::in_filename]
+    if {$out_filename == ""} {
+        set out_filename [file rootname $::in_filename]
+        append out_filename ".tcl"
+    }
+    if [catch {open $::in_filename r} ::src] {
+        puts stderr "Could not open grammar file '$::in_filename'."
+        exit $::IO_ERROR
+    }
+    if [catch {open $out_filename w} ::dest] {
+        puts stderr "Could not open output file '$out_filename'."
+        exit $::IO_ERROR
+    }
+    if $write_defs_file {
+        set header_filename "[file rootname $out_filename].tab.tcl"
+        if [catch {open $header_filename w} ::header] {
+            puts stderr "Could not open header file '$header_filename'."
+            exit $::IO_ERROR
+        }
+    } else {
+        set ::header ""
+    }
+    if $write_verbose_file {
+        set verbose_filename "[file rootname $out_filename].output"
+        if [catch {open $verbose_filename w} ::verbose] {
+            puts stderr "Could not open verbose file '$verbose_filename'."
+            exit $::IO_ERROR
+        }
+    } else {
+        set ::verbose ""
+    }
+}
+
+# Actually do the parser generation.
+proc taccle_main {} {
+    set ::line_count 0
+    
+    # counts number of rules in the grammar
+    # rule number 0 is reserved for the special augmentation S' -> S
+    set ::rule_count 1
+
+    # used to keep track of token IDs:
+    # 0 is reserved for the special token '$'
+    # 256 for the error token
+    set ::next_token_id 257
+
+    # used to keep track of operator precedence level
+    # level 0 is reserved for terminals without any precedence
+    set ::next_precedence 1
+
+    # keep track of where within the file I am:
+    # definitions, rules, or subroutines
+    set file_state definitions
+
+    while {[gets $::src line] >= 0} {
+        incr ::line_count
+    
+        if {$line == "%%"} {
+            if {$file_state == "definitions"} {
+                set file_state "rules"
+            } elseif {$file_state == "rules"} {
+                set file_state "subroutines"
+            } else {
+                taccle_error "Syntax error." $::SYNTAX_ERROR
+            }
+        } else {
+            if {$file_state == "definitions"} {
+		if {[lindex $line 0] == "#include"} {
+		    set fn [lindex $line 1]
+		    if {$fn != {}} {
+			if [catch {open [file join $::in_dir $fn] r} ch] {
+			    puts stderr "Could not open definition file '$fn'."
+			    exit $::IO_ERROR
+			}
+			while {[gets $ch line] >= 0} {
+			    incr ::line_count
+			    handle_defs $line
+			}			    
+			catch {close $fn}
+		    }
+		} else {
+		    handle_defs $line
+		}
+            } elseif {$file_state == "rules"} {
+                # keep reading the rest of the file until EOF or
+                # another '%%' appears
+                set rules_buf [strip_comments $line]
+                while {[gets $::src line] >= 0 && $file_state == "rules"} {
+                    if {$line == "%%"} {
+                        set file_state "subroutines"
+		    } elseif {[lindex $line 0] == "#include"} {
+			set fn [lindex $line 1]
+			if {$fn != {}} {
+			    if [catch {open [file join $::in_dir $fn] r} ch] {
+				puts stderr "Could not open include file '$fn'."
+				exit $::IO_ERROR
+			    }
+			    while {[gets $ch line] >= 0} {
+				incr ::line_count
+				append rules_buf "\n" [strip_comments $line]
+			    }			    
+			    catch {close $fn}
+			}
+                    } else {
+                        append rules_buf "\n" [strip_comments $line]
+                    }
+                }
+                build_parser $rules_buf
+                set file_state "subroutines"
+                write_parser_utils
+                write_parser
+            } else {
+                # file_state is subroutines -- copy verbatim to output file
+                puts $::dest $line
+            }
+        }
+    }
+    if {$::header != ""} {
+        write_header_file
+    }
+    if {$::verbose != ""} {
+        print_symbol_table
+        puts $::verbose ""
+        print_rule_table
+        puts $::verbose ""
+        #print_first_table
+        #puts $::verbose ""
+        #print_lr1_table
+        print_lalr1_table
+        print_lalr1_parse
+    }
+}
+
+######################################################################
+# start of actual script
+
+set IO_ERROR 1
+set SYNTAX_ERROR 2
+set PARAM_ERROR 3
+set GRAMMAR_ERROR 4
+
+set TERMINAL 0
+set NONTERMINAL 1
+
+taccle_args $argv
+taccle_main