cell-types.lisp

;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*-
#|

    Cells -- Automatic Dataflow Managememnt

(See defpackage.lisp for license and copyright notigification)

|#

(in-package :cells)

(defstruct (cell (:conc-name c-))
  model
  slot-name
  value
  
  inputp ;; t for old c-variable class
  synaptic
  (caller-store (make-fifo-queue) :type cons) ;; (C3) probably better to notify callers FIFO
  
  (state :nascent :type symbol) ;; :nascent, :awake, :optimized-away
  (value-state :unbound :type symbol) ;; {:unbound | :unevaluated | :uncurrent | :valid}
                                                       ; uncurrent (aka dirty) new for 06-10-15. we need this so
                                                       ; c-quiesce can force a caller to update when asked
                                                       ; in case the owner of the quiesced cell goes out of existence
                                                       ; in a way the caller will not see via any kids dependency. Saw
                                                       ; this one coming a long time ago: depending on cell X implies
                                                       ; a dependency on the existence of instance owning X
  (pulse 0 :type fixnum)
  (pulse-last-changed 0 :type fixnum) ;; lazys can miss changes by missing change of X followed by unchange of X in subsequent DP
  (pulse-observed 0 :type fixnum)
  lazy
  (optimize t)
  debug
  md-info)



;_____________________ print __________________________________

#+sigh
(defmethod print-object :before ((c cell) stream)
  (declare (ignorable stream))
  #+shhh (unless (or *stop* *print-readably*)
    (format stream "[~a~a:" (if (c-inputp c) "i" "?")
      (cond
       ((null (c-model c)) #\0)
       ((eq :eternal-rest (md-state (c-model c))) #\_)
       ((not (c-currentp c)) #\#)
       (t #\space)))))

(defmethod print-object ((c cell) stream)
  (declare (ignorable stream))
  (if *stop*
      (format stream "<~d:~a ~a/~a = ~a>"
        (c-pulse c)
        (subseq (string (c-state c)) 0 1)
        (symbol-name (or (c-slot-name c) :anoncell))
        (md-name (c-model c))
        (type-of (c-value c)))
    (let ((*print-circle* t))
      #+failsafe (format stream "~a/~a" (c-model c)(c-slot-name c))
      (if *print-readably*
          (call-next-method)
        (progn
          (c-print-value c stream)
          (format stream "<~d:~a ~a/~a = ~a>"
            (c-pulse c)
            (subseq (string (c-state c)) 0 1)
            (symbol-name (or (c-slot-name c) :anoncell))
            (print-cell-model (c-model c))
            (if (consp (c-value c))
                "LST" (c-value c))))))))

(export! print-cell-model)

(defgeneric print-cell-model (md)
  (:method (other) (print-object other nil)))

(defmethod trcp :around ((c cell))
  (and ;*c-debug*
    (or (c-debug c)
      (call-next-method))))

(defun c-callers (c)
  "Make it easier to change implementation"
  (fifo-data (c-caller-store c)))

(defun caller-ensure (used new-caller)
  (unless (find new-caller (c-callers used))
    (trc nil "caller-ensure fifo-adding new-caller" new-caller :used used)
    (fifo-add (c-caller-store used) new-caller)))

(defun caller-drop (used caller)
  (fifo-delete (c-caller-store used) caller))

; --- ephemerality --------------------------------------------------
; 
; Not a type, but an option to the :cell parameter of defmodel
;
(defun ephemeral-p (c)
  (eql :ephemeral (md-slot-cell-type (type-of (c-model c)) (c-slot-name c))))

(defun ephemeral-reset (c)
  (when (ephemeral-p c) ;; so caller does not need to worry about this
    ;
    ; as of Cells3 we defer resetting ephemerals because everything
    ; else gets deferred and we cannot /really/ reset it until
    ; within finish_business we are sure all callers have been recalculated
    ; and all outputs completed.
    ;
    ; ;; good q: what does (setf <ephem> 'x) return? historically nil, but...?
    ;
    ;;(trcx bingo-ephem c)
    (with-integrity (:ephemeral-reset c)
      (trc nil "!!!!!!!!!!!!!! ephemeral-reset resetting:" c)
      (md-slot-value-store (c-model c) (c-slot-name c) nil)
      (setf (c-value c) nil))))

; -----------------------------------------------------

(defun c-validate (self c)
  (when (not (and (c-slot-name c) (c-model c)))
    (format t "~&unadopted cell: ~s md:~s" c self)
    (c-break "unadopted cell ~a ~a" self c)
    (error 'c-unadopted :cell c)))

(defstruct (c-ruled
            (:include cell)
            (:conc-name cr-))
  (code nil :type list) ;; /// feature this out on production build
  rule)

(defun c-optimized-away-p (c)
  (eq :optimized-away (c-state c)))

;----------------------------

(defmethod trcp-slot (self slot-name)
  (declare (ignore self slot-name)))

(defstruct (c-dependent
            (:include c-ruled)
            (:conc-name cd-))
  ;; chop (synapses nil :type list)
  (useds nil :type list)
  (usage (blank-usage-mask)))

(defun blank-usage-mask ()
  (make-array 16 :element-type 'bit
    :initial-element 0))

(defstruct (c-drifter
            (:include c-dependent)))

(defstruct (c-drifter-absolute
            (:include c-drifter)))

;_____________________ accessors __________________________________

(defmethod c-useds (other) (declare (ignore other)))
(defmethod c-useds ((c c-dependent)) (cd-useds c))

(defun c-validp (c)
  (eql (c-value-state c) :valid))

(defun c-unboundp (c)
  (eql :unbound (c-value-state c)))


;__________________

(defmethod c-print-value ((c c-ruled) stream)
  (format stream "~a" (cond ((c-validp c) (cons (c-value c) "<vld>"))
                            ((c-unboundp c) "<unb>")
                            ((not (c-currentp c)) "dirty")
                            (t "<err>"))))

(defmethod c-print-value (c stream)
  (declare (ignore c stream)))