;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: dt-loader.lsp
;;;;    System: FIRE
;;;;   Version: 1.0
;;;;    Author: Ken Forbus
;;;;   Created: November 5, 2000 20:32:21
;;;;   Purpose: Loading domain theories into KB's
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Saturday, April 10, 2004 at 19:14:32 by Kenneth Forbus
;;;; ---------------------------------------------------------------------------

(in-package :fire)

(defparameter *current-dt* 'data::base-kb
  "Domain theory into which facts will be loaded.")

;;; Forms used in defining domain theories
;; set-dt-name
;; defUniversalFact
;; defEntity
;; defRelation
;; defPredicate
;; defUnit
;; defReifiableFunction
;; defQuantityFunction
;; ForAll
;; defEvalFn
;; defSuggestion

(defun flat-file->kb (file-name 
                      &key (kb *kb*) (verbose? t) (dt *current-dt*)
                      (legacy? nil) (primitive? nil) callback-fn (check-for-mt-type nil))
  (declare (ignore check-for-mt-type)) ;; only used for cyc meld files
  (let ((*current-dt* dt)
        (eof? (cons file-name nil))
        (data-package (find-package :data))
        (count 0))
    (with-open-file (fin file-name :direction :input)
      (do* ((form (trap-error (condition nil)
                              (read-in-package fin nil eof? nil
                                               data-package))
                  (trap-error (condition nil)
                              (read-in-package fin nil eof? nil
                                               data-package)))
            (translation (process-flat-file-form%
                          form eof? :kb kb :verbose? verbose?)
                         (process-flat-file-form%
                          form eof? :kb kb :verbose? verbose?)))
           ((eq form eof?) count)
        (when callback-fn
            (funcall callback-fn form fin))
        (if (and translation
                 (listp translation)
                 (every 'listp translation))
            (dolist (assertion translation)
              (incf count)
              (if legacy? (setq assertion (sme->fire-expression 
                                           assertion)))
              (if primitive? (setq assertion (attribute->isa-statement
                                              assertion)))
              (store-no-testing assertion kb)
              ;;; KDF: I removed this because we're going to do something fancier in dbex
              ;;; when we move to a context system.
;;;              (store-no-testing
;;;               (make-dt-membership *current-dt* assertion) kb)
              ))))
    :done))

(defun attribute->isa-statement (exp)
  (cond ((not (listp exp)) exp)
        ((= (length exp) 2)
         (make-isa (cadr exp) (car exp)))
        (t exp)))

(defun flat-file->assertions (file-name &key (kb *kb*) (verbose? t)
                                        (legacy? nil)(primitive? nil))
  (let ((*current-dt* *current-dt*)
        (data-package (find-package :data))
        (eof? (cons file-name nil)))
    (with-open-file (fin file-name :direction :input :if-does-not-exist nil)
      (when fin
        (do* ((form (trap-error (condition nil)
                              (read-in-package fin nil eof? nil
                                               data-package))
                  (trap-error (condition nil) 
                              (read-in-package fin nil eof? nil
                                               data-package)))
            (translation (process-flat-file-form%
                          form eof? :kb kb :verbose? verbose?)
                         (process-flat-file-form%
                          form eof? :kb kb :verbose? verbose?))
           (assertions nil))
           ((eq form eof?) assertions)
        (when (and (listp translation)
                   (every 'listp translation))
          (when legacy?
            (setq assertions
                  (mapcar #'(lambda (exp)
                              (sme->fire-expression 
                               exp))
                    assertions)))
          (when primitive? 
            (setq assertions 
                  (mapcar #'(lambda (exp)
                              (attribute->isa-statement exp))
                    assertions)))
          (setq assertions (nconc assertions translation))))))))

(defun
    process-flat-file-form% (form eof-val &key (kb *kb*) (verbose? t))
  "Wrapper for use with flat-file->kb and flat-file->assertions."
  (cond ((and (eq form eof-val) verbose?)
         (format t "~%Done loading ~A." (car eof-val))
         nil)
        ((eq form eof-val)
         nil)
        (t
         (process-flat-file-form form :kb kb :verbose? verbose?))))
           
(defun process-flat-file-form (form &key (kb *kb*) (verbose? t))
  (cond ((not (listp form))
         (if verbose? (format t "~% Unknown form in flat file: ~A." form)))
        (t (case (car form)
             (data::set-dt-name ;; this should be lambda-bound above somewhere
              (setq *current-dt* (cadr form)))
             (data::defuniversalfact
                 (defuniversalfact->assertions form kb))
             (data::defentity (defentity->assertions form kb))
             (data::defrelation (defrelation->assertions form kb))
             (data::defpredicate (defpredicate->assertions form kb))
             (data::defunit (defunit->assertions form kb))
             (data::defreifiablefunction 
                 (defreifiablefunction->assertions form kb))
             (data::defquantityfunction
                 (defquantityfunction->assertions form kb))
             ((data::forall data::=>>) (list form))
             (data::deffunction (deffunction->assertions form kb))
             (data::defEvalFn (defEvalFn->assertions form kb))
             (data::defmodelfragment (defmodelfragment->assertions form kb))
             (data::defSuggestion (defSuggestion->assertions form kb))
             ((data::in-package data::delete-item data::format) nil)
             (data::defobject (defobject->assertions form kb))
             (data::defscenario (defscenario->assertions form kb))
             ((data::defdescription sme::defdescription)
              (defdescription->assertions form kb))
             (sme::defentity nil)
             (data::with-undefined-scenario-objects 
                 (process-flat-file-form (cadr form) :kb kb :verbose? verbose?))
             (dte-db::add-pidgin-string (add-pidgin-string->assertions form))
             (sme::defpredicate (sme-defpredicate->assertions form))
             (t (when verbose?
                  (format t "~%Unexpected form type: ~A::~A." 
                    (if (and (consp form) (symbolp (car form)))
                        (symbol-package (car form)) "ERROR")
                    (car form))
                  (pprint form))
                nil)))))
               
(defun substitute-for-self (thing form)
  (cond ((eq form :self) thing)
        ((not (consp form)) form)
        (t (cons (substitute-for-self thing (car form))
                 (substitute-for-self thing (cdr form))))))


;;; (defuniversalfact <fact> :documentation <string>)
(defun defuniversalfact->assertions (form &optional (kb *kb*))
  (with-kb kb 
    (destructuring-bind (fact &key documentation) (cdr form)
      (let ((assertions (list fact)))
        (when documentation
          (push (make-comment-statement fact documentation) assertions))
        assertions))))

;;; (defobject <individual> :documentation <string>)
(defun defobject->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (individual &key documentation) (cdr form)
      (let ((assertions (list (make-individual individual))))
        (when documentation
          (push (make-comment-statement individual documentation) assertions))
        assertions))))

