# demo.tcl --
#
#	Code that demonstrates the Tcl-to-LLVM compilation capabilities of
#	tclquadcode. Most of this file is demonstration procedures that we can
#	compile; the rest is the driver code (though that is mostly factored
#	out into demosupport.tcl).
#
# Copyright (c) 2014-2017 by Kevin B. Kenny
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

#############################################################################
#
# Test code definitions. These are all procedures; that's all we can currently
# compile.

proc cos {x {n 16}} {
#    set x [expr {double($x)}]
#    set n [expr {int($n)}]
    set j 0
    set s 1.0
    set t 1.0
    set i 0
    while {[incr i] < $n} {
	set t [expr {-$t*$x*$x / [incr j] / [incr j]}]
	set s [expr {$s + $t}]
    }
    return $s
}
proc coscaller1 {x} {
    cos [expr {double($x)}]
}
proc coscaller2 {} {
    for {set i -100} {$i <= 100} {incr i} {
	set x [expr {0.00314159 * $i}]
	cos $x
    }
}

proc fib {n} {
    set n [expr {int($n)}]
    if {$n < 1} {
	return 0
    }
    set a 0
    set b 1
    for {set i 1} {$i < $n} {incr i} {
	set c [expr {$a + $b}]
	set a $b
	set b $c
    }
    return $b
}
proc inttest {x} {
    set x [expr {int($x)}]
    incr x $x
    expr {($x / 3)**7 * 2 + $x}
}
proc shift {x y} {
    set y [expr {int($y)}]
    expr {int($x) >> $y}
}
proc tantest {x} {
    return [expr {tan(double($x))**3}]
}
proc polartest {u v} {
    set th [expr {atan2($v,$u)}]
    set r [expr {hypot($v,$u)}]
    set u2 [expr {$r * cos($th)}]
    set v2 [expr {$r * sin($th)}]
    return [expr {hypot($v2-$v, $u2-$u)}]
}

# This is a cut-down version of the version in Tcllib's math package
namespace eval math {}
proc ::math::ln_Gamma { x } {

    # Handle the common case of a real argument that's within the
    # permissible range.

    if { [string is double -strict $x]
	 && ( $x > 0 )
	 && ( $x <= 2.5563481638716906e+305 )
     } {
	set x [expr { $x - 1.0 }]
	set tmp [expr { $x + 5.5 }]
	set tmp [ expr { ( $x + 0.5 ) * log( $tmp ) - $tmp }]
	set ser 1.0
	foreach cof {
	    76.18009173 -86.50532033 24.01409822
	    -1.231739516 .00120858003 -5.36382e-6
	} {
	    set x [expr { $x + 1.0 }]
	    set ser [expr { $ser + $cof / $x }]
	}
	return [expr { $tmp + log( 2.50662827465 * $ser ) }]
    }

    # Handle the error cases.

    if { ![string is double -strict $x] } {
	return -code error -errorcode {TCL VALUE NUMBER} \
	    "expected a floating point number but got \"$x\""
    }

    if { $x <= 0.0 } {
	return -code error \
	    -errorcode {ARITH DOMAIN {non-positive number}} \
	    "argument to ::math::ln_Gamma must be positive"
    }

    return -code error \
	-errorcode [list ARITH OVERFLOW \
		    "floating-point value too large to represent"] \
	"floating-point value too large to represent"
}

proc powmul1 {n r} {
    set n [expr {int($n)}]
    set r [expr {int($r)}]
    for {set i 0} {$i < $n} {incr i} {
	set r [expr {$r * $n}]
    }
    return $r
}

proc powmul2 {n r} {
    for {set i 0} {$i < $n} {incr i} {
	set r [expr {$r * $n}]
    }
    return $r
}

proc strtest {x y} {
    set y [expr {int($y)}]
    for {set i [expr {int($x)}]; set j 0} {$i <= $y} {incr i} {
	incr j [string length $i]
    }
    return $j
}

proc passthrough {{a "example"}} {
    return $a
}

proc streqtest {a b} {
    if {$a ne $b} {
	return "is not equal"
    } else {
	return "is equal"
    }
}

proc strconcattest {a b {n 8}} {
    set s $a.$b
    for {set i 0} {$i < 10} {incr i} {
	set s $a.$b.$i
	if {$i > int($n)} {
	    return $s
	}
    }
    return $s
}

proc comparetest {a b} {
    for {set x 1; set y 1.0} {$x < int($a) && $y < double($b)} {incr x} {
	set y [expr {$y * 1.3}]
    }
    return $x~$y
}

