Subject: [SPOILER] Perl 'Expert' Quiz-of-the-Week #24 - msg#00218

Previous Message by Date: click to view message preview

Re: Solution to QOTW #23 in language of QOTW #24

On Tue, Sep 21, 2004 at 02:28:46PM -0400, Mark Jason Dominus wrote: > > On Sep 21, 2004, at 1:51 PM, Mark Jason Dominus wrote: > >I think it has fewer > >states and fewer total instructions, > > I realize now that I could have gotten rid of at least one state and > five instructions: > > > >C_scan_R [ C_scan_R [ R > >C_scan_R ] C_scan_R ] R > >C_scan_R ( C_close [ R > >C_scan_R ) C_close [ R > >C_scan_R _ D_fix _ L > > > >C_close ( C_open ] R > >C_close ) C_open ] R > > > >C_open ( C_close [ R > >C_open ) C_close [ R > >C_open _ D_fix _ L > > C_open is superfluous here; I could re-use C_scan_R instead, like this: > > > >C_close ( C_scan_R ] R > >C_close ) C_scan_R ] R > > and then get rid of C_open and its three instructions entirely. There've been preprocessors discussed earlier to allow more convenient forms for writing code for the TM; this suggests that adding an optimizing postprocessor could also be done. (That particular redundant state could be discover automatically, although others might be harder to recognize.) Now, let's just add text processing and we can call it emagccs(TM). --

Next Message by Date: click to view message preview

[SPOILER] I love parsing. Parsity parse parse parse

