----
 proc comment {args} {}
comment {
[Zarutian] 24. june 2005: what I have been working with:
}
 wm withdraw .
 proc comment args {}
 proc save_state args {
   # ná í stikur fallsins/ferilins
   set vars [lindex $args 0]
   set op   [lindex $args end]
   
   if {$op == "leave"} {
     # assumes that template for the traced procedure is
     # kept in variable body in the traced procedure's stackframe
     upvar body body
     set subst [list %body% [list $body]]
     foreach item $vars {
       upvar $item tmp
       lappend subst "%[set item]%"
       lappend subst [list $tmp ]
     }
     puts "debug: $subst"
     set caller [lindex [info level 1] 0]
     proc $caller [list [info args $caller]] [string map $subst $body]
   }
 }
 proc lcombine {listA listB} {
   set res [list]
   foreach item $listA {
     lappend res $item
   }
   foreach item $listB {
     lappend res $item
   }
   set res
 }
 proc clock_millisecs {} {
   # crude but gets the job done for now
   set a [clock seconds]
   set b [clock clicks -millisec]
   set c [string range $b end-2 end]
   while {[string index $c 0] == "0"} {
     set c [string range $c 1 end]
   }
   if {[string index $b 0] == "-"} {
     set b [format "%03d" [expr 1000 -$c]]
   } else {
     set b $c
   }
   return "[set a][set b]"
 }
 proc makeReplicatedSafeInterp {sync_proc {seed -1}} {
    set me [lindex [info level 0] 0]
    proc $me [list sync_proc [list seed [incr seed]]] [info body $me]
    set name "replicaInterp[set seed]"
    set body {
      # nearly instance variables ;-)
      set body %body% ; # sort of template for the procedure
      set sync_proc %sync_proc%
      set sub_interp %sub_interp%
      set state_log %state_log%
      # stuff to save
      set vars [list sync_proc sub_interp state_log]
      trace add execution [lindex [info level 0] 0] leave [list save_state $vars]

      # initilize
      set dispatch [list]

      # method dispatch: (or nearly so)
      switch -exact -- [lindex $args 0] {
        "snapshot" {
          return $state_log
        }
        "alias_called" {
          set dispatch $sub_interp
          lappend dispatch "invokehidden"
          set dispatch [lcombine $dispatch [lrange $args 1 end]]
          lappend state_log [list [clock_millisecs] [lrange $args 1 end]]
        }
        "eval" {
          $sync_proc cause [lrange $args 1 end] [lindex [info level 0] 0]
          set dispatch $sub_interp
          lappend dispatch "eval"
          set dispatch [lcombine $dispatch [lrange $args 1 end]]
        }
        "eval-without-cause" {
          set dispatch $sub_interp
          lappend dispatch "eval"
          set dispatch [lcombine $dispatch [lrange $args 1 end]]
        }
        default {
          set dispatch $sub_interp
          set dispatch [lcombine $dispatch $args] 
        }
     }
     if {[llength $dispatch] > 0} {
       return [eval $dispatch]
     }
   }
   set sub_interp [interp create -safe]
   foreach item { after append binary catch close fcopy fileevent flush foreach gets incr info interp lappend lset namespace package proc puts read regexp regsub rename scan seek set trace unset } {
     $sub_interp hide $item
     $sub_interp alias $item $name alias_called $item
   }
   set subst [list %body% [list $body] %sync_proc% [list $sync_proc] %sub_interp% [list $sub_interp] %state_log% "{}"]
   proc $name args [string map $subst $body]
   return $name
 }


comment {
 Command:    Side-effects? (does invokation of the command change the var env?)
 after          yes
 append         yes
 array          yes (array set)
 binary         yes (binary scan)
 break          nope (flow control)
 case           nope
 catch          yes (if args more than 1)
 clock          no (simply calculation and an accessor)
 close          yes (I/O)
 concat         nope
 continue       nope (flow control)
 eof            nope (I/O state checker)
 error          nope (???)
 eval           nope (???)
 expr           nope (calculations)
 fblocked       nope (I/O state checker)
 fcopy          yes (I/O)
 fileevent      yes (I/O)
 flush          yes (I/O)
 for            nope (not directly)
 foreach        yes (changes some var as it iterates throug a list)
 format         nope
 gets           yes (I/O)
 global         nope (just opens up access for the current procedure to access that global var)
 if             nope
 incr           yes
 info           yes (info script)
 interp         yes (???)
 join           nope
 lappend        yes
 lindex         nope
 linsert        nope
 list           nope
 llength        nope
 lrange         nope
 lreplace       nope
 lsearch        nope
 lset           yes
 lsort          nope
 namespace      yes
 package        yes
 pid            nope
 proc           yes
 puts           yes (I/O)
 read           yes (I/O)
 regexp         yes
 regsub         yes
 rename         yes
 return         nope (flow control)
 scan           yes
 seek           yes
 set            yes
 split          nope
 string         nope
 subst          nope (not directly)
 switch         nope
 tell           nope (I/O state checker/accessor)
 time           nope (not directly)
 trace          yes
 unset          yes
 update         nope
 uplevel        see eval
 upvar          ???
 variable       see global
 vwait          nope
 while          nope
}

