anchor.diff:  
   ;; PRINT-OBJECT
   
  -(defmethod print-object ((e event) s)
  -  (print-unreadable-object (e s :type t :identity t)
  -    (format s "owner-path: ~a time: ~a fn: ~a"
  -	    (owner-path-of e) (time-of e) (fn-of e))
  -    (when (slot-boundp e 'args)
  -      (format s " args: ~a" (args-of e)))))
  +(defmethod print-object ((ev event) s)
  +  (print-unreadable-object (ev s :type t)
  +    (format s "time: ~a fn: ~a"
  +	    (time-of ev) (fn-of ev))
  +    (when (slot-boundp ev 'args)
  +      (format s " args: ~a" (args-of ev)))
  +    (format s "owner: ~a" (owner-of ev))))
   
   
   
   ;; FUNCTIONS AND METHODS
   
  -
  -(let ((clock 0))
  -  (defun gettime (evs)
  -    (if (null evs)
  -	clock
  -	(setf clock
  -	      (time-of (first evs))))))
  -
  -
  -(defun path-starts-with (seq test)
  -  (equal (subseq seq 0 (length test))
  -	 test))
  -
  -
  -(defun sort-events (evs)
  -  (stable-sort evs #'< :key #'time-of))
  -
  -
  -(defmethod i/o-connect ((sim simulator) (out out-port) (in in-port))
  +(defmethod retry-delay ((sim simulator) (out out-port) (obj object))
  +  0)
  +
  +
  +(defmethod handle-input ((sim simulator) (in in-port) (obj object))
  +  ;; NB: add-child
  +  nil)
  +
  +
  +(defmethod connect-port ((sim simulator) (out out-port) (in in-port))
  +  "Contract: simulator out-port in-port -> simulator
  +
  +   Purpose: to map the out-port to the in-port in the i/o-map of sim.
  +
  +   Note: sim must be the parent of the owners of out-port and in-port."
     (setf (gethash (id-of out) (out-in-map-of sim))
   	in)
     sim)
   
   
  -(defmethod i/o-connected ((sim simulator) (out out-port))
  -  (gethash (id-of out) (out-in-map-of sim)))
  -
  -
  -(defmethod i/o-disconnect ((sim simulator) (out out-port))
  +(defmethod disconnect-port ((sim simulator) (out out-port))
  +  "Contract: simulator out-port -> simulator
  +
  +   Purpose: to remove the out-in mapping from the sim i/o map.
  +
  +   Note: sim must be the parent of the owners of out-port and in-port."
     (remhash (id-of out) (out-in-map-of sim))
     sim)
   
   
  -(defmethod retry-delay ((sim simulator) (evs list) (out out-port)
  -			(obj object))
  -  10)
  -
  -
  -;; schedulable
  -(defmethod handle-input ((sim simulator) (evs list) (in in-port)
  -			 (obj object))
  -  (values (list (add-child sim obj))
  -	  evs))
  -
  -
  -(defmethod do-output ((sim simulator) (evs list) (out out-port)
  -		      (obj object))
  -  (restart-case
  -      (multiple-value-bind (new-sims new-evs)
  -	  (transition sim evs out obj)
  -	;; new-sims contains the destination simulator
  -	(values (cons (remove-child sim obj)
  -		      new-sims)
  -		new-evs))
  -    ;;; restarts:
  -    ;; waiting for the destination's in-port to be free
  -    (wait-in (sim evs in obj)
  -      (setf (waiting-queue-of in)
  -	    (append (waiting-queue-of in)
  -		    (id-of sim)))
  -      (values (list sim) evs)
  -
  -    ;; waiting for the out port to be free
  -    (wait-out (sim evs out obj)
  -      (setf (waiting-p-of out) t)
  -      (values (list sim))
  -
  -    ;; try again after a computed delay
  -    (retry (sim evs out obj)
  -      (schedule sim evs (make-instance 'event
  -				       :owner-path (path sim)
  -				       :fn #'do-output
  -				       :time (+ (gettime evs)
  -						(retry-delay sim evs
  -							     out obj))
  -				       :args (list out obj))))
  -
  -    ;; cancel output attempt
  -    (cancel (sim evs out obj)
  -      (values (list sim) evs))))))
  -
  -
  -; example of specializing method
  -;(defmethod do-output ((sim specialized-simulator) (evs list)
  -;		      (out out-port) (obj object))
  -  ;; WARNING! if output attempt fails, obj must be stored inside of sim
  -;  (handler-bind ((port-not-connected #'cancel)
  -;		 (out-port-busy #'retry)
  -;		 (in-port-busy #'wait))
  -;    (call-next-method)))
  -
  -
  -(defmethod transition ((sim simulator) (evs list) (out out-port)
  -		       (obj object))
  -  (multiple-value-bind (in connected-p)
  -      (i/o-connected (parent-of sim) out)
  -    (with-accessors ((dest owner-of)) in
  -      (cond ((not connected-p)
  -	     (error 'port-not-connected
  -		    :sim sim :evs evs :port out :obj obj))
  -	    ((busy-p-of out)
  -	     (error 'out-port-busy
  -		    :sim sim :evs evs :port out :obj obj))
  -	    ((busy-p-of in)
  -	     (error 'in-port-busy
  -		    :sim sim :evs evs :port in :obj obj))
  -	    (t (schedule dest obj evs
  -			 (make-instance 'event
  -					:owner-path (path dest)
  -					:time (gettime evs)
  -					:fn #'handle-input
  -					:args (list in obj))))))))
  +(defmethod lock-port ((port p) (obj object))
  +  "Contract: port object -> (or unlock-event nil)
  +
  +   Purpose: to lock the port and decide when unlock it.
  +
  +   Stereotype: Template Method for access-port.
  +
  +   Description: the default lock policy is to not lock at all.
  +                Specialize this method to provide your own lock
  +                policy."
  +  (assert (not (busy-p-of p)) nil "Locking a locked port.")
  +  nil)
  +
  +
  +(defmethod unlock-port ((in-port in))
  +  "TODO"
  +  nil)
  +
  +
  +(defmethod unlock-port ((out-port out))
  +  "TODO"
  +  nil)
  +
  +
  +(defmethod access-port ((sim simulator) (out out-port) (obj object))
  +  "Contract: simulator out-port object -> (or in-port nil)
  +                                          (or unlock-event nil)
  +
  +   Purpose: to retrieve the in-port connected to out.
  +
  +   Stereotype: uses lock-port as Template Method.
  +
  +   Errors: out-port-busy
  +           port-not-connected
  +
  +   Description: specialize lock-port to provide a lock / unlock policy
  +                for the out-port."
  +  (if (busy-p-of out)
  +      (restart-case (error 'out-port-busy)
  +	(wait ()
  +	  (setf (waiting-p-of out)
  +		t)
  +	  (values nil nil))
  +	(cancel ()
  +	  (values nil nil)))
  +      (multiple-value-bind (in in-p)
  +	  (gethash (id-of out)
  +		   (out-in-map-of (parent-of sim)))
  +	(if (not in-p)
  +	    (restart-case (error 'port-not-connected)
  +	      (cancel ()
  +		(values nil nil)))
  +	    (let ((unlock-event (lock-port out obj)))
  +	      (values in unlock-event))))))
  +
  +
  +(defmethod access-port ((sim simulator) (in in-port) (obj object))
  +  "Contract: simulator in-port object -> (or simulator nil)
  +                                         (or unlock-event nil)
  +
  +   Purpose: to retrieve the owner of in-port.
  +
  +   Stereotype: uses lock-port as Template Method.
  +
  +   Errors: in-port-busy
  +
  +   Description: specialize lock-port to provide a lock / unlock policy
  +                for the in-port."
  +  (if (busy-p-of in)
  +      (restart-case (error 'in-port-busy)
  +	(wait ()
  +	  (setf (waiting-queue-of in)
  +		(append (waiting-queue-of in)
  +			sim))
  +	  (values nil nil))
  +	(cancel ()
  +	  (values nil nil)))
  +      (values (the simulator (owner-of in))
  +	      (the event (lock-port in obj)))))
  +
  +
  +(defmethod output-events ((sim simulator) (out out-port) (obj object))
  +  "Contract: simulator out-port object -> events
  +
  +   Purpose: to create a new event that will call handle-input on the
  +            destination of out and the given object.
  +
  +   Description: specialize this method and wrap call-next-method with
  +                handler-bind."
  +  (multiple-value-bind (in out-unlock-event)
  +      (access-port sim out)
  +    (when in
  +      (multiple-value-bind (dest in-unlock-event)
  +	  (access-port sim in)
  +	(list out-unlock-event in-unlock-event
  +	      (make-instance 'event
  +			     :owner dest
  +			     :time (clock-of sim)
  +			     :fn #'handle-input
  +			     :args (list in obj))))
   
   
   (defmethod add-child ((sim simulator) (obj object))
  +  "Contract: simulator object -> simulator
  +
  +   Purpose: to add obj into the children map of sim."
     (setf (gethash (id-of obj) (children-by-id-of sim))
  -	(assign-path obj sim))
  +	obj)
     sim)
   
   
   (defmethod remove-child ((sim simulator) (obj object))
  -  (multiple-value-bind (val val-p) (gethash (id-of obj)
  -					    (children-by-id-of sim))
  -    (declare (ignore val))
  -    (assert val-p nil "cannot remove obj, not a child of sim!")
  -    (remhash (id-of obj) (children-by-id-of sim))
  -    sim))
  +  "Contract: simulator object -> simulator
  +
  +   Purpose: to remove obj from the children map of sim."
  +  (remhash (id-of obj) (children-by-id-of sim))
  +  sim)
   
   
   (defmethod add-children ((sim simulator) (ch list))
  +  "Contract: simulator objects -> simulator
  +
  +   Purpose: to add recursively all the objects to sim."
     (if (null ch)
         sim
         (add-children (add-child sim (first ch))
  
positive.code: 
  
  (defmethod remove-children ((sim simulator) (ch list))
    (if (null ch)
        sim
        (remove-children (remove-child sim (first ch))
  		       (rest ch))))
  
  
  (defmethod children ((sim simulator))
    (loop
       :for obj
       :being :the :hash-values :in (children-by-id-of sim)
       :collect obj))
  
  
  (defmethod assign-path ((obj object) (sim simulator))
    (setf (parents-path-of obj)
  	(path sim))
    obj)
  
  
  (defmethod path ((obj object))
    (append (parents-path-of obj)
  	  (list (id-of obj))))
  
  
  (defmethod belongs ((obj object) (ev event))
    (equal (path obj)
  	 (owner-path-of ev)))
  
  
  (defmethod schedule ((sim simulator) (evs list) (ev event))
    (values (list (add-event sim ev))
  	  (sort-events (cons ev evs))))
  
  
  (defmethod add-event ((sim simulator) (ev event))
    (setf (events-of sim)
  	(sort-events (cons ev (events-of sim))))
    sim)
  
  
  (defmethod pop-event ((sim simulator))
    (values sim
  	  (the event
  	    (pop (events-of sim)))))
  
  
  (defmethod evolve ((sim simulator) (evs list))
    (let ((next-ev (first evs)))
      (if (belongs sim next-ev)
  	(multiple-value-bind (sim ev)
  	    (pop-event sim)
  	  (assert (eql ev (first evs)) nil "ev is not the first event!")
  	  (apply (fn-of ev)
  		 (append (list sim (rest evs))
  			 (when (slot-boundp ev 'args)
  			   (args-of ev)))))
  	;; else next-ev belongs to one of the children
  	(let ((evolving (find-if (lambda (child)
  				   (path-starts-with (owner-path-of next-ev)
  						     (path child)))
  				 (children sim))))
  	  (if (null evolving)
  	      ;; next-ev's owner not found
  	      (values (list sim) evs)
  	      ;; else evolve and return values
  	      (multiple-value-bind (new-children new-evs)
  		  (evolve evolving evs)
  		(values (add-children sim new-children)
  			new-evs)))))))
  
negative.code:     :type list)))
  
  
  (defclass port ()
    ((id
      :reader id-of
  