;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: cyc-reader.lsp
;;;;    System: 
;;;;   Version: 1.0
;;;;    Author: Ken Forbus
;;;;   Created: November 5, 2000 21:10:23
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Friday, November 17, 2000 at 23:26:53 by forbus
;;;; ---------------------------------------------------------------------------

(in-package :fire)


(defun load-cyc-converted-file (file
                                &optional (db dbex::*dbh*))
  (let ((eof (cons nil nil)))
    (with-open-file (fin file :direction :input)
      (do ((form (read fin nil eof)
                 (read fin nil eof))
           (counter 0 (1+ counter)))
          ((eq form eof) counter)
        ;; ***** Reinhard says it barfs with variables right now, so
        ;; *****  we'll be kind
        (when (dbex::groundp form)
          (dbex::store-exp form db))))))

;;; Crude

;; FSM:
;; #$ -- starts a new symbol.
;; Upper case symbol, with previous being lower case -- hyphen
;; space -- normal mode

(defun convert-cyc-file (cyc-file file-out)
  (with-open-file (fin cyc-file :direction :input)
    (with-open-file (fout file-out :direction :output
                          :if-exists :supersede)
      (let ((eof (cons nil nil)))
        (do ((char (read-char fin nil eof)
                   (read-char fin nil eof))
             (state :start)
             (last-char nil))
            ((eq char eof))
          (case state
            (:start
             (cond ((eq char #\#) (setq state #\#))
                   (t (write-char char fout))))
            (#\#
             (cond ((eq char #\$) (setq state :symbol))
                   (t (write-char char fout)
                      (setq state :start))))
            (:symbol
             (cond ((upper-case-p char)
                    (unless (eq last-char #\$)
                      (write-char #\- fout))
                    (write-char (char-downcase char) fout))
                   ((excl::whitespace-char-p char)
                    (setq state :start)
                    (write-char char fout))
                   (t (write-char char fout)))))
          (setq last-char char))))))




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