(in-package #:hominy/treec)

;;;; FIXME: Code duplication
;;;; Also this is all pretty inefficient.

  Return a list of lvars free in NODE .
(defgeneric free (node))

  OPERATIVE and LETN have FREE as a slot reader .
(defmethod free ((link link)) nil)
(defmethod free ((ref ref)) (list (ref-symbol ref)))
(defmethod free ((const const)) nil)
(defmethod free ((combination combination))
  (union (free (combiner combination))
         (union (free (combinand combination)) (free (env combination)))))
(defmethod free ((node listn))
  (reduce #'union (elements node) :key #'free :initial-value ()))
(defmethod free ((node unwrap)) (free (applicative node)))
(defmethod free ((node wrap)) (free (unwrap node)))
(defmethod free ((seq seq))
  (union (free (final seq))
         (reduce #'union (for-effect seq) :key #'free :initial-value ())))
(defmethod free ((ifn ifn))
  (union (free (if-cond ifn)) (union (free (then ifn)) (free (else ifn)))))
(defmethod free ((setn setn))
  (free (value setn)))

(defgeneric enclosed (node))
(defmethod enclosed ((link link)) nil)
(defmethod enclosed ((ref ref)) nil)
(defmethod enclosed ((const const)) nil)
(defmethod enclosed ((setn setn)) nil)
(defmethod enclosed ((combination combination))
  (union (enclosed (combiner combination))
         (union (enclosed (combinand combination))
                (enclosed (env combination)))))
(defmethod enclosed ((listn listn))
  (reduce #'union (elements listn) :key #'enclosed :initial-value ()))
(defmethod enclosed ((unwrap unwrap)) (enclosed (applicative unwrap)))
(defmethod enclosed ((wrap wrap)) (enclosed (unwrap wrap)))
(defmethod enclosed ((seq seq))
  (union (enclosed (final seq))
         (reduce #'union (for-effect seq) :key #'enclosed :initial-value ())))
(defmethod enclosed ((ifn ifn))
  (union (enclosed (if-cond ifn))
         (union (enclosed (then ifn)) (enclosed (else ifn)))))
(defmethod enclosed ((letn letn))
  (union
   ;; Stuff that's enclosed in the body but also bound here is irrelevant.
  ( The LETN will check the enclosed of its body , not itself . )
   (set-difference (enclosed (body letn)) (ptree-symbols (ptree letn)))
   (enclosed (value letn))))
(defmethod enclosed ((op operative)) (free op))

(defgeneric sets (node))
(defmethod sets ((link link)) nil)
(defmethod sets ((ref ref)) nil)
(defmethod sets ((const const)) nil)
(defmethod sets ((setn setn)) (ptree-symbols (ptree setn)))
(defmethod sets ((combination combination))
  (union (sets (combiner combination))
         (union (sets (combinand combination)) (sets (env combination)))))
(defmethod sets ((listn listn))
  (reduce #'union (elements listn) :key #'sets :initial-value ()))
(defmethod sets ((unwrap unwrap)) (sets (applicative unwrap)))
(defmethod sets ((wrap wrap)) (sets (unwrap wrap)))
(defmethod sets ((seq seq))
  (union (sets (final seq))
         (reduce #'union (for-effect seq) :key #'sets :initial-value ())))
(defmethod sets ((ifn ifn))
  (union (sets (if-cond ifn)) (union (sets (then ifn)) (sets (else ifn)))))
(defmethod sets ((letn letn))
  (union
   (set-difference (sets (body letn)) (ptree-symbols (ptree letn)))
   (sets (value letn))))
(defmethod sets ((op operative))
  (set-difference (sets (body op)) (ptree-symbols (cons (eparam op) (ptree op)))))

;;; Variables that are both set and enclosed.
(defun enclosed-sets (node)
  (intersection (enclosed node) (sets node)))

 FIXME: Code duplication
 Also this is all pretty inefficient.
 Stuff that's enclosed in the body but also bound here is irrelevant.
 Variables that are both set and enclosed.
(in-package #:hominy/treec)


  Return a list of lvars free in NODE .
(defgeneric free (node))

  OPERATIVE and LETN have FREE as a slot reader .
(defmethod free ((link link)) nil)
(defmethod free ((ref ref)) (list (ref-symbol ref)))
(defmethod free ((const const)) nil)
(defmethod free ((combination combination))
  (union (free (combiner combination))
         (union (free (combinand combination)) (free (env combination)))))
(defmethod free ((node listn))
  (reduce #'union (elements node) :key #'free :initial-value ()))
(defmethod free ((node unwrap)) (free (applicative node)))
(defmethod free ((node wrap)) (free (unwrap node)))
(defmethod free ((seq seq))
  (union (free (final seq))
         (reduce #'union (for-effect seq) :key #'free :initial-value ())))
(defmethod free ((ifn ifn))
  (union (free (if-cond ifn)) (union (free (then ifn)) (free (else ifn)))))
(defmethod free ((setn setn))
  (free (value setn)))

(defgeneric enclosed (node))
(defmethod enclosed ((link link)) nil)
(defmethod enclosed ((ref ref)) nil)
(defmethod enclosed ((const const)) nil)
(defmethod enclosed ((setn setn)) nil)
(defmethod enclosed ((combination combination))
  (union (enclosed (combiner combination))
         (union (enclosed (combinand combination))
                (enclosed (env combination)))))
(defmethod enclosed ((listn listn))
  (reduce #'union (elements listn) :key #'enclosed :initial-value ()))
(defmethod enclosed ((unwrap unwrap)) (enclosed (applicative unwrap)))
(defmethod enclosed ((wrap wrap)) (enclosed (unwrap wrap)))
(defmethod enclosed ((seq seq))
  (union (enclosed (final seq))
         (reduce #'union (for-effect seq) :key #'enclosed :initial-value ())))
(defmethod enclosed ((ifn ifn))
  (union (enclosed (if-cond ifn))
         (union (enclosed (then ifn)) (enclosed (else ifn)))))
(defmethod enclosed ((letn letn))
  (union
  ( The LETN will check the enclosed of its body , not itself . )
   (set-difference (enclosed (body letn)) (ptree-symbols (ptree letn)))
   (enclosed (value letn))))
(defmethod enclosed ((op operative)) (free op))

(defgeneric sets (node))
(defmethod sets ((link link)) nil)
(defmethod sets ((ref ref)) nil)
(defmethod sets ((const const)) nil)
(defmethod sets ((setn setn)) (ptree-symbols (ptree setn)))
(defmethod sets ((combination combination))
  (union (sets (combiner combination))
         (union (sets (combinand combination)) (sets (env combination)))))
(defmethod sets ((listn listn))
  (reduce #'union (elements listn) :key #'sets :initial-value ()))
(defmethod sets ((unwrap unwrap)) (sets (applicative unwrap)))
(defmethod sets ((wrap wrap)) (sets (unwrap wrap)))
(defmethod sets ((seq seq))
  (union (sets (final seq))
         (reduce #'union (for-effect seq) :key #'sets :initial-value ())))
(defmethod sets ((ifn ifn))
  (union (sets (if-cond ifn)) (union (sets (then ifn)) (sets (else ifn)))))
(defmethod sets ((letn letn))
  (union
   (set-difference (sets (body letn)) (ptree-symbols (ptree letn)))
   (sets (value letn))))
(defmethod sets ((op operative))
  (set-difference (sets (body op)) (ptree-symbols (cons (eparam op) (ptree op)))))

(defun enclosed-sets (node)
  (intersection (enclosed node) (sets node)))