proc appendtest {n} {
    set s ""
    set t ""
    for {set i 1} {$i <= int($n)} {incr i} {
	append s $t
	append s $i
	set t ","
    }
    return $s
}

proc appendtest2 {n} {
    set s ""
    for {set i 1} {$i <= int($n)} {incr i} {
	if {$i > 1} {
	    append s ,
	}
	append s $i
    }
    return $s
}

proc appendtest3 {n} {
    set s ""
    for {set i 1; set t ""} {$i <= int($n)} {incr i; set t ","} {
	append s $t $i
    }
    return $s
}

proc rev {str} {
    set accum {}
    for {set i [string length $str]} {[incr i -1] >= 0} {} {
	append accum [string index $str $i]
    }
    return $accum
}

proc idx {str} {
    return [string index $str 3]
}

proc ranged {str} {
    set accum {}
    for {set i 0; set j [string length $str]} {$i<[incr j -1]} {incr i} {
	append accum [string range $str $i $j] ,
    }
    return $accum
}

proc substrtest {from to} {
    set s abcdefghijklmnopqrstuvwxyz
    set from [string first $from $s]
    set to [string last $to $s]
    return [string cat [string range $s 0 [expr {$from-1}]] > \
		[string range $s $from $to] < \
		[string range $s [expr {$to+1}] end]]
}

proc replacing {from to} {
    set s abcdefghijklmnopqrstuvwxyz
    set from [string first $from $s]
    set to [string last $to $s]
    return [string replace $s $from $to \
		[string cat > [string range $s $from $to] <]]
}

proc replacing2 {str} {
    string cat > [string map {cde CDEF} $str] | [string map {def XYZ} $str] \
	| [string map {ghi ""} $str] <
}

proc replacing3 {str} {
    set x 7
    set x end-$x
    set y end-3
    string replace $str $x $y [string cat | [string range $str $x $y] |]
}

proc substrtest2 {from to} {
    set s abcdefghijklmnopqrstuvwxyz
    string range $s [string first $from $s] [string last $to $s]
}

proc matchtest {str} {
    string match *abc* $str
}

proc cmptest {str} {
    string compare *abc* $str
}
proc cmptest2 {a b} {
    list [expr {$a == $b}] [expr {$a != $b}] \
	[expr {$a > $b}] [expr {$a >= $b}] \
	[expr {$a < $b}] [expr {$a <= $b}] \
	$a $b
}

proc trimtest {str} {
    string cat [string trimleft $str ABC] | [string trim $str ABC] | \
	[string trimright $str ABC]
}

proc casetest {str} {
    string cat [string toupper $str] | [string tolower $str] | [string totitle $str]
}

proc strclasstest {str} {
    string is xdigit $str
}

proc switchfail {str} {
    set s D
    switch -regexp -- $str {
	abc {
	    set s A
	}
	def {
	    set s B
	}
	.*(?:y).** {
	    set s C
	}
    }
    return $s
}

proc uplustest {x y} {
    return [expr {+ "$x$y"}]
}

proc wideretest {x} {
    lindex $x 1
    return "a constant"
}

proc substtest {str} {
    subst {>>$str|[
	string cat [regexp .+a.+ $str] .
    ]|$str|[
	string cat [regexp .+q.+ $str] .
    ]|$str<<}
}
proc substtest2 {str} {
    set i 0
    subst {>>$str|[incr i]|$str|[incr i]|$str<<}
}

proc listtest {x y} {
    list 1 $x abc $y 0.12
}

proc listjoin1 {list} {
    set result ""
    set sep ""
    for {set i 0} {$i < [llength $list]} {incr i} {
	append result $sep [lindex $list $i]
	set sep ","
    }
    return $result
}
proc listjoin2 {list} {
    set result ""
    set sep ""
    foreach item $list {
	append result $sep $item
	set sep ","
    }
    return $result
}
proc listjoin3 {list} {
    return [join $list ","]
}

proc magicreturn {x} {
    set y [return -level 0 [expr {int($x) + int($x)}]]
    set l 0
    set z [return -level $l [expr {$y + $y}]]
    return [expr {$z + $z}]
}

proc returntest {x y} {
    set c [catch {
	return -options {a b} -foo $y $x
    } a b]
    return [list a= $a c= $c b= $b]
}

