Memoizing wrapper for Tcl procs

I made a small fix to my MangaDex downloader this afternoon which in turn made me fiddle until I got a neat and tidy proc memoization wrapper as commonly available in dynamic languages. And as a bonus, a similar wrapper to get rate limiting for my API calls!

proc proc_memo {name args body} {
    set cvar [string cat $name _memo_cache]
    global $cvar
    set $cvar [dict create]

    tailcall proc $name args [quasiquote {
        global `$cvar
        if {[dict exists $`$cvar $args]} {
            return [dict get $`$cvar $args]
        }
        set ret [apply {`$args `$body `[uplevel 1 namespace current]`} {*}$args]
        dict set `$cvar $args $ret
        return $ret
    }]
}

proc_memo p {x y} {
    puts "args: $x $y"
    string cat $y $x
}

puts [p 1 2]; # => args: 1 2↵21
puts [p 1 2]; # => 21
puts [p 3 4]; # => args: 3 4↵43
puts [p 3 4]; # => 43

It Just Werks™, in large part thanks to my precious quasiquote helper. Really too bad global doesn't allow for clean "once only" initialization like C's static or CL's defvar…

An LRU evicting version would be necessary for real-world use - to avoid unbounded cache growth - but here Tcl showcases the limitations RMS infamously ranted about more than 30 years ago: you can't build complex datastructures from scratch (i.e. not based on the builtin ones) like an LRU cache that needs at least a linked list with head/tail access, no if no but.

One would have to either cobble something with struct::record or more realistically, painfully write it in C via Critcl to get the required high performance.

Well, let's put ranting aside and take a look at the rate-limiting version:

proc proc_rate_limited {name callnum/duration args body} {
    set fvar [string cat $name _rate_limit_fifo]
    global $fvar
    set $fvar [list]

    lassign [split ${callnum/duration} /] callnum duration
    set duration_ms [uscale $duration ms]

    tailcall proc $name args [quasiquote {
        global `$fvar
        set now [clock milliseconds]
        if {[llength $`$fvar] == `$callnum} {
            set `$fvar [lassign $`$fvar last]
            if {($now - $last) < `$duration_ms} {
                after [expr {round(`$duration_ms - ($now - $last))}]
            }
        }
        lappend `$fvar $now
        apply {`$args `$body `[uplevel 1 namespace current]`} {*}$args
    }]
}

# No more throttling from MangaDex!
# cf https://api.mangadex.org/docs/2-limitations/#general-rate-limit
proc_rate_limited api_get 5/1.1s {endpoint {query_params ""}} {
   exec curl ...
}

Clean, isn't it? Well, I do think so, at least.