;;; File: kpml-load-circ-focus.lisp
;;; This file will load all the other files necessary to use the new
;;; systems for adverbial ordering.
;;; Susan Williams, May, 1995


;(load "~/master/finalfix")
;(load "~/master/circ-focus")
;(load "~/master/adjunct-macros.spl")
(load "~nlu/penman/additions/kpml-finalfix") ;; changed by Jon 21/01/97 
(load "~nlu/penman/additions/kpml-circ-focus") ;; changed by Jon 21/01/97 
(load "~nlu/penman/additions/adjunct-macros.spl")

(in-package :penman)

(reset-system-network)
(SET-GRAMMAR-KEYWORD-TYPES)
(set-inquiry-mode-implemented)

;;;-----------------------------------------------------------------
;;; The rest of this file is demostrations that the new systems work.
;;; To run them, type
;;;          (short-demo)
;;;       or (demonstrate-adverbial-ordering)
;;; at the Lisp prompt.
;;;-----------------------------------------------------------------



(defun susan-reset ()
  (reset-system-network)
  (SET-GRAMMAR-KEYWORD-TYPES))

(defun s-implement ()
  (set-inquiry-mode-implemented))

(defvar adverbs-to-test
  '(accompaniment manner role
		  spatial-location temporal-location
		  spatial-extent temporal-extent))

(defvar chunks
  '((:inclusive (chip / person
		      :lex programmer
		      :determiner the))
    (:manner (prec / quality :lex precisely))
    (:role-playing (whole / person
			  :lex programmer
			  :determiner a))
    (:spatial-locating (tv / one-or-two-d-location
			   :lex television
			   :determiner the
			   :provenance-property-ascription
			   (tv-provenance / provenance-class-quality
					  :lex local)))
    (:temporal-locating (t1 / relative-spatial-temporal
			    :identifiability-q identifiable
			    :lex last-week))
    (:spatial-extent (d / thing
			:lex mile
			:quantity-ascription 4))
    (:temporal-extent (d / day
			 :lex day
			 :quantity-ascription 4))))

(defvar tenses-to-test
  '(present past future present-continuous
	    past-continuous future-continuous
	    present-perfect past-perfect future-perfect))
;;   future-in-present present-perfect-continous)

(defvar positions-to-test
  '(:medial :initial-end :end))

(defvar speechacts '(assertion yes-no-question))
(defvar polarities '(positive negative))

(defun demonstrate-adverbial-ordering ()
  (write-line "------------------------------------------------------------")
  (write-line "This is the long example set.") (terpri)
  (write-line "It shows the positioning of each circumstantial adjunct for")
  (write-line "tense.  Not all of these sentences are well formed.  Later")
  (write-line "work, will hopefully show what restrictions should be added")
  (write-line "to prevent these occurrences.")
  (write-line "------------------------------------------------------------")
  (susan-reset)
  (s-implement)
  (for position in positions-to-test do
       (for adverb in adverbs-to-test
	    for chunk in chunks
	    do (progn
		 (format t "~%~%Testing for ~S in ~S position:~%~%"
			 adverb position)
		 (for tense in tenses-to-test do
		      (format t "~S:~20,T~A~%" tense
			      (say-spl
			       `(fly / nondirected-action
				     :actor (speaker / person)
				     :lex talk
				     :conjunctive also ;; :polarity negative
				     :tense ,tense ;;    :speechact yes-no-question
				     :of-matter (comp / one-or-two-d-location
						      :lex computer
						      :determiner the)
				     ,position ,adverb
				     ,@chunk))))
		 ))))


(lexical-item
 :name MILE
 :spelling "mile"
 :sample-sentence "The bone in my leg is broken."
 :features (NOUN S COMMON NOT-NOMINALIZATION COUNTABLE NONSUBSTITUTE
		 NONE-OF-THATCOMP-TYPIC)
 :date "Apr15-95"
 :editor "WW")


(defvar extras '((:speechact assertion)
		 (:polarity negative)
		 (:speechact yes-no-question)))

(defun short-demo ()
  (write-line "------------------------------------------------------------")
  (write-line "This is the short example set.")
  (terpri)
  (write-line "It puts a matter adjunct in medial, intial-end, and end")
  (write-line "positions for positive, negative, and interrogative ")
  (write-line "versions of the sentence:")
  (write-line "     \"I talk with the programmer about the computer.\"")
  (write-line "------------------------------------------------------------")
  (susan-reset)
  (s-implement)
  (for position in positions-to-test do
       (progn
	 (format t "~%~%Testing for matter in ~S position:~%~%"
		 position)
	 (for tense in tenses-to-test do
	      (for extra in extras do
		   (format t "~S:~20,T~A~%" tense
			   (say-spl
			    `(fly / nondirected-action
				  :actor (speaker / person)
				  :lex talk
				  :conjunctive also 
					  :tense ,tense
					  ,@extra
					  :of-matter
					     (comp / one-or-two-d-location
						   :lex computer
						   :determiner the)
					  ,position matter
					  :inclusive (chip / person
							   :lex programmer
							   :determiner the))))
		   )))))

;;;---------------------------------------------------------------
;;; A few spls that one can "Say" to test the new systems.

(defvar demo-accompaniment
  '(fly / nondirected-action
	:actor (speaker / person)
	:lex talk
	:tense present-perfect
	:of-matter (comp / one-or-two-d-location
			 :lex computer
			 :determiner the)
	:inclusive (chip / person
			 :lex programmer
			 :determiner the)))

(defvar demo-manner
  '(fly / nondirected-action
	:actor (speaker / person)
	:lex talk
	:tense present-perfect
	:of-matter (comp / one-or-two-d-location
			 :lex computer
			 :determiner the)
	:manner (prec / quality :lex precisely)))

(defvar demo-temporal-extent
  '(rain / ambient-process
	 :lex rain
	 :tense present-perfect
	 :of-matter (comp / one-or-two-d-location
			  :lex computer
			  :determiner the)
	 :temporal-extent (d / day
			     :lex day
			     :quantity-ascription 4)))

(defvar demo-role-playing
  '(fly / nondirected-action
	:actor (speaker / person)
	:lex talk
	:tense present-perfect
	:of-matter (comp / one-or-two-d-location
			 :lex computer
			 :determiner the)
	:role-playing (whole / person
			     :lex programmer
			     :determiner a)))

(defvar demo-spatial-locating
  '(fly / nondirected-action
	:actor (speaker / person)
	:lex talk
	:tense present-perfect
	:of-matter (comp / one-or-two-d-location
			 :lex computer
			 :determiner the)
	:spatial-location-specification-q spatiallocation
	:spatial-locating (tv / one-or-two-d-location
			      :lex television
			      :determiner the
			      :provenance-property-ascription
			      (tv-provenance / provenance-class-quality
					     :lex local))))

(defvar demo-temporal-locating
  '(fly / nondirected-action
	:actor (speaker / person)
	:lex talk
	:tense present-perfect
	:of-matter (comp / one-or-two-d-location
			 :lex computer
			 :determiner the)
	:temporal-locating (t1 / relative-spatial-temporal
			       :identifiability-q identifiable
			       :lex last-week)))