proc errortest1 {x} {
    set b [catch { error $x$x$x } a]
    return "a=$a b=$b"
}
proc errortest2 {x} {
    error $x$x$x
}
proc errortest3 {x} {
    set msg ok
    try {
	if {[string length $x] == 3} {
	    error $x$x$x
	}
    } on error msg {
    }
    return $msg
}
proc errortest4 {x} {
    set msg ok
    try {
	if {[string length $x] == 3} {
	    error $x$x$x
	}
    } on error msg {
	error "error occurred: $msg"
    }
    return $msg
}
proc errortest4a {x} {
    list [catch {errortest4 $x} msg] $msg
}
proc errortest5 {x} {
    catch {throw {FOO BAR} $x} a b
    list $a [dict get $b -errorcode]
}
proc errortest6 {x} {
    set x [expr {int($x)}]
    set msg ok
    try {
	if {$x == 1} {
	    throw {FOO BAR} "x is $x - 1"
	} elseif {$x == 2} {
	    throw {FOO BOO} "x ix $x - 2"
	} else {
	    set msg "x is $x - 3"
	}
    } trap {FOO BAR} m {
	set msg '$m'
    } on error {m o} {
	set msg "''$m''"
    }
    return $msg
}
proc errortest2-caller {str} {
    set code [catch {
	errortest2 $str
    } msg opt]
    dict unset opt -errorstack
    dict unset opt -errorinfo
    list $code $msg $opt
}

proc dictest {d} {
    if {[dict exists $d foo]} {
	dict set d foofoo [dict get $d foo]
	return [dict unset d foo]
    }
    return "nothing at_all"
}
proc dictest2 {d} {
    dict append d abc 123x
    dict append d abc 456y
    dict lappend d abc def
    dict lappend d abc ghi
    dict incr d def
    dict incr d def 3
    return $d
}
proc dictest3 {d} {
    dict update d a b {
	set b $b.$b
    }
    return $d
}
proc dictest4 {a b c d} {
    set x [dict create $a 1 $b 2 $c 3 $d 4]
    set y [dict merge $x]
    list $x $y
}
proc dictest5 {} {
    dict set d a b
    return $d
}
proc dictest6 {} {
    for {set i 0} {$i < 10} {incr i} {
	dict set d $i x
    }
    return $d
}

proc lrangetest {l} {
    return [lrange $l 0 3],[lrange $l end-1 end]
}

proc lsetest {l {ix { 2 }}} {
    for {set i 0} {$i < [llength $l]} {incr i} {
	lset l $i >[lindex $l $i]<
    }
    lset l $ix abc
    lset l 1 1 def
    return $l
}
proc lappendtest {l} {
    lappend l a
    lappend l b c
    return $l
}

proc jumptable {a} {
    switch $a {
	a {return aaa}
	b {return bbb}
	c {return ccc}
    }
    return ddd
}

proc rangetest {from to} {
    set result {}
    set i [expr {int($from)}]
    set j [expr {int($to)}]
    for {} {$i <= $j} {incr i} {
	lappend result $i
    }
    return $result
}

proc numberitems {list} {
    set result {}
    set i 0
    foreach item $list {
	lappend result [incr i]:$item
    }
    return $result
}
proc numberitems2 {list} {
    set result {}
    set i 0
    foreach sublist $list {
	foreach item $sublist {
	    lappend result [incr i]:$item
	}
    }
    return $result
}
proc numberitems3 {list} {
    set result {}
    set i 0
    foreach {item1 item2} $list {
	lappend result [incr i]:$item1:$item2
    }
    return $result
}
proc doubleitems {list} {
    lmap x $list {string cat $x $x}
}

proc containment {list} {
    expr {"a" in $list && "b" ni $list}
}

proc dictfor {dictionary} {
    set result {}
    dict for {k v} $dictionary {
	lappend result "d($k)=$v"
    }
    return $result
}

proc concatenater {x} {
    set x [expr {int($x)}]
    concat [expr {$x - 1}] $x [expr {$x + 1.5}] "ok"
}

proc booltest {val} {
    set res {}
    if {[string is boolean -strict $val]} {
	lappend res ok
    }
    lappend res [string is boolean $val]
    lappend res [string is true -strict $val] [string is true $val]
    lappend res [string is false -strict $val] [string is false $val]
    return $res
}

proc stristest {x} {
    return [
	    string is int -strict $x
	],[
	    string is double -strict $x
	],[
	    string is int $x
        ],[
	    string is double $x
        ]
}

proc wordcounter1 {words} {
    foreach word $words {
	incr count($word)
	set done($word) 0
    }
    lmap word $words {
	if {$done($word)} continue
	set done($word) 1
	list $word $count($word)
    }
}

proc wordcounter2 {words} {
    array set count {}
    array set done {}
    foreach word $words {
	incr count($word)
	set done($word) 0
    }
    lmap word $words {
	if {$done($word)} continue
	set done($word) 1
	list $word $count($word)
    }
}