comment {
 proc prepend {varname data} {
   upvar $varname tmp
   set tmp "[set data][set tmp]"
 }
 proc lexclude {b a} {
   # returns list a where all elements of list b have been removed.
   set tmp [list]
   foreach item $a {
     if {[lsearch $b $item] == -1} {
       lappend tmp $item
     }
   }
   return $tmp
 }

 comment {
----
[Zarutian] 19 june 2005: This developed out of the idea outlined by the Croquet Project (http://www.opencroquet.org/Croquet_Technologies/architecture.html). 
Which is to replicate state of an object over many machines and synchronize those replicas.

This is a bit crude and thrown together implemention.

First, start of by setting up an slave interp. Alias after to be able to capture after scripts.

 }
 set i [interp create -safe]

 proc slave_after args {
   puts "debug: [info level 0]"
   set i [lindex $args 0]
   if {[lindex $args 1] != "info"} {
     store_after_script [lindex $args 0] [clock seconds] [lrange $args 1 end]
   }
   set tmp $i
   lappend tmp "invokehidden" 
   lappend tmp "after"
   foreach arg [lrange $args 1 end] { lappend tmp $arg }
   puts "debug:\t \$tmp = [list $tmp]"
   eval $tmp  
 }
 $i hide after
 $i alias after slave_after $i
 comment {
Then set up probe procedures for dumping the state of the slave interp.
 }
 #proc store_after_script {interp when_invoked args} {
 #  puts "debug: [info level 0]"
 #  variable after_scripts
 #  set first [lindex $args 0]
 #  if {[string is digit $first]} {
 #    while {[string length $first] < 4} {
 #      prepend first "0" 
 #    }
 #    append after_scripts($interp) "when \{\[clock seconds\] > ($when_invoked +"
 #    append after_scripts($interp) " [string range $first 0 end-3])\} \{\n"
 #    append after_scripts($interp) "  after [string range $first end-2 end] [list [lindex [lindex $args 1] 1]]\n"
 #    append after_scripts($interp) "\} 1000\n"
 #  } else {
 #    append after_scripts($interp) "when \{\[clock seconds\] > $when_invoked \} \{\n  after "
 #    foreach arg $args {
 #      append after_scripts($interp) $arg
 #      append after_scripts($interp) " "
 #    } 
 #    append after_scritps($interp) "\n\}\n"
 #  }
 #}
 proc store_after_script {interp when_invoked args} {
   puts "debug: [info level 0]"
   variable after_scripts
   append after_scripts($interp) "reschedule_after_script $when_invoked [list $args]\n"
 }
 proc capture_after_scripts {interp} {
   set res {
     proc when {condition body {interval 1000}} {
       if $condition $body else {
         after $interval [info level 0]
       }
     }
   }
   variable after_scripts
   if {[info exists after_scritps($interp)]} {
     append res $after_scripts($interp)
   }
   return $res
 }
 # a helper functions:
 proc interp_ns {interp namespace script} {
   return [$interp eval [list namespace eval $namespace $script]]
 }
 proc list_vars {interp namespace} {
   set globals [interp_ns $interp $namespace {info globals}]
   if {$namespace == {}} { set globals {} }
   set vars [interp_ns $interp $namespace {info vars}]
   return [lexclude $globals $vars]
 }
 proc capture_vars {interp {namespace {}}} {
   set vars [list_vars $interp $namespace]
      set tmp "# variables: \n"
   append tmp "namespace eval [list $namespace] \{\n"
   foreach var $vars {
     if {[interp_ns $interp $namespace [list array exists $var]]} {
       append tmp "array set [list $var] [list [interp_ns $interp $namespace [list array get $var]]]\n"
     } else {
       append tmp "set [list $var] [list [interp_ns $interp $namespace [list set $var]]]\n"
     }
   }
   append tmp "\}"
   return $tmp
 }
 proc capture_procs {interp {namespace {}}} {
   set procs [interp_ns $interp $namespace {info procs}]
   set tmp "# procedures: \n"
   append tmp "namespace eval [list $namespace] \{\n"
   foreach proc $procs {
     # dangerous asumption: expect that no variable will be named: {}
     # why: because it's the only way to squease data out of [info default]
     # proposed alt: add an -withDefaults to [info args]
     set args [list]
     foreach arg [interp_ns $interp $namespace [list info args $proc]] {
       if {[interp_ns $interp $namespace [list info default $proc $arg {}]]} {
         lappend args [list $arg [interp_ns $interp $namespace [list set {}]]]
       } else {
         lappend args $arg
       }
       catch { [interp_ns $interp $namespace [list unset {}]] }
     }
     set body [interp_ns $interp $namespace [list info body $proc]]
     append tmp "proc [list $proc] [list $args] [list $body]\n"
   }
   append tmp "\}"
   return $tmp
 }
 proc capture_varTraces {interp {namespace {}}} {
   set vars [list_vars $interp $namespace]
      set tmp "# traces on variables: \n"
   append tmp "namespace eval [list $namespace] \{\n"
   foreach var $vars {
     set traces [interp_ns $interp $namespace [list trace info variable $var]]
     foreach trace $traces {
       append tmp "trace add variable [list $var] [list [lindex $trace 0]] [list [lindex $trace 1]]\n"
     }
   }
   append tmp "\}"
   return $tmp
 }
 proc capture_all {interp {namespace {}}} {
   set tmp ""
   if {$namespace == {}} {
     append tmp "# Fascmile of interp state -BEGIN- \n"
   }
   append tmp "[capture_vars  $interp $namespace]\n"
   append tmp "[capture_procs $interp $namespace]\n"
   append tmp "[capture_varTraces $interp $namespace]\n"
   append tmp "[capture_after_scripts $interp]\n"

   set children [$interp eval [list namespace children $namespace]]
   if {[llength $children] > 0} {
     foreach child $children {
       append tmp [capture_all $interp $child]
     }
   }
   if {$namespace == {}} {
     append tmp "# Fascmile of interp state -END- \n"
   }
   return $tmp
 }

 proc update_replicas args {
   puts "debug: [info level 0]"
   variable channels_to_Replicas'_masters
   foreach chan [set channels_to_Replicas'_masters] {
     catch {
       puts $chan "cause [list $args]"
       flush $chan
     }
   }
 }
 comment {
Next handle incoming requests from other instances of the same replicated slave interp
 }
 proc connection_handler {sock} {
   variable buffers
   append buffers($sock) [gets $sock]
   append buffers($sock) "\n"
   if {[info complete $buffers($sock)]} {
     switch -exact -- [lindex $buffers($sock) 0] {
       "cause" {
         variable i
         if {[lsearch [$i hidden] [lindex [lindex $buffers($sock) 1] 0]] != -1} {
           set tmp $i
           lappend tmp "invokehidden"
           foreach item [lindex $buffers($sock) 1] { lappend tmp $item }
           eval $tmp
         } else {
           $i eval [lindex $buffers($sock) 1]
         }
       }
       "gimme_snapshot" {
         variable i
         set tmp [capture_all $i]
         catch {
           puts $sock "snapshot [list $tmp]"
           flush $sock
         }
       }
     }
     unset buffers($sock)
   }
   if {[eof $sock]} { close $sock; return }
 }
 comment {
Not fully tested yet

I am thinking I am aproaching this proplem from a wrong perspective.
----
[Lars H], 20 June 2005: Maybe if you gave more of an explanation of how it's supposed to work someone could lend a hand. For starters, what's the idea behind doing something special with [after]? It's probably a key part of the approach, but to what end isn't terribly clear from the above.

As an aside, the many
  puts "debug: ..."
lines are better coded like e.g.
  putdebug ...
with
  proc putdebug {str} {puts "debug: $str"}
as they can then easily be disabled by a simple
  proc putdebug {str} {}
when you're not debugging.

[Zarutian] 22 june 2005: Well the basic idea is to store the starting state of an object 
(here an slave interp), instancenate an object by using that state (replicate the object) 
and synchronise these two (or more) replicas together by sending external influences to all replicas in the same sequence as they occur (from some coordnator's point of view which could be the origin replica of a given external influence). How's that for a sentence ;-)

Why I have such an intrest in after is that unfired after-scripts are part of the slave's interp state.
 }

 comment {
[Zarutian] 19 june 2005 23:23 : Something like this would be cleaner:

   proc makeReplicatedSafeInterp {sync_proc {seed -1}} {
     proc [lindex [info level 0] 0] [list sync_chan [list seed [incr seed]]] [info body [lindex [info level 0]]
     set body {
       # nearly instance variables ;-)
       set body %body%
       set sync_proc %sync_proc%
       set sub_interp %sub_interp%
       set state_log %state_log%
       # stuff to save
       set subst [list \%body\% $body \%sync_proc\% $sync_proc \%sub_interp\% $sub_interp \%state_log\% $state_log]
       trace add execution [lindex [info level 0] 0] leave save_state

       # initilize
       set dispatch false
  
       # method dispatch: (or nearly so)
       switch -exact -- [lindex $args 0] {
         "alias_called" {
           set tmp $sub_interp
           lappend tmp "invokehidden"
           foreach arg [lrange $args 1 end] {
             lappend tmp arg
           }
           eval $tmp
         }
         "eval" {
           $sync_proc cause [lrange $args 1 end] [lindex [info level 0] 0]
           set dispatch true
         }
         default { set dispatch true }
       }
       
       # save yourself!

       proc [lindex [info level 0] 0] args [string map $subst $body]

       if {$dispatch} {
         set tmp $sub_interp
         foreach arg $args {
           lappend tmp $arg
         }
         return [eval $tmp]
       }
     }
     set subst [list \%body\% $body \ 
                     \%sync_proc\% $sync_proc \
                     \%sub_interp\% $sub_interp \
               ]
     proc "replicaInterp[set seed]" args [string map $subst $body]
   }
   proc save args {}
 }
----
}