;;; (defquantityfunction <predicate> <arglist> :documentation <string>) 
;;; E.g.:
;;; (defquantityfunction estimated-unit-speed (?unit ?area)
;;;   :documentation "quantification of estimates for unit speeds given 
;;;                   terrain classes")
(defun defquantityfunction->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (predicate arglist &key documentation) (cdr form)
      (let ((assertions (list (make-continuous-quantity predicate)
                              (make-arity predicate (length arglist)))))
        (when documentation
          (push (make-comment-statement predicate documentation) assertions))
        assertions))))

;;; (deffunction <predicate> <arglist> := <expression> :axiom <expression>
;;; E.g.:
;;; (defFunction max-cruising-range (?car) 
;;;   := (* (max-fuel-level ?car) (gas-milage ?car)))
;;; (deffunction fastest-unrestricted-travel-to-location 
;;;              (?location ?set-of-movable-objects)
;;;  :axiom (result-isa fastest-to-location modern-military-unit--deployable))
(defun deffunction->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (predicate arglist &key = axiom) (cdr form)
      (let ((assertions (list (make-function-declaration predicate)
                              (make-arity predicate (length arglist)))))
        (when =
          (push (make-function-expression (cons predicate arglist) =) 
                assertions))
        (when axiom
          (push axiom assertions))
        assertions))))


(defun defEvalFn->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (name &key args lispcode axioms documentation) (cdr form)
      (let* ((arity (get-arity-from-args args))
             (arglist (get-arglist-from-args args))
             (assertions nil))
        ;; Add the mapping between the predicate and the lisp form to 
        ;; the evalfn-table. Should this be done here? 
;;;        (add-to-evalfn-table *kb* name arity arglist lispcode)
        (push (make-eval-function-declaration name) assertions)
        (push (make-lisp-definition name (list arity arglist lispcode)) assertions)
        (push (make-comment-statement name documentation) assertions)
        (values (append assertions axioms))))))

;;;  (defreifiablefunction <predicate> <arglist> 
;;;                       :documentation <string> :result-isa <collection>
;;;                       :arg-isas <list of collections>)
;;; E.g.:
;;; (defreifiablefunction agent-case-fn (?agent)
;;;   :result-isa case
;;;   :documentation
;;;   "Creates a Case by finding all the relations that reference ?agent, 
;;;    plus all relations between objects in that first set of relations.  
;;;   (Designed with ?agent being of type agent.)")
(defun defreifiablefunction->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (predicate arglist &key result-isa arg-isas documentation) 
        (cdr form)
      (let ((assertions (list (make-function-declaration predicate)
                              (make-arity predicate (length arglist)))))
        (when documentation
          (push (make-comment-statement predicate documentation) assertions))
        (when result-isa
          (push (make-result-type predicate result-isa) assertions))
        (when arg-isas
          (setq assertions
                (nconc (translate-arg-isas-keyword predicate arg-isas)
                       assertions)))
        assertions))))