Randy tells me he has been having a rough week, and he is also a little bummed that there were so few posted solutions to his quiz. So I thought I would whip one up for him. But for some perverse reason, I whipped up the least useful plausible solution I could. I used my ancient "py" tool to build the expression parser. "py" is one of the weirdest, hackiest hacks I've ever written. It is a tool for writing parser programs in Perl, and in some ways it works very well. But the way it works is totally bizarre. You first write a YACC specification for the grammar you want to parse, and then you run GNU 'bison' on the specification, in verbose debugging mode. Then you run 'py'. 'py' looks at bison's debugging output and reconstructs a parser for you, written in glorious Perl 4. On my web page about py, I said: Well, it's an awfully silly idea, but it certainly did work, and I've been happy with it. If I got to hacker heaven and they asked me what hacks I'd done that would justify letting me in, I think I'd mention 'py'. It was clever, unusual, interesting, and satisfied the required constraints. It was a silly project, but a very successful one. Ten years later, I stil feel about the same. It warms my evil little heart to use py again. (Full details and downloads are at http://perl.plover.com/py/ .) Anyway, the resulting module is in three files. You get Parse.pm, which requires in two auxiliary files: 'py-skel.pl' is the canned, table-driven parser produced by 'py', and 'parse-rules.pl' is the handwritten lexer, some support functions, and the front end. The front end is a function called 'parse'. It gets two arguments. The first is the string containing the expression you want to parse. The second is a callback function that wil be invoked whenever the parser wants to evaluate an expression of the form "{blah blah blah}". It's up to the callback to decide what value these expressions have. For example, it might decide that "{Text::Template}" should evaluate to the version number of the Text::Template module, and look up and return the appropriate number. By changing the callback function, you can assign any meaning you want to the "{...}" expressions. 'parse' then evaluates the expression and returns the result. Expressions may have the form {blah blah} (meaning is assigned by the callback function) 12345 (numbers) "..." (strings) expr > expr expr < expr expr >= expr expr <= expr (numeric comparison operators) expr == expr (these are overloaded to do string comparison expr != expr if the right-hand argument is a string constant) expr && expr (boolean operators, with the correct precedence expr || expr and overloading) ! expr ( expr ) The parser I wrote actually compiles the expression into an abstract syntax tree, and then evaluates it recursively. I did this because that's the easiest way to get the short-circuiting semantics I wanted. I omitted the almost-always-useless ^^ operator. Without further explanation, then, here is Parse.pm, which is just the tables for the table-driven parser: -------------------- Parse.pm starts here #!/usr/bin/perl # parse language described in parse.output # Perl source code automatically generated at Tue Sep 28 00:04:34 2004 by # py v.0.1 25 Aug 1995 # Source code copyright 1995 M-J. Dominus (mjd-e+AXbWqSrlAAvxtiuMwx3w@xxxxxxxxxxxxxxxx) # package Parse; require 'py-skel.pl'; require 'parse-rules.pl'; local $; = "\034"; %act = ( "0negated_expression", 'goto 8', "0(", 'shift 5', "0value", 'goto 11', "0expr", 'goto 32', "0boolean_expression", 'goto 10', "0disjunction", 'goto 6', "0ATOM", 'shift 1', "0conjunction", 'goto 7', "0NUMBER", 'shift 3', "0!", 'shift 2', "0atomic_expression", 'goto 9', "0STRING", 'shift 4', "1\$default", 'reduce 17', "1End_of_Input", 'goto $', "1||", 'reduce 16', "1)", 'reduce 16', "1&&", 'reduce 16', "2(", 'shift 5', "2atomic_expression", 'goto 12', "2ATOM", 'shift 1', "2boolean_expression", 'goto 10', "2value", 'goto 11', "2NUMBER", 'shift 3', "2STRING", 'shift 4', "3\$default", 'reduce 18', "4\$default", 'reduce 19', "5boolean_expression", 'goto 10', "5negated_expression", 'goto 8', "5atomic_expression", 'goto 9', "5STRING", 'shift 4', "5ATOM", 'shift 1', "5(", 'shift 5', "5conjunction", 'goto 7', "5value", 'goto 11', "5disjunction", 'goto 13', "5!", 'shift 2', "5NUMBER", 'shift 3', "6\$default", 'reduce 1', "7||", 'shift 14', "7\$default", 'reduce 2', "8&&", 'shift 15', "8\$default", 'reduce 4', "9\$default", 'reduce 6', "10\$default", 'reduce 9', "11==", 'shift 16', "11!=", 'shift 17', "11>=", 'shift 19', "11>", 'shift 18', "11<=", 'shift 21', "11<", 'shift 20', "12\$default", 'reduce 7', "13)", 'shift 22', "14value", 'goto 11', "14STRING", 'shift 4', "14negated_expression", 'goto 8', "14ATOM", 'shift 1', "14(", 'shift 5', "14atomic_expression", 'goto 9', "14NUMBER", 'shift 3', "14conjunction", 'goto 7', "14!", 'shift 2', "14disjunction", 'goto 23', "14boolean_expression", 'goto 10', "15NUMBER", 'shift 3', "15STRING", 'shift 4', "15boolean_expression", 'goto 10', "15ATOM", 'shift 1', "15atomic_expression", 'goto 9', "15!", 'shift 2', "15negated_expression", 'goto 8', "15conjunction", 'goto 24', "15value", 'goto 11', "15(", 'shift 5', "16NUMBER", 'shift 3', "16STRING", 'shift 4', "16ATOM", 'shift 25', "16value", 'goto 26', "17NUMBER", 'shift 3', "17ATOM", 'shift 25', "17STRING", 'shift 4', "17value", 'goto 27', "18value", 'goto 28', "18STRING", 'shift 4', "18NUMBER", 'shift 3', "18ATOM", 'shift 25', "19ATOM", 'shift 25', "19NUMBER", 'shift 3', "19STRING", 'shift 4', "19value", 'goto 29', "20value", 'goto 30', "20NUMBER", 'shift 3', "20STRING", 'shift 4', "20ATOM", 'shift 25', "21NUMBER", 'shift 3', "21STRING", 'shift 4', "21ATOM", 'shift 25', "21value", 'goto 31', "22\$default", 'reduce 8', "23\$default", 'reduce 3', "24\$default", 'reduce 5', "25\$default", 'reduce 17', "26\$default", 'reduce 10', "27\$default", 'reduce 11', "28\$default", 'reduce 12', "29\$default", 'reduce 13', "30\$default", 'reduce 14', "31\$default", 'reduce 15', "32End_of_Input", 'goto 33', "33End_of_Input", 'goto 34', "34\$default", 'accept', ); @length = (0, 1, 1, 3, 1, 3, 1, 2, 3, 1, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, ); @rhs = ('', 'expr', 'disjunction', 'disjunction', 'conjunction', 'conjunction', 'negated_expression', 'negated_expression', 'atomic_expression', 'atomic_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'value', 'value', 'value', ); @rule = ( '', 'expr -> disjunction', 'disjunction -> conjunction', 'disjunction -> conjunction || disjunction', 'conjunction -> negated_expression', 'conjunction -> negated_expression && conjunction', 'negated_expression -> atomic_expression', 'negated_expression -> ! atomic_expression', 'atomic_expression -> \'(\' disjunction \')\'', 'atomic_expression -> boolean_expression', 'boolean_expression -> value == value', 'boolean_expression -> value != value', 'boolean_expression -> value > value', 'boolean_expression -> value >= value', 'boolean_expression -> value < value', 'boolean_expression -> value <= value', 'boolean_expression -> ATOM', 'value -> ATOM', 'value -> NUMBER', 'value -> STRING', ); "Cogito, ergo sum."; -------------------- Parse.pm ends here The interesting code is mostly in parse-rules.pl, which contains the expression evaluator, the lexer, the rules for contructing the AST, and the front-end parse() function: -------------------- parse-rules.pl starts here # # Reduction rules for parse.pl # Perl source code automatically generated at Tue Sep 28 00:49:22 2004 by # py v.0.1 25 Aug 1995 # Source code copyright 1995 M-J. Dominus (mjd-e+AXbWqSrlAAvxtiuMwx3w@xxxxxxxxxxxxxxxx) # # rule 1 # expr -> disjunction sub rule_1 { return $_[0]; } # rule 2 # disjunction -> conjunction sub rule_2 { return $_[0]; } # rule 3 # disjunction -> conjunction OR disjunction sub rule_3 { return ['||', $_[0], $_[2]]; } # rule 4 # conjunction -> negated_expression sub rule_4 { return $_[0]; } # rule 5 # conjunction -> negated_expression AND conjunction sub rule_5 { return ['&&', $_[0], $_[2]]; } # rule 6 # negated_expression -> atomic_expression sub rule_6 { return $_[0]; } # rule 7 # negated_expression -> NOT atomic_expression sub rule_7 { return ['!', $_[1]]; } # rule 8 # atomic_expression -> '(' disjunction ')' sub rule_8 { return $_[1]; } # rule 9 # atomic_expression -> boolean_expression sub rule_9 { return $_[0]; } # rule 10 # boolean_expression -> value EQ value sub rule_10 { return ['==', $_[0], $_[2]]; } # rule 11 # boolean_expression -> value NE value sub rule_11 { return ['!=', $_[0], $_[2]]; } # rule 12 # boolean_expression -> value GT value sub rule_12 { return ['>', $_[0], $_[2]]; } # rule 13 # boolean_expression -> value GE value sub rule_13 { return ['>=', $_[0], $_[2]]; } # rule 14 # boolean_expression -> value LT value sub rule_14 { return ['<', $_[0], $_[2]]; } # rule 15 # boolean_expression -> value LE value sub rule_15 { return ['<=', $_[0], $_[2]]; } # rule 16 # boolean_expression -> ATOM sub rule_16 { return ['ATOM', $_[0]]; } # rule 17 # value -> ATOM sub rule_17 { return ['ATOM', $_[0]]; } # rule 18 # value -> NUMBER sub rule_18 { return ['NUMBER', $_[0]]; } # rule 19 # value -> STRING sub rule_19 { return ['STRING', $_[0]]; } # Main program # sub parse { my ($string, $callback) = @_; set_target($string); return if yyparse() != 0; my $result = shift @values; evaluate($result, $callback); } my %op = ('>' => sub { $_[0] > $_[1] }, '<' => sub { $_[0] < $_[1] }, '>=' => sub { $_[0] >= $_[1] }, '<=' => sub { $_[0] <= $_[1] }, '!' => sub { ! $_[0] }, ); sub evaluate { my ($expression, $callback) = @_; die unless ref $expression; my ($primary, @args) = @$expression; if ($primary eq 'ATOM') { return $callback->(@args) } if ($primary eq 'STRING' || $primary eq 'NUMBER') { return $args[0]; # unbox } # Short-circuiting if ($primary eq '&&') { my $RESULT = 1; for (@args) { $RESULT &&= evaluate($_, $callback); last unless $RESULT; } return $RESULT; } elsif ($primary eq '||') { my $RESULT = undef; for (@args) { $RESULT ||= evaluate($_, $callback); last if $RESULT; } return $RESULT; } # Overloaded == and != operators if ($primary eq "==" || $primary eq "!=") { my $result; if ($args[1][0] eq 'STRING') { $result = evaluate($args[0], $callback) eq $args[1][1]; } else { $result = evaluate($args[0], $callback) == $args[1][1]; } return $primary eq "!=" ? !$result : $result; } # Ordinary operators my @vals = map evaluate($_, $callback), @args; return $op{$primary}->(@vals); } # # Lexer # my $target; sub set_target { $target = shift; } sub yylex { $target =~ /\G([()])/gc && return $1; $target =~ /\G( && | \|\| | ! )/xgc && return $1; $target =~ /\G( [=!]= | [<>]=? )/xgc && return $1; $target =~ /\G\{([^\}]*)\}/xgc && do { $yylval = $1; return 'ATOM' }; $target =~ /\G\s+/gc && redo; $target =~ /\G([\d.]+)/gc && do { $yylval = $1; return 'NUMBER' }; $target =~ /\G"([^"]*)"/gc && do { $yylval = $1; return 'STRING' }; $target =~ /\G$/gc && return 'End_of_Input'; $target =~ /\G(.)/gc && return 'HUH?'; } 1; -------------------- parse-rules.pl ends here The parser itself is in py-skel.pl, and is available from http://perl.plover.com/py/package/py-skel.pl . A demonstration program might look like this: use Parse; $Parse::yydebug = 1 if $ENV{YYDEBUG}; # This function assigns the meanings of the {...} expressions sub callback { print "Call back for value of {@_} macro\n"; return 1 if $_[0] eq "ONE"; return 2 if $_[0] eq "TWO"; return 3 if $_[0] eq "THREE"; return "00" if $_[0] eq "double zero"; return 0; } my $result = Parse::parse('{ONE} > 2 || {TWO} < 3 && {THREE} == 3', \&callback); print $result ? "yes\n" : "no\n"; The result here is 'true', and by playing around with the conditions you can see that the short-circuiting is working properly. Notice that you can enable py's built-in diagnostic output by setting YYDEBUG. If you don't like the overloading semantics, they are easy to change. For example, it would be the work of a few minutes to have the parser raise an error if you try to compare a number with a string using "==", or to overload "<" to behave like "lt" when operating on strings. Anyway, my goal was to provide the most useless and absurd possible working solution, and Randy will have to judge how well I succeeded. Share and enjoy!

Previous Message by Thread: click to view message preview

[SPOILER] Solution to QOTW #24 in Haskell

I hope that whoever is writing up the summary hasn't closed the book yet. I've been trying to learn Haskell, and so I did this problem in Haskell. (Figuring that Turing Machine simulation is about as iterative a process as you can get, and therefore exactly the wrong sort of thing to do in Haskell) The solution is attached. When compiled with ghc and -O2, this is about three times as fast as the various perl implementations. It's fairly long, at just over 100 lines, and surely some Haskell expert could shorten it productively. Almost all of the code is taken up with parsing the .tm file - the core of actually running the Turing Machine is just: runTM :: TuringMachine -> String -> Tape -> Tape runTM tm st tp = case lookupFM tm (st,headTM tp) of Nothing -> tp Just (st', actn) -> runTM tm st' $ actn tp I didn't use any regular expression library nor did I use the standard parser libraries, so that might account for some of the length. However, I think that the end result is readable, even if it could use more commenting. Although Haskell has very nice facilities for defining infinite strings that would seem to be ideal for defining the initial tape, I was uncertain how to display the infinite strings after the machine halted without getting into trouble. Therefore, my tape uses two Haskell String values - see the mvLeft, mvRight, headTM, and write functions for the details of how those two Strings are being used. To compile this, assuming that you have ghc available, do: ghc -O2 -o tm tm.hs It can then be run as in: ./tm parens.tm 4 | perl -pe 'tr/xo_/()\n/' -- @/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/; map{y/X_/\n /;print}map{pop@$_}@/for@/ tm.hs Description: Text Data

