Posted to tcl by bairui at Wed May 24 11:53:08 GMT 2017view raw
- 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