(defun translate-arg-isas-keyword (predicate arg-isas)
  (when (or arg-isas
            (not (listp arg-isas))) ;; Punt if not there
    (let ((index 1)
          (result nil))
      (dolist (col arg-isas (nreverse result))
        (push (list (intern (format nil "arg~DIsa" index) (find-package :data))
                    predicate col) result)
        (incf index)))))
    
;;; (defrelation <predicate> <arglist>  
;;;     :subclass-of <list of collections>
;;;     :=> <expression> 
;;;     :function <t or nil> 
;;;     :n-ary? <t or nil>
;;;     :documentation <string>
(defun defrelation->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (predicate arglist 
                                   &key subclass-of => function n-ary? arg-isas 
                                        documentation) 
        (cdr form)
      (let ((assertions nil))
        (if function
          (push (make-function-declaration predicate) assertions)
          (push (make-relation-declaration predicate) assertions))
        (if n-ary?
          (push (make-n-ary predicate (if function :function :relation)) assertions)
          (push (make-arity predicate (length arglist)) assertions))
        (dolist (super subclass-of)
          (push (make-genls predicate super) assertions))
        (when =>
          (push (make-implies (cons predicate arglist) =>) assertions))
        (when documentation
          (push (make-comment-statement predicate documentation) assertions))
        (when arg-isas
          (setq assertions
                (nconc (translate-arg-isas-keyword predicate arg-isas)
                       assertions)))
        assertions))))
  
;;;  (defpredicate <predicate> <arglist> <pred-type>
;;;      :n-ary? <t or nil>
;;;      :commutative? <t or nil>
;;;      :documentation <string>
;;;      :expression-type <collection>)
;;; E.g.:
;;; (defpredicate perpendicular-corner ((line1 Line-Segment) 
;;;                                     (line2 Line-Segment)) 
;;;       relation :commutative? T
;;;       :documentation "Line segments are both perpendicular to one another 
;;;         and form a corner.")
(defun defpredicate->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (predicate arglist pred-type
                                   &key n-ary? commutative? arg-isas
                                        documentation expression-type) 
        (cdr form)
      (let ((assertions nil)
            (arg-count 0))
        (case pred-type
          (data::relation 
           (push (make-relation-declaration predicate) assertions))
          (data::function 
           (push (make-function-declaration predicate) assertions)
           (when expression-type
             (push (make-result-type predicate expression-type) assertions)))
          (data::attribute 
           (push (make-attribute-declaration predicate) assertions))
          (t (format t "~%Unknown assertion type: ~A, ~A; ~A."
               pred-type predicate arglist)))
        (dolist (arg-entry arglist)
          (when (consp arg-entry)
            (push (make-arg-type predicate (second arg-entry) (incf arg-count))
                  assertions)))
        (if n-ary?
          (push (make-n-ary predicate (if (eq pred-type 'data::function) :function
                                        :relation)) assertions)
          (push (make-arity predicate (length arglist)) assertions))
        (when commutative? 
          (push (make-commutative predicate) assertions))
        (when documentation
          (push (make-comment-statement predicate documentation) assertions))
        (when arg-isas
          (setq assertions
                (nconc (translate-arg-isas-keyword predicate arg-isas)
                       assertions)))
        assertions))))
        
