Tcl Source Code

Artifact c7ed2ca0eccad74d12047c7f815ce9b862a8ec3e:

set ::RADIAN_CONV 57.2957795131

proc distance { lat1 lon1 lat2 lon2 } {
    global RADIAN_CONV
    set lat1 [expr {$lat1 / $RADIAN_CONV}]
    set lat2 [expr {$lat2 / $RADIAN_CONV}]
    set dlon [expr {($lon2 - $lon1) / $RADIAN_CONV}]
    
    expr {acos(sin($lat1) * sin($lat2) + \
            cos($lat1) * cos($lat2) * cos($dlon)) * \
	    6371.0}
}

proc mtime {script {n 1}} {
    set smap [list %N% $n %SCRIPT% $script]
    set body {
	set i -1
	while {[incr i] < %N%} {
	    %SCRIPT%
	}
    }
    set lambda [list {} [string map $smap $body]]

    ::apply $lambda;# compile $body before running
    set total [lindex [time {::apply $lambda} 1] 0]
    return "[expr {double($total)/$n}] microseconds per iteration"
}

proc toBody {proc args} {
    # only works for procs with no default arguments
    set body {}
    foreach v $args f [info args $proc] {
	append body "set $f $v\n"
    }
    append body "\n[info body $proc]"
}

proc display scr {
    puts "\[$scr\]: [uplevel 1 $scr]"
}

set cmd {distance 41.0 -81.0 42.0 -82.0}
set scr [toBody {*}$cmd]
set n 100000


puts "tcl[info patchlevel]: "
display { time $cmd $n}
display {mtime $cmd $n}
display {mtime $scr $n}