[Zarutian] tormented [kbk] the other day (late Desember 2007 or early January 2008) with this:

 package Tcl 8.5
 variable storage {}
 proc restore {caller vars} {
   if {![dict exists $::storage $caller]} { return }
   foreach var $vars {
     uplevel 1 [list set $var [dict get $::storage $caller $var]]
   }
 }
 proc save {caller vars} {
   foreach var $vars {
     dict set ::storage $caller $var [uplevel 1 [list set $var]]
   }
 }
 
 proc persist {args} {
   set vars $args; unset args
   if {[uplevel 1 [list info exists __[info level 0]]]} { return }
   uplevel 1 [list set __[info level 0] exists]

   set caller [lindex [info level 1] 0]
   uplevel 1 [list restore $caller $vars]
   catch [list uplevel 1 [info body $caller]] result options
   uplevel 1 [list save $caller $vars]
   dict incr options -level +2
   return -options $options $result 
 }
 
 proc prufa {args} {
   persist si
   incr si 42
   puts "si = $si"
 }

----

another well known [proc]edure decorator is [memoize], but that only works for referentially transparent functions (i.e. side-effect free procedures).

[DKF]: So what does this code ''do''? It's not at all clear from just reading the code...

[RS]: Could it have to do with [static variables]? But I don't understand the code either...

[Zarutian]: indeed the above example of an decorator is for persisting [static variables].

----
[Zarutian] adds an memoize decorator:
 # not tested yet
 
 package require Tcl 8.5
 variable memoize_storage {}
 proc memoize {} {
   if {[uplevel 1 [liss info exists __[info level 0]]} { return }
   uplevel 1 [list set __[info level 0] exists]

   variable memoize_storage

   set invocation [info level 1]
   if {[dict exists $memoize_storage $invocation]]} {
     set result  [dict get $memoize_storage $invocation result]
     set options [dict get $memoize_storage $invocation return_options]
   } else {
     set caller [lindex $invocation 0]
     catch [list uplevel 1 [info body $caller]] result options
     dict set memoize_storage $invocation result $result
     dict set memoize_storage $invocation return_options $options
   }
   dict incr options -level +2
   return -options $options $result 
 }
----
[kruzalex] Example above adapted on Tcl 8.4 and after testing should look with some modifications:

 package require dict

 variable memoize_storage {}
 proc memoize {args} {
	set vars $args; unset args
	foreach var $vars break
   if {[uplevel 1 [list info exists __[info level 0]]]} {return }
   uplevel 1 [list set __[info level 0] exists]

   variable memoize_storage

   set invocation [info level 1]
   set caller [lindex $invocation 0]
   set procname [lindex [info level -1] 0]
   if {[dict exists $memoize_storage $caller]} {
	   set result [uplevel 1 [list set $var [dict get $memoize_storage $caller $var]]]
       catch [list uplevel 1 [info body $caller]] result 
       dict set memoize_storage $caller $var [uplevel 1 [list set $var]]
   } else {
      catch [list uplevel 1 [info body $caller]] result 
	  dict set memoize_storage $caller $var [uplevel 1 [list set $var]]  
   } 
   return -code return $result
 }
 
  proc prufa {{si 0}} {
   memoize si
   incr si 42
   puts "si = $si"
 }
 
prufa
prufa
prufa

----
[kruzalex] For Tcl 8.4 lovers example mentioned on the top should work in this way

package require dict

 variable storage {}
 proc restore {caller vars} {
   if {![dict exists $::storage $caller]} { return }
   foreach var $vars {
     uplevel 1 [list set $var [dict get $::storage $caller $var]]
   }
 }
 proc save {caller vars} {
   foreach var $vars {
     dict set ::storage $caller $var [uplevel 1 [list set $var]]
   }
 }

 proc persist {args} {
   set vars $args; unset args
   if {[uplevel 1 [list info exists __[info level 0]]]} { return }
   uplevel 1 [list set __[info level 0] exists]

   set caller [lindex [info level 1] 0]
   uplevel 1 [list restore $caller $vars]
   catch [list uplevel 1 [info body $caller]] result
   uplevel 1 [list save $caller $vars]
   dict incr -level +2
   return -code return $result
 }

 proc prufa {{si 0}} {
   persist si
   incr si 42
   puts "si = $si"
 }
 
 prufa
 prufa
 prufa
----

!!!!!!
%| enter categories here |%
!!!!!!