summaryrefslogtreecommitdiffstats
path: root/taccle
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2018-06-21 19:51:40 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2018-06-21 19:51:40 (GMT)
commit67f7b317d8c54c06c71a8f645129b6646de5ab5f (patch)
treede86d46a2bdc2556d5684d58fc2def1889575d8c /taccle
parentfa52e6c892d06e9f4d9b23dc70538585068ef2b2 (diff)
downloadblt-67f7b317d8c54c06c71a8f645129b6646de5ab5f.zip
blt-67f7b317d8c54c06c71a8f645129b6646de5ab5f.tar.gz
blt-67f7b317d8c54c06c71a8f645129b6646de5ab5f.tar.bz2
update taccle
Diffstat (limited to 'taccle')
-rw-r--r--taccle/COPYING340
-rw-r--r--taccle/ChangeLog48
-rw-r--r--taccle/README.md121
-rw-r--r--taccle/examples/Makefile17
-rw-r--r--taccle/examples/if_then_else.tac18
-rw-r--r--taccle/examples/infix_calc.tac35
-rw-r--r--taccle/examples/interactive_calculator.tac42
-rw-r--r--taccle/examples/lalr_reduce_reduce.tac18
-rw-r--r--taccle/examples/reduce_reduce.tac20
-rw-r--r--taccle/examples/reduce_reduce2.tac15
-rw-r--r--taccle/examples/shift_reduce.tac17
-rw-r--r--taccle/examples/shift_reduce2.tac20
-rw-r--r--taccle/examples/simple_calculator.tac36
-rw-r--r--taccle/examples/simple_expressions.tac30
-rw-r--r--taccle/examples/simple_grammar.tac27
-rw-r--r--taccle/examples/simple_scanner.fcl16
-rw-r--r--taccle/taccle.tcl1698
17 files changed, 0 insertions, 2518 deletions
diff --git a/taccle/COPYING b/taccle/COPYING
deleted file mode 100644
index d60c31a..0000000
--- a/taccle/COPYING
+++ /dev/null
@@ -1,340 +0,0 @@
- 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/taccle/ChangeLog b/taccle/ChangeLog
deleted file mode 100644
index e9728f1..0000000
--- a/taccle/ChangeLog
+++ /dev/null
@@ -1,48 +0,0 @@
-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/taccle/README.md b/taccle/README.md
deleted file mode 100644
index 6a3b1ff..0000000
--- a/taccle/README.md
+++ /dev/null
@@ -1,121 +0,0 @@
-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
- - 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/taccle/examples/Makefile b/taccle/examples/Makefile
deleted file mode 100644
index 7235aea..0000000
--- a/taccle/examples/Makefile
+++ /dev/null
@@ -1,17 +0,0 @@
-# $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/taccle/examples/if_then_else.tac b/taccle/examples/if_then_else.tac
deleted file mode 100644
index eee631a..0000000
--- a/taccle/examples/if_then_else.tac
+++ /dev/null
@@ -1,18 +0,0 @@
-# $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/taccle/examples/infix_calc.tac b/taccle/examples/infix_calc.tac
deleted file mode 100644
index 95ef2ee..0000000
--- a/taccle/examples/infix_calc.tac
+++ /dev/null
@@ -1,35 +0,0 @@
-# $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/taccle/examples/interactive_calculator.tac b/taccle/examples/interactive_calculator.tac
deleted file mode 100644
index ac8a3ba..0000000
--- a/taccle/examples/interactive_calculator.tac
+++ /dev/null
@@ -1,42 +0,0 @@
-# $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/taccle/examples/lalr_reduce_reduce.tac b/taccle/examples/lalr_reduce_reduce.tac
deleted file mode 100644
index fb7e493..0000000
--- a/taccle/examples/lalr_reduce_reduce.tac
+++ /dev/null
@@ -1,18 +0,0 @@
-# $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/taccle/examples/reduce_reduce.tac b/taccle/examples/reduce_reduce.tac
deleted file mode 100644
index 4de6556..0000000
--- a/taccle/examples/reduce_reduce.tac
+++ /dev/null
@@ -1,20 +0,0 @@
-# $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/taccle/examples/reduce_reduce2.tac b/taccle/examples/reduce_reduce2.tac
deleted file mode 100644
index 53c6d3b..0000000
--- a/taccle/examples/reduce_reduce2.tac
+++ /dev/null
@@ -1,15 +0,0 @@
-# $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/taccle/examples/shift_reduce.tac b/taccle/examples/shift_reduce.tac
deleted file mode 100644
index 8905e26..0000000
--- a/taccle/examples/shift_reduce.tac
+++ /dev/null
@@ -1,17 +0,0 @@
-# $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/taccle/examples/shift_reduce2.tac b/taccle/examples/shift_reduce2.tac
deleted file mode 100644
index c3ad0d3..0000000
--- a/taccle/examples/shift_reduce2.tac
+++ /dev/null
@@ -1,20 +0,0 @@
-# $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/taccle/examples/simple_calculator.tac b/taccle/examples/simple_calculator.tac
deleted file mode 100644
index ea104aa..0000000
--- a/taccle/examples/simple_calculator.tac
+++ /dev/null
@@ -1,36 +0,0 @@
-# $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/taccle/examples/simple_expressions.tac b/taccle/examples/simple_expressions.tac
deleted file mode 100644
index 7cc1f58..0000000
--- a/taccle/examples/simple_expressions.tac
+++ /dev/null
@@ -1,30 +0,0 @@
-# $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/taccle/examples/simple_grammar.tac b/taccle/examples/simple_grammar.tac
deleted file mode 100644
index ea354d9..0000000
--- a/taccle/examples/simple_grammar.tac
+++ /dev/null
@@ -1,27 +0,0 @@
-# $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/taccle/examples/simple_scanner.fcl b/taccle/examples/simple_scanner.fcl
deleted file mode 100644
index 99ff67f..0000000
--- a/taccle/examples/simple_scanner.fcl
+++ /dev/null
@@ -1,16 +0,0 @@
-# $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/taccle.tcl b/taccle/taccle.tcl
deleted file mode 100644
index affa9b2..0000000
--- a/taccle/taccle.tcl
+++ /dev/null
@@ -1,1698 +0,0 @@
-#!/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
generated by cgit v0.12 at 2024-07-03 07:23:17 (GMT)