;;; Alef Lazily Evaluates Functions
;;; (C) 2008-2009 Dr. Gergo ERDI <http://gergo.erdi.hu/>

(in-package :alef)

(defclass payload ()
  ((symbol :initarg :symbol :accessor payload-symbol)
   (children :initform (list) :accessor payload-children :type list))
  (:documentation "Graph node payload: a key and a list of child nodes"))

(defclass gnode ()
  ((payload :initarg :payload :accessor payload :type payload))
  (:documentation
   "Graph Node: a vertex of the program graph. Its content is stored in
its payload field: this is merely a pinpoint to a place in the
graph. See samples/ring.lisp for why it can be useful."))

(defun make-gnode (symbol)
  (make-instance 'gnode :payload (make-instance 'payload :symbol symbol)))

(defun gnode-symbol (gnode)
  (declare (gnode gnode))
  (payload-symbol (payload gnode)))

(defun gnode-children (gnode)
  (declare (gnode gnode))
  (payload-children (payload gnode)))

(defun overwrite-gnode (target src)
  (declare (gnode target src))
  (setf (payload target) (payload src))
  target)

(defun gnode-add-child (parent child)
  (declare (gnode parent child))
  (setf (payload-children (payload parent))
        (append (payload-children (payload parent)) (list child)))
  child)

(defun gnode-add-children (parent &rest children)
  (declare (gnode parent))
  (dolist (child children)
    (gnode-add-child parent child)))

(defun deepclone-gnode (gnode &optional mapping)
  (declare (gnode gnode) (list mapping))

  (let ((dict (make-hash-table)))
    (when mapping
      (loop for (k . v) in mapping
            do (setf (gethash k dict) v)))
    (labels ((deepclone (gnode)
               (or (gethash gnode dict)
                   (let ((gnode/copy (make-gnode (gnode-symbol gnode))))
                     (setf (gethash gnode dict) gnode/copy)
                     (apply #'gnode-add-children gnode/copy (mapcar #'deepclone (gnode-children gnode)))
                     gnode/copy))))
      (deepclone gnode))))

(defvar *gnode-indent-depth* 0)

(defun print-gnode (root &optional reducep (stream *standard-output*))
  (declare (gnode root) (stream stream) (boolean reducep))
  
  (when reducep
    (reduce-expr* root))
  
  (labels ((format-indented (stream &optional (format-str "") &rest args)
             (apply #'format
                    stream
                    (format nil "~~&~~A~A~~%" format-str)
                    (make-string (* 2 *gnode-indent-depth*) :initial-element #\Space)
                    args)))
    (format-indented stream "~A:~A: ~S"
                     root
                     (payload root)
                     (gnode-symbol root))  
    (let ((*gnode-indent-depth* (1+ *gnode-indent-depth*)))
      (if (< *gnode-indent-depth* 10)
          (dolist (child (gnode-children root))
            (print-gnode child reducep stream))
          (when (gnode-children root)
            (format-indented t "..."))))))