# -*- tcl -*-
# Tcl Benchmark File
#
# This file contains a number of benchmarks for the 'struct::queue'
# data structure to allow developers to monitor package performance.
#
# (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net>


# We need at least version 8.2 for the package and thus the
# benchmarks.

if {![package vsatisfies [package present Tcl] 8.2]} {
    bench_puts "Need Tcl 8.2+, found Tcl [package present Tcl]"
    return
}

# ### ### ### ######### ######### ######### ###########################
## Setting up the environment ...

set moddir [file dirname [file dirname [info script]]]
lappend auto_path $moddir

bench_puts "Autopath += $moddir"

# Support package
package forget struct::list
catch {namespace delete ::struct::list}
source [file join [file dirname [info script]] list.tcl]

bench_puts "Loaded struct::list [package present struct::list] (support)"
bench_puts "       [file join [file dirname [info script]] list.tcl]"

# Package to benchmark
package forget struct::queue
catch {namespace delete ::struct::queue}
source [file join [file dirname [info script]] queue.tcl]

bench_puts "Loaded struct::queue [package present struct::queue] (under test)"
bench_puts "       [file join [file dirname [info script]] queue.tcl]"

namespace import struct::queue

set code tcl
if {![catch {package present tcllibc}]} {
    bench_puts "Using Tcllibc accelerator"
}

# ### ### ### ######### ######### ######### ###########################

proc makeNcmd {n} {
    return [linsert [struct::list iota $n] 0 s put]
}

proc makeN {n} {
    queue s
    if {$n > 0} { eval [makeNcmd $n] }
    return
}

# ### ### ### ######### ######### ######### ###########################
## Benchmarks.

# We have only 6 queue operations
#
# * clear  - Remove all elements from the queue.
# * get    - Destructively retrieve N elements, N > 0
# * peek   - Retrieve N elements, keep on queue, N > 0
# * put    - Add N elements to the queue, N > 0
# * size   - Query the size of the queue.
# * unget  - Add N elements to _front_ of the queue, N > 0

# note on peek, get:
# - current testing is fine for single queue area.
# - split return/append => should check performance of peek crossing boundaries
# - split unget/return/append ? ditto, now possibly crossing 2 boundaries.

# peek/put:
# - Time to retrieve/remove 1/10/100/1000 elements incrementally from a queue.
# - Time to retrieve/remove ............. elements at once from a queue.
# - Queue sizes 10/100/1000/1000 and pop only elements less than size.
# Expected: Amortized linear time in number of retrieved/removed elements.

bench_puts {=== get/peek =========}

foreach base {10 100 1000 10000} {
    foreach remove {1 10 100 1000 10000} {
	if {$remove > $base} continue

	bench -desc "queue get once $base/$remove" -ipre {
	    makeN $base
	} -body {
	    s get $remove
	} -ipost {
	    s destroy
	}

	bench -desc "queue get incr $base/$remove" -pre {
	    set cmd {}
	    foreach x [struct::list iota $remove] {
		lappend cmd [list s get]
	    }
	    proc foo {} [join $cmd \n]
	    catch {foo} ;# compile
	} -ipre {
	    makeN $base
	} -body {
	    foo
	} -ipost {
	    s destroy
	} -post {
	    rename foo {}
	}

	bench -desc "queue peek $base/$remove" -ipre {
	    makeN $base
	} -body {
	    s peek $remove
	} -ipost {
	    s destroy
	}
    }
}

# put:
# - Time to add 1/10/100/1000 elements incrementally to an empty queue
# - Time to add ............. elements at once to an empty queue.
# - As above, to a queue containing 1/10/100/1000 elements already.
# Expected: Amortized linear time in number of elements added.

bench_puts {=== put/unget =========}

foreach base  {0 1 10 100 1000} {
    foreach add {1 10 100 1000} {

	bench -desc "queue put once $base/$add" -ipre {
	    makeN $base
	    set cmd [makeNcmd $add]
	} -body {
	    eval $cmd
	} -ipost {
	    s destroy
	}

	bench -desc "queue put incr $base/$add" -pre {
	    set cmd {}
	    foreach x [struct::list iota $add] {
		lappend cmd [list s put $x]
	    }
	    proc foo {} [join $cmd \n]
	    catch {foo} ;# compile
	} -ipre {
	    makeN $base
	} -body {
	    foo
	} -ipost {
	    s destroy
	} -post {
	    rename foo {}
	}

	bench -desc "queue unget incr $base/$add" -pre {
	    set cmd {}
	    foreach x [struct::list iota $add] {
		lappend cmd [list s unget $x]
	    }
	    proc foo {} [join $cmd \n]
	    catch {foo} ;# compile
	} -ipre {
	    makeN $base
	} -body {
	    foo
	} -ipost {
	    s destroy
	} -post {
	    rename foo {}
	}
    }
}

# size
# - Time to query size of queue containing 0/1/10/100/1000/10000 elements.
# Expected: Constant time.

bench_puts {=== size =========}

foreach n {0 1 10 100 1000 10000} {
    bench -desc "queue size $n" -pre {
	makeN $n
    } -body {
	s size
    } -post {
	s destroy
    }
}

# clear
# - Time to clear a queue containing 0/1/10/100/1000/10000 elements.
# Expected: Constant to linear time in number of elements to clear.

bench_puts {=== clear =========}

foreach n {0 1 10 100 1000 10000} {
    bench -desc "queue clear $n" -ipre {
	makeN $n
    } -body {
	s clear
    } -ipost {
	s destroy
    }
}

# ### ### ### ######### ######### ######### ###########################
## Complete

return

# ### ### ### ######### ######### ######### ###########################
## Notes ...

# Notes on optimizations we can do.
#
# Tcl - Cache structural data - depth, ancestors ...
# C   - Cache results, like child lists (Tcl_Obj's!)
#       Maybe use Tcl_Obj/List for child arrays instead
#       of N* ? Effect on modification performance ?