proc wordcounter3 {words} {
    set count(example) 49
    array set count {}
    array set done {example 1}
    foreach word $words {
	incr count($word)
	incr done($word) 0
    }
    lmap word $words {
	if {$done($word)} continue
	set done($word) 1
	list $word $count($word)
    }
}

proc calltest {from to joiner} {
    set to [expr {int($to)}]
    set l {}
    for {set i [expr {int($from)}]} {$i <= $to} {incr i} {
	lappend l $i
    }
    return [join $l $joiner]
}
proc calltest2 {from to joiner} {
    set to [expr {int($to)}]
    set l {}
    for {set i [expr {int($from)}]} {$i <= $to} {incr i} {
	lappend l $i
    }
    return [join $l $joiner "trigger an error"]
}
proc calltest3 {from to} {
    set result {}
    set d {a 5 b 7 c 8}
    for {set i [expr {int($from)}]} {$i < int($to)} {incr i} {
	set v [lindex [dict values $d] $i]
	lappend result $v [expr {$v ** $i}]
    }
    return $result
}

proc nextest1 {x} { # throwIfNotExists, unoptimized
    if {$x} {
	set y 1
    }
    list [catch {set y} result] $result
}

proc nextest2 {x} { # throwIfNotExists, extractExists, unset, optimized
                    # both ways
    if {$x} {
	set y 1
    }
    list [catch {
	if {[info exists y]} {
	    return -level 0 [list 1 $y]
	} else {
	    return -level 0 [list 0 $y]
	}
    } result] $result
}

proc nextest3 {x} { # initIfNotExists, optimized both ways
    if {$x} {
	set y {a b}
    }
    if {[info exists y]} {
	return [dict set y a b]
    } else {
	return [dict set y c d]
    }
}

proc nextest4 {} {
    if {[info exists x]} {
	return "BAD"
    } else {
	return "GOOD"
    }
}

proc xsum {a args} {
    foreach b $args {
	set a [expr {$a + $b}]
    }
    return $a
}
proc xsum2 {} {
    list \
	[catch {xsum 1} r] $r \
	[catch {xsum 2} r] $r \
	[catch {xsum 1.0} r] $r \
	[catch {xsum 1.0 2 3 4} r] $r \
	[catch {xsum 1 2 3 4.0} r] $r \
	[catch {xsum 2 1 3 4.0} r] $r \
        [catch {xsum 1 2 3 4} r] $r \
	[catch {xsum 2 1 3 4} r] $r \
	[catch {xsum 1 fish head} r] $r
    #	[catch {xsum} r] $r	I'm not doing "wrong # args" yet
}

namespace eval mrtest {
    namespace export calc integer plus minus times quotient fibo rfib
    proc calc {x} {
	switch -exact -- [lindex $x 0] {
	    "i" {
		set result [integer [lindex $x 1]]
	    }
	    "+" {
		set result [plus [lindex $x 1] [lindex $x 2]]
	    }
	    "-" {
		set result [minus [lindex $x 1] [lindex $x 2]]
	    }
	    "*" {
		set result [times [lindex $x 1] [lindex $x 2]]
	    }
	    "/" {
		set result [quotient [lindex $x 1] [lindex $x 2]]
	    }
	    "f" {
		set result [fibo [lindex $x 1]]
	    }
	}
	return $result
    }
    proc integer {x} {
	expr {int($x)}
    }
    proc plus {x y} {
	expr {[calc $x] + [calc $y]}
    }
    proc minus {x y} {
	expr {[calc $x] - [calc $y]}
    }
    proc times {x y} {
	expr {[calc $x] * [calc $y]}
    }
    proc quotient {x y} {
	expr {[calc $x] / [calc $y]}
    }
    proc fibo {x} {
	return [rfib [calc $x]]
    }
    proc rfib {x} {
	if {$x <= 1} {
	    return 1
	} else {
	    return [expr {[rfib [expr {$x - 1}]] + [rfib [expr {$x - 2}]]}]
	}
    }
}

proc bctest {x {r 0}} {
    if {$r} {
	set t f
	set f t
    } else {
	set t t
	set f f
    }
    expr {($x == $t || $x == $f) && ($t || $f)}
}

proc asmtest {} {
    ::tcl::unsupported::assemble {
        beginCatch @badLabel
        push error
        push testing
        invokeStk 2
        endCatch
        pop
        push 0
        jump @okLabel
        label @badLabel
        endCatch
        push 1; # should be pushReturnCode
        label @okLabel
        pop
    }
    return ok
}

