Last active
May 15, 2018 09:08
-
-
Save yyamasak/1b8fa0ea5090053fbb576c2d20b35b0c to your computer and use it in GitHub Desktop.
A challenge to make Tcl expr handle Inf or NaN transparently (but failed because of [expr {NaN}])
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
proc is_computable_double {val} { | |
expr {[string is double -strict $val] && ![is_nan $val]} | |
} | |
proc is_nan {val} { | |
string match -nocase [string trimleft $val +-] "nan" | |
} | |
proc is_infinite {val} { | |
expr {$val == Inf || $val == -Inf} | |
} | |
proc sqrtf {a} { | |
if {[is_computable_double $a] && $a >= 0} { | |
expr {sqrt($a)} | |
} else { | |
return NaN | |
} | |
} | |
proc divf {a b} { | |
if {$a == 0 && $b == 0 || [is_infinite $a] && [is_infinite $b]} { | |
return NaN | |
} elseif {[is_nan $a] || [is_nan $b]} { | |
return NaN | |
} elseif {![string is double -strict $a] || ![string is double -strict $a]} { | |
return NaN | |
} else { | |
expr {$a / double($b)} | |
} | |
} | |
proc mulf {a b} { | |
if {[is_infinite $a] && $b == 0} { | |
return NaN | |
} elseif {$a == 0 && [is_infinite $b]} { | |
return NaN | |
} elseif {[is_nan $a] || [is_nan $b]} { | |
return NaN | |
} elseif {![string is double -strict $a] || ![string is double -strict $a]} { | |
return NaN | |
} else { | |
expr {$a * double($b)} | |
} | |
} | |
proc subf {a b} { | |
if {$a == Inf && $b == Inf} { | |
return NaN | |
} elseif {$a == -Inf && $b == -Inf} { | |
return NaN | |
} elseif {[is_nan $a] || [is_nan $b]} { | |
return NaN | |
} elseif {![string is double -strict $a] || ![string is double -strict $a]} { | |
return NaN | |
} else { | |
expr {$a - double($b)} | |
} | |
} | |
proc addf {a b} { | |
if {$a == Inf && $b == -Inf} { | |
return NaN | |
} elseif {$a == -Inf && $b == Inf} { | |
return NaN | |
} elseif {[is_nan $a] || [is_nan $b]} { | |
return NaN | |
} elseif {![string is double -strict $a] || ![string is double -strict $a]} { | |
return NaN | |
} else { | |
expr {$a + double($b)} | |
} | |
} | |
proc lopf {op vals} { | |
set res {} | |
foreach v $vals { | |
if {$res eq {}} { | |
set res $v | |
} else { | |
set res [$op $res $v] | |
} | |
} | |
return $res | |
} | |
proc tcl::mathfunc::sqrtf {a} { | |
::sqrtf $a | |
} | |
proc tcl::mathfunc::divf {args} { | |
::lopf ::divf $args | |
} | |
proc tcl::mathfunc::mulf {args} { | |
::lopf ::mulf $args | |
} | |
proc tcl::mathfunc::subf {a b} { | |
::lopf ::subf $args | |
} | |
proc tcl::mathfunc::addf {args} { | |
::lopf ::addf $args | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment