;;; -*- 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)

;;; 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)

(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)))

(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

(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 ()))

(load "mywords.lisp")