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]]"