namespace eval nstest {
    interp alias {} [namespace current]::pts {} ::puts
    proc nstest0 {} {
	namespace which ::puts
    }
    proc nstest1 {} {
	namespace which ::nstest::pts
    }
    proc nstest2 {} {
	namespace which pts
    }
    proc nstest3 {} {
	namespace origin [namespace which ::puts]
    }
    proc nstest4 {} {
	namespace origin ::nstest::pts
    }
    proc nstest5 {} {
	namespace origin pts
    }
    proc nstest6 {} {
	namespace origin puts
    }
    proc nstest7 {} {
	namespace origin fish-head
    }
}

namespace eval bug-0616bcf08e {
    proc mulsum {x y z} {
	expr {double($x) * double($y) + double($z)}
    }
    proc msrange {from to} {
	set total [expr {double(0.0)}]
	for {set i [expr {int($from)}]} {$i<int($to)} {incr i} {
	    set total [mulsum $total $i $i]
	}
	return $total
    }

    proc mulsum2 {x y z} {
	expr {$x * $y + $z}
    }
    proc msrange2 {from to} {
	set total 0.0
	set from [expr {$from + 0}]
	set to [expr {$to + 0}]
	for {set i $from} {$i<$to} {incr i} {
	    set total [mulsum $total $i $i]
	}
	return $total
    }
}

proc lcmRange {to} {
    set to [expr {int($to)}]
    set primes {}
    set plist {}
    for {set i 2} {$i <= $to} {incr i} {
	set j $i
	set thisp {}
	foreach p $plist {
	    while {$j % $p == 0} {
		set j [expr {$j / $p}]
		dict incr thisp $p
	    }
	}
	if {$j > 1} {
	    lappend plist $j
	    dict incr primes $j
	}
	dict for {p c} $thisp {
	    if {[dict get $primes $p] < $c} {
		dict set primes $p $c
	    }
	}
    }
    set lcm 1
    dict for {p c} $primes {
	set lcm [expr {$lcm * $p ** $c}]
    }
    return $lcm
}

proc qsort {L {left 0} {right -1}} {
    set left [expr {int($left)}]
    set right [expr {int($right)}]
    if {$right < 0} {set right [expr {[llength $L] - 1}]}
    set pivot [lindex $L [expr {($left + $right) / 2}]]

    set i $left
    set j $right
    while {$i <= $j} {
        set a [lindex $L $i]
        set b [lindex $L $j]

        while {$a < $pivot} {
            set a [lindex $L [incr i]]
        }
        while {$b > $pivot} {
            set b [lindex $L [incr j -1]]
        }

        if {$i <= $j} {
	    lset L $i $b
	    lset L $j $a
	    incr i
	    incr j -1
        }
    }

    if { $left < $j } {
        set L [qsort $L $left $j]
    }
    if { $i < $right } {
        set L [qsort $L $i $right]
    }
    return $L
}

proc impure {a b c} {
    set x 0
    for {set i $a} {$i < $b} {incr i $c} {
	set x [expr {$x + $i}]
    }
    return $x
}

proc impure-typecheck-int {a b c} {
    if {[string is int -strict $a]
	&& [string is int -strict $b]
	&& [string is int -strict $c]} {
	set x 0
	for {set i $a} {$i < $b} {incr i $c} {
	    set x [expr {$x + $i}]
	}
	return $x
    } else {
	error "type error"
    }
}

proc impure2 {a b c} {
    set x 0x0
    for {set i $a} {$i < $b} {incr i $c} {
	set x [expr {$x + $i}]
    }
    return $x
}

proc impure-caller {} {
    impure 10 10000 10
}

proc comps {a b} {
    list [string is double -strict $a] \
	[expr {$a == $b}] \
	[expr {$a eq $b}] \
	[expr {$a >= $b}] [expr {[string compare $a $b] >= 0}] \
	[expr {$a > $b}] [expr {[string compare $a $b] > 0}] \
	[expr {$a <= $b}] [expr {[string compare $a $b] <= 0}] \
	[expr {$a < $b}] [expr {[string compare $a $b] < 0}] \
	[expr {$a != $b}] \
	[expr {$a ne $b}]
}

namespace eval ::bug-7c599d4029 {
    proc classify x {
	if {[string is integer -strict $x]} {
	    return [list I $x]
	} else {
	    return [list S $x]
	}
    }
    proc bug {x} {
        if {[string is integer -strict $x]} {
            set y 1
        } else {
            set y 0
        }
        list $y [classify $x]
    }
}

