Posted to tcl by evilotto at Fri Aug 24 22:51:07 GMT 2018view raw

  1. namespace eval ::ref {
  2. variable refs {}
  3. variable cnt 0
  4. }
  5.  
  6. proc ref {value} {
  7. set rv ::ref::<refs_[incr ::ref::cnt]>
  8. dict set ::ref::refs $rv $value
  9. return $rv
  10. }
  11.  
  12. proc getref {rv} {
  13. dict get $::ref::refs $rv
  14. }
  15.  
  16. proc setref {rv value} {
  17. dict set ::ref::refs $rv $value
  18. }
  19.  
  20. proc collect {} {
  21. set arefs $::ref::refs
  22. foreach v [info globals] {
  23. if [array exists ::$v] continue
  24. set val [set ::$v]
  25. if {[dict exists $arefs $val]} {
  26. dict unset arefs $val
  27. }
  28. }
  29. set count 0
  30. foreach k [dict keys $arefs] {
  31. puts "no reference to $k"
  32. dict unset ::ref::refs $k
  33. incr count
  34. }
  35. puts "collected $count"
  36. }
  37.