(in-package "KPML")

;; File: features-record.lisp
;;
;; CODE to implement a structure and access functions for
;; Penman-Features: Licheng; 1992.
;;
;; Code from Licheng for recording various version details about
;; the system being used.
;;
;; Note: (John:IPSI:July94; use of macros below can get you
;;        into trouble if they are used from the wrong 
;;        package... So, package is made explicit below.)

(defstruct penman-feature
  language
  version
  morphology
  site
  interface
  semantics         ;; 4.1
)

(defvar *penman-features*  (make-penman-feature))

;; ACCESSOR FUNCTIONS

(defmacro get-penman-feature (feature)
"Accessor macro for penman features
 Takes feature slot name as argument (quoted, unquoted or as key e.g.
:language)"

  ;1. Unquote  Quoted argument
  (when (and (listp feature)  
             (equal (car feature) 'quote))
    (setq feature (second feature)))

  ;2. Form the structure slot accessor
  (let ((slot-accessor (read-from-string
                         (concatenate 'string "kpml::penman-feature-"
                                              (string feature)))))
    `(when (and *penman-features*
                (typep *penman-features* 'penman-feature))
       (,slot-accessor *penman-features*))))


; (get-penman-feature 'language)

(defmacro set-penman-feature (feature value)
"Sets value of a  penman feature
 feature as key e.g. :language
 value must be keyword e.g. :language)"

  ;1. Form the structure slot setter
  (let ((slot-accessor (read-from-string
                           (concatenate 'string "kpml::penman-feature-"
                                                (string feature)))))
    `(when (and *penman-features*
                (typep *penman-features* 'penman-feature))
       (setf (,slot-accessor *penman-features*) ,value))))

;;;===================================================================
;;; Initial default settings.
;;; sets up the standard *penman-features* value as it is for
;;; a KPML release from IPSI (for comparison, those values for a 
;;; standard PENMAN release from ISI follow commented out).
;;;
;;; Individual files which expand on the basic Penman/KPML facilities
;;; then add in their additions, changes, etc.
;;;
;;; KPML4.0
;;;  this is not really used too much currently, although the information
;;;  it provides is correct. Updated for usual KPML releases from Bremen
;;;  Dec 2003. Some of the options are no longer options: for example,
;;;  KPML is always multilingual.
;;;
(set-penman-feature :language ':english)
(set-penman-feature :site '|Uni Bremen|)             ;; previously: 'isi, 'ipsi
(set-penman-feature :morphology 'hardcoded)
(set-penman-feature :interface 'tty)
(set-penman-feature :version *kpml-version*)         ;; prior to KPML: 'Penman93
(set-penman-feature :semantics :|unknown (if any)|)  ;; 4.1

;;;================================================================================
;;; Some useful functions that now conditionalize otherwise standard
;;; Penman functions...

(defun ml-p ()
  "Is the multilingual system installed?"
  (consp (get-penman-feature :language)))

(defun systemic-morphology-p ()
  "Is systemicized morphology installed?"
  (eq (get-penman-feature :morphology) 'systemic))

;;; ======================================================================
;;; 4.1 might sometime replace or augment the above...

(defun METADATA (&key (features nil))
  (loop for (s v) in features
	when (equal s :semantics)
	do (set-penman-feature :semantics v)))
