Posted to tcl by bairui at Wed May 24 11:53:08 GMT 2017view raw

  1. package require grammar::aycock
  2.  
  3. proc lex {expression} {
  4. set tokens {}
  5. set values {}
  6. while {$expression ne {}} {
  7. if {[regexp {^([+*])(.*)} $expression -> token rest]} {
  8. # Single-character operators
  9. lappend tokens $token
  10. lappend values {}
  11. } elseif {[regexp {^([[:digit:]]+)(.*)} $expression -> token rest]} {
  12. # Numbers
  13. lappend tokens NUMBER
  14. lappend values $token
  15. } elseif {[regexp {^([()])(.*)} $expression -> bracket rest]} {
  16. # Brackets
  17. lappend tokens $bracket
  18. lappend values {}
  19. } elseif {[regexp {^[[:space:]]+(.*)} $expression -> rest]} {
  20. # Whitespace
  21. } else {
  22. # Anything else is an error
  23. return -code error -errorcode [list CALC \
  24. [string index $expression 0]] [list invalid character [string index $expression 0]]
  25. }
  26. set expression $rest
  27. }
  28. return [list $tokens $values]
  29. }
  30.  
  31. set p [grammar::aycock::parser {
  32. start ::= E {}
  33. E ::= E + T {expr {[lindex $_ 0] + [lindex $_ 2]}}
  34. E ::= T {}
  35. T ::= T * F {expr {[lindex $_ 0] * [lindex $_ 2]}}
  36. T ::= F {}
  37. F ::= NUMBER {}
  38. F ::= ( E ) {lindex $_ 1}
  39. }]
  40. lassign [lex {( 2 + 3 ) * ( 7 + 1 )}] tokens values
  41. puts [$p parse $tokens $values]
  42. $p destroy
  43.