namespace eval ::linesearch {
    proc colinear {x1 y1 x2 y2 x3 y3} {
	expr {$x1*($y2-$y3) + $x2*($y3-$y1) + $x3*($y1-$y2) == 0}
    }
    proc sameline {x1 y1 x2 y2 x3 y3 x4 y4} {
	expr {
	    [colinear $x1 $y1 $x2 $y2 $x3 $y3]
	    && [colinear $x1 $y1 $x2 $y2 $x4 $y4]
	}
    }

    proc getAllLines1 {range} {
	set lines {}
	for {set x1 0} {$x1<=$range} {incr x1} {
	    for {set y1 0} {$y1<=$range} {incr y1} {
		for {set x2 0} {$x2<=$range} {incr x2} {
		    for {set y2 0} {$y2<=$range} {incr y2} {
			if {$x1==$x2 && $y1==$y2} continue
			set present 0
			foreach {x3 y3 x4 y4} $lines {
			    if {[sameline $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4]} {
				set present 1
				break
			    }
			}
			if {!$present} {
			    lappend lines $x1 $y1 $x2 $y2
			}
		    }
		}
	    }
	}
	return $lines
    }

    proc getAllLines2 {range} {
	set lines {}
	set range [expr {int($range)}]
	for {set x1 0} {$x1<=$range} {incr x1} {
	    for {set y1 0} {$y1<=$range} {incr y1} {
		for {set x2 0} {$x2<=$range} {incr x2} {
		    for {set y2 0} {$y2<=$range} {incr y2} {
			if {$x1==$x2 && $y1==$y2} continue
			set present 0
			foreach {x3 y3 x4 y4} $lines {
			    set x3 [expr {int($x3)}]
			    set y3 [expr {int($y3)}]
			    set x4 [expr {int($x4)}]
			    set y4 [expr {int($y4)}]
			    if {[sameline $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4]} {
				set present 1
				break
			    }
			}
			if {!$present} {
			    lappend lines $x1 $y1 $x2 $y2
			}
		    }
		}
	    }
	}
	return $lines
    }
}

namespace eval ::flightawarebench {
    # See https://github.com/flightaware/tclbench/blob/master/math/bench.tcl
    proc degrees_radians {degrees} {
	return [expr {$degrees * 3.14159265358979323846 / 180.0}]
    }
    proc latlongs_to_distance {lat1 lon1 lat2 lon2} {
	set dLat [degrees_radians [expr {$lat2 - $lat1}]]
	set dLon [degrees_radians [expr {$lon2 - $lon1}]]

	set lat1 [degrees_radians $lat1]
	set lat2 [degrees_radians $lat2]

	set a [expr {sin($dLat / 2) ** 2  + sin($dLon / 2) ** 2 * cos($lat1) * cos($lat2)}]
	set c [expr {2 * atan2(sqrt($a), sqrt(1 - $a))}]
	return [expr {3963. * $c}]
    }
    proc test {{incrA 1} {incrB 1} {incrC 1}} {
	set result {}
	for {set lon -180} {$lon < 180} {incr lon $incrA} {
	    for {set lat -90} {$lat < 90} {incr lat $incrB} {
		for {set lon2 40} {$lon2 < 48} {incr lon2 $incrC} {
		    lappend result [latlongs_to_distance $lat $lon 44 $lon2]
		}
	    }
	}
	return $result
    }

    # proc clockscan {{yinc 1} {minc 1} {dinc 1}} {
    # 	set results {}
    # 	return abc
    # 	for {set year 1970} {$year < 2015} {incr year $yinc} {
    # 	    for {set month 1} {$month <= 12} {incr month $minc} {
    # 		for {set day 1} {$day <= 28} {incr day $dinc} {
    # 		    set result [clock scan "$month/$day/$year 00:00"]
    # 		    set fmty [clock format $result -gmt 1]
    # 		    lappend results $result $fmty
    # 		    #set result2 [clock scan $fmty]
    # 		    #lappend list $result $fmty $result2
    # 		}
    # 	    }
    # 	}
    # 	return $results
    # }
}

proc cleanopt {opt} {
    # A simple helper that is not compiled, but rather just shortens code below
    dict remove $opt -errorstack -errorinfo
}

#########################################################################
#
# List of demonstration scripts. Each of these will be executed before and
# after having the compilation engine applied; the output values from before
# and after will be compared, and if they match, the performance ratio will be
# computed.
#
# Note that the 'bytes' variable contains a byte array, at least at the start
# of the run for timing (it's *not* reset for each loop of the timing).

