(defun extract-with-lambda (filename lambda)
  (with-open-file (stream filename :direction :input)
    (ignore-errors
     (loop for form = (read stream nil nil)
           while form
           when (funcall lambda form)
             collect form into result
           finally (return result)))))

(defun extract-fun-names (filename)
  (extract-with-lambda filename (lambda (form) (eq (first form) 'defun))))

(defun extract-class-names (filename)
  (extract-with-lambda filename (lambda (form) (eq (first form) 'defclass))))

(defun extract-gf-names (filename)
  (extract-with-lambda filename (lambda (form) (eq (first form) 'defgeneric))))

(defun extract-method-names (filename)
  (extract-with-lambda filename (lambda (form) (eq (first form) 'defmethod))))

(defun extract-macro-names (filename)
  (extract-with-lambda filename (lambda (form)
                                  (or (eq (first form) 'defmacro)
                                      (search "macro" (string (first form)) :test #'string-equal)))))

(defun extract-constructor-names (filename)
  (extract-with-lambda filename (lambda (form)
                                  (and (<= 6 (length (string (first form)))) 
                                       (string-equal "define" (subseq (string (first form)) 0 6))
                                       (not (search "macro"
                                                    (string (first form)) :test #'string-equal))))))

(defun extract-global-names (filename)
  (extract-with-lambda filename (lambda (form)
                                  (or (eq (first form) 'defvar)
                                      (eq (first form) 'defparameter)
                                      (eq (first form) 'defconstant)))))

(defun extract-in (in dir target)
  (test::nil-as-list)
  (with-open-file (ss target :direction :output :if-exists :supersede :if-does-not-exist :create)
    (let* ((file-list)
           (files (cl-fad:walk-directory (make-pathname :directory dir)
                                         (lambda (name) (pushnew (namestring name) file-list)))) 
           (*readtable* (copy-readtable nil))
           (*print-case* :downcase))
      (declare (ignore files))
      (loop for file in file-list
            while file
            do (format ss "~{~&~s~&~%~}" (funcall in file))))
    (finish-output ss)))

(defun functions-in (dir &optional (target "/home/oleo/workdir-state/functions-of.lisp"))
  (extract-in #'test::extract-fun-names dir target))

(defun classes-in (dir &optional (target "/home/oleo/workdir-state/classes-of.lisp"))
  (extract-in #'test::extract-class-names dir target))

(defun generic-functions-in (dir &optional
                                   (target "/home/oleo/workdir-state/generic-functions-of.lisp"))
  (extract-in #'test::extract-gf-names dir target))

(defun methods-in (dir &optional (target "/home/oleo/workdir-state/methods-of.lisp"))
  (extract-in #'test::extract-method-names dir target))

(defun macros-in (dir &optional (target "/home/oleo/workdir-state/macros-of.lisp"))
  (extract-in #'test::extract-macro-names dir target))

(defun constructors-in (dir &optional (target "/home/oleo/workdir-state/constructors-of.lisp"))
  (extract-in #'test::extract-constructor-names dir target))

(defun globals-in (dir &optional (target "/home/oleo/workdir-state/globals-of.lisp"))
  (extract-in #'test::extract-global-names dir target))