;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;   Author: Andrew Reifers
;;;;   Contact: alr288@psu.edu
;;;;   Institution: Penn State University
;;;;   Date: 2/11/04
;;;;   Title: Cadadis Lisp Port
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;; establishes a connection with the tcl cadadis port
(setf *cadadis-stream* (uni-make-socket "127.0.0.1" 2001))


;; provides a function for sending the commands to the tcl file
(defun cadadis-update (time prod)
  (uni-send-string *cadadis-stream* (format nil "~a ~a" prod time)))


;; Overloads the mathcing cycle matching-cycle function in  hooks-fns.lisp
;; this code has only one minor change.
(defun matching-cycle (&optional (cycles nil) 
                                 (retrieval-threshold *retrieval-threshold*) 
                                 (utility-threshold *utility-threshold*))
  "Implements the production matching (lhs) cycle called by run-fct and the 
   PM scheduler.  Cycles is the time limit for the matching cycle if 
   applicable. Returns the latency of the action phase if any, nil otherwise."
  (let ((matching-latency 0.0)
        (failed-latencies 0.0)
        (action nil))
    (when (and *retrieval-threshold* *activation-noise* *threshold-noise*)
      (let ((noise (noise *activation-noise*)))
        (setf *retrieval-threshold* (+ retrieval-threshold noise))
        (signal-output *activation-trace* 
                       "   Adding noise ~6,3F to retrieval threshold for a ~
                           total of ~6,3F"
                       noise *retrieval-threshold*)))
    (when (and *utility-threshold* *exp-gain-noise* *threshold-noise*)
      (let ((noise (noise *exp-gain-noise*)))
        (setf *utility-threshold* (+ utility-threshold noise))
        (signal-output (or *exact-matching-trace* *partial-matching-trace*)
                       "   Adding noise ~6,3F to utility threshold for a ~
                        total of ~6,3F"
                       noise *utility-threshold*)))
    (generate-all-instantiations)
    (when *matches-trace*
      (pprint-instantiations *conflict-set* *matches-trace* *matches-trace*))
    (setf *instantiation* nil)
    (when (or *conflict-set-hook-fn* *conflict-set-hook-fns*)
      (let ((instantiations (if *conflict-set-hook-fn*
                                (funcall *conflict-set-hook-fn* 
                                         *conflict-set*)
                              nil)))
        (when *conflict-set-hook-fns*
          (dolist (x *conflict-set-hook-fns*)
            (let ((val (funcall x *conflict-set*)))
              (when val (setf instantiations val)))))
        
        (when instantiations ; if returns nil, then continue unchanged
          (cond ((listp instantiations) ; if returns a list, 
                                        ; then interpret as new cset
                 (setf *conflict-set* instantiations))
                (t ; otherwise, restrict the conflict set to 
                   ; selected instantiation
                 (setf *conflict-set* (list instantiations)))))))
    (unless *instantiation*        
      (multiple-value-setq (*instantiation* matching-latency failed-latencies)
        (choose-instantiation)))
    ;;; the following used to be part of the action cycle but really 
    ;;; belongs in matching
    (cond (*instantiation*
           (let ((production (instantiation-production *instantiation*)))
             (cond ((and *abort-instantiation* *enable-rational-analysis*
                         (floatp cycles)
                         (> (+ *time* matching-latency)
                            cycles))
                    (signal-output *latency-trace* 
                                   "Time ~6,3F: ~A Aborted" 
                                   *time* production))
                   (t
                    (when (or *base-level-learning* *associative-learning*
                              *strength-learning*)
                      (learn-matching))
                    (when *enable-rational-analysis*
                      (incf *time* matching-latency)
                      (when (plusp matching-latency)
                        (signal-output *latency-trace* 
                                       "Latency ~6,3F: ~A Matching"
                                       matching-latency production)))
					; only change made here
                   (progn  (signal-output *cycle-trace* 
                                   "Time ~6,3F: ~A Selected" 
                                   *time* production)
						   (cadadis-update *time* production))
                    (setf (instantiation-latency *instantiation*)
                          (- matching-latency failed-latencies))
                    (setf action (production-action-cost production))))))
          ((and *enable-rational-analysis* 
                *pop-upon-failure* (null *retrieval-scheduler*))
           (incf *time* matching-latency)
           (when (plusp matching-latency)
             (signal-output *latency-trace* "Latency ~6,3F: Failure Matching"
                            matching-latency))
           (setf action *default-action-time*))
          (t
           (signal-output *latency-trace* 
                          "Time ~6,3F: No Instantiation Found." *time*)))
    action))