Posted to tcl by bairui at Wed May 24 11:53:08 GMT 2017view pretty
package require grammar::aycock proc lex {expression} { set tokens {} set values {} while {$expression ne {}} { if {[regexp {^([+*])(.*)} $expression -> token rest]} { # Single-character operators lappend tokens $token lappend values {} } elseif {[regexp {^([[:digit:]]+)(.*)} $expression -> token rest]} { # Numbers lappend tokens NUMBER lappend values $token } elseif {[regexp {^([()])(.*)} $expression -> bracket rest]} { # Brackets lappend tokens $bracket lappend values {} } elseif {[regexp {^[[:space:]]+(.*)} $expression -> rest]} { # Whitespace } else { # Anything else is an error return -code error -errorcode [list CALC \ [string index $expression 0]] [list invalid character [string index $expression 0]] } set expression $rest } return [list $tokens $values] } set p [grammar::aycock::parser { start ::= E {} E ::= E + T {expr {[lindex $_ 0] + [lindex $_ 2]}} E ::= T {} T ::= T * F {expr {[lindex $_ 0] * [lindex $_ 2]}} T ::= F {} F ::= NUMBER {} F ::= ( E ) {lindex $_ 1} }] lassign [lex {( 2 + 3 ) * ( 7 + 1 )}] tokens values puts [$p parse $tokens $values] $p destroy