anchor.diff:  
   
   (defmethod remove-children ((sim simulator) (ch list))
  +  "Contract: simulator objects -> simulator
  +
  +   Purpose: to remove recursively all the objects from sim."
     (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))))
  +(defmethod schedule ((sce scenario) &rest events)
  +  "Contract: scenario events -> scenario
  +
  +   Purpose: to add the given events to the scenario, keeping them
  +            ordered by time."
  +  (flet ((sort-events (evs)
  +	   (stable-sort evs #'< :key #'time-of)))
  +    (setf (events-of sce)
  +	  (sort-events (append (events-of sce)
  +			       events)))
  +    sce))
  +
  +
  +(defmethod synchronize ((sim simulator) tm)
  +  "Contract: simulator time -> simulator
  +
  +   Purpose: to synchronize sim's internal clock with the given time."
  +  (declare (time-type tm))
  +  (setf (clock-of sim)
  +	tm)
     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)))))))
  +(defmethod evolve ((sim simulator) (ev event))
  +  "Contract: simulator event -> events
  +
  +   Purpose: to apply the event to sim
  +
  +   Example: (evolve bell hit-event) -> ring-event vibrate-event"
  +  (apply (fn-of ev)
  +	 (append (list (synchronize sim (time-of ev)))
  +		 (when (slot-boundp ev 'args)
  +		   (args-of ev))))))
  +
  +
  +(defmethod evolving ((sce scenario))
  +  "Contract: scenario -> simulator event
  +
  +   Purpose: to return the next simulator that must execute its event.
  +
  +   Example: (multiple-value-call #'evolve (evolving example-scenario))"
  +  (let ((ev (pop (events-of sce))))
  +    (if (null ev)
  +	(values nil nil)
  +	(values (owner-of ev) ev))))
  
positive.code:     :type list)))
  
  
  (defclass object ()
    ((id
      :reader id-of
      :type id-type)
     (parent
      :accessor parent-of)
     (parents-path
      :accessor parents-path-of
      :type list
      :documentation "A list of id telling where the object is in the object tree.
      Example: given the tree
        sim-0
          sim-1
            sim-2
            obj-3
          obj-4
          sim-5
            obj-6
      the path of obj-6 is (0 5)
      the paths of sim-2 and obj-3 are the same (0 1)")))
  
  
  (defclass simulator (object)
    ((children-by-id
      :initform (make-hash-table)
      :reader children-by-id-of
      :type hash-table)
     (events
      :accessor events-of
      :initform (list)
      :type list)
     (out-in-map
      :initform (make-hash-table)
      :reader out-in-map-of
      :type hash-table)))
  
  
  (defclass port ()
    ((id
      :reader id-of
  
negative.code: 
  ;; PRINT-OBJECT
  
  (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
  
  (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 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 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))
  	obj)
    sim)
  
  
  (defmethod remove-child ((sim simulator) (obj object))
    "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))
  