set errorCode {}
set demos {
    # Mathematical operations; [fib] and [cos] are supposed to be accelerated
    # heavily, the others are less critical
    {fib 85}
    {cos 1.2}
    # Fails on a roundoff error: {tantest 1.2}
    {inttest 345}
    {math::ln_Gamma 1.3}
    {polartest 0.6 0.8}
    {powmul1 13 3}
    {powmul2 13 3}
    {uplustest 123 456}
    {uplustest 01 010}
    {list [catch {uplustest abc def} msg] $msg}
    # String operations
    {strtest 1 15}
    {passthrough;}
    {passthrough xyz}
    {streqtest abc def}
    {strconcattest abc def}
    {comparetest 5 5.2}
    {appendtest 20}
    {appendtest2 20}
    {appendtest3 20}
    {rev abcdef}
    {rev $bytes}
    {idx abcdefg}
    {ranged abcdefgh}
    {substrtest g t}
    {substrtest t g}
    {substrtest2 b f}
    {replacing e k}
    {replacing2 abcdefghi}
    {replacing2 abcdefghiabcdefghiabcdefghi}
    {replacing3 abcdefghijklm}
    {matchtest xyzaxyz}
     {matchtest xyzaxyzabxyzabcxyz}
    {cmptest abc}
    {cmptest2 0x10 16}
    {cmptest2 0x10 15}
    {cmptest2 0e0 .0}
    {cmptest2 0e0 0x0}
    {trimtest ABCDABC}
    {trimtest DABCABCD}
    {casetest aBcDe}
    {strclasstest abc123}
    {strclasstest abc-123}
    {concatenater 7}
    {list [booltest on] [booltest no] [booltest ""] [booltest fruitbat]}
    {stristest ""}
    {stristest x}
    {stristest 0}
    {stristest 1.2}
    {stristest 0xAB}
    # List operations (also see some [try] tests)
    {listtest a b}
    {lsetest {a b c d e f}}
    {lappendtest {x y z}}
    {list [catch {lappendtest "x \{y"} msg] $msg}
    {rangetest 1 20}
    {lrangetest {a b c d e f}}
    {numberitems {a b c d e f}}
    {numberitems2 {{a b c} {d e f}}}
    {numberitems3 {a b c d e f}}
    {doubleitems {a b c d e f}}
    {containment {A B C a c e}}
    {listjoin1 {a b c d e f g h}}
    {listjoin2 {a b c d e f g h}}
    {listjoin3 {a b c d e f g h}}
    {calltest 1 5 ,}
    # Array operations
    {wordcounter1 "this is an example and is full of example words"}
    {wordcounter2 "this is an example and is full of example words"}
    {wordcounter3 "this is an example and is full of example words"}
    # Dictionary operations (also see some [try] tests)
    {dictest {a b c d foo bar boo boo}}
    {dictest {a b c d}}
    {dictest2 {a b c d}}
    {dictest3 {a b c d}}
    {dictest4 p q r q}
    {dictest5}
    {dictest6}
    {dictfor {a b c d e f g h i j}}
    # Failure handling, [subst], [try]
    {list [catch {switchfail xyz} msg] $msg}
    {jumptable a}
    {jumptable b}
    {jumptable c}
    {jumptable xyz}
    {wideretest x}
    {substtest pqr}
    {substtest2 pqr}
    {magicreturn 5}
    {returntest x bar}
    {errortest1 pqr}
    {catch {errortest2 pqr}}
    {list [catch {errortest2 pqr} msg opt] $msg [cleanopt $opt]}
    {errortest2-caller pqr}
    {errortest3 pqr}
    {errortest3 st}
    {list [catch {errortest4 pqr} msg] $msg}
    {catch {errortest4 qwe}}
    {errortest4 qwerty}
    {errortest4a pqr}
    {errortest4a qwe}
    {errortest4a qwerty}
    {errortest5 abc}
    {errortest6 1}
    {errortest6 2}
    {errortest6 3}
    {nextest1 0}
    {nextest1 1}
    {nextest2 0}
    {nextest2 1}
    {nextest3 0}
    {nextest3 1}
    {nextest4}
    {catch {calltest2 1 5 ,} msg}
    {calltest3 0 3}
    {coscaller1 1.0471975511965976}
    {coscaller2}
    {mrtest::calc {/ {* {+ {i 2} {i 3}} {* {f {i 4}} {i 4}}} {i 10}}}
    {lcmRange 25}
    {xsum2}
    {bctest -1}
    {bctest 0}
    {bctest 1}
    {bctest "t"}
    {bctest "f"}
    {bctest "true"}
    {bctest "fish head"}
    {asmtest}

    {nstest::nstest0}
    {nstest::nstest1}
    {nstest::nstest2}
    {nstest::nstest3}
    {nstest::nstest4}
    {nstest::nstest5}
    {nstest::nstest6}
    {list [catch {nstest::nstest7} result] $result $::errorCode}

    {bug-0616bcf08e::msrange 0 10}
    {bug-0616bcf08e::msrange2 0 10}
    {qsort {3 6 8 7 0 1 4 2 9 5}}
    {impure 0x0 0 0}
    {impure 0x3 0 0}
    {impure 0 1 1}
    {impure 10 10000 10}
    {impure 1 +2000 [string range "123" 2 2]}
    {impure-typecheck-int 10 10000 10}
    {impure-typecheck-int 1 +2000 [string range "123" 2 2]}
    {impure-caller}
    {impure2 0x0 0 0}
    {impure2 0x3 0 0}
    {impure2 0 1 1}
    {impure2 10 10000 10}
    {impure2 0b1 0x80 0o13}
    {comps 1 2}
    {comps 2 1}
    {comps 0x10 0y2}
    {comps 0y2 3}
    {comps 3 0x10}
    {list [catch {bug-7c599d4029::bug {fish head}} r] $r}
    {bug-7c599d4029::bug 1}
    {bug-7c599d4029::bug 0x1}
    {linesearch::getAllLines1 2}
    {linesearch::getAllLines2 2}
    # {flightawarebench::test 5 5 2}
    # {flightawarebench::clockscan 5 5 5}
}
set demos'slow' {
    {flightawarebench::test 5 5 2}
}

