Next: Ein Beispieldialog ;;uber Up: Integration von Sortenals ausgezeichnete Previous: Unifikation mit :-Notation

Erweiterung um Sortbase



(defvar *sortstyle*          'static "static or dynamic sorts ")


(defun collect-databases ()
  "Returns a list of all databases."
  (list *rfi-sortbase* *rfi-prelude* *rfi-database* *tracebase*) )

(defun rfi-command (userline)
  .
  .
  .
          ((eq com 'consult-sortbase)
           (rfi-sortbase-cmd-consult userline))
          ((eq com 'complete-taxonomy)
           (if (eq *sortstyle* 'static)
               (complete-taxonomy)
               (rf-error "- running dynamic sort model")))
          ((eq com 'unique-glb)
           (if (eq *sortstyle* 'static)
               (unique-glb)
               (rf-error "- running dynamic sort model")))
          ((eq com 'unsubsumes)
           (setq *rfi-sortbase* (unsubsumes *rfi-sortbase*)))
          ((eq com 'resubsumes)
           (setq *rfi-sortbase* (resubsumes *rfi-sortbase*)))
          ((eq com 'compile-sortbase)
           (if (eq *sortstyle* 'static)
                   ( compile-sortbase *rfi-sortbase*)
                   (rf-error "- running dynamic sort model")))
          ((eq com 'sortstyle)
           (rfi-cmd-sortstyle userline))
          ((eq com 'destroy-sortbase)
           (setq *subsumes-individuals* nil)
           (setq *rfi-sortbase* nil))
          ((eq com 'sortbase)
           (rfi-cmd-l (cadr userline) *rfi-sortbase*))
          ((eq com 'browse-sortbase)
           (if (eq *sortstyle* 'static)
               (when *tcl* (browse-sortbase (cadr userline)))
               (rf-error "- running dynamic sort model")))
  .
  .
  .
)


(defun rfi-cmd-sortstyle (userline)
  (let ((error-p nil) )
       (cond ((= 2 (length userline))
              (cond ((eq (second userline) 'static)
                     (setq *sortstyle* 'static))
                    ((eq (second userline) 'dynamic)
                     (setq *sortstyle* 'dynamic))
                    (t (setq error-p t))))
             ((= 1 (length userline))
              (rf-print *sortstyle*))
             (t (setq error-p t)))
       (if error-p
           (progn
            (rf-terpri)
            (rf-princ-like-lisp "Error.  Use:")
            (rf-terpri)
            (rf-princ-like-lisp "   sortstyle static")
            (rf-terpri)
            (rf-princ-like-lisp "or")
            (rf-terpri)
            (rf-princ-like-lisp "   sortstyle dynamic")
            (rf-terpri)
            (rf-princ-like-lisp "or")
            (rf-terpri)
            (rf-princ-like-lisp "   sortstyle")
            (rf-terpri)))))

(defun rfi-sortbase-cmd-consult (userline)
  (let* ((filename (rfi-extension (cadr userline) (rf-or-rfp))))
    (if (probe-file filename)
        (setq *rfi-sortbase* (append *rfi-sortbase*
                                     (rfi-cmd-consult-1 filename)))
      (rf-error "(rfi-sortbase-cmd-consult): " filename " file doesn't exist!"))))


Harold Boley & Victoria Hall (hall@dfki.uni-kl.de)