;;;  (defentity <name> 
;;;      :subclass-of <list of collections>
;;;      :consequences <expressions>
;;;      :quantities <quantity types>
;;;      :documentation <string>
(defun defentity->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (name &key subclass-of consequences
                                   quantities documentation)
        (cdr form)
      (let ((assertions (list (make-attribute-declaration name))))
        (dolist (super subclass-of)
          (push (make-genls name super) assertions))
        (when consequences 
          (push (make-forall
                 '(data::?x)
                 (make-implies
                  (make-isa 'data::?x name)
                  (apply 'make-conjunction
                         (substitute-for-self 'data::?x consequences))))
                assertions))
        (dolist (qtype quantities)
          (push (make-forall '(data::?x)
                             (make-implies
                              (make-isa 'data::?x name)
                              (make-quantity-term (car qtype) 'data::?x)))
                assertions))
        (when documentation
          (push (make-comment-statement name documentation) assertions))
        assertions))))
      
(defparameter *test-defentity*
  (->data 
   `(defentity armored-unit--military-specialty
        :subclass-of (modern-military-unit--deployable)
      :quantities ((typical-unit-speed))
      :consequences ((default-nvalue (typical-speed :self terrain-unrestricted) 24)
                     (default-nvalue (typical-speed :self terrain-restricted) 16)
                     (default-nvalue (typical-speed :self terrain-severely-restricted) 1))
      :documentation "The collection of all military units that employ 
                      motorized vehicles engineered to resist penetration 
                      by explosives and projectile weapons. In modern armed 
                      forces, it usually entails the presence of tanks and 
                      heavy artillery.")))

;;;  (add-pidgin-string <predicate> <string-template>)
;;; E.g.:
;;;   (dte-db:add-pidgin-string 'nvalue "the value of ?thing is ?value")
(defun add-pidgin-string->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (predicate template) (cdr form)
      (list (make-pidgin predicate template)))))

;;;  (FORALL)
;;; Just pass these through. 

;;;  (=>>) 
;;; Just pass these through as well.  Forward chaining rules?

;;; (defunit <unit-name> :dimension <dimension-name>)
;;; E.g.:
;;;   (defunit milliseconds-duration :dimension time-dimension)
(defun defunit->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (unit &key dimension) (cdr form)
      (let ((assertions (list (make-units unit))))
        (when dimension
          (push (make-dimension unit dimension) assertions))
        assertions))))

;;; (DEFMODELFRAGMENT :CONSEQUENCES :CONDITIONS :PARTICIPANTS :QUANTITIES :SUBCLASS-OF)
(defun defmodelfragment->assertions (form &optional (kb *kb*))
  (with-kb kb
    (let* ((mf (cadr form))
           (assertions (list (make-model-fragment-type mf))))
      (do* ((keys (cddr form) (cddr keys))
            (key (car keys) (car keys))
            (value (cadr keys) (cadr keys)))
           ((null keys) assertions)
        (case key
          (:subclass-of (dolist (super value)
                          (push (make-genls mf super) assertions)))
          (:participants (push (make-participants mf value) assertions))
          (:quantities (push (make-quantities mf value) assertions))
          (:consequences (push (make-consequences mf value) assertions))
          (:conditions (push (make-conditions mf value) assertions))
          (t (format t "~%Unknown keyword in defModelFragment: ~A in ~A."
               key mf)))))))


;;; *** This is obsolete. Changed drastically. Add documentation here ***
;;; becomes the following two axioms in the KB. The first one tells when
;;; the suggestion is valid, and the second one is the content of
;;; the suggestion. 
;;;`(implies ,test
;;;          (suggestFor ,goal 
;;;                       (try ,name ,goal)))
;;; If there is no test, then we just assert the consequent of the 
;;; above statement. 
;;; Note that (try ,name ,goal) is the op-instance and the goal in
;;; form here is bound to the specific problem that led to the
;;; instantiation of this operator. 
;;;
;;; (ContentOfSuggestion (try ,name ,goal)
;;;                      ((subgoals ,subgoals) ;; all subgoals un-ordered-and
;;;                       (result-step ,result-step)))
;;;
;;;(defun defSuggestion->assertions (form &optional (kb *kb*))
;;;  (with-kb kb
;;;    (destructuring-bind (name goal &key documentation test subgoals result-step)
;;;        (cdr form)
;;;      (let (assertions)
;;;        (push (->data (make-suggestion-type name)) assertions)
;;;        (push (->data (make-suggestion-comment-stmt name documentation)) assertions)
;;;        (push (->data (make-suggest-for-axiom name goal test)) assertions)
;;;        (push (->data (make-content-of-suggestion-axiom 
;;;                       name goal subgoals result-step)) assertions)
;;;        (values assertions)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Macro for writing suggestions. Expands the suggestions from the user 
;; friendly format into axioms for the KB. Goes into dtloader.lsp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; (DEFSUGGESTION NAME GOAL :DOCUMENTATION :TEST :SUBGOALS :RESULT-STEP) 

(defun defSuggestion->assertions (form &optional (kb *kb*))
  (with-kb kb
    (destructuring-bind (name goal &key documentation test subgoals result-step)
        (cdr form)
      ;; A suggestion has to have a name, goal, subgoals. If any of this is missing, 
      ;; we quit. The following are optional - result-step, documentation and test. 
      (if (or (null name) (null goal) (null subgoals))
        (return-from defSuggestion->assertions))
      (let (assertions)
        (push (->data (make-suggestion-type name)) assertions)
        (push (->data (make-suggest-for-axiom name goal test)) assertions)
        (push (->data (make-suggestion-goal-form name goal)) assertions)
        (push (->data (make-suggestion-subgoals-stmt name subgoals)) assertions)
        (if (not (null result-step))
          (push (->data (make-suggestion-result-step-stmt name result-step)) assertions))
        (if (not (null documentation))
          (push (->data (make-suggestion-comment-stmt name documentation)) assertions))
        ;; create an ist-Asserted SuggestionMT statement for each of the assertions 
        ;; so we later can grab all suggestions in one go.
        (values (append (mapcar #'make-ist-suggestion-stmt assertions) assertions))))))

(defparameter *test-defsuggestion-popcorn*
  '(defSuggestion VolumeStrategyForCount 
       (CounContained ?contained ?container ?count)
     :documentation "strategy for finding the count using volumes"
     :test (and (containsExpression ?criteria (physicallyContains ?container ?contained))
                (hasAttributes ?container Volume)
                (hasAttributes ?contained Volume))
     :subgoals ((volumeOfObject ?container ?vol-container)
                (volumeOfObject ?contained ?vol-contained))
     :result-step (evaluate ?count (QuotientFn ?vol-container ?vol-contained))))

;;; (DEFSCENARIO :INITIALLY :DOCUMENTATION :INDIVIDUALS :THROUGHOUT)
(defun defscenario->assertions (form &optional (kb *kb*))
  (with-kb kb
    (let* ((sc (cadr form))
           (assertions (list (make-scenario sc))))
      (do* ((keys (cddr form) (cddr keys))
            (key (car keys) (car keys))
            (value (cadr keys) (cadr keys)))
           ((null keys) assertions)
        (case key
          (:subclass-of (dolist (super value)
                          (push (make-genls sc super) assertions)))
          (:initially (push (make-scenario-initially sc value) assertions))
          (:throughout (push (make-scenario-throughout sc value) assertions))
          (:individuals (push (make-scenario-individuals sc value) assertions))
          (:documentation (push (make-comment-statement sc value) assertions))
          (t (format t "~%Unknown keyword in defScenario: ~A in ~A."
               key sc)))))))

;;; (sme::defdescription <dgroup name> . <statements>)
;;; (sme::defdescription <dgroup name> entities <list of entities>
;;;                      expressions <list of expressions>)
;;; where <list of expressions> entries are either
;;;  <proposition>
;;;  (<proposition> :name <symbolic name>)
;;; In the latter case, symbolic names can be used freely as shorthand in
;;; other expressions.

(defun defdescription->assertions (form &optional (kb *kb*))
  (with-kb kb
    (let* ((case-name (cadr form))
           (contents (cddr form))
           (keyword-format? (or (member 'data::entities contents)
                                (member :entities contents)))
           (expressions (cond (keyword-format?
                               (let ((exps (member 'data::expressions contents)))
                                 (cond (exps (cadr exps))
                                       (t (setq exps (member :expressions contents))
                                          (unless exps 
                                            (error "No expressions in dgroup: ~A." form))
                                          (cadr exps)))))
                              (t contents))))
      (when keyword-format?
        (setq expressions (sme::perform-dgroup-name-substitutions
                           expressions)))
      (setq expressions (find-root-expressions expressions))
      (cons (make-isa case-name 'data::Case)
            (mapcar #'(lambda (fact)
                        (make-case-fact case-name fact))
              expressions)))))

(defun find-root-expressions (expressions)
  "Finds all top-level expressions in the set of expressions given."
  (remove-if #'(lambda (exp) (some #'(lambda (other)
                                       (and (not (equal exp other))
                                            (subexpression-of exp other)))
                                   expressions))
             expressions))

(defun subexpression-of (x y)
  (cond ((null y) nil)
        ((equal x y) t) ;; may need version that handles floats well from ltre or sme
        ((not (listp y)) nil)
        (t (or (subexpression-of x (car y))
               (subexpression-of x (cdr y))))))

(defun sme-defpredicate->assertions (form)
  (let ((pred-name (cadr form))
        (arglist (third form))
        (type (fourth form))
        (keywords (cddddr form))
        (assertions nil))
    (ecase type
      (data::attribute (push (make-attribute-declaration pred-name)
                             assertions))
      ((data::relation data::taxonomy) (push (make-relation-declaration pred-name)
                            assertions))
      (data::logical (push (make-connective-declaration pred-name)
                           assertions))
      (data::function (push (make-function-declaration pred-name) assertions)))
    (push (make-arity-assertion pred-name type arglist keywords) assertions)
    (let ((commutative? (member :commutative? keywords)))
      (when (cadr commutative?)
        (push (make-commutative pred-name) assertions)))
    assertions))
             
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Creating test KB for debugging

(defparameter *test-kb-flat-files*
  (list (make-full-file-spec (make-qrg-path "FIRE" "flat-files")
                             "base-theory" ".lsp")
        (make-full-file-spec (make-qrg-path "FIRE" "flat-files")
                             "analogy-dt" ".lsp")
        (make-full-file-spec (make-qrg-path "FIRE" "flat-files")
                             "countries_and_borders" ".lsp")
        (make-full-file-spec (make-qrg-path "FIRE" "flat-files")
                             "populations" ".lsp")))

(defparameter *test-dgroup-files*
  (nconc 
   (list (make-full-file-spec (make-qrg-path "FIRE" "flat-files"
                                             "MACFAC Test Data")
                              "sys2lang" ".vcb")
         (make-full-file-spec (make-qrg-path "FIRE" "flat-files"
                                             "MACFAC Test Data")
                              "solar" ".dgr")
         (make-full-file-spec (make-qrg-path  "FIRE" "flat-files"
                                             "MACFAC Test Data")
                              "ruther" ".dgr")
         (make-full-file-spec (make-qrg-path "FIRE" "flat-files"
                                             "MACFAC Test Data")
                              "swater" ".dgr")
         (make-full-file-spec (make-qrg-path  "FIRE" "flat-files"
                                             "MACFAC Test Data")
                              "sheat" ".dgr")
;;;          (make-full-file-spec (make-qrg-path  "FIRE" "flat-files"
;;;                                              "MACFAC Test Data")
;;;                               "buying-person" ".dgr")
;;;          (make-full-file-spec (make-qrg-path  "FIRE" "flat-files"
;;;                                              "MACFAC Test Data")
;;;                               "buying-robot" ".dgr")
         ;; MAC/FAC thermodynamics examples
         (make-full-file-spec (make-qrg-path "FIRE" "flat-files"
                                             "MACFAC Test Data" "Thermo")
                              "cpad" ".vcb"))
   (directory 
    (make-full-file-spec (make-qrg-path "FIRE" "flat-files"
                                            "MACFAC Test Data" "Thermo")
                         "*" ".dgr"))
   ;; Is-like study examples
   (directory
    (make-full-file-spec (make-qrg-path "FIRE" "flat-files"
                                        "MACFAC Test Data" "islike")
                         "*" ".dgr"))
   ;; syslit study examples
   (directory
    (make-full-file-spec (make-qrg-path "FIRE" "flat-files"
                                        "MACFAC Test Data" "syslit")
                         "*" ".dgr"))
   (list (make-full-file-spec (make-qrg-path "FIRE" "flat-files" "MACFAC Test Data")
                              "test-case-libraries" ".lsp"))))

(defun make-bootstrap-kb ()
  (make-kb *test-kb-path* *test-kb-name* 
           :new? t
           :force-update? t
           :predicate-style :hyphen)
  (open-kb)
  (dolist (flat-file *test-kb-flat-files*)
    (format t "~%Loading ~A." flat-file)
    (flat-file->kb flat-file :legacy? t))
  (dolist (case-file *test-dgroup-files*)
    (format t "~%Loading ~A." case-file)
    (flat-file->kb case-file :legacy? t)))

(defun make-case-library-forms (library-name case-list)
  (format t "~%(defuniversalfact (case-library (case-library-fn ~S)))" library-name)
  (dolist (case case-list)
    (format t
        "~%(defuniversalfact (element-of (case-library-fn ~S) (explicit-case-fn ~S)))"
      library-name case)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Gathering information about KB flat files

(defun gather-form-types-from-files (file-list)
  (let ((table nil)
        (end (cons nil nil)))
    (dolist (file file-list table)
      (with-open-file (fin file :direction :input)
        (do ((form (read fin nil end)
                   (read fin nil end)))
            ((eq form end))
          (when (listp form)
            (pushnew (car form) table)))))))

(defparameter *dt-directories* 
  (list (make-qrg-path "dte" "databases")
        (make-qrg-path "dte" "databases" "RKF")
        (make-qrg-path "dte" "databases" "coas")
        (make-qrg-path "dte" "databases" "coas" "COA Cases")
        (make-qrg-path "dte" "databases" "coas" "COA Critiques")
        (make-qrg-path "dte" "databases" "factbook")
        (make-qrg-path "dte" "databases" "tdc")
        (make-qrg-path "dte" "databases" "pidgen")
        (make-qrg-path "dte" "databases" "nuSketch")
        (make-qrg-path "dte" "databases" "gas-model")
        (make-qrg-path "dte" "databases" "factbook")))

;;; (unless (find-package :dte-db)
;;;   (make-package dte-db :use '("COMMON-LISP" "COMMON-LISP-USER")))
;;; 
;;; (defun dte-db::add-pidgin-string (&rest args) args)
;;; (export 'dte-db::add-pidgin-string (find-package 'cl-user))

;;; Quick utility for generalizing paths

(defun generalize-pathname-to-qrg (pathname)
  `(qrg::make-full-file-spec 
    (qrg::make-qrg-path ,@ (cddr (pathname-directory pathname)))
    ,(pathname-name pathname)
    ,(pathname-type pathname)))

;;; (defparameter *dt-files*
;;;   (list 
;;;    #p"D:\\qrg\\dte\\databases\\factbook\\cia_populations.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\factbook\\cia_countries_and_borders.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-5.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-4.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-3.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\gas-model\\natural-gas-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\gas-model\\constants.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-icces-specific.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-hpkb-specific.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\nuSketch\\ink-vocabulary.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\nuSketch\\debug-app-vocabulary.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\nuSketch\\debug-app-facts-vocabulary.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-app-vocabulary.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\nuSketch\\coa-app-facts-vocabulary.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\tdc\\TDC-defs-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\factbook\\cia_populations.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\factbook\\cia_countries_and_borders.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\coa-critique-rules.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-defs-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-cases-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\coa-force-ratio-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\coa-choke-points-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-7.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-6.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-5.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-4.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-3.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Critiques\\critique-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\previously-undefined.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-ubiq-preds.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-5-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-2-3.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-2-2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-2-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-1-3.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-1-2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-4-1-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-5.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-4.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-3.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-3-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-4.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-4-phased.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-3.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-2-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5-extra-facts.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-5-1-extra-facts.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-4.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-4-extra-facts.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-3.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-3-extra-facts.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-2-extra-facts.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-1.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\COA Cases\\coa-1-1-extra-facts.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\previously-undefined-coa-preds-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\critique-defs-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\critique-cases-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\coa-ubiq-preds.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\coa-genl-cases.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\coa-force-ratio-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\coas\\coa-choke-points-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\RKF\\spider-oxygen-circulation-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\RKF\\recirculated-water-heating-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\RKF\\orig-forced-air-heating-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\RKF\\forced-air-heating-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\RKF\\fish-oxygen-circulation-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\qrg-pidgen.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\visual-figures.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\units.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\units-dt-x.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\military-movement-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\mil-units2-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\macros-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\hpkp-upper-v2.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\georep-rules-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\georep-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\geography-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\dtde-demo.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\DQ-analysis-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\dq-analysis-cyc-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\CYC-NEW-AXIOMS.LSP"
;;;  #p"D:\\qrg\\dte\\databases\\control-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\cia_populations.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\cia_countries_and_borders.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\battlespace1-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\base-theory.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\analytical-factors-dt.lsp"
;;;  #p"D:\\qrg\\dte\\databases\\analogy-dt.lsp"))"

(defparameter *dt-files* (list
(make-full-file-spec (make-qrg-path "dte" "databases") "base-theory"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "hpkp-upper-v2"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "battlespace1-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "analytical-factors-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_populations" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_countries_and_borders" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "georep-rules-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "georep-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "geography-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "analogy-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "DQ-analysis-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "dq-analysis-cyc-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "CYC-NEW-AXIOMS"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "control-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "cia_populations" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "cia_countries_and_borders" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-icces-specific" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-hpkb-specific" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "ink-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "debug-app-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "debug-app-facts-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-app-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-app-facts-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "tdc")
                     "TDC-defs-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_populations" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_countries_and_borders" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "visual-figures"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "units" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "units-dt-x"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "military-movement-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "mil-units2-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "macros-dt"
                     ".lsp")
;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model")
;;;                      "natural-gas-5" ".lsp")
;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model")
;;;                      "natural-gas-4" ".lsp")
;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model")
;;;                      "natural-gas-3" ".lsp")
;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model")
;;;                      "natural-gas-2" ".lsp")
;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model")
;;;                      "natural-gas-1" ".lsp")
;;; (MAKE-FULL-FILE-SPEC (MAKE-QRG-PATH "dte" "databases" "gas-model")
;;;                      "constants" ".lsp")

(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "coa-critique-rules" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-defs-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-cases-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "coa-force-ratio-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "coa-choke-points-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-7" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-6" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-5" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "previously-undefined" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-ubiq-preds" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-5-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-2-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-2-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-2-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-1-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-1-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-1-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-5" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-4-phased" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5-1-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-4-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-3-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-2-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-1-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "previously-undefined-coa-preds-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-defs-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-cases-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-ubiq-preds" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "coa-genl-cases" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "coa-force-ratio-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "coa-choke-points-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "spider-oxygen-circulation-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "recirculated-water-heating-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "orig-forced-air-heating-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "forced-air-heating-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "fish-oxygen-circulation-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "qrg-pidgen"
                     ".lsp")
))


(defparameter *pruned-dt-files* (list
(make-full-file-spec (make-qrg-path "dte" "databases") "base-theory"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "hpkp-upper-v2"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "battlespace1-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "analytical-factors-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_populations" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_countries_and_borders" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "georep-rules-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "georep-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "geography-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "analogy-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "CYC-NEW-AXIOMS"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "control-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "cia_populations" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "cia_countries_and_borders" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-icces-specific" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-hpkb-specific" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "ink-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "debug-app-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "debug-app-facts-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-app-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                     "coa-app-facts-vocabulary" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "tdc")
                     "TDC-defs-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_populations" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                     "cia_countries_and_borders" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "visual-figures"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "units" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "units-dt-x"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases")
                     "military-movement-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "mil-units2-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "macros-dt"
                     ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "gas-model")
                     "natural-gas-5" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "gas-model")
                     "constants" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "coa-critique-rules" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-defs-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-cases-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "coa-force-ratio-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "coa-choke-points-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-7" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-6" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-5" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "previously-undefined" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-ubiq-preds" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-5-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-2-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-2-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-2-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-1-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-1-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-4-1-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-5" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"

                                    "COA Cases")
                     "coa-3-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-3-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-4-phased" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-2-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-5-1-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-4" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-4-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-3" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-3-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-2" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-2-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-1" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-1-1-extra-facts" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "previously-undefined-coa-preds-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-defs-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Critiques")
                     "critique-cases-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                    "COA Cases")
                     "coa-ubiq-preds" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "coa-genl-cases" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "coa-force-ratio-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "coas")
                     "coa-choke-points-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "spider-oxygen-circulation-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "recirculated-water-heating-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "orig-forced-air-heating-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "forced-air-heating-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                     "fish-oxygen-circulation-dt" ".lsp")
(make-full-file-spec (make-qrg-path "dte" "databases") "qrg-pidgen"
                     ".lsp")
))

(defun gather-dt-files (directories)
  (mapcan #'(lambda (directory)
              (directory (concatenate 'string directory "*.lsp")))
    directories))

(defun gather-keywords-from-files (file-list)
  (let ((table nil)
        (end (cons nil nil)))
    (dolist (file file-list table)
      (with-open-file (fin file :direction :input)
        (do ((form (trap-error (condition nil) (read fin nil end))
                   (trap-error (condition nil) (read fin nil end))))
            ((eq form end))
          (when (listp form)
            (let ((entry (assoc (car form) table)))
              (unless entry
                (push (setq entry (cons (car form) nil))
                      table))
              (dolist (arg form)
                (when (keywordp arg)
                  (pushnew arg (cdr entry)))))))))))

;; What is used in the DTE flat files:
;;; ((DEFMODELFRAGMENT :CONSEQUENCES :CONDITIONS :PARTICIPANTS)
;;;  (DEFFUNCTION := :AXIOM) (DELETE-FACT) (=>>) (DEFUNIT :DIMENSION)
;;;  (DEFSCENARIO :INITIALLY :DOCUMENTATION :INDIVIDUALS :THROUGHOUT)
;;;  (DEFREIFIABLEFUNCTION :DOCUMENTATION :RESULT-ISA)
;;;  (WITH-UNDEFINED-SCENARIO-OBJECTS) (ADD-PIDGIN-STRING) (FORALL)
;;;  (CG:BEEP) (QUOTE) (NIL) (DEFRELATION :=> :FUNCTION :DOCUMENTATION)
;;;  (DEFPREDICATE :N-ARY? :COMMUTATIVE? :DOCUMENTATION :EXPRESSION-TYPE)
;;;  (FORMAT) (DELETE-ITEM) (DEFOBJECT)
;;;  (DEFENTITY :CONSEQUENCES :QUANTITIES :DOCUMENTATION :SUBCLASS-OF)
;;;  (IN-PACKAGE :COMMON-LISP-USER :CL-USER)
;;;  (DEFUNIVERSALFACT :DOCUMENTATION)
;;;  (DEFQUANTITYFUNCTION :DOCUMENTATION) (SET-DT-NAME))


(defparameter *test-dt-files* 
  (list
   (make-full-file-spec (make-qrg-path "dte" "databases") "base-theory"
                        ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases") "hpkp-upper-v2"
                        ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases")
                        "battlespace1-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases")
                        "analytical-factors-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                        "cia_populations" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "factbook")
                        "cia_countries_and_borders" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                        "coa-icces-specific" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                        "coa-hpkb-specific" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                        "ink-vocabulary" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                        "debug-app-vocabulary" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                        "debug-app-facts-vocabulary" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                        "coa-app-vocabulary" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "nuSketch")
                        "coa-app-facts-vocabulary" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "tdc")
                        "TDC-defs-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases") "visual-figures"
                        ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases") "units" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases") "units-dt-x"
                        ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases")
                        "military-movement-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases") "mil-units2-dt"
                        ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "gas-model")
                        "natural-gas-5" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "gas-model")
                        "constants" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "oil-model")
                        "constants" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "oil-model")
                        "eia-dt-7" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "oil-model")
                        "production-consumption" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                       "COA Critiques")
                        "coa-critique-rules" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                       "COA Critiques")
                        "critique-defs-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                       "COA Critiques")
                        "coa-force-ratio-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "coas"
                                       "COA Critiques")
                        "coa-choke-points-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                        "spider-oxygen-circulation-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                        "recirculated-water-heating-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                        "orig-forced-air-heating-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                        "forced-air-heating-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases" "RKF")
                        "fish-oxygen-circulation-dt" ".lsp")
   (make-full-file-spec (make-qrg-path "dte" "databases") "qrg-pidgen"
                        ".lsp")))
  
(defun load-legacy-domain-theories (&key (kb *kb*)
                                         (files *test-dt-files*))
  (dolist (file files)
    (load-domain-theory file :kb kb :legacy? t)))

(defun load-domain-theory (file &key (kb *kb*) (legacy? nil))
  (format t "~% Processing ~A..." file)
  (cond ((probe-file file)
         (format t "~%   ~D assertions." 
           (time (flat-file->kb file :kb kb :legacy? legacy?))))
        (t (format t "~%  Skipping ~A, not on this machine." file))))

;;; Loading the integral dt, for playing with suggestions..
;;;(defparameter *integral-dt* 
;;;  (make-full-file-spec (make-qrg-path "fire" "v1" "sarq" "integral") 
;;;                       "integral-dt" ".lsp"))
;;;(defun load-integral-dt (&key (kb *kb*)
;;;                              (file *integral-dt*))
;;;  (load-domain-theory file :kb kb :legacy? nil))


;;;; ---------------------------------------------------------------------------
;;; END OF CODE