Making Tcl expr handle Inf or NaN transparently

mymath.tcl

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 {args} {
	::lopf ::subf $args
}

proc tcl::mathfunc::addf {args} {
	::lopf ::addf $args
}

proc myexpr {args} {
	if {[catch {uplevel 1 expr [concat $args]} res]} {
		if {$res eq "domain error: argument not in valid range"} {
			return NaN
		} else {
			return -code error $res
		}
	} else {
		return $res
	}
}