#########################################################################
#
# List of procedures to compile. These do not need to be fully-qualified; the
# compilation engine will do that for us if necessary.

set toCompile {
    # Mathematical operations; [fib] and [cos] are supposed to be accelerated
    # heavily, the others are less critical
    fib
    ::cos
    tantest
    inttest
    math::ln_Gamma
    polartest
    shift
    powmul1 powmul2
    uplustest
    # String operations
    strtest
    passthrough
    streqtest
    strconcattest
    comparetest
    appendtest appendtest2 appendtest3
    rev
    idx
    ranged
    substrtest substrtest2
    casetest
    cmptest
    cmptest2
    matchtest
    replacing replacing2 replacing3
    strclasstest
    jumptable
    concatenater
    booltest
    stristest
    # Failure handling, [subst], [try]
    wideretest
    substtest
    substtest2
    switchfail
    trimtest
    magicreturn
    returntest
    errortest1
    errortest2
    # errortest2-caller		BUG: NOTHING ends up in phi node?
    errortest3
    errortest4 errortest4a
    errortest5 errortest6
    # List operations (also see some [try] tests)
    listtest
    lrangetest
    listjoin1 listjoin2
    listjoin3
    lsetest
    lappendtest
    rangetest
    numberitems numberitems2 numberitems3 doubleitems
    containment
    # Dictionary operations (also see some [try] tests)
    dictest
    dictest2 dictest3
    dictest4 dictest5
    dictest6
    dictfor
    # Nonexistent variables
    nextest1
    nextest2
    nextest3
    nextest4
    # Array operations
    wordcounter1
    wordcounter2
    wordcounter3
    # Calls of uncompiled code
    calltest
    calltest2
    calltest3
    # The interprocedural tests
    mrtest::*
    coscaller1
    coscaller2
    xsum xsum2
    # Namespace tests
    nstest::nstest0
    nstest::nstest1
    # nstest::nstest2      NEEDS CALLFRAME SUPPORT
    nstest::nstest3
    nstest::nstest4
    # nstest::nstest5      NEEDS CALLFRAME SUPPORT
    nstest::nstest6
    nstest::nstest7
    # Miscellaneous other tests
    bctest
    asmtest
    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    qsort
    impure
    impure-caller
    impure-typecheck-int
    impure2
    comps
    bug-7c599d4029::*
    linesearch::colinear
    linesearch::sameline
    linesearch::getAllLines1
    linesearch::getAllLines2
    flightawarebench::*
}

#############################################################################
#
# Demonstration/test running code. In particular, this (effectively) calls:
#
#	LLVM configure {*}$argv
#	LLVM optimise {*}$toCompile
#	foreach script $demos {
#	    time $script
#	}
#
# There's more complexity than that (to do tracking and comparisons of values,
# representations, speed, etc.), but not hugely more. The view above is

# Load the local package and its dependencies
lappend auto_path [file dirname [info script]]
package require tclquadcode

# Load the demo runner support code
source -encoding utf-8 [file join [file dirname [info script]] demosupport.tcl]

# Parse and init the command line arguments
DemoParseArguments

# Run the test cases above in before-and-after-compilation and compare for
# correctness and speed.
DemoCompileAndCompare

# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# End:
