Posted to tcl by alan at Tue May 19 19:48:24 GMT 2026view pretty
#!/usr/bin/env tclsh
# =============================================================================
# dict_update_native_vs_custom_new.tcl
#
# Benchmark: native "dict update" vs custom dict_update proc
#
# The custom proc generalises "dict update" to support nested key paths via
# a dynamic keyList argument (using {*}$keyList expansion).
#
# Setup:
# - A dict of N=1000 keys, each holding a list of M=100000 elements.
#
# Scenarios:
# 1. lset replace element at index j=50000 in list at key i=500
# 2. lappend append a new element to the list at key i=500
#
# Each scenario is profiled with: profile {demo_<name> ...} $iter
# profile discards the first run (warmup); dict is recreated before each call
# =============================================================================
# ---------------------------------------------------------------------------
# Custom dict_update proc (from spec unchanged)
# ---------------------------------------------------------------------------
proc dict_update {dictObjVar keyList entryVar script} {
upvar $dictObjVar dictObj
upvar $entryVar entry
try {
set entry [dict get $dictObj {*}$keyList]
dict set dictObj {*}$keyList {}
uplevel $script
} finally {
dict set dictObj {*}$keyList $entry
}
}
# ---------------------------------------------------------------------------
# Configuration
# ---------------------------------------------------------------------------
set N 1000 ;# number of dict keys
set M 100000 ;# number of elements per list value
set iter 50 ;# iterations passed to [time]
set demo_i 500 ;# key to operate on
set demo_j 50000 ;# list index to modify in the lset scenario
# ---------------------------------------------------------------------------
# make_dict build and return a fresh dict
# ---------------------------------------------------------------------------
proc make_dict {} {
global N M
set d {}
for {set i 0} {$i < $N} {incr i} {
dict set d $i [lrepeat $M 0]
}
return $d
}
# ---------------------------------------------------------------------------
# profile discard first run, recreate dict before timing, then time
# ---------------------------------------------------------------------------
proc profile {cmd n} {
uplevel 1 $cmd ;# warmup (uses current benchDict)
uplevel 1 [list time $cmd $n]
}
# ---------------------------------------------------------------------------
# Demo procs lset (replace element at index j)
# ---------------------------------------------------------------------------
proc demo_native_lset {benchDict demo_i demo_j} {
upvar 1 $benchDict myDict
dict update myDict $demo_i entry {
lset entry $demo_j 1
}
}
proc demo_custom_lset {benchDict demo_i demo_j} {
upvar 1 $benchDict myDict
dict_update myDict [list $demo_i] entry {
lset entry $demo_j 1
}
}
# ---------------------------------------------------------------------------
# Demo procs lappend (append new element to the list)
# ---------------------------------------------------------------------------
proc demo_native_lappend {benchDict demo_i} {
upvar 1 $benchDict myDict
dict update myDict $demo_i entry {
lappend entry newElem
}
}
proc demo_custom_lappend {benchDict demo_i} {
upvar 1 $benchDict myDict
dict_update myDict [list $demo_i] entry {
lappend entry newElem
}
}
# ---------------------------------------------------------------------------
# Benchmarks
# ---------------------------------------------------------------------------
proc print_result {label t} {
puts [format " %-30s %s" "$label:" $t]
}
puts "=== Scenario 1: lset (key=$demo_i, index=$demo_j) ==="
set benchDict [make_dict]
print_result "native dict update" [profile {demo_native_lset benchDict $demo_i $demo_j} $iter]
puts "updated value: [lindex [dict get $benchDict $demo_i] $demo_j]"
set benchDict [make_dict]
print_result "custom dict_update" [profile {demo_custom_lset benchDict $demo_i $demo_j} $iter]
puts "updated value: [lindex [dict get $benchDict $demo_i] $demo_j]"
puts ""
puts "=== Scenario 2: lappend (key=$demo_i) ==="
set benchDict [make_dict]
print_result "native dict update" [profile {demo_native_lappend benchDict $demo_i} $iter]
puts "updated value llength: [llength [dict get $benchDict $demo_i]]"
set benchDict [make_dict]
print_result "custom dict_update" [profile {demo_custom_lappend benchDict $demo_i} $iter]
puts "updated value llength: [llength [dict get $benchDict $demo_i]]"