;;; -*- mode: lisp; package: gpsg; base: 10; syntax: common-lisp -*-
;;;
;;; semantic roles/thematic roles/lexical conceptual structures
;;; agent - j gave m a book
;;; patient/theme - j gave m a book
;;; beneficiary/goal - j gave m a book
;;; location - j put a book on the table
;;; proposition - j thinks that mary saw bill
;;; objective - j told mary to eat ice cream

;;; nouns

; (in-package 'gpsg :use '(lisp))

(add-word-semantics 'bill 'name 'bill)
(add-word-semantics 'fido 'name 'fido)
(add-word-semantics 'fred 'name 'fred)
(add-word-semantics 'jane 'name 'jane)
(add-word-semantics 'john 'name 'john)
(add-word-semantics 'mary 'name 'mary)
(add-word-semantics 'rusty 'name 'rusty)
;; new (ex20)
(add-word-semantics 'somebody 'name 'somebody)

;;; noun phrases

(defun add-noun (noun number)
  (add-word-semantics noun 'n
		      `(lambda (det ap?)
			 `(,',noun :definite? ,det
			         :number ,',number
				 ,@(if ap? `(:mod ,ap?))))))

(defun add-mass-noun (noun)
  (add-word-semantics noun 'n+mass
		      `(lambda (ap?)
			 `(,',noun :definite? nil
			         :number mass
				 ,@(if ap? `(:mod ,ap?))))))

(add-noun 'book 'singular)
(add-noun 'books 'plural)
(add-noun 'cadillac 'singular)
(add-noun 'car 'singular)
(add-noun 'cats 'plural)
(add-noun 'cities 'plural)
(add-noun 'city 'singular)
(add-noun 'communist 'singular)
(add-noun 'conference 'singular)
(add-noun 'corner 'singular)
(add-noun 'cows 'plural)
(add-noun 'dog 'singular)
(add-noun 'drugs 'plural)
(add-noun 'eggplant 'singular)
(add-mass-noun 'eggplant)
(add-noun 'exam 'singular)
(add-noun 'fact 'singular)
(add-noun 'friends 'plural)
(add-noun 'guy 'singular)
(add-noun 'horses 'plural)
(add-noun 'kennel 'singular)
(add-noun 'keys 'plural)
(add-noun 'letter 'singular)
(add-noun 'man 'singular)
(add-noun 'mets 'plural)
(add-noun 'park 'singular)
(add-noun 'pencil 'singular)
(add-noun 'pot 'singular)
(add-noun 'redsox 'singular)
(add-noun 'room 'singular)
(add-noun 'table 'singular)
(add-noun 'tax 'singular)
(add-noun 'teams 'plural)
(add-noun 'theory 'singular)
(add-noun 'tree 'singular)
(add-noun 'tune 'singular)
(add-noun 'volume 'singular)
(add-noun 'volumes 'plural)
(add-noun 'werewolf 'singular)
(add-noun 'woman 'singular)
(add-noun 'years 'plural)

;;; determiners

(add-word-semantics 'the 'det t)
(add-word-semantics 'this 'det t) ;demonstrative?
(add-word-semantics 'a 'det nil)
(add-word-semantics 'an 'det nil)

(add-word-semantics 'who 'pronp+wh '?who)
(add-word-semantics 'what 'pronp+wh '?what)
(add-word-semantics 'where 'adv+wh '(:locative ?where))

;;; verbs

(defmacro add-v1 (v-tns v+past v+present)
   `(progn
      (add-word-semantics ',v-tns 'v1-tns
			  `(lambda (agent)
			     `(,',',v-tns :agent ,agent)))
      (add-word-semantics ',v+past 'v1+tns
			  `(lambda (agent)
			     `(,',',v-tns :agent ,agent :tense past)))
      (add-word-semantics ',v+present 'v1+tns
			  `(lambda (agent)
			     `(,',',v-tns :agent ,agent :tense present)))))

(add-v1 come came comes)
(add-v1 drive drove drives)
(add-v1 eat ate eats)
(add-v1 return returned returns)
(add-v1 sing sang sings)
(add-v1 sleep slept sleeps)
(add-v1 talk talked talks)

(defmacro add-v2 (v-tns v+past v+present)
   `(progn
      (add-word-semantics ',v-tns 'v2-tns
			  `(lambda (agent patient)
			     `(,',',v-tns :agent ,agent :patient ,patient)))
      (add-word-semantics ',v+past 'v2+tns
			  `(lambda (agent patient)
			     `(,',',v-tns :agent ,agent :patient ,patient :tense past)))
      (add-word-semantics ',v+present 'v2+tns
			  `(lambda (agent patient)
			     `(,',',v-tns :agent ,agent :patient ,patient :tense present)))))
;;new
(add-v2 kiss kissed kisses)

(add-v2 eat ate eats)
(add-v2 buy bought buys)
(add-v2 catch caught catches)
(add-v2 chase chased chases)
(add-v2 compute computed computes)
(add-v2 drive drove drives)
(add-v2 find found finds)
(add-v2 hate hated hates)
(add-v2 keep kept keeps)
(add-v2 kill killed kills)
(add-v2 like liked likes)
(add-v2 love loved loves)
(add-v2 make made makes)
(add-v2 pass passed passes)
(add-v2 please pleased pleases)
(add-v2 sing sang sings)
(add-v2 see saw sees)
(add-v2 support supported supports)
(add-v2 surprise surprised surprises)
(add-v2 visit visited visits)

(defmacro add-v3 (v-tns v+past v+present)
   `(progn
      (add-word-semantics ',v-tns 'v3-tns
			  `(lambda (agent beneficiary patient)
			     `(,',',v-tns :agent ,agent :patient ,patient
			       :beneficiary ,beneficiary)))
      (add-word-semantics ',v+past 'v3+tns
			  `(lambda (agent beneficiary patient)
			     `(,',',v-tns :agent ,agent :patient ,patient 
			       :beneficiary ,beneficiary :tense past)))
      (add-word-semantics ',v+present 'v3+tns
			  `(lambda (agent beneficiary patient)
			     `(,',',v-tns :agent ,agent :patient ,patient 
			       :beneficiary ,beneficiary :tense present)))))

(add-v3 give gave gives)

;; new (ex6) 
(add-word-semantics 'kissed 'v2+passp
		    '(lambda (agent patient)
		       `(kiss :agent ,agent
			      :patient ,patient
			      :tense past
			      :type passive)))

(add-word-semantics 'put 'v4+tns
		    '(lambda (agent patient locative)
		       `(put :agent ,agent
			     :patient ,patient
			     :locative ,locative
			     :tense past)))

(add-word-semantics 'liked 'v5+tns
		    '(lambda (agent objective)
		       `(like :agent ,agent
			      :objective ,objective
			      :tense past)))

(add-word-semantics 'told 'v6+tns
		    '(lambda (agent patient objective)
		       `(tell :agent ,agent
			      :patient ,patient
			      :objective ,objective
			      :tense past)))

(add-word-semantics 'thinks 'v8+tns
		    '(lambda (agent proposition)
			`(think :agent ,agent
				:proposition ,proposition
				:tense present)))

(add-word-semantics 'regretted 'v9+tns
		    '(lambda (agent factive)
			`(regret :agent ,agent
				 :factive ,factive
				 :tense past)))

(add-word-semantics 'looked 'v10+tns
		    '(lambda (individual state-of-being)
			`(look :individual ,individual
			       :state-of-being ,state-of-being
			       :tense past)))

(add-word-semantics 'wondered 'v11+tns
		    '(lambda (agent object)
			`(wonder :agent ,agent
			         :object ,object
			         :tense past)))

(add-word-semantics 'offered 'v12+tns
		    '(lambda (agent object)
		       `(offer :agent ,agent
			       :object ,object
			       :tense past)))

;;; preposition

(add-word-semantics 'in 'p
		    '(lambda (location)
		       `(lambda (frame)
			  (add-feature frame :locative
				       '(:relation in :location ,location)))))

(add-word-semantics 'under 'p
		    '(lambda (location)
		       `(lambda (frame)
			  (add-feature frame :locative
				       '(:relation under :location ,location)))))

(add-word-semantics 'on 'p+loc
		    '(lambda (location)
		       `(on ,location)))

;; new (ex 2)
(add-word-semantics 'to 'p+to
		    '(lambda (beneficiary)
		       `,beneficiary))

;; new (ex 7)
(add-word-semantics 'by 'p+agby
		    '(lambda (agent)
		       `,agent))


(add-word-semantics 'of 'p
		    '(lambda (source)
		       `(of ,source)))

;;; adjectives


(add-word-semantics 'rabid 'a '(rabid))
(add-word-semantics 'raw 'a '(raw))
(add-word-semantics 'smart 'a '(smart))

(add-word-semantics 'red 'a '(:color red))
(add-word-semantics 'blue 'a '(:color blue))
(add-word-semantics 'green 'a '(:color green))
(add-word-semantics 'yellow 'a '(:color yellow))

;;; predicate adjective

(add-word-semantics 'suspicious 'a
		    '(lambda (source)
		        (cond (source `(suspicious :source ,source))
			      (t `(suspicious :source something)))))

;;; aux and modal

;; new (ex6) - ambiguous, could be "was kissed" or "was a baby"...passive
;; versus past tense

(add-word-semantics 'was 'aux%be+tns
		    '(lambda ()))

(add-word-semantics 'did 'aux%do+tns
		    '(lambda (verb-frame)
		       (append verb-frame '(:tense past))))

(add-word-semantics 'does 'aux%do+tns
		    '(lambda (verb-frame)
		       (append verb-frame '(:tense present))))

(add-word-semantics 'can 'modal
		    '(lambda (verb-frame)
		       (append verb-frame '(:mood can :tense present))))

;;; form words

(add-word-semantics 'to '*to '(lambda ()))
(add-word-semantics 'that '*that '(lambda ()))
(add-word-semantics 'whether 'comp+wh '(lambda ()))