Arithmetic evaluation: Difference between revisions
Content added Content deleted
(→{{header|Tcl}}: renamed 'arieval' to the clearer 'ast') |
(→{{header|Tcl}}: removed unnecessary upvar) |
||
| Line 1,459: | Line 1,459: | ||
proc s {args} { |
proc s {args} { |
||
# parse "(a + b) * c + d" to "+ [* [+ a b] c] d" |
# parse "(a + b) * c + d" to "+ [* [+ a b] c] d" |
||
if {[llength $args]==1} {set args [lindex $args 0]} |
if {[llength $args] == 1} {set args [lindex $args 0]} |
||
if [regexp {[()]} $args] { |
if [regexp {[()]} $args] { |
||
eval s [string map {( "\[s " ) \]} $args] |
eval s [string map {( "\[s " ) \]} $args] |
||
} elseif {"*" in $args} { |
} elseif {"*" in $args} { |
||
s [s_group args *] |
s [s_group $args *] |
||
} elseif {"/" in $args} { |
} elseif {"/" in $args} { |
||
s [s_group args /] |
s [s_group $args /] |
||
} elseif {"+" in $args} { |
} elseif {"+" in $args} { |
||
s [s_group args +] |
s [s_group $args +] |
||
} elseif {"-" in $args} { |
} elseif {"-" in $args} { |
||
s [s_group args -] |
s [s_group $args -] |
||
} else { |
} else { |
||
string map {\{ \[ \} \]} [join $args] |
string map {\{ \[ \} \]} [join $args] |
||
} |
} |
||
} |
} |
||
proc s_group { |
proc s_group {list op} { |
||
# turn ".. a op b .." to ".. {op a b} .." |
# turn ".. a op b .." to ".. {op a b} .." |
||
upvar 1 $listName list |
|||
set pos [lsearch -exact $list $op] |
set pos [lsearch -exact $list $op] |
||
set p_1 [- $pos 1] |
set p_1 [- $pos 1] |
||
set p1 [+ $pos 1] |
set p1 [+ $pos 1] |
||
lreplace $list $p_1 $p1 \ |
|||
[list $op [lindex $list $p_1] [lindex $list $p1 |
[list $op [lindex $list $p_1] [lindex $list $p1]] |
||
} |
} |
||
#-- Test suite |
#-- Test suite |
||