diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2017-07-27 20:41:06 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2017-07-27 20:41:06 (GMT) |
commit | 3071f542c5b8d2957f22f92e8382006d9c7446d3 (patch) | |
tree | 5af359bb04c40bac592b81b9c83d0a10b5a753b2 | |
parent | a89231ca666294b1855b4469fcd8907ccb5c846f (diff) | |
download | blt-3071f542c5b8d2957f22f92e8382006d9c7446d3.zip blt-3071f542c5b8d2957f22f92e8382006d9c7446d3.tar.gz blt-3071f542c5b8d2957f22f92e8382006d9c7446d3.tar.bz2 |
backout parser changes
30 files changed, 0 insertions, 4412 deletions
diff --git a/fickle/COPYING b/fickle/COPYING deleted file mode 100755 index d60c31a..0000000 --- a/fickle/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/fickle/ChangeLog b/fickle/ChangeLog deleted file mode 100755 index 2b26507..0000000 --- a/fickle/ChangeLog +++ /dev/null @@ -1,49 +0,0 @@ -2004-11-13 J. Tang <tang@jtang.org> - - * Released as fickle version 2.04. - - * Reworded parts of README; included explanation of change to - [unput]. - - * Changes some internal variable names. With the exception of - yy_scan_string, all other global variables beginning with 'yy_' - are used to keep track of internal fickle states. (Of course, - this is all changed if %option prefix is given.) - - * Fixed a missing parameter within yyless function. Thanks to Jon - Harrison for reporting this. - -2004-09-30 J. Tang <tang@jtang.org> - - * Found some problems when both %option debug and %option prefix - enabled. - - * Found a problem with patterns that use vertical bars. - -2004-09-30 J. Tang <tang@jtang.org> - - * Added some more comments; reformatted code slightly. - -2004-09-27 J. Tang <tang@jtang.org> - - * Removed errornous space in "%buffersize" within handle_defs - switch. Thanks to jcw for discovering this. - -2004-08-19 J. Tang <tang@jtang.org> - - * definitions containing backslashses correctly maintain those - backslashes during substitution. thanks to Matt Newman for - discovering this bug. - -2004-08-18 J. Tang <tang@jtang.org> - - * added interactive mode (-I option) - -2004-08-05 J. Tang <tang@jtang.org> - - * fixed yy_scan_string; moved comments about to be Tcldoc-friendly - -2002-06-24 J. Tang <tang@jtang.org> - - * fixed spelling and grammar mistakes within README - diff --git a/fickle/README.md b/fickle/README.md deleted file mode 100755 index 399bc26..0000000 --- a/fickle/README.md +++ /dev/null @@ -1,166 +0,0 @@ -$Id: README,v 1.3 2004/11/14 02:36:28 tang Exp $ - -fickle 2.04 by Jason Tang (tang@jtang.org) - -This is a scanner generator program much like flex(1) is to C. If you -have no desire to author Tcl programs, particularly those that -manipulate text, fickle is not for you. A passing knowledge of flex -or some other lex-like program would be useful as that fickle uses -nearly identical syntax and commands as flex. Two good references are -the flex(1) man page and the O'Reilly book 'lex & yacc' by Levine, -Mason, and Brown. - -Examples of working fickle code may be found in the 'examples' -directory. See the examples' README for further details. - -fickle is protected by the GNU general public license. See the file -COPYING for details. - - -USAGE ------ -fickle is to be used as a command-line utility that translates 'fickle -specification files' into valid Tcl code. Invoke fickle like so: - -$ tclsh fickle.tcl some_spec_file.f - -and it will generate a file 'some_spec_file.tcl' containing the -resultant scanner. fickle supports the more popular of flex's -options: - - Usage: fickle [options] [FILE] - FILE a fickle specification file - - Options: - -h print this help message and quit - -v be verbose while generating scanner - -o FILE specify name to write scanner - -d enable debug mode while running scanner - -i generate a case-insensitive scanner - -l keep track of line numbers in global variable yylineno - -s suppress default rule; unmatched input aborts with errors - -t write scanner to standard output - -I read input interactively - -P PREFIX change default yy prefix to PREFIX - --version print fickle version and quit - -If no input files are given fickle reads from standard input. Also -like flex fickle supports the following '%option' directives (and -their "no" counterparts): - - caseful or case-sensitive opposite of -i option (default) - caseless or case-insensitive -i option - debug -d option - default opposite of -s option - interactive -I option - verbose -v option - stack enables start states - yylineno enables tracking of line numbers - yywrap call [yywrap] upon end-of-file - -In addition fickle has two additional directives: - - %buffersize NUM set size of internal input buffer (default 1024) - %option noheaders strips fickle-generated comments from output file - - -CAPABILITIES ------------- -fickle is capable of most of flex's functionality. In addition to the -options listed above the following functions work how one would expect -within a Tcl environment: - - input, unput, yy_scan_string, yyless, yylex, yyrestart, yywrap, - ECHO, YY_FLUSH_BUFFER, and YY_INPUT - -as well as these global variables: - - ::yytext, ::yyleng, ::yyin, and ::yyout - -With debug mode enabled (either -d flag or %option debug) fickle -adds a global variable ::yy_flex_debug. Set this to non-zero to -display to standard error every time the scanner matches a pattern as -well as when it reaches the end of a file. - -With start states enabled (%option stack) one now can call the -functions yy_push_state, yy_pop_state, yy_top_state, and BEGIN. Like -flex fickle allows for both inclusionary (%s directive) and -exclusionary (%x) states. - -With line numbers enabled (%option yylineno) fickle will keep track of -newlines within the input file. The line number may be accessed -through the global variable ::yylineno. - -See a generated file for full documentation of these fickle-supplied -functions, assuming that one did not call '%option noheaders'. - - -DIFFERENCES ------------ -fickle does its best to emulate flex but there are some important -differences to note. The following functions/macros are not supported -by fickle: - - output, yymore, yy_*_buffer, REJECT, YY_CURRENT_BUFFER, or YY_DECL - -nor does it support the declarations %T, %unused, or %used. Unlike -flex, unput() is a procedure that takes accepts any string not just a -character at a time. - -Textual substitutions of definitions is kind of blind, and will ignore -backslashes preceding opening braces. For example, if there exists a -definition 'foo' then it would be substituted into the patterns -"{foo}" as well as "\{foo}". Substitutions are performed by order of -appearance. Thus if the result of one substitution creates a pattern -that looks like a second definition then a second substitution occurs. -To prevent this behavior place definitions that might result in -creating a valid name higher up in the file. Furthermore fickle will -not issue any warnings whenever a pattern has an undefined name. - -Interactive mode differs somewhat from flex. fickle reads from -$::yyin a block of bytes at a time; by default this block is 1024 -bytes though it may be changed with %buffersize. This is akin to -flex's batch processing mode. However this behavior is very -undesirable for interactive programs; fickle would block until a user -types in 1024 characters. Instead when in interactive mode, set by -either the -I command line option or %interactive directive, fickle -reads a line at a time from $::yyin through the [gets] procedure. -Unlike flex, fickle defaults to batch mode and not interactive mode. - -The start state INITIAL is exactly that -- the literal "INITIAL" and -not the value zero. In addition fickle does not support start -condition scopes. - -fickle calls Tcl's [regexp] to handle pattern matching, so any valid -Tcl regexp is valid under fickle. This does lead to some -incompatiblities with flex-style regexps. <<EOF>> is unsupported. -Circumflexes (^) may behave oddly; fickle tries to handle ^ sanely by -modifying its internal buffer whenever it matches newlines. Finally, -Tcl regexps do not treat double quotation marks as metacharacters. -For example, given the regular expression "/*" the call: - - regexp -- {"/*"} $string - -attempts to match any number of forward slashes rather than a C-style -comment token. fickle rewrites patterns containing double quotes to -explicitly escape metacharacters within. Therefore fickle instead -interprets the above pattern as: - - regexp -- {\/\*} $string - - -MISCELLANY ----------- -fickle, like flex, allows the user to change all 'yy' prefaces through -the -P flag. The argument to -P will automagically be downcased. -However, the pre-defined macro 'BEGIN' does not have a prefix. To get -around this limitation it takes an optional second parameter which -will direct it to the correct parameter. For example suppose one -invokes fickle with '-P zz'. All internal calls to 'BEGIN' will set -"zz" as the second parameter. Any of your code which calls 'BEGIN' -will need to pass "zz" as well, otherwise 'BEGIN' will default to -using the "yy" internally. - -Finally, fickle will exhaust its internal buffer prior to calling -yywrap. That means regular expressions cannot match across file -boundaries. diff --git a/fickle/examples/Makefile b/fickle/examples/Makefile deleted file mode 100755 index 4a40f68..0000000 --- a/fickle/examples/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -# $Id: Makefile,v 1.1.1.1 2004/07/23 19:22:41 tang Exp $ - -# A simple Makefile that calls fickle upon the example specification -# files. - -TCL=/usr/bin/tclsh -FICKLE=../fickle.tcl -FCL_EXS=cat.tcl verbs.tcl wc.tcl wc2.tcl cl.tcl csa.tcl tsa.tcl - -all: fcl_exs - -fcl_exs: $(FCL_EXS) - -%.tcl: %.fcl - -$(TCL) $(FICKLE) $< - -clean: - -rm -f $(FCL_EXS:.fcl=.tcl) - -.PHONY: clean diff --git a/fickle/examples/README b/fickle/examples/README deleted file mode 100755 index 117e566..0000000 --- a/fickle/examples/README +++ /dev/null @@ -1,102 +0,0 @@ -$Id: README,v 1.1.1.1 2004/07/23 19:22:41 tang Exp $ - -The example fickle code programs are based upon the lex examples found -within "lex & yacc" by John R. Levine, Tony Mason, and Doug Brown (by -O'Reilly & Associates, ISBN 1-56592-000-7). For more information on -using lex and yacc, see http://www.oreilly.com/catalog/lex/. - -Run the Makefile to generate resulting Tcl code. Descriptions of -individual files are below. The reader is assumed to have a familiarity -with flex; if not consider purchasing the aforementioned book. - - -cat.fcl -------- -This is the simplest fickle example possible. It copies its input (from -stdin) to output (stdout), much like the cat(1) program does without any -arguments. Note that one must explicitly call yylex to run the lexer. - - -verbs.fcl ---------- -This examples demonstrates a verbatim section (the text between '%{' -and '%}'). Also note how fickle specification files may have -Tcl-style comments embedded within. This program searches its input -for various English verbs and copies it to the output. The program -makes use of the variable $yytext (really just an upvar'ed version of -the global ::yytext variable) to print out the text that matched. - - -wc.fcl ------- -This program will count the number of characters, words, and lines in -its input, much like wc(1). Called without any arguments, wc.tcl reads -from stdin; it reads from a file if given an argument. Unless otherwise -specified, 'yyin' points to stdin and 'yyout' to stdout. Overriding -these variables forces the lexer to read from another stream. This -program also uses $yyleng (an upvar'ed version of ::yyleng) which is -set to [string length $::yytext]. - - -wc2.fcl -------- -This example supports multiple filenames. With more than one argument, -wc2 will print a report for each line and a summary line totalling all -metrics. No summary is displayed given zero or one argument. - -wc2 handles multiple files by overriding the definition for yywrap. -yywrap returns 0 when additional files need to be processed. - -The directive `%option noheaders' causes fickle to not include -comments about the autogenerated functions within wc2.tcl. Note the -difference in size between wc2.tcl and wc.tcl. - - -cl.fcl ------- -This example demonstrates how to feed the lexer input from a source -other than a file -- in this case, the command line. One must rewrite -YY_INPUT to use the alternative source. The first parameter should be -'upvar'ed; it holds the next string to scan. 'result' should be the -size of the buffer, or zero to indicate an end of file; this too needs -to be 'upvar'ed. The final parameter indicates the maximum allowed -buffer size. By default this is 1024; use the `%option buffersize' -directive to change this amount. - -Also note the use of `%option nodefault'. By default fickle will -write to yyout any unmatched input through the ECHO function. Use -`%option nodefault' to abort the program upon unmatched input; this is -useful during debugging sessions. One can also invoke this -suppression behavior with the `-s' flag on the fickle command line. - - -csa.fcl -------- -The next example is a C source analyzer. It takes a single C source -file as a parameter; it then counts the lines of code, comments, and -whitespace within. - -This example demonstrates the start state feature of fickle, enabled -through the directive `%option stack'. fickle supports both exclusive -start states (as indicated by '%x') as well as regular start states -('%s', though not featured in this program). Start states specify -when a pattern is allowed. Switch states through calls to 'BEGIN', -'yy_push_state', and 'yy_pop_state'. - -The initial state is called, not surprisingly, 'INITIAL'. Unlike flex, -'BEGIN 0' and 'BEGIN INITIAL' are not identical. To match all states, -prepend the pattern with '<*>'. Patterns that have no state listed are -defaulted to matching only INITIAL and any regular start state.[*] - -Note that if multiple patterns match the input, the largest match takes -precedence. In case of a tie the pattern appearing earlier within the -specification file wins. - -[*] Regular start states are a source of much confusion and are rarely -useful. Avoid them like the plague. - - -tsa.fcl -------- -In comparison to the above this program instead analyzes Tcl code. -It's not particularly foolproof but does get the job done. diff --git a/fickle/examples/cat.fcl b/fickle/examples/cat.fcl deleted file mode 100755 index ebbd8e9..0000000 --- a/fickle/examples/cat.fcl +++ /dev/null @@ -1,4 +0,0 @@ -%% -.|\n ECHO; -%% -yylex diff --git a/fickle/examples/cl.fcl b/fickle/examples/cl.fcl deleted file mode 100755 index 0949843..0000000 --- a/fickle/examples/cl.fcl +++ /dev/null @@ -1,76 +0,0 @@ -# $Id: cl.fcl,v 1.1.1.1 2004/07/23 19:22:41 tang Exp $ - -# Scans its command line for various arguments. - -# This is based upon example 'ape-05.l' (which is the flex version of -# 'ch2-05.l') from "lex & yacc" by John R. Levine, Tony Mason, and -# Doug Brown (by O'Reilly & Associates, ISBN 1-56592-000-7). For more -# information on using lex and yacc, see -# http://www.oreilly.com/catalog/lex/. - -# myinput() could have been written much more efficiently because Tcl -# handles command line arguments as a list. For the sake of porting -# the original example to Tcl, I used the same logic found within the -# original flex code. - -%{ -#!/usr/bin/tclsh -%} - -%buffersize 1024 -%option nodefault - -%% - --h | --\? | --help { - puts "usage is: $::progName \[-help | -h | -? \] \[-verbose | -v \] \[(-file | -f) filename\]" - # actually, the -f option is not handled by this program. - # that is left as an exercise to the reader. - } --v | --verbose { - puts "verbose mode is on" - set ::verbose 1 - } - -%% - -proc YY_INPUT {buf result max} { - upvar $result ret_val - upvar $buf buf_data - set ret_val [myinput buf_data $max] -} - -set ::offset 0 -proc myinput {buf max} { - upvar $buf buf_data - if {[llength $::targv] == 0} { - # no arguments left, so return an EOF - return 0 - } - set len [string length [lindex $::targv 0]] - if {$len >= $max} { - set copylen [expr {$max - 1}] - } else { - set copylen $len - } - if {$len > 0} { - set buf_data [string range [lindex $::targv 0] $::offset $copylen] - } - if {[string length [lindex $::targv 0]] >= $::offset + $copylen} { - append buf " " - incr copylen - set ::offset 0 - set ::targv [lrange $::targv 1 end] - } else { - incr ::offset $copylen - } - return $copylen -} - -set progName $argv0 -set verbose 0 -set ::targv $argv ;# holds remainder of argument list -yylex diff --git a/fickle/examples/csa.fcl b/fickle/examples/csa.fcl deleted file mode 100755 index 3cd6dc3..0000000 --- a/fickle/examples/csa.fcl +++ /dev/null @@ -1,65 +0,0 @@ -# $Id: csa.fcl,v 1.1.1.1 2004/07/23 19:22:41 tang Exp $ - -# Counts the lines of comments, code, and whitespace within a C -# program. - -# This is based upon example 'ch2-09.l' from "lex & yacc" by John -# R. Levine, Tony Mason, and Doug Brown (by O'Reilly & Associates, ISBN -# 1-56592-000-7). For more information on using lex and yacc, see -# http://www.oreilly.com/catalog/lex/. - -%{ -#!/usr/bin/tclsh - -set comments 0 -set code 0 -set whitespace 0 - -proc update_count { a b c } { - incr ::comments $a - incr ::code $b - incr ::whitespace $c - puts -nonewline "code: $::code, comments: $::comments, whitespace: $::whitespace\r" - flush stdout -} - -%} - -%option noheaders stack nodefault -%x COMMENT - -%% - -^[ \t]*"/*" { BEGIN COMMENT } -^[ \t]*"/*".*"*/"[ \t]*\n { update_count 1 0 0 } -<COMMENT>"*/"[ \t]*\n { BEGIN INITIAL; update_count 1 0 0 } -<COMMENT>"*/" { BEGIN INITIAL } -<COMMENT>\n { update_count 1 0 0 } -<COMMENT>.\n { update_count 1 0 0 } - -^[ \t]*\n { update_count 0 0 1 } - -.+"/*".*"*/".*\n { update_count 0 1 0 } -.*"/*".*"*/".+\n { update_count 0 1 0 } -.+"/*".*\n { BEGIN COMMENT; update_count 0 1 0 } -.\n { update_count 0 1 0 } - -<*>. # do nothing - -%% - -if {[llength $argv] == 0} { - puts stderr "C source analyzer needs a filename." - exit 0 -} - -if {[catch {open [lindex $argv 0] r} yyin]} { - puts stderr "Could not open [lindex $argv 0]" - exit 0 -} - -yylex - -close $yyin - -puts "" diff --git a/fickle/examples/tsa.fcl b/fickle/examples/tsa.fcl deleted file mode 100755 index 86a3733..0000000 --- a/fickle/examples/tsa.fcl +++ /dev/null @@ -1,79 +0,0 @@ -#$Id: tsa.fcl,v 1.1.1.1 2004/07/23 19:22:41 tang Exp $ - -# Counts lines of comments, logical lines of code, and function -# invocations in Tcl code. - -# The patterns can handle most "normal" Tcl code. There are some -# instances where it will not correctly detect a function call. - -%{ -#!/usr/bin/tclsh - -proc found_func {funcname} { - if [info exist ::func($funcname)] { - incr ::func($funcname) - } else { - set ::func($funcname) 1 - } -} - -proc spin {} { - if {$::numlines % 8 == 0} { - puts -nonewline "." - flush stdout - } -} - -set comments 0 -set numlines 0 -set spinner_count 0 - -%} - -%option stack -%x ARG - -%% - -<*>^\s*\n { incr ::numlines; spin } -<*>;?\s*#.*\n { incr ::comments; incr ::numlines; spin } -<*>\n { yy_pop_state; incr ::numlines; spin } -<*>\s # ignore whitespace -<*>\\(.|\n) # ignore escaped characters -<*>\d+ # numbers are ignored -<INITIAL>\w+ { found_func $yytext; yy_push_state ARG } -<ARG>\w+ # ignore arguments -<*>\[\s*\w+ { set start [string first "\[" $yytext] - set func [string range $yytext [expr {$start + 1}] end] - found_func [string trim $func] - yy_push_state ARG } -<ARG>\] { yy_pop_state } -<*>; { yy_pop_state } -<*>. # unknown character; ignore it - -%% - -# start of main -if {[llength $argv] > 0} { - if {[catch {open [lindex $argv 0]} yyin]} { - puts stderr "could not open file" - exit 0 - } -} - -yylex - -if {[llength $argv] > 0} { - close $yyin -} - -puts "" -puts "Comments: $comments" -puts "Num lines: $numlines" -puts "Function calls:" -parray func -set totalcalls 0 -foreach {name calls} [array get func] { - incr totalcalls $calls -} -puts "Total calls: $totalcalls" diff --git a/fickle/examples/verbs.fcl b/fickle/examples/verbs.fcl deleted file mode 100755 index c9317ae..0000000 --- a/fickle/examples/verbs.fcl +++ /dev/null @@ -1,34 +0,0 @@ -# $Id: verbs.fcl,v 1.1.1.1 2004/07/23 19:22:41 tang Exp $ - -# Recognizes various English verbs in sentences. - -# This is based upon example 'ch1-02.l' from "lex & yacc" by John -# R. Levine, Tony Mason, and Doug Brown (by O'Reilly & Associates, ISBN -# 1-56592-000-7). For more information on using lex and yacc, see -# http://www.oreilly.com/catalog/lex/. - -%{ -#!/usr/bin/tclsh -%} - -%% -[\t ]+ # ignore whitespace -is | -am | -are | -were | -was | -be | -being | -been | -do | -does | -did | -will puts "$yytext: is a verb" -[a-zA-Z]+ puts "$yytext: is not a verb" - -.|\n ECHO ;# normal default anyway - -%% - -yylex diff --git a/fickle/examples/wc.fcl b/fickle/examples/wc.fcl deleted file mode 100755 index 871b3ad..0000000 --- a/fickle/examples/wc.fcl +++ /dev/null @@ -1,40 +0,0 @@ -%{ -#!/usr/bin/tclsh - -# Counts characters, words, and lines within its input. - -# This is based upon example 'ch2-02.l' from "lex & yacc" by John -# R. Levine, Tony Mason, and Doug Brown (by O'Reilly & Associates, ISBN -# 1-56592-000-7). For more information on using lex and yacc, see -# http://www.oreilly.com/catalog/lex/. - -set charCount 0 -set wordCount 0 -set lineCount 0 - -%} - -word [^ \t\n]+ -eol \n - -%% - -{word} { incr ::wordCount; incr ::charCount $yyleng } -{eol} { incr ::charCount; incr ::lineCount } -. { incr ::charCount } - -%% - -if {[llength $argv] > 0} { - if {[catch {open [lindex $argv 0]} f]} { - puts stderr "could not open file [lindex $argv 0]" - exit 1 - } - set yyin $f -} - -yylex - -puts "$charCount $wordCount $lineCount" - -return 0 diff --git a/fickle/examples/wc2.fcl b/fickle/examples/wc2.fcl deleted file mode 100755 index e887003..0000000 --- a/fickle/examples/wc2.fcl +++ /dev/null @@ -1,102 +0,0 @@ -%{ -#!/usr/bin/tclsh - -# Counts characters, words, and lines, with support for multiple -# filenames. - -# This is based upon example 'ch2-03.l' from "lex & yacc" by John -# R. Levine, Tony Mason, and Doug Brown (by O'Reilly & Associates, ISBN -# 1-56592-000-7). For more information on using lex and yacc, see -# http://www.oreilly.com/catalog/lex/. - -set charCount 0 -set wordCount 0 -set lineCount 0 - -%} - -%option noheaders - -word [^ \t\n]+ -eol \n - -%% - -{word} { incr ::wordCount; incr ::charCount $yyleng } -{eol} { incr ::charCount; incr ::lineCount } -. { incr ::charCount } - -%% - -# lexer calls yywrap to handle EOF conditions (e.g., to -# connect to a new file, as we do in this case.) -proc yywrap {} { - set file "" - if {$::currentFile != 0 && $::nFiles > 1 && $::currentFile < $::nFiles} { - # print out statstics for previous file - puts [format "%8u %8u %8u %s" $::lineCount $::wordCount $::charCount \ - [lindex $::fileList [expr {$::currentFile - 1}]]] - incr ::totalCC $::charCount - incr ::totalWC $::wordCount - incr ::totalLC $::lineCount - set ::charCount 0 - set ::wordCount 0 - set ::lineCount 0 - close $::yyin - } - while {$::currentFile < $::nFiles} { - if {[catch {open [lindex $::fileList $::currentFile] r} file]} { - puts stderr "could not open [lindex $::fileList $::currentFile]" - incr ::currentFile - } else { - set ::yyin $file - incr ::currentFile - break - } - } - if {$file != ""} { - return 0 ;# 0 means there's more input - } else { - return 1 - } -} - -set fileList "" -set currentFile 0 -set nFiles 0 -set totalCC 0 -set totalWC 0 -set totalLC 0 - -set fileList $argv -set nFiles [llength $argv] - -if {[llength $argv] == 1} { - # handle single file case differenly since we don't need to print a - # summary line - set currentFile 1 - if {[catch {open [lindex $argv 0] r} file]} { - puts stderr "could not open file [lindex $argv 0]" - exit 1 - } - set yyin $file -} -if {[llength $argv] > 1} { - yywrap -} - -yylex - -# handle zero or one file differently from multiple files -if {[llength $argv] > 1} { - puts [format "%8u %8u %8u %s" $lineCount $wordCount $charCount \ - [lindex $argv [expr {$currentFile - 1}]]] - incr totalCC $charCount - incr totalWC $wordCount - incr totalLC $lineCount - puts [format "%8u %8u %8u total" $totalLC $totalWC $totalCC] -} else { - puts [format "%8u %8u %8u" $lineCount $wordCount $charCount] -} - -return 0 diff --git a/fickle/fickle.tcl b/fickle/fickle.tcl deleted file mode 100755 index 8321451..0000000 --- a/fickle/fickle.tcl +++ /dev/null @@ -1,906 +0,0 @@ -#!/usr/bin/tclsh - -# $Id: fickle.tcl,v 1.6 2004/11/14 02:36:28 tang Exp $ - -set FICKLE_VERSION 2.04 - -#//# -# Fickle is a lexical analyzer generator written in pure Tcl. It -# reads a <em>fickle specification file</em> to generate pure Tcl code -# that implements a scanner. See the {@link README} file for complete -# instructions. Additional information may be found at {@link -# http://mini.net/tcl/fickle}. -# -# @author Jason Tang (tang@jtang.org) -# @version 2.04 -#//# - -# Process a definition / directive on a single line. -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 { - "%s" { - foreach state_name [split $args] { - if {$state_name != ""} { - set ::state_table($state_name) $::INCLUSIVE - } - } - } - "%x" { - foreach state_name [split $args] { - if {$state_name != ""} { - set ::state_table($state_name) $::EXCLUSIVE - } - } - } - "%option" { - handle_options $args - } - "%buffersize" { - if {$args == ""} { - fickle_error "%buffersize must have an integer parameter" $::PARAM_ERROR - } elseif {[string is digit $args] && $args > 0} { - set ::BUFFER_SIZE $args - } else { - fickle_error "%buffersize parameter must be positive integer" $::PARAM_ERROR - } - } - default { - # check if the directive is an option or a substitution - if {[string index $keyword 0] == "%"} { - fickle_error "Unknown directive \"$keyword\"" $::SYNTAX_ERROR - } else { - add_definition $line - } - } - } - } -} - -# Copy everything between ^%\{$ to ^%\}$ to the destination file. -proc handle_literal_block {} { - set end_defs 0 - while {$end_defs == 0} { - if {[gets $::src line] < 0} { - fickle_error "No terminator to verbatim section found " $::SYNTAX_ERROR - } elseif {[string trim $line] == "%\}"} { - set end_defs 1 - } else { - puts $::dest $line - } - incr ::line_count - } -} - -# Examine each option (given by a %option directive) and set/unset -# flags as necessary. -proc handle_options {optargs} { - foreach option [split $optargs] { - if {$option == ""} { - continue - } - if {$option == "default"} { - # special construct to handle %option default (because I - # can't match this in the switch statement below - set ::suppress 0 - continue - } - switch -- $option { - "caseful" - "case-sensitive" - - "nocaseless" - "nocase-insensitive" { set ::nocase 0 } - "caseless" - "case-insensitive" - - "nocaseful" - "nocase-sensitive" { set ::nocase 1 } - "debug" { set ::debugmode 1 } - "nodebug" { set ::debugmode 0 } - "nodefault" { set ::suppress 1 } - "interactive" { set ::interactive 1 } - "nointeractive" { set ::interactive 0 } - "verbose" { set ::verbose 1 } - "noverbose" { set ::verbose 0 } - "stack" { set ::startstates 1 } - "nostack" { set ::startstates 0 } - "yylineno" { set ::linenums 1 } - "noyylineno" { set ::linenums 0 } - "yywrap" { set ::callyywrap 1 } - "noyywrap" { set ::callyywrap 0 } - "headers" { set ::headers 1 } - "noheaders" { set ::headers 0 } - default { - # note this is /not/ the same as %option default (see above) - fickle_error "Unknown %option $option" $::PARAM_ERROR - } - - } - } -} - -# Adds a definition to the substition table. -proc add_definition {line} { - if {![regexp -line -- {\A\s*([a-zA-Z_]\S*)\s+(.+)} $line foo name pattern]} { - fickle_error "Malformed definition" $::SYNTAX_ERROR - } - # make any substitutions within the pattern now - foreach {sub_rule sub_pat} [array get ::sub_table] { - # the quotes around the regexp below is necessary, to - # allow for substitution of the sub_rule - regsub -all -- "\{$sub_rule\}" $pattern "\($sub_pat\)" pattern - } - # double the backslashes (during the next round of substitution - # the extras will go away) - regsub -all -- {\\} $pattern {\\\\} pattern - set ::sub_table($name) $pattern -} - -# Actually build the scanner given a set of pattern / action pairs. -proc build_scanner {rules_buf} { - # step 0: parse the rules buffer into individual rules and actions - handle_rules_buf $rules_buf - - if $::interactive { - set ::BUFFER_SIZE 1 - } - - # step 1: write scanner support functions - write_scanner_utils - - # step 2: write the scanner to the destination file - write_scanner -} - -# Scan though the rules buffer, pulling out each pattern / action pair. -proc handle_rules_buf {rules_buf} { - set regexp_list "" - set num_rules 0 - while {[string length $rules_buf] > 0} { - set line_start $::line_count - # remove the next line from the buffer - regexp -line -- {\A(.*)\n?} $rules_buf foo line - set rules_buf [string range $rules_buf [string length $foo] end] - # consume blank lines - if {[string trim $line] == ""} { - incr ::line_count - continue - } - # extract the left hand side - if {![regexp -line -- {\A\s*(\S+)(.*)} $line foo pattern line]} { - fickle_error "No pattern found" $::SYNTAX_ERROR - } - # the pattern may contain spaces; use [info complete] to keep - # appending to it - set pattern_done 0 - while {!$pattern_done && $line != ""} { - if [info complete $pattern] { - set pattern_done 1 - } else { - regexp -- {\A(\S*\s?)(.*)} $line foo p line - append pattern $p - } - } - if {!$pattern_done} { - fickle_error "Pattern appears to be unterminated" $::SYNTAX_ERROR - } - set pattern [rewrite_pattern [string trim $pattern]] - set orig_pattern $pattern - - # check the pattern to see if it has a start state - set state_name "" - if [regexp -- {\A<([^>]+)>} $pattern foo state_name] { - if {!$::startstates} { - fickle_error "Start state specified, but states were not enabled with `%option stack'" $::GRAMMAR_ERROR - } - # a state was found; remove it from the pattern - regsub -- {\A<[^>]+>} $pattern "" pattern - # check that the state was declared - if {$state_name != "*" && ![info exists ::state_table($state_name)]} { - fickle_error "Undeclared start state $state_name" $::GRAMMAR_ERROR - } - } - # check if any textual substitutions are needed - foreach sub_rule [array names ::sub_table] { - # the quotes around the regexp below is necessary, to - # allow for substitution of the sub_rule - regsub -all -- "\{$sub_rule\}" $pattern "\($::sub_table($sub_rule)\)" pattern - } - - # now determine the action; an action of just a vertical bar - # means to use the subsequent action - set action [string trimleft $line] - if {[string trim $action] == ""} { - fickle_error "Rule has no associated action" $::SYNTAX_ERROR - } elseif {[string trim $action] == "|"} { - # blank action means to use next one - set action "" - } else { - # keep scanning through buffer until action is complete - set num_lines 0 - set action_done 0 - while {!$action_done && $rules_buf != ""} { - if [info complete $action] { - set action_done 1 - } else { - regexp -line -- {\A(.*)\n?} $rules_buf foo line - set rules_buf [string range $rules_buf [string length $foo] end] - append action "\n$line" - incr num_lines - } - } - if {!$action_done && ![info complete $action]} { - fickle_error "Unterminated action" $::SYNTAX_ERROR - } - # clean up the action, especially if it had curly braces - # around the ends - set action [string trim $action] - if {[string index $action 0] == "{" && \ - [string index $action end] == "}"} { - set action [string trim [string range $action 1 end-1]] - } - incr ::line_count $num_lines - } - lappend ::rule_table [list $orig_pattern $state_name $pattern $action $line_start] - incr ::line_count - if $::verbose { - if {$state_name == ""} { - set state "default state" - } else { - set state "state $state_name" - } - if {$action == ""} { - set action "<fallthrough>" - } - puts stderr "Rule $num_rules: \[$pattern\] ($state) -> $action" - incr num_rules - } - } -} - -# Tcl style regexps are not 100% compatible with flex, so rewrite them -# here. -proc rewrite_pattern {pattern} { - set in_quotes 0 - set in_brackets 0 - set in_escape 0 - foreach c [split $pattern {}] { - if $in_escape { - append newpattern $c - set in_escape 0 - continue - } - if $in_quotes { - if {$c == "\""} { - set in_quotes 0 - } else { - # metacharacters lose their meaning within quotes - if [regexp -- {[.*\[\]^$\{\}+?|/\(\)]} $c foo] { - append newpattern "\\" - } - append newpattern $c - } - continue - } - switch -- $c { - "\\" { append newpattern "\\"; set in_escape 1 } - "\[" { append newpattern "\["; incr in_brackets } - "\]" { append newpattern "\]"; incr in_brackets -1 } - "\"" { - if $in_brackets { - append newpattern "\\\"" - } else { - set in_quotes 1 - } - } - default { - append newpattern $c - } - } - } - return $newpattern -} - -###################################################################### -# procedure to write scanner - -# Writes all of the support procedures needed by the scanner during -# run time. -proc write_scanner_utils {} { - puts $::dest " -###### -# Begin autogenerated fickle (version $::FICKLE_VERSION) routines. -# Although fickle 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/fickle for other details. -###### -" - if $::callyywrap { - if $::headers { - puts $::dest "# If ${::p}wrap() returns false (zero), then it is assumed that the -# function has gone ahead and set up ${::p}in to point to another input -# file, and scanning continues. If it returns true (non-zero), then -# the scanner terminates, returning 0 to its caller. Note that in -# either case, the start condition remains unchanged; it does not -# revert to INITIAL. -# -- from the flex(1) man page" - } - puts $::dest "proc ${::p}wrap \{\} \{ - return 1 -\} -" - } - if $::headers { - puts $::dest "# ECHO copies ${::p}text to the scanner's output if no arguments are -# given. The scanner writes its ECHO output to the ${::p}out global -# (default, stdout), which may be redefined by the user simply by -# assigning it to some other channel. -# -- from the flex(1) man page" - } - puts $::dest "proc ECHO \{\{s \"\"\}\} \{ - if \{\$s == \"\"\} \{ - puts -nonewline \$::${::p}out \$::${::p}text - \} else \{ - puts -nonewline \$::${::p}out \$s - \} -\} -" - if $::headers { - puts $::dest "# ${::P}_FLUSH_BUFFER flushes the scanner's internal buffer so that the -# next time the scanner attempts to match a token, it will first -# refill the buffer using ${::P}_INPUT. -# -- from the flex(1) man page" - } - puts $::dest "proc ${::P}_FLUSH_BUFFER \{\} \{ - set ::${::p}_buffer \"\" - set ::${::p}_index 0 - set ::${::p}_done 0 -\} -" - if $::headers { - puts $::dest "# ${::p}restart(new_file) may be called to point ${::p}in at the new input -# file. The switch-over to the new file is immediate (any previously -# buffered-up input is lost). Note that calling ${::p}restart with ${::p}in -# as an argument thus throws away the current input buffer and -# continues scanning the same input file. -# -- from the flex(1) man page" - } - puts $::dest "proc ${::p}restart \{new_file\} \{ - set ::${::p}in \$new_file - ${::P}_FLUSH_BUFFER -\} -" - if $::headers { - puts $::dest "# The nature of how it gets its input can be controlled by defining -# the ${::P}_INPUT macro. ${::P}_INPUT's calling sequence is -# \"${::P}_INPUT(buf,result,max_size)\". Its action is to place up to -# max_size characters in the character array buf and return in the -# integer variable result either the number of characters read or the -# constant ${::P}_NULL (0 on Unix systems) to indicate EOF. The default -# ${::P}_INPUT reads from the global file-pointer \"${::p}in\". -# -- from the flex(1) man page" - } - puts $::dest "proc ${::P}_INPUT \{buf result max_size\} \{ - upvar \$result ret_val - upvar \$buf new_data - if \{\$::${::p}in != \"\"\} \{" - if $::interactive { - puts $::dest " gets \$::${::p}in new_data - if \{!\[eof \$::${::p}in\]\} \{ - append new_data \\n - \}" - } else { - puts $::dest " set new_data \[read \$::${::p}in \$max_size\]" - } - puts $::dest " set ret_val \[string length \$new_data\] - \} else \{ - set new_data \"\" - set ret_val 0 - \} -\} -" - if $::headers { - puts $::dest "# yy_scan_string sets up input buffers for scanning in-memory -# strings instead of files. Note that switching input sources does -# not change the start condition. -# -- from the flex(1) man page" - } - puts $::dest "proc ${::p}_scan_string \{str\} \{ - append ::${::p}_buffer \$str - set ::${::p}in \"\" -\} -" - if $::headers { - puts $::dest "# unput(c) puts the character c back onto the input stream. It will -# be the next character scanned. -# -- from the flex(1) man page" - } - puts $::dest "proc unput \{c\} \{ - set s \[string range \$::${::p}_buffer 0 \[expr \{\$::${::p}_index - 1\}\]\] - append s \$c - set ::${::p}_buffer \[append s \[string range \$::${::p}_buffer \$::${::p}_index end\]\] -\} -" - if $::headers { - puts $::dest "# Returns all but the first n characters of the current token back to -# the input stream, where they will be rescanned when the scanner -# looks for the next match. ${::p}text and ${::p}leng are adjusted -# appropriately. -# -- from the flex(1) man page" - } - puts $::dest "proc ${::p}less \{n\} \{ - set s \[string range \$::${::p}_buffer 0 \[expr \{\$::${::p}_index - 1\}\]\] - append s \[string range \$::${::p}text \$n end\] - set ::${::p}_buffer \[append s \[string range \$::${::p}_buffer \$::${::p}_index end\]\] - set ::${::p}text \[string range \$::${::p}text 0 \[expr \{\$n - 1\}\]\] - set ::${::p}leng \[string length \$::${::p}text\] -\} -" - if $::headers { - puts $::dest "# input() reads the next character from the input stream. -# -- from the flex(1) man page" - } - puts $::dest "proc input \{\} \{ - if \{\[string length \$::${::p}_buffer\] - \$::${::p}_index < $::BUFFER_SIZE\} \{ - set new_buffer_size 0 - if \{\$::${::p}_done == 0\} \{ - ${::P}_INPUT new_buffer new_buffer_size $::BUFFER_SIZE - append ::${::p}_buffer \$new_buffer - if \{\$new_buffer_size == 0\} \{ - set ::${::p}_done 1 - \} - \} - if \$::${::p}_done \{" - if $::callyywrap { - puts -nonewline $::dest " if \{\[${::p}wrap\] == 0\} \{ - return \[input\] - \} else" - } else { - puts -nonewline $::dest " " - } - puts $::dest "if \{\[string length \$::${::p}_buffer\] - \$::${::p}_index == 0\} \{ - return \{\} - \} - \} - \} - set c \[string index \$::${::p}_buffer \$::${::p}_index\] - incr ::${::p}_index - return \$c -\} -" - if $::startstates { - if $::headers { - puts $::dest "# Pushes the current start condition onto the top of the start -# condition stack and switches to new_state as though you had used -# BEGIN new_state. -# -- from the flex(1) man page" - } - puts $::dest "proc ${::p}_push_state \{new_state\} \{ - lappend ::${::p}_state_stack \$new_state -\} -" - if $::headers { - puts $::dest "# Pops off the top of the state stack; if the stack is now empty, then -# pushes the state \"INITIAL\". -# -- from the flex(1) man page" - } - puts $::dest "proc ${::p}_pop_state \{\} \{ - set ::${::p}_state_stack \[lrange \$::${::p}_state_stack 0 end-1\] - if \{\$::${::p}_state_stack == \"\"\} \{ - ${::p}_push_state INITIAL - \} -\} -" - if $::headers { - puts $::dest "# Returns the top of the stack without altering the stack's contents. -# -- from the flex(1) man page" - } - puts $::dest "proc ${::p}_top_state \{\} \{ - return \[lindex \$::${::p}_state_stack end\] -\} -" - if $::headers { - puts $::dest "# BEGIN followed by the name of a start condition places the scanner -# in the corresponding start condition. . . .Until the next BEGIN -# action is executed, rules with the given start condition will be -# active and rules with other start conditions will be inactive. If -# the start condition is inclusive, then rules with no start -# conditions at all will also be active. If it is exclusive, then -# only rules qualified with the start condition will be active. -# -- from the flex(1) man page" - } - puts $::dest "proc BEGIN \{new_state\ \{prefix $::p\}\} \{ - eval set ::\${prefix}_state_stack \[lrange \\\$::\${prefix}_state_stack 0 end-1\] - eval lappend ::\${prefix}_state_stack \$new_state -\} -" - } - - puts $::dest "# initialize values used by the lexer -set ::${::p}text {} -set ::${::p}leng 0 -set ::${::p}_buffer \{\} -set ::${::p}_index 0 -set ::${::p}_done 0" - if $::startstates { - puts $::dest "set ::${::p}_state_stack \{\} -BEGIN INITIAL -array set ::${::p}_state_table \{[array get ::state_table]\}" - } - if $::linenums { - puts $::dest "set ::${::p}lineno 1" - } - if $::debugmode { - puts $::dest "set ::${::p}_flex_debug 1" - } - puts $::dest "if \{!\[info exists ::${::p}in\]\} \{ - set ::${::p}in \"stdin\" -\} -if \{!\[info exists ::${::p}out\]\} \{ - set ::${::p}out \"stdout\" -\} -" -} - - -# Writes the actual scanner as a function called <code>yylex</code>. -# Note that this function may be renamed if the <code>-P</code> flag -# was given at the command line. -proc write_scanner {} { - puts $::dest "###### -# autogenerated ${::p}lex function created by fickle -###### - -# Whenever yylex() is called, it scans tokens from the global input -# file yyin (which defaults to stdin). It continues until it either -# reaches an end-of-file (at which point it returns the value 0) or -# one of its actions executes a return statement. -# -- from the flex(1) man page -proc ${::p}lex \{\} \{ - upvar #0 ::${::p}text ${::p}text - upvar #0 ::${::p}leng ${::p}leng - while \{1\} \{" - if $::startstates { - puts $::dest " set ${::p}_current_state \[${::p}_top_state\]" - } - puts $::dest " if \{\[string length \$::${::p}_buffer\] - \$::${::p}_index < $::BUFFER_SIZE\} \{ - if \{\$::${::p}_done == 0\} \{ - set ${::p}_new_buffer \"\" - ${::P}_INPUT ${::p}_new_buffer ${::p}_buffer_size $::BUFFER_SIZE - append ::${::p}_buffer \$${::p}_new_buffer - if \{\$${::p}_buffer_size == 0 && \\ - \[string length \$::${::p}_buffer\] - \$::${::p}_index == 0\} \{ - set ::${::p}_done 1 - \} - \} - if \$::${::p}_done \{" - if $::debugmode { - puts $::dest " if \$::${::p}_flex_debug \{ - puts stderr \" --reached end of input buffer\" - \}" - } - if $::callyywrap { - puts -nonewline $::dest " if \{\[${::p}wrap\] == 0\} \{ - set ::${::p}_done 0 - continue - \} else" - } else { - puts -nonewline $::dest " " - } - puts $::dest "if \{\[string length \$::${::p}_buffer\] - \$::${::p}_index == 0\} \{ - break - \} - \} - \} - set ::${::p}leng 0 - set ${::p}_matched_rule -1" - - # build up the if statements to determine which rule to execute; - # lex is greedy and will use the rule that matches the most - # strings - if {$::nocase} { - set scan_args "-nocase" - } else { - set scan_args "" - } - set rule_num 0 - foreach rule $::rule_table { - foreach {orig_pattern state_name pattern action rule_line} $rule {} - puts $::dest " # rule $rule_num: $orig_pattern" - puts -nonewline $::dest " if \{" - if $::startstates { - if {$state_name == ""} { - puts -nonewline $::dest "\$::${::p}_state_table(\$${::p}_current_state) && \\\n " - } elseif {$state_name != "*"} { - puts -nonewline $::dest "\$${::p}_current_state == \"$state_name\" && \\\n " - } - } - puts $::dest "\[regexp -start \$::${::p}_index -indices -line $scan_args -- \{\\A($pattern)\} \$::${::p}_buffer ${::p}_match\] > 0\ && \\ - \[lindex \$${::p}_match 1\] - \$::${::p}_index + 1 > \$::${::p}leng\} \{ - set ::${::p}text \[string range \$::${::p}_buffer \$::${::p}_index \[lindex \$${::p}_match 1\]\] - set ::${::p}leng \[string length \$::${::p}text\] - set ${::p}_matched_rule $rule_num" - if $::debugmode { - puts $::dest " set ${::p}rule_num \"rule at line $rule_line\"" - } - puts $::dest " \}" - incr rule_num - } - # now add the default case - puts $::dest " if \{\$${::p}_matched_rule == -1\} \{ - set ::${::p}text \[string index \$::${::p}_buffer \$::${::p}_index\] - set ::${::p}leng 1" - if $::debugmode { - puts $::dest " set ${::p}rule_num \"default rule\"" - } - puts $::dest " \} - incr ::${::p}_index \$::${::p}leng - # workaround for Tcl's circumflex behavior - if \{\[string index \$::${::p}text end\] == \"\\n\"\} \{ - set ::${::p}_buffer \[string range \$::${::p}_buffer \$::${::p}_index end\] - set ::${::p}_index 0 - \}" - if $::debugmode { - puts $::dest " if \$::${::p}_flex_debug \{ - puts stderr \" --accepting \$${::p}rule_num (\\\"\$::${::p}text\\\")\" - \}" - } - if $::linenums { - puts $::dest " set numlines \[expr \{\[llength \[split \$::${::p}text \"\\n\"\]\] - 1\}\]" - } - puts $::dest " switch -- \$${::p}_matched_rule \{" - set rule_num 0 - foreach rule $::rule_table { - puts -nonewline $::dest " $rule_num " - if {[string length [lindex $rule 3]] == 0} { - # action is empty, so use next pattern's action - puts $::dest "-" - } else { - puts $::dest "\{\n[lindex $rule 3]\n \}" - } - incr rule_num - } - puts $::dest " default" - if {$::suppress == 0} { - puts $::dest " \{ ECHO \}" - } else { - puts -nonewline $::dest " \{ puts stderr \"unmatched token: \$::${::p}text" - if $::startstates { - puts -nonewline $::dest " in state `\$${::p}_current_state'" - } - puts $::dest "\"; exit -1 \}" - } - puts $::dest " \}" - if $::linenums { - puts $::dest " incr ::${::p}lineno \$numlines" - } - puts $::dest " \} - return 0 -\} -###### -# end autogenerated fickle functions -###### -" -} - -###################################################################### -# utility functions - -# Given a line, returns a new line with any comments removed. -proc strip_comments {line} { - regexp -- {\A([^\#]*)} $line foo line - return $line -} - -# If the first non-whitespace character on a line is a hash, then -# return an empty string; otherwise return the entire line. -proc strip_only_comments {line} { - if [regexp -- {\A\s*\#} $line] { - return "" - } else { - return $line - } -} - -# 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 "fickle: option requires an argument -- $param_name" - exit $::PARAM_ERROR - } - return [lindex $param_list $pn] -} - -# Display an error message to standard error along with where within -# the specification file it occurred. Then abort this program. -proc fickle_error {message returnvalue} { - puts -nonewline stderr $message - puts stderr " (line $::line_count)" - exit $returnvalue -} - -# Display to a channel a brief summary of fickle command line options. -proc print_fickle_help {chan} { - puts $chan "fickle: a Tcl lexical anaylzer generator -Usage: fickle \[options\] \[FILE\] - FILE a fickle specification file - -Options: - -h print this help message and quit - -v be verbose while generating scanner - -o FILE specify name to write scanner - -d enable debug mode while running scanner - -i generate a case-insensitive scanner - -l keep track of line numbers in global variable yylineno - -s suppress default rule; unmatched input aborts with errors - -t write scanner to standard output - -I read input interactively - -P PREFIX change default yy prefix to PREFIX - --version print fickle version and quit - -For more information see http://mini.net/tcl/fickle" -} - -# Displays to standard out the fickle version, then exits program. -proc print_fickle_version {} { - puts "fickle version $::FICKLE_VERSION" - exit 0 -} - -###################################################################### -# other fickle functions - -# Parse the command line and set all global options. -proc fickle_args {argv} { - set argvp 0 - set out_filename "" - set write_to_stdout 0 - set ::callyywrap 1 - set ::debugmode 0 - set ::headers 1 - set ::interactive 0 - set ::nocase 0 - set ::linenums 0 - set ::startstates 0 - set ::suppress 0 - set ::BUFFER_SIZE 1024 - set ::p "yy" - set ::P "YY" - set ::verbose 0 - while {$argvp < [llength $argv]} { - set arg [lindex $argv $argvp] - switch -- $arg { - "-d" { set ::debugmode 1 } - "-h" - "--help" { print_fickle_help stdout; exit 0 } - "-i" { set ::nocase 1 } - "-l" { set ::linenums 1 } - "-o" { set out_filename [get_param $argv argvp "o"] } - "-s" { set ::suppress 1 } - "-t" { set write_to_stdout 1 } - "-v" { set ::verbose 1 } - "-I" { set ::interactive 1 } - "-P" { - set prefix [get_param $argv argvp "P"] - set ::p [string tolower $prefix] - set ::P [string toupper $prefix] - } - "--version" { print_fickle_version } - default { - if {[string index $arg 0] != "-"} { - break - } else { - puts stderr "fickle: unknown option $arg" - print_fickle_help stderr - exit $::PARAM_ERROR - } - } - } - incr argvp - } - if {$argvp >= [llength $argv]} { - # read from stdin - set ::src stdin - set out_filename "lex.yy.tcl" - } else { - set in_filename [lindex $argv $argvp] - 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 specification file '$in_filename'." - exit $::IO_ERROR - } - } - if $write_to_stdout { - set ::dest stdout - } else { - if [catch {open $out_filename w} ::dest] { - puts stderr "Could not create output file '$out_filename'." - exit $::IO_ERROR - } - } -} - -# Actually do the scanner generation. -proc fickle_main {} { - set ::line_count 0 - - # keep track of all rules found - set ::rule_table "" - - # set up the INITIAL start state to be a normal inclusionary state - set ::state_table(INITIAL) $::INCLUSIVE - - # 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 { - fickle_error "Syntax error." $::SYNTAX_ERROR - } - } else { - if {$file_state == "definitions"} { - handle_defs $line - } elseif {$file_state == "rules"} { - # keep reading the rest of the file until EOF or - # another '%%' appears - set rules_buf [strip_only_comments $line] - while {[gets $::src line] >= 0 && $file_state == "rules"} { - if {$line == "%%"} { - set file_state "subroutines" - break - } else { - append rules_buf "\n" [strip_only_comments $line] - } - } - build_scanner $rules_buf - set file_state "subroutines" - } else { - # file_state is subroutines -- copy verbatim to output file - puts $::dest $line - } - } - } -} - -###################################################################### -# start of actual script - -set IO_ERROR 1 -set SYNTAX_ERROR 2 -set PARAM_ERROR 3 -set GRAMMAR_ERROR 4 - -# two types of start states allowed: -set INCLUSIVE 1 -set EXCLUSIVE 0 - -fickle_args $argv -fickle_main diff --git a/taccle/COPYING b/taccle/COPYING deleted file mode 100755 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 100755 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 100755 index b02ea31..0000000 --- a/taccle/README.md +++ /dev/null @@ -1,123 +0,0 @@ -$Id: README,v 1.5 2005/03/17 20:42:21 tang Exp $ - -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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 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 100755 index 368d8ea..0000000 --- a/taccle/taccle.tcl +++ /dev/null @@ -1,1607 +0,0 @@ -#!/usr/bin/tclsh - -# $Id: taccle.tcl,v 1.6 2005/03/17 20:42:21 tang Exp $ - -set TACCLE_VERSION 1.1 - -#//# -# 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 - } - 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. -###### - -proc ${::P}ABORT \{\} \{ - return -code return 1 -\} - -proc ${::P}ACCEPT \{\} \{ - return -code return 0 -\} - -proc ${::p}clearin \{\} \{ - upvar ${::p}token t - set t \"\" -\} - -proc ${::p}error \{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] - - puts $::dest "\nproc ${::p}parse {} { - set ${::p}state_stack {0} - set ${::p}value_stack {{}} - set ${::p}token \"\" - set ${::p}accepted 0 - while {\$${::p}accepted == 0} { - set ${::p}state \[lindex \$${::p}state_stack end\] - if {\$${::p}token == \"\"} { - set ::${::p}lval \"\" - set ${::p}token \[${::p}lex\] - set ${::p}buflval \$::${::p}lval - } - if {!\[info exists ::${::p}table(\$${::p}state:\$${::p}token)\]} { - \# pop off states until error token accepted - while {\[llength \$${::p}state_stack\] > 0 && \\ - !\[info exists ::${::p}table(\$${::p}state:error)]} { - set ${::p}state_stack \[lrange $${::p}state_stack 0 end-1\] - set ${::p}value_stack \[lrange $${::p}value_stack 0 \\ - \[expr {\[llength $${::p}state_stack\] - 1}\]\] - set ${::p}state \[lindex $${::p}state_stack end\] - } - if {\[llength \$${::p}state_stack\] == 0} { - ${::p}error \"parse error\" - return 1 - } - lappend ${::p}state_stack \[set ${::p}state \$::${::p}table($${::p}state:error,target)\] - lappend ${::p}value_stack {} - \# consume tokens until it finds an acceptable one - while {!\[info exists ::${::p}table(\$${::p}state:\$${::p}token)]} { - if {\$${::p}token == 0} { - ${::p}error \"end of file while recovering from error\" - return 1 - } - set ::${::p}lval {} - set ${::p}token \[${::p}lex\] - set ${::p}buflval \$::${::p}lval - } - continue - } - switch -- \$::${::p}table(\$${::p}state:\$${::p}token) { - shift { - lappend ${::p}state_stack \$::${::p}table(\$${::p}state:\$${::p}token,target) - lappend ${::p}value_stack \$${::p}buflval - set ${::p}token \"\" - } - reduce { - set ${::p}rule \$::${::p}table(\$${::p}state:\$${::p}token,target) - set ${::p}l \$::${::p}rules(\$${::p}rule,l) - if \{\[info exists ::${::p}rules(\$${::p}rule,e)\]\} \{ - set ${::p}dc \$::${::p}rules(\$${::p}rule,e) - \} else \{ - set ${::p}dc \$::${::p}rules(\$${::p}rule,dc) - \} - set ${::p}stackpointer \[expr {\[llength \$${::p}state_stack\]-\$${::p}dc}\] - ${::p}setupvalues \$${::p}value_stack \$${::p}stackpointer \$${::p}dc - set _ \$1 - set ::${::p}lval \[lindex \$${::p}value_stack end\] - switch -- \$${::p}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 " } - ${::p}unsetupvalues \$${::p}dc - # pop off tokens from the stack if normal rule - if \{!\[info exists ::${::p}rules(\$${::p}rule,e)\]\} \{ - incr ${::p}stackpointer -1 - set ${::p}state_stack \[lrange \$${::p}state_stack 0 \$${::p}stackpointer\] - set ${::p}value_stack \[lrange \$${::p}value_stack 0 \$${::p}stackpointer\] - \} - # now do the goto transition - lappend ${::p}state_stack \$::${::p}table(\[lindex \$${::p}state_stack end\]:\$${::p}l,target) - lappend ${::p}value_stack \$_ - } - accept { - set ${::p}accepted 1 - } - goto - - default { - puts stderr \"Internal parser error: illegal command \$::${::p}table(\$${::p}state:\$${::p}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" - } - } - puts $::header "set ::${::p}lval \{\}" -} - -###################################################################### -# 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 out_filename "" - set ::p "yy" - 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] - set ::P [string toupper $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] - 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"} { - 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" - } 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 |