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