(in-package "KPML")

;;; File:  templates.lisp
;;; Author: John; Ober-Ramstadt, Jan97 (based on the first draft
;;; of November 95).
;;;
;;; Provided for KPML as patch KPML 1.0.21
;;;
;;; Contains facilities for using templates in SPLs. Examples of
;;; such SPL expressions are given at the end of the file.
;;;
;;; TEMPORARY LIMITATION:
;;; Complicated slightly by the fact that nonembedded SPL terms are
;;; not filled in with anything but dummy values when they are
;;; passed through constitent0. They are only instantiated after
;;; this point---usually, in fact, within the call to 
;;; modification-specification. This only happens only certain
;;; circumstances: whether there is much of a motivation for moving
;;; this (fill-global-info-in-spec) is unclear to me at this
;;; point.  For example of problem, see example (5) at the end of this file.
;;; Since it is always possible to express the same desired effect
;;; by embedding the relevant SPL terms at their point of use, this
;;; limitation is maintained at this time.
;;; ----------------------------------------------------------------------

;;; 1.0.21 Template addition.
;;; Step 1. Interpose a new function in place of old constituent0.
;;; This places an extra decision point between
;;; grammar traversal and descent through SPL terms. Each SPL term is
;;; examined to see if it in fact represents a template rather than
;;; an old-style semantic specification. If so, grammar traversals
;;; are only triggered for any holes left in the template. The
;;; structure returned behaves like a normal structure (although 
;;; selection expressions are of course missing).
;;; (Original function defined in systemicized-morphology.lisp).
;;; 2.0 now makes sure that annotation information also gets passed
;;;     in two structures created by templates.
;;; ----------------------------------------------------------------------

;;; Following functions do the main template interpretation  work.

;;; Following creates a structure
;;; looking more or less identical to a normal result of traversing
;;; the grammar, but produced from a given template rather than
;;; traversal. Note that the brownboard has to be of the same
;;; length as the whiteboard else all-parts0 screws up realization.

