74 lines
2.0 KiB
Tcl
74 lines
2.0 KiB
Tcl
package require Tcl 8.6
|
|
package require pt::pgen
|
|
|
|
###
|
|
### A simple expression parser for a subset of Tcl's expression language
|
|
###
|
|
|
|
# Define the grammar of expressions that we want to handle
|
|
set grammar {
|
|
PEG Calculator (Expression)
|
|
Expression <- Term (' '* AddOp ' '* Term)* ;
|
|
Term <- Factor (' '* MulOp ' '* Factor)* ;
|
|
Fragment <- '(' ' '* Expression ' '* ')' / Number / Var ;
|
|
Factor <- Fragment (' '* PowOp ' '* Fragment)* ;
|
|
Number <- Sign? Digit+ ;
|
|
Var <- '$' ( 'x'/'y'/'z' ) ;
|
|
|
|
Digit <- '0'/'1'/'2'/'3'/'4'/'5'/'6'/'7'/'8'/'9' ;
|
|
Sign <- '-' / '+' ;
|
|
MulOp <- '*' / '/' ;
|
|
AddOp <- '+' / '-' ;
|
|
PowOp <- '**' ;
|
|
END;
|
|
}
|
|
|
|
# Instantiate the parser class
|
|
catch [pt::pgen peg $grammar snit -class Calculator -name Grammar]
|
|
|
|
# An engine that compiles an expression into Tcl code
|
|
oo::class create CompileAST {
|
|
variable sourcecode opns
|
|
constructor {semantics} {
|
|
set opns $semantics
|
|
}
|
|
method compile {script} {
|
|
# Instantiate the parser
|
|
set c [Calculator]
|
|
set sourcecode $script
|
|
try {
|
|
return [my {*}[$c parset $script]]
|
|
} finally {
|
|
$c destroy
|
|
}
|
|
}
|
|
|
|
method Expression-Empty args {}
|
|
method Expression-Compound {from to args} {
|
|
foreach {o p} [list Expression-Empty {*}$args] {
|
|
set o [my {*}$o]; set p [my {*}$p]
|
|
set v [expr {$o ne "" ? "$o \[$v\] \[$p\]" : $p}]
|
|
}
|
|
return $v
|
|
}
|
|
forward Expression my Expression-Compound
|
|
forward Term my Expression-Compound
|
|
forward Factor my Expression-Compound
|
|
forward Fragment my Expression-Compound
|
|
|
|
method Expression-Operator {from to args} {
|
|
list ${opns} [string range $sourcecode $from $to]
|
|
}
|
|
forward AddOp my Expression-Operator
|
|
forward MulOp my Expression-Operator
|
|
forward PowOp my Expression-Operator
|
|
|
|
method Number {from to args} {
|
|
list ${opns} value [string range $sourcecode $from $to]
|
|
}
|
|
|
|
method Var {from to args} {
|
|
list ${opns} variable [string range $sourcecode [expr {$from+1}] $to]
|
|
}
|
|
}
|