Next Message by Thread: click to view message preview

[SPOILER] I love parsing. Parsity parse parse parse

Randy tells me he has been having a rough week, and he is also a little bummed that there were so few posted solutions to his quiz. So I thought I would whip one up for him. But for some perverse reason, I whipped up the least useful plausible solution I could. I used my ancient "py" tool to build the expression parser. "py" is one of the weirdest, hackiest hacks I've ever written. It is a tool for writing parser programs in Perl, and in some ways it works very well. But the way it works is totally bizarre. You first write a YACC specification for the grammar you want to parse, and then you run GNU 'bison' on the specification, in verbose debugging mode. Then you run 'py'. 'py' looks at bison's debugging output and reconstructs a parser for you, written in glorious Perl 4. On my web page about py, I said: Well, it's an awfully silly idea, but it certainly did work, and I've been happy with it. If I got to hacker heaven and they asked me what hacks I'd done that would justify letting me in, I think I'd mention 'py'. It was clever, unusual, interesting, and satisfied the required constraints. It was a silly project, but a very successful one. Ten years later, I stil feel about the same. It warms my evil little heart to use py again. (Full details and downloads are at http://perl.plover.com/py/ .) Anyway, the resulting module is in three files. You get Parse.pm, which requires in two auxiliary files: 'py-skel.pl' is the canned, table-driven parser produced by 'py', and 'parse-rules.pl' is the handwritten lexer, some support functions, and the front end. The front end is a function called 'parse'. It gets two arguments. The first is the string containing the expression you want to parse. The second is a callback function that wil be invoked whenever the parser wants to evaluate an expression of the form "{blah blah blah}". It's up to the callback to decide what value these expressions have. For example, it might decide that "{Text::Template}" should evaluate to the version number of the Text::Template module, and look up and return the appropriate number. By changing the callback function, you can assign any meaning you want to the "{...}" expressions. 'parse' then evaluates the expression and returns the result. Expressions may have the form {blah blah} (meaning is assigned by the callback function) 12345 (numbers) "..." (strings) expr > expr expr < expr expr >= expr expr <= expr (numeric comparison operators) expr == expr (these are overloaded to do string comparison expr != expr if the right-hand argument is a string constant) expr && expr (boolean operators, with the correct precedence expr || expr and overloading) ! expr ( expr ) The parser I wrote actually compiles the expression into an abstract syntax tree, and then evaluates it recursively. I did this because that's the easiest way to get the short-circuiting semantics I wanted. I omitted the almost-always-useless ^^ operator. Without further explanation, then, here is Parse.pm, which is just the tables for the table-driven parser: -------------------- Parse.pm starts here #!/usr/bin/perl # parse language described in parse.output # Perl source code automatically generated at Tue Sep 28 00:04:34 2004 by # py v.0.1 25 Aug 1995 # Source code copyright 1995 M-J. Dominus (mjd-e+AXbWqSrlAAvxtiuMwx3w@xxxxxxxxxxxxxxxx) # package Parse; require 'py-skel.pl'; require 'parse-rules.pl'; local $; = "\034"; %act = ( "0negated_expression", 'goto 8', "0(", 'shift 5', "0value", 'goto 11', "0expr", 'goto 32', "0boolean_expression", 'goto 10', "0disjunction", 'goto 6', "0ATOM", 'shift 1', "0conjunction", 'goto 7', "0NUMBER", 'shift 3', "0!", 'shift 2', "0atomic_expression", 'goto 9', "0STRING", 'shift 4', "1\$default", 'reduce 17', "1End_of_Input", 'goto $', "1||", 'reduce 16', "1)", 'reduce 16', "1&&", 'reduce 16', "2(", 'shift 5', "2atomic_expression", 'goto 12', "2ATOM", 'shift 1', "2boolean_expression", 'goto 10', "2value", 'goto 11', "2NUMBER", 'shift 3', "2STRING", 'shift 4', "3\$default", 'reduce 18', "4\$default", 'reduce 19', "5boolean_expression", 'goto 10', "5negated_expression", 'goto 8', "5atomic_expression", 'goto 9', "5STRING", 'shift 4', "5ATOM", 'shift 1', "5(", 'shift 5', "5conjunction", 'goto 7', "5value", 'goto 11', "5disjunction", 'goto 13', "5!", 'shift 2', "5NUMBER", 'shift 3', "6\$default", 'reduce 1', "7||", 'shift 14', "7\$default", 'reduce 2', "8&&", 'shift 15', "8\$default", 'reduce 4', "9\$default", 'reduce 6', "10\$default", 'reduce 9', "11==", 'shift 16', "11!=", 'shift 17', "11>=", 'shift 19', "11>", 'shift 18', "11<=", 'shift 21', "11<", 'shift 20', "12\$default", 'reduce 7', "13)", 'shift 22', "14value", 'goto 11', "14STRING", 'shift 4', "14negated_expression", 'goto 8', "14ATOM", 'shift 1', "14(", 'shift 5', "14atomic_expression", 'goto 9', "14NUMBER", 'shift 3', "14conjunction", 'goto 7', "14!", 'shift 2', "14disjunction", 'goto 23', "14boolean_expression", 'goto 10', "15NUMBER", 'shift 3', "15STRING", 'shift 4', "15boolean_expression", 'goto 10', "15ATOM", 'shift 1', "15atomic_expression", 'goto 9', "15!", 'shift 2', "15negated_expression", 'goto 8', "15conjunction", 'goto 24', "15value", 'goto 11', "15(", 'shift 5', "16NUMBER", 'shift 3', "16STRING", 'shift 4', "16ATOM", 'shift 25', "16value", 'goto 26', "17NUMBER", 'shift 3', "17ATOM", 'shift 25', "17STRING", 'shift 4', "17value", 'goto 27', "18value", 'goto 28', "18STRING", 'shift 4', "18NUMBER", 'shift 3', "18ATOM", 'shift 25', "19ATOM", 'shift 25', "19NUMBER", 'shift 3', "19STRING", 'shift 4', "19value", 'goto 29', "20value", 'goto 30', "20NUMBER", 'shift 3', "20STRING", 'shift 4', "20ATOM", 'shift 25', "21NUMBER", 'shift 3', "21STRING", 'shift 4', "21ATOM", 'shift 25', "21value", 'goto 31', "22\$default", 'reduce 8', "23\$default", 'reduce 3', "24\$default", 'reduce 5', "25\$default", 'reduce 17', "26\$default", 'reduce 10', "27\$default", 'reduce 11', "28\$default", 'reduce 12', "29\$default", 'reduce 13', "30\$default", 'reduce 14', "31\$default", 'reduce 15', "32End_of_Input", 'goto 33', "33End_of_Input", 'goto 34', "34\$default", 'accept', ); @length = (0, 1, 1, 3, 1, 3, 1, 2, 3, 1, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, ); @rhs = ('', 'expr', 'disjunction', 'disjunction', 'conjunction', 'conjunction', 'negated_expression', 'negated_expression', 'atomic_expression', 'atomic_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'boolean_expression', 'value', 'value', 'value', ); @rule = ( '', 'expr -> disjunction', 'disjunction -> conjunction', 'disjunction -> conjunction || disjunction', 'conjunction -> negated_expression', 'conjunction -> negated_expression && conjunction', 'negated_expression -> atomic_expression', 'negated_expression -> ! atomic_expression', 'atomic_expression -> \'(\' disjunction \')\'', 'atomic_expression -> boolean_expression', 'boolean_expression -> value == value', 'boolean_expression -> value != value', 'boolean_expression -> value > value', 'boolean_expression -> value >= value', 'boolean_expression -> value < value', 'boolean_expression -> value <= value', 'boolean_expression -> ATOM', 'value -> ATOM', 'value -> NUMBER', 'value -> STRING', ); "Cogito, ergo sum."; -------------------- Parse.pm ends here The interesting code is mostly in parse-rules.pl, which contains the expression evaluator, the lexer, the rules for contructing the AST, and the front-end parse() function: -------------------- parse-rules.pl starts here # # Reduction rules for parse.pl # Perl source code automatically generated at Tue Sep 28 00:49:22 2004 by # py v.0.1 25 Aug 1995 # Source code copyright 1995 M-J. Dominus (mjd-e+AXbWqSrlAAvxtiuMwx3w@xxxxxxxxxxxxxxxx) # # rule 1 # expr -> disjunction sub rule_1 { return $_[0]; } # rule 2 # disjunction -> conjunction sub rule_2 { return $_[0]; } # rule 3 # disjunction -> conjunction OR disjunction sub rule_3 { return ['||', $_[0], $_[2]]; } # rule 4 # conjunction -> negated_expression sub rule_4 { return $_[0]; } # rule 5 # conjunction -> negated_expression AND conjunction sub rule_5 { return ['&&', $_[0], $_[2]]; } # rule 6 # negated_expression -> atomic_expression sub rule_6 { return $_[0]; } # rule 7 # negated_expression -> NOT atomic_expression sub rule_7 { return ['!', $_[1]]; } # rule 8 # atomic_expression -> '(' disjunction ')' sub rule_8 { return $_[1]; } # rule 9 # atomic_expression -> boolean_expression sub rule_9 { return $_[0]; } # rule 10 # boolean_expression -> value EQ value sub rule_10 { return ['==', $_[0], $_[2]]; } # rule 11 # boolean_expression -> value NE value sub rule_11 { return ['!=', $_[0], $_[2]]; } # rule 12 # boolean_expression -> value GT value sub rule_12 { return ['>', $_[0], $_[2]]; } # rule 13 # boolean_expression -> value GE value sub rule_13 { return ['>=', $_[0], $_[2]]; } # rule 14 # boolean_expression -> value LT value sub rule_14 { return ['<', $_[0], $_[2]]; } # rule 15 # boolean_expression -> value LE value sub rule_15 { return ['<=', $_[0], $_[2]]; } # rule 16 # boolean_expression -> ATOM sub rule_16 { return ['ATOM', $_[0]]; } # rule 17 # value -> ATOM sub rule_17 { return ['ATOM', $_[0]]; } # rule 18 # value -> NUMBER sub rule_18 { return ['NUMBER', $_[0]]; } # rule 19 # value -> STRING sub rule_19 { return ['STRING', $_[0]]; } # Main program # sub parse { my ($string, $callback) = @_; set_target($string); return if yyparse() != 0; my $result = shift @values; evaluate($result, $callback); } my %op = ('>' => sub { $_[0] > $_[1] }, '<' => sub { $_[0] < $_[1] }, '>=' => sub { $_[0] >= $_[1] }, '<=' => sub { $_[0] <= $_[1] }, '!' => sub { ! $_[0] }, ); sub evaluate { my ($expression, $callback) = @_; die unless ref $expression; my ($primary, @args) = @$expression; if ($primary eq 'ATOM') { return $callback->(@args) } if ($primary eq 'STRING' || $primary eq 'NUMBER') { return $args[0]; # unbox } # Short-circuiting if ($primary eq '&&') { my $RESULT = 1; for (@args) { $RESULT &&= evaluate($_, $callback); last unless $RESULT; } return $RESULT; } elsif ($primary eq '||') { my $RESULT = undef; for (@args) { $RESULT ||= evaluate($_, $callback); last if $RESULT; } return $RESULT; } # Overloaded == and != operators if ($primary eq "==" || $primary eq "!=") { my $result; if ($args[1][0] eq 'STRING') { $result = evaluate($args[0], $callback) eq $args[1][1]; } else { $result = evaluate($args[0], $callback) == $args[1][1]; } return $primary eq "!=" ? !$result : $result; } # Ordinary operators my @vals = map evaluate($_, $callback), @args; return $op{$primary}->(@vals); } # # Lexer # my $target; sub set_target { $target = shift; } sub yylex { $target =~ /\G([()])/gc && return $1; $target =~ /\G( && | \|\| | ! )/xgc && return $1; $target =~ /\G( [=!]= | [<>]=? )/xgc && return $1; $target =~ /\G\{([^\}]*)\}/xgc && do { $yylval = $1; return 'ATOM' }; $target =~ /\G\s+/gc && redo; $target =~ /\G([\d.]+)/gc && do { $yylval = $1; return 'NUMBER' }; $target =~ /\G"([^"]*)"/gc && do { $yylval = $1; return 'STRING' }; $target =~ /\G$/gc && return 'End_of_Input'; $target =~ /\G(.)/gc && return 'HUH?'; } 1; -------------------- parse-rules.pl ends here The parser itself is in py-skel.pl, and is available from http://perl.plover.com/py/package/py-skel.pl . A demonstration program might look like this: use Parse; $Parse::yydebug = 1 if $ENV{YYDEBUG}; # This function assigns the meanings of the {...} expressions sub callback { print "Call back for value of {@_} macro\n"; return 1 if $_[0] eq "ONE"; return 2 if $_[0] eq "TWO"; return 3 if $_[0] eq "THREE"; return "00" if $_[0] eq "double zero"; return 0; } my $result = Parse::parse('{ONE} > 2 || {TWO} < 3 && {THREE} == 3', \&callback); print $result ? "yes\n" : "no\n"; The result here is 'true', and by playing around with the conditions you can see that the short-circuiting is working properly. Notice that you can enable py's built-in diagnostic output by setting YYDEBUG. If you don't like the overloading semantics, they are easy to change. For example, it would be the work of a few minutes to have the parser raise an error if you try to compare a number with a string using "==", or to overload "<" to behave like "lt" when operating on strings. Anyway, my goal was to provide the most useless and absurd possible working solution, and Randy will have to judge how well I succeeded. Share and enjoy!