(defun MAKE-CONSTITUENT-PASS-FROM-TEMPLATE
    (template-in whiteboard-element-param bundle-for-display-param)
  (declare (ignore bundle-for-display-param))
	   
  ;;; First get the list of pseudofunctions and number then (as required
  ;;; internally somewhere no doubt!)

  (let* ((template (if (consp template-in) template-in (list template-in)))
         (templated-structure (create-templated-structure template))
	 (numbered-pseuds 
	  (number-pseudo-functions (mapcar #'first templated-structure))))
    (declare (ignore bundle-for-display-param))

    (make-Constituent-Pass
     :blackboard                               ;; parent and children
     `((expanded-object 
	,(whiteboard-elt-aliasfn whiteboard-element-param)
	,@numbered-pseuds)
       ,@numbered-pseuds)

     :brownboard                 ; conflations and classifies, etc.
     (loop for pseudo-wbe in templated-structure
	 collect 
	   (make-brownboard-elt
	    :functionlist 
	    (make-conflation :alias 
			     (Number-Pseudo-Functions (first pseudo-wbe)))))

     :sequences (list numbered-pseuds)
   ;;  :associations <slots and hubs>
   ;;  :orderingrelations (Number-Functions Ordering-Relations)

     :whiteboard 
;;; The whiteboard is the simplest to set up; we only need to take
;;; the processed structured template and put it in here, term-graphs
;;; trigger a whiteboard-id of 'preselect', otherwise realization gets
;;; set to the string. Not sure how much of the other information is 
;;; absolutely necessary. Complicated by the possibility of non-embedded
;;; SPL terms that must have their global definitions folded in at
;;; this point too.     
     
     (loop for pseudo-wbe in templated-structure
	 when (stringp (cdr pseudo-wbe))
	 collect 
	   (make-Whiteboard-Elt
	    :id 'lexify
	    :aliasfn (Number-Pseudo-Functions (first pseudo-wbe))
	    :featurelist nil
	    :realization (cdr pseudo-wbe)
	    ;; 2.0 need the hub even for strings so that we can pass through
	    ;;     annotations from the SPL...
	    :hub (whiteboard-elt-hub whiteboard-element-param)
	    :index nil)
	   
	 when (term-graph-p (cdr pseudo-wbe))
	 collect
	   (make-Whiteboard-Elt
	    :id 'preselect
	    :aliasfn (Number-Pseudo-Functions (first pseudo-wbe))
	    :featurelist nil
	    :realization nil
	    :hub (let ((id (term-graph-id (cdr pseudo-wbe))))
		   (fill-global-info-in-spec id)
		   id)
	    :index nil))

     :selection-expression nil))
  
  )

;;; ----------------------------------------------------------------------
;;; Following function returns a list of pairs made from
;;; a template value. Each pair consists of a pseudo-function
;;; (i.e., something that looks like a microfunction but
;;; is not) and the value for that pseudofunction. The
;;; value is either a string or a term-graph that needs to
;;; trigger further realization.

(defvar *template-segment-name* "TEMPLATE-SEGM")
(defvar *template-slot-name* "TEMPLATE-SLOT")

(defun CREATE-TEMPLATED-STRUCTURE (template)
  (loop for x in template
      for i from 1
      collect
	(typecase x
	  (string 
	   (cons (intern 
		  (concat *template-segment-name*
			  (format nil "~A" i)) "KPML") x))
	  (term-graph
	   (cons (intern 
		  (concat *template-slot-name*
			  (format nil "~A" i)) "KPML") x))
	  (otherwise
	   (warning "Error in template structure!: " template)))))


;;; ----------------------------------------------------------------------
;;; Essentially the same as number-functions and tag-fn-name, but
;;; do not bother to check that the objects are real functions.

(defun NUMBER-PSEUDO-FUNCTIONS (Object-List)
  (cond
   ((listp Object-List)
    (loop for Object in Object-List collect (Number-Pseudo-Functions Object)))
   (Object-List
    (Tag-Pseudo-Fn-Name Object-List))))

(defun TAG-PSEUDO-FN-NAME (elt)
  (if (> constituent-index 200)
      (intern 
       (concatenate 'string 
	 (symbol-name elt) "#" (princ-to-string constituent-index)))
    (intern (concatenate 
		'string (symbol-name elt) 
		(cadr 
		 (assoc 
		  constituent-index constituent-index-to-string-alist))))
    ))

;;; ----------------------------------------------------------------------
;;; Examples of SPLs with `templates'.

#|

1) generated constituents within top-level templates...
((s / template 
    :pattern ("The first of the " o1 " always sails to " o2)) 
 (o1 / ship :singularity-q nonsingular :multiplicity-q multiple) 
 (o2 / port))
=> "The first of the  ships    always sails to   a  port  "

2) templates embedded within generated sentences...
(s / directed-action :lex eat
   :actor (speaker / person)
   :actee (s2 / template
	      :pattern "all sorts of nice stuff"))
=> "I  eat   all sorts of nice stuff . "

3) generated constituents within embedded templates...
(say '((s / directed-action :lex eat
	  :tense past
	  :actor (speaker / person)
	  :actee (s2 / template
		     :pattern ("all sorts of nice" s3)))
       (s3 / object :lex cheese :number mass)
       ))
=> "I  ate   all sorts of nice  CHEESE . "

4) recursion of templates...
(say '((s / template 
	  :pattern ("The first of the " o1 " always sails to " o2)) 
       (o1 / ship :singularity-q nonsingular :multiplicity-q multiple) 
       (o2 / template :pattern ("a port to the west of" o3))
       (o3 / template :pattern ("the Scilly Isles"))))
=>
"The first of the  ships    always sails to   a port to the west 
of  the Scilly Isles "

5) NOT WORKING: templates hanging off roles nonembedded...
i.e., 

(say '((s / sail :actor d1 :destination p)
       (d1 / template :pattern  "My favorite ship" )
       (p / template :pattern "my favorite port")))
=> "A  TEMPLATE  sails   to  a  TEMPLATE . "

whereas:

(say '(s / sail 
       :actor (d1 / template :pattern  "My favorite ship" )
       :destination (p / template :pattern "my favorite port")))
=> "My favorite ship  sails   to  my favorite port . "

6) Intermixing and graphology:

(say '((s / template 
	  :pattern ("The first of the " o1 " always sails to " o2)) 
       (o1 / ship :singularity-q nonsingular :multiplicity-q multiple) 
       (o2 / template :pattern ("a port to the west of" o3))
       (o3 / object :lex island
	:size-property-ascription 
	(o4 / template :pattern ("absolutely huge")))))
=>
"The first of the  ships    always sails to   a port to the
 west of  an  absolutely huge  ISLAND "

|#


