(in-package "KPML")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;COPYRIGHT (C) UNIVERSITY OF SOUTHERN CALIFORNIA, 1987                         ;
;University Of Southern California, Information Sciences Institute             ;
;4676 Admiralty Way                                                            ;
;Marina Del Rey, California 90292                                              ;
;                                                                              ;
;This software was partially developed under National Science Foundation       ;
;Grant IST-8408726, Federal Contract numbers MDA903-81-C-0335,                 ;
;MDA903-87-C-0641, F49620-84-C-0100, and F49620-87-C-0005, and the             ;
;Government holds license rights under DAR 7-104.9 (a)(c)(1).  It is           ;
;transmitted outside of the University of Southern California only under       ;
;written license agreements or software exchange agreements, and its use       ;
;is limited by these agreements.  At no time shall any recipient use this      ;
;software in any manner which conflicts or interferes with the                 ;
;governmental license rights or other provisions of the governing              ;
;agreement under which it is obtained.  It is supplied "AS IS," without        ;
;any warranties of any kind.  It is furnished only on the basis that any       ;
;party who receives it indemnifies and holds harmless the parties who          ;
;furnish and originate it against any claims, demands or liabilities           ;
;connected with using it, furnishing it to others or providing it to a         ;
;third party.  THIS NOTICE MUST NOT BE REMOVED FROM THE SOFTWARE, AND IN       ;
;THE EVENT THAT THE SOFTWARE IS DIVIDED, IT SHOULD BE ATTACHED TO EVERY        ;
;PART.                                                                         ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Macros:  keyword/value pairs that expand to specific inquiry responses
;;; Identifiers should be gensyms to avoid conflict with existing symbols.
;;; Macros are to be placed at the proper rank level in the sentence plan,
;;; and expand to answers to specific inquiries at that rank. 

;;; Each macro definition is recorded in a spl-macro structure:

(defstruct spl-macro
  (name nil :type atom)
  (value-alist nil :type list)
  (default-value nil :type list)
  (variables nil :type list))


;;; *SPL-MACRO-TABLE*
;;; =================
;;;
;;;	Hash table to hold macro definitions, indexed by name.

(defvar *spl-macro-table* (make-hash-table :size 50))


;;; DEFSPL-MACRO
;;; ============
;;;
;;; used to define macros, and enter them into *spl-macro-table*

(defmacro defspl-macro (name value-map)
  `(defspl-macro-1 ,name ',value-map))

(defun defspl-macro-1 (name value-map)
  ;; adds an entry to the macro table with keyword NAME
  ;; and expansion defined by VALUE-MAP alist.
  (let ((def (make-spl-macro :name name
			     :value-alist value-map
			     :default-value (or (cdr (assoc '? value-map))
						(cdr (assoc t value-map)))
			     :variables (find-variables value-map)))
	(prev-def (gethash name *spl-macro-table*)))
    (if prev-def
      (warning "The SPL macro " name " is being redefined.")
      (setf (gethash (intern (symbol-name name) (find-package 'penman)) *spl-keyword-table*) 'macro))
    (setf (gethash name *spl-macro-table*) def)))


;;; FIND-VARIABLES
;;; ==============
;;;
;;; collect list of all variables in value-map
;;; (i.e. those symbols with "?" as first character).

(defun find-variables (value)
  (if (atom value)
      (when (char= (char (symbol-name value) 0) #\?)
	(list value))
      (let (vars)
	(dolist (elt value)
	  (setq vars (union vars (find-variables elt))))
	vars)))


;;; EXPAND-SPL-MACRO
;;; ================

(defun expand-spl-macro (keyword value &optional third-param)
  "Expands a keyword-value pair, if keyword has been defined as a macro."
  (let ((macro (gethash keyword *spl-macro-table*)))
    (if macro
	
	;; expand macro
	(let ((expansion (assoc value (spl-macro-value-alist macro)))
	      (vars (spl-macro-variables macro))
	      expanded-features)
	  (if expansion
	      (setq expansion (cdr expansion))
	      (setq expansion (spl-macro-default-value macro)))
	  (setq expanded-features
		(if vars
		    ;; substitute gensyms for all variables in expansion
		    (let ((var-alist
			    (mapcar
			      #'(lambda (var)
				  (if (eq var '?)
				      (cons var value)
				      (cons var (gentemp (subseq (symbol-name var) 1)))))
			      vars)))
		      (sublis var-alist expansion))
		    expansion))
	  (reparse-features expanded-features))
	
	;; keyword is not a macro, so just return the original SPL feature
	(if third-param 
	    `((,keyword ,value ,third-param))
	    `((,keyword ,value))))))


;;; REPARSE-FEATURES
;;; ================
;;;
;;; group feature-value pairs of list,
;;; and recursively expand any features which are macros.
;;; NOTE: this code might also be used in term-to-graph  -- Bob Kasper

(defun reparse-features (list)
  (let (feature-list)
    (mapl #'(lambda (tail)
	      (when (keyword-p (first tail))
		(setq feature-list
		      (nconc (expand-spl-macro
			       (first tail)
			       (second tail)
			       (if (and (listp (second tail))
					(not (keyword-p (third tail))))
				   (third tail)))
			     feature-list))))
	  list)
    feature-list))

(defun keyword-p (exp)
  (and (symbolp exp)
       (eq (symbol-package exp)
	   (find-package 'keyword))))
