(in-package "KPML")

;;; File: loader.lisp
;;; John: Edinburgh: 23Sep97

;;; The normal method of making definitions of systemic objects inherited
;;; from Penman is by using macros that provide the definitional forms.
;;; These macros typically provide simple syntax checking by relying
;;; on Lisp to recognize keyword mismatches, etc. For standalone versions
;;; of KPML we can no longer rely on macros since these require the
;;; compiler to be present. The following function therefore provides
;;; a load facility that itself does the necessary work of recognizing
;;; systemic object declarations without relying on macros. Since macros
;;; are fine when we are not in standalone mode, we parameterize the 
;;; loading function...

;;; N.B. the body of the load loop that interprets each item read is
;;;      just the same as is used by kpml-eval (in utilities.lisp).
;;;      So it is broken out into a macro defined there in case 
;;;      changes/extensions are made. 
;;;
;;; Additions/changes: any new KPML declaration has to be added in here
;;; so that it can be processed.
;;;
;;; 4.0  Also add in Unicode conditionalisation for Lispworks. If
;;;      we find that we have a Unicode file, then we enforce 
;;;      standalone reading mode and open the file with Unicode
;;;      as the external format. This makes it easy for normal KPML
;;;      operations to be used for loading, e.g., Unicode lexicons.
;;;      This functionality only confirmed for Lispworks 4.1+ as yet.
;;;
;;;      Also takes a peek to see if it looks like an XML file...
;;;
;;; Something strange happens with the scoping on the variable
;;; unicode-input? which is used in the macrolet definition.
;;; It likes to set itself apparently, causing unpredictable
;;; (and fatal) attempts to read Unicode files when they are
;;; not. So make sure that the use of the variable is at a time
;;; when it is definitely locally bound! Still breaks. For the
;;; present, disable unicode loading for standalones. 

(defun KPML-LOAD (file &key (verbose T)(protocol nil))
  (protocol-edit `(kpml-load ,file))
  (let* ((*currently-used-file* file)
	 (unicode-input? (unicode-file-p file))
	 (xml-input?     (xml-file-p file unicode-input?)))
    (declare (special *currently-used-file*))

    ;; 4.0 anything that looks like XML is headed off at the pass...
    (when xml-input?
      (kpml-xml-lexicon-load file)
      (return-from KPML-LOAD T))

    ;; 4.0 Non unicode input that we can just load is picked off here...
    (unless (or *standalone* unicode-input?)
      (load file)
      (return-from KPML-LOAD T))

    (let ((*package* (find-package "KPML"))
	  (pathname (if (pathnamep file) file
		      (pathname file)))
	  form
	  (system-count 0)
	  (chooser-count 0)
	  (inquiry-count 0)
	  (lexeme-count 0)
	  (example-count 0)
	  (declaration-count 0)
	  (opn-count 0)
	  )
      (declare (special
		system-count chooser-count inquiry-count lexeme-count
		example-count declaration-count opn-count))
      (macrolet ((FILE-OPENER 
		  (&body body)
		  (if (and unicode-input? (not *standalone*))
		      `(with-open-file 
			(stream pathname 
				:direction :input
				:if-does-not-exist nil
				:external-format 
				'(:UNICODE :EOL-STYLE :CRLF)
				)
			,@body)
		    `(with-open-file 
		      (stream pathname 
			      :direction :input
			      :if-does-not-exist nil
			      )
		      ,@body))))
		  
       (labels ((EXTRACT-KEYWORD (key form &key (allow-nil-p nil))
		 (let ((p (position key form))
		       (res nil))
		   (cond ((and (numberp p) (< p (length form)))
			  (setf res (nth (1+ p) form))
			  (if res 
			    (return-from EXTRACT-KEYWORD 
			      (if (and (consp res)
				       (eq (first res) 'quote))
				  (second res)
				res))
			  (if allow-nil-p (return-from EXTRACT-KEYWORD nil)
			    (progn
			      (format 
			       *trace-output* 
			       "~%;;; ... kpml loader error (nil arg): ~S" 
			       form)
			      (throw 'kpml-load-error nil)))))
		       (allow-nil-p (return-from EXTRACT-KEYWORD nil))
		       (t
			(format *trace-output* 
				"~%;;; ... kpml loader error: ~S" form)
			(throw 'kpml-load-error nil))))))

   (with-open-file 
    (stream pathname 
	    :direction :input
	    :if-does-not-exist nil)
	(when (streamp stream)
	  (when verbose
	    (format *trace-output* 
		    (if unicode-input?
			"~%;;; KPML loading (Unicode): ~A"
		      "~%;;; KPML loading: ~A")
		    pathname))
	  (loop until (eq (setf form (read stream nil :eof)) :eof)
	      when (listp form)
	      do 
		(when protocol (protocol-edit form))
		(catch 'kpml-load-error
		  (eval-kpml-form)
		  ))
	  )))
    (when verbose (load-report))))))


;;; ----------------------------------------------------------------------
;;; Report what we've done...

(defun LOAD-REPORT ()
  (declare (special
	    system-count chooser-count inquiry-count lexeme-count
	    example-count declaration-count opn-count))
  (format *trace-output* "~%")
  (when (> system-count 0) 	
    (format *trace-output* ";;; ...~A systems loaded." system-count))
  (when (> chooser-count 0) 
    (format *trace-output* ";;; ...~A choosers loaded." chooser-count))
  (when (> inquiry-count 0) 
    (format *trace-output* ";;; ...~A inquiries loaded." inquiry-count))
  (when (> lexeme-count 0) 
    (format *trace-output* ";;; ...~A lexemes loaded." lexeme-count))
  (when (> example-count 0) 
    (format *trace-output* ";;; ...~A examples loaded." example-count))
  (when (> declaration-count 0) 
    (format *trace-output* ";;; ...~A declarations loaded." declaration-count))
  (when (> opn-count 0)
    (format *trace-output* ";;; ...~A operations performed." opn-count))
  )



