pattern-stream.cl

(defclass pattern-stream ()
  ((pattern :accessor ps-patt :initarg :patt)
   (args :accessor ps-args :initarg :args :initform '())
   ; the 'seq' slot holds the simplified version of the sequence
   ; (generated by applying each parent ps's simplification function
   ; to the original sequence)
   (nseq :accessor ps-nseq :initarg :nseq :initform (make-nseq))
   (known-terms :accessor ps-terms :initform '())
   (i :accessor ps-next-index :initform 0)
   (env :accessor ps-env :initform (make-hash-table))))


(defun pattern-stream-p (x)
  (eq (type-of x) 'pattern-stream))


;; makes a copy of the specified pattern stream, optionally updating a
;; nested pattern-stream with the specified arguments
(defmethod ps-copy ((ps pattern-stream)
                    &optional (ps-to-update pattern-stream) (new-args cons))
  (let ((copy (make-instance 'pattern-stream
                             :patt (ps-patt ps))))
    (setf (ps-args copy)
          (if (eq ps ps-to-update)
              new-args
            (mapcar (lambda (arg)
                      (if (pattern-stream-p arg)
                          (ps-copy arg ps-to-update new-args)
                        arg))
                    (ps-args ps))))
    (setf (ps-nseq copy) (ps-nseq ps))
    copy))


(defmethod ps-reset ((ps pattern-stream))
  (setf (ps-terms ps) '())
  (setf (ps-next-index ps) 0)
  (clrhash (ps-env ps))
  (loop for arg in (ps-args ps) do
    (when (pattern-stream-p arg)
      (ps-reset arg))))


(defmethod ps-equal ((ps1 pattern-stream) (ps2 pattern-stream))
  (and (eq (ps-patt ps1) (ps-patt ps2))
       (every (lambda (arg1 arg2) (or (and (pattern-stream-p arg1)
                                           (pattern-stream-p arg2)
                                           (ps-equal arg1 arg2))
                                      (equal arg1 arg2)))
              (ps-args ps1)
              (ps-args ps2))))


(defmethod print-object ((ps pattern-stream) stream)
  (format stream
          "(~A SEQ=~A~[~; ARGS:~]~{ ~A~})"
          (ps-name ps)
          ;(ps-next-index ps)
          (if (ps-nseq ps) (nseq-seq (ps-nseq ps)) nil)
          (if (> (length (ps-args ps)) 0) 1 0)
          (ps-args ps)))

                               

(defmethod ps-name ((ps pattern-stream))
  (patt-name (ps-patt ps)))


;; determines if there are *no* arguments specified for the given
;; pattern stream (ignoring patterns that take 0 args); this is NOT
;; recursive
(defmethod ps-uninitialized-p ((ps pattern-stream))
  (and (not (null (ps-params ps)))
       (null (ps-args ps))))


(defmethod ps-executable-p ((ps pattern-stream))
  (null (ps-next-uninit-ps ps)))


(defmethod ps-next-uninit-ps ((ps pattern-stream))
  (if (ps-uninitialized-p ps)
      ;; the pattern stream has no initialized arguments, so it is the
      ;; "next uninitialized ps"
      ps
    ;; else, do depth-first search for the next uninitialied ps arg
    ;; that is a pattern-stream and that has a missing arg; a
    ;; depth-first search is required because we always want to
    ;; initialize the earliest-occuring ps arguments entirely (because
    ;; our ability to suggest arg values for later params will depend
    ;; upon us having simplified the sequence with the earlier arg
    ;; values)
    (or 
     (loop for arg in (ps-args ps) do
       (let ((x (and (pattern-stream-p arg)
                     (ps-next-uninit-ps arg))))
         (when x (return x))))
     (if (= (length (ps-params ps))
            (length (ps-args ps)))
         nil
       ps))))
  

;; note: "partially-initalized ps" = "unexpanded internal node"

;; calc a confidence for a ps tree by taking the min of
;; the individual confidence values for each partially-initalized
;; pattern stream
(defmethod ps-confidence ((ps pattern-stream))
  (if (null (ps-args ps))
      ;; if the ps has NO arguments, then we need to calculate a
      ;; confidence value for it
      (pattern-confidence (ps-patt ps) (ps-nseq ps))
    ;; if the ps is fully or partially initialized, we're already
    ;; "committed" to it, so we'll only be interested in the
    ;; confidence scores of its uninitialized child ps args (i.e.,
    ;; since the confidence score is used to determine whether we
    ;; continue expanding this ps tree, we're only interested in the
    ;; confidence scores of the ps args that are leafs)
    (loop for arg in (ps-args ps) do
      minimize (if (pattern-stream-p arg)
                   (ps-confidence arg)
                 1.0))))


(defmacro ps-var (var)
  `(gethash ,var (ps-env ps)))


(defmacro ps-set-var (var val)
  `(setf (gethash ,var (ps-env ps)) ,val))


(defmacro prev-term (&optional (n 1)) `(ps-term ps (- i ,n)))


(defmethod ps-next ((ps pattern-stream))
  (ps-term ps (ps-next-index ps)))


(defmethod ps-next ((n integer))
  n)


(defmethod ps-term ((ps pattern-stream) i)
  (assert (ps-executable-p ps) nil
          "pattern stream not executable (args uninitialized?)")
  (if (< i (ps-next-index ps))
      ;; return the previously calculated (cached) term
      (nth i (ps-terms ps))
    ;; generate all missing terms up to requested i'th term, inclusive
    (do ((j (ps-next-index ps) (1+ j)))
        ((> j i) (car (last (ps-terms ps))))
      (setf (ps-terms ps)
            (append (ps-terms ps)
                    (list (pattern-term (ps-patt ps) ps j (ps-args ps)))))
      (incf (ps-next-index ps)))))


; args is either a pattern-stream or a literal expression (e.g. "5")
(defmethod ps-eval (arg i)
  (if (pattern-stream-p arg)
      ;; the argument is a pattern-stream, so we apply the pattern to
      ;; its arguments (which may themselves be pattern-streams!)
      (ps-term arg i)
    arg))

    
(defmethod ps-gen ((ps pattern-stream) &optional (n 20))
  (loop for i from 0 below n
    collect (ps-term ps i)))


(defmethod make-pattern-stream ((patt pattern) &rest args-list)
  (if (eq (patt-name patt) 'basic-patt)
      *basic-patt-stream*
    (let* ((default-args
             (if (> (length (patt-params patt)) (length args-list))
                 (make-list (- (length (patt-params patt))
                               (length args-list))
                            :initial-element *basic-patt-stream*)
               '()))
           (all-args (append args-list default-args)))
      (make-instance 'pattern-stream :patt patt :args all-args))))


;; used to view patterns
(defmacro ps (pattern &rest args)
  `(make-pattern-stream ,pattern ,@args))


;; used during search
(defmacro ps-no-args (pattern &optional simplified-seq)
  `(make-instance 'pattern-stream
                  :patt ,pattern
                  :nseq (analyze-seq ,simplified-seq)
                  :args '()))


;; only used for debugging
(defmacro ps-some-args (pattern simplified-seq &rest args)
  `(make-instance 'pattern-stream
                  :patt ,pattern
                  :nseq (analyze-seq ,simplified-seq)
                  :args (list ,@args)))


(defun ps-params (ps)
  (patt-params (ps-patt ps)))