(FILECREATED "26-Sep-84 15:07:58" {ERIS}<LISPCORE>SOURCES>MSPARSE.;3
 46121  

      changes to:  (FNS MSSETUP)

      previous date: "15-Aug-84 00:53:55" {ERIS}<LISPCORE>SOURCES>MSPARSE.;2)


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT MSPARSECOMS)

(RPAQQ MSPARSECOMS
 [(FNS SETKNOWN DOESPHRASE SETSETTYPE FAIL MSJOINSET BLOCKER PATHOPTIONS MSPARSE 
			 FIXUPTYPES VERBTYPE SETREP MSSEEKPHRASE TYPEMATCHRATING MSTRYSPELL 
			 MSTRYPARSE COMMAND SUBJTYPE OBJTYPE VERB MSSPLST MSWORD? SEEKTYPE MSRESPELL 
			 JOINTYPES SIMPLESET MATCHRATING SEEK VERBED CAN'T JOINDETS NEGATESET 
			 GETNEXTWORD PREDICATE CHECKSYNONYM SEEKWORD SETWORDTYPE EATWORD TRYSPELLTYPE 
			 SETPHRASE QUOTEDWORD FIXVERBSETTYPE SETSYNONYM MSSETUP)
	(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS * PARSERRECORDS)
		  (MACROS GETWORDTYPE))
	(VARS CONJUNCTABLE (MSSPLST))
	(FILEVARS INITWORDLIST)
	(P (APPLY (QUOTE MSSETUP)
		  INITWORDLIST))
	(BLOCKS (MSPARSEBLOCK SETKNOWN DOESPHRASE SETSETTYPE FAIL MSJOINSET BLOCKER PATHOPTIONS 
			      MSPARSE FIXUPTYPES VERBTYPE SETREP MSSEEKPHRASE TYPEMATCHRATING 
			      MSTRYSPELL MSTRYPARSE COMMAND SUBJTYPE OBJTYPE VERB MSSPLST MSWORD? 
			      SEEKTYPE MSRESPELL JOINTYPES SIMPLESET MATCHRATING SEEK VERBED CAN'T 
			      JOINDETS NEGATESET GETNEXTWORD PREDICATE CHECKSYNONYM SEEKWORD EATWORD 
			      TRYSPELLTYPE SETPHRASE QUOTEDWORD FIXVERBSETTYPE
			      (ENTRIES MSPARSE MSJOINSET MSTRYSPELL SETSYNONYM MSSETUP)
			      (RETFNS MSTRYPARSE)
			      (SPECVARS SPELLING)
			      (LOCALFREEVARS CONJUNCTIONS LASTADVERB LASTPARSED NEXTWORD PARSED S 
					     SEEKING SENTENCE RESETS)
			      (BLKAPPLYFNS DOESPHRASE VERBED BLOCKER PATHOPTIONS SETREP COMMAND VERB 
					   PREDICATE SETPHRASE)
			      (LOCALFREEVARS SETTYPE SETDET)
			      (NOLINKFNS . T)
			      (GLOBALVARS MSWORDS MSSPLST CONJUNCTABLE)
			      MSSETUP SETWORDTYPE SETSYNONYM)
		(NIL (LOCALVARS . T)
		     (GLOBALVARS MSWORDS)))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA SEEKWORD SEEK)
									      (NLAML)
									      (LAMA])
(DEFINEQ

(SETKNOWN

  (LAMBDA (SET)                                             (* lmm "21-SEP-78 05:34")

                                                            (* lmm: 16-MAR-76 15 34)

    (replace
 KNOWN of
 SET with
 T)
    (SETSETTYPE
 SET (QUOTE FNS))
    (SELECTQ (fetch
 ID of
 (fetch
 REP of
 SET))
	     (NOT (SETKNOWN
 (fetch
 NEGATED of
 (fetch
 REP of
 SET))))
	     ((AND OR ANDNOT)
	       (SETKNOWN
 (fetch
 (CSET SET1) of
 SET))
	       (SETKNOWN
 (fetch
 (CSET SET2) of
 SET)))
	     NIL)))

(DOESPHRASE

  (LAMBDA NIL                                               (* lmm "19-NOV-77 21:29")

    (AND (SEEKWORD
 DOES
 DO
)
	 (create
 SETPHRASE
		 REP ←(create
 THAT
			      OTHERSET ←(OR (SEEK
 SETPHRASE)
					    (CAN'T
))
			      VERB ←(PROGN (COND
					     ((NOT (SEEK
 VERB S))
					       (CAN'T
)))
					   (replace
 TENSE of
 LASTPARSED with
 (QUOTE ED))
					   LASTPARSED))))))

(SETSETTYPE

  (LAMBDA (SET TYPE)                                        (* lmm "23-DEC-78 15:22")

    (AND SET TYPE (PROG (REP)
		        (COND
			  ((AND (NULL (fetch
 TYPE of
 SET))
				(NULL (fetch
 DEFAULTTYPE of
 SET)))
			    (replace
 DEFAULTTYPE of
 SET with
 TYPE)
			    (SELECTQ (fetch
 ID of
 (SETQ REP (fetch
 REP of
 SET)))
				     (THAT (FIXVERBSETTYPE
 SET))
				     (NOT (SETSETTYPE
 (fetch
 NEGATED of
 (fetch
 REP of
 SET))
						      TYPE))
				     ((AND OR ANDNOT)
				       (SETSETTYPE
 (fetch
 (CSET SET1) of
 REP)
						   TYPE)
				       (SETSETTYPE
 (fetch
 (CSET SET2) of
 REP)
						   TYPE))
				     NIL))
			  ((NOT (EQUAL (OR (fetch
 TYPE of
 SET)
					   (fetch
 DEFAULTTYPE of
 SET))
				       TYPE))
			    (printout
 T "Expecting " TYPE " but supplied "
				      (OR (fetch
 TYPE of
 SET)
					  (fetch
 DEFAULTTYPE of
 SET))
				      "." T)))))
    SET))

(FAIL

  (LAMBDA (FLG)                                             (* lmm "23-DEC-78 15:29")

    (PROG (POS)
          (OR FLG (GO ERR))
      SEARCH
          (OR (SETQ POS (STKPOS (FUNCTION MSTRYPARSE)
				1
				(STKNTH -1 POS POS)
				POS))
	      (GO ERR))
          (COND
	    ((EQ (STKARG 1 POS)
		 (QUOTE COMMAND))
	      (RETFROM POS NIL T)))
          (GO SEARCH)
      ERR (printout
 T "Sorry, couldn't parse that!" T)
          (ERROR!))))

(MSJOINSET

  (LAMBDA (C SET1 SET2)                                     (* lmm "23-DEC-78 15:20")

    (PROG (TYPE)
          (COND
	    ((AND (EQ C (QUOTE AND))
		  (EQ (fetch
 ID of
 (fetch
 REP of
 SET1))
		      (QUOTE QUOTE))
		  (LITATOM (fetch
 QUOTED of
 (fetch
 REP of
 SET1)))
		  (EQ (fetch
 ID of
 (fetch
 REP of
 SET2))
		      (QUOTE QUOTE))
		  (LITATOM (fetch
 QUOTED of
 (fetch
 REP of
 SET2))))
	      (printout
 T (fetch
 QUOTED of
 (fetch
 REP of
 SET2))
			, C , (fetch
 QUOTED of
 (fetch
 REP of
 SET1))
			" -> "
			(fetch
 QUOTED of
 (fetch
 REP of
 SET2))
			,
			(SETQQ C OR)
			,
			(fetch
 QUOTED of
 (fetch
 REP of
 SET1))
			".")))
          (replace
 DET of
 SET1 with
 (JOINDETS
 C (fetch
 DET of
 SET1)
					      (fetch
 DET of
 SET2)))
          (replace
 TYPE of
 SET1 with
 (JOINTYPES
 C (fetch
 TYPE of
 SET1)
						(fetch
 TYPE of
 SET2)))
          (SETSETTYPE
 SET1 (SETQ TYPE (JOINTYPES
 C (fetch
 DEFAULTTYPE of
 SET1)
						 (fetch
 DEFAULTTYPE of
 SET2))))
          (SETSETTYPE
 SET2 TYPE)
          (COND
	    ((fetch
 KNOWN of
 SET2)
	      (SETKNOWN
 SET1))
	    ((fetch
 KNOWN of
 SET1)
	      (SETKNOWN
 SET2)))
          (replace
 REP of
 SET1 with
 (COND
				      ((AND (EQ C (QUOTE AND))
					    (NULL (fetch
 REP of
 SET1)))
					(fetch
 REP of
 SET2))
				      ((AND (EQ C (QUOTE AND))
					    (NULL (fetch
 REP of
 SET2)))
					(fetch
 REP of
 SET1))
				      (T (create
 CSET
						 ID ← C
						 SET1 ←(create
 SETPHRASE using
 SET1)
						 SET2 ← SET2)))))
    SET1))

(BLOCKER

  (LAMBDA NIL                                               (* lmm " 2-DEC-78 16:17")

    (SEEKWORD
 ANY THE A AN)
    (PROG (TYPES FNS FILES)
          (SETQ TYPES (OR (SEEKTYPE
 (QUOTE BLOCKS))
			  (RETURN)))
          (COND
	    ((SEEKWORD
 OF)
	      (SETQ FNS (OR (SEEK
 SETPHRASE FNS)
			    (RETURN)))))
          (COND
	    ((SEEKWORD
 ON)
	      (SETQ FILES (OR (SEEK
 SETPHRASE FILES)
			      (RETURN)))
	      (OR FNS (AND (SEEKWORD
 OF)
			   (SETQ FNS (OR (SEEK
 SETPHRASE FNS)
					 (RETURN)))))))
          (OR FNS FILES (RETURN))
          (RETURN (create
 BLOCKS
			  TYPES ← TYPES
			  FNS ← FNS
			  FILES ← FILES)))))

(PATHOPTIONS

  (LAMBDA (FLG)                                             (* lmm "23-DEC-78 15:19")

    (while
 (SEEKTYPE
 (QUOTE PATH)) collect
 (CONS LASTPARSED
						 (OR (SELECTQ LASTPARSED
							      ((OUTPUT LINELENGTH)
								(COND
								  (FLG (printout
 T LASTPARSED 
						 "not meaningful except in a SHOW PATHS command!"
										 T)))
								(EATWORD
))
							      (FROM (SEEK
 SETPHRASE FNS T))
							      (SEEK
 SETPHRASE FNS))
						     (CAN'T
))))))

(MSPARSE

  (LAMBDA (SENTENCE)                                        (* lmm "24-DEC-78 12:54")

    (PROG (NEXTWORD LASTADVERB CONJUNCTIONS VAL RESETS LASTPARSED FLG SEEKING SPELLING RESPELL POSS 
		    PARSED (S SENTENCE)
		    OUTPUTFILE)
      PARSE
          (OR (SETQ VAL (SEEK
 COMMAND))
	      (GO FAIL))
          (COND
	    ((SEEKWORD
 OUTPUT)
	      (SETQ OUTPUTFILE (EATWORD
))))
          (AND (GETNEXTWORD
)
	       (GO FAIL))
          (COND
	    (LASTADVERB (GO FAIL)))
          (FIXUPTYPES
 PARSED)
          (COND
	    (CONJUNCTIONS (for
 X in
 (DREVERSE CONJUNCTIONS)
			     do
 (SETQ POSS (for
 Y in
 (fetch
 POSSIBLES of
 X)
					      when
 (AND (EQ (fetch
 ENDING of
 Y)
							    (fetch
 START of
 X))
							(EQ (CAR (fetch
 SOUGHT of
 Y))
							    (CAR (fetch
 SOUGHT
								    of
 (fetch
 PARSED of
 X)))))
					      collect
 Y))
				(COND
				  ((NULL POSS)
				    (FAIL
))
				  ((CDR POSS)
				    (SETQ POSS (SORT (for
 Y in
 POSS
							collect
 (CONS (MATCHRATING

									(fetch
 (CONJUNCTION PARSED)
									   of
 X)
									Y
									(fetch
 (CONJUNCTION C)
									   of
 X))
								      Y))
						     T))
				    (COND
				      ((EQ (CAAR POSS)
					   (CAADR POSS))
					(printout
 T "ambiguous conjunction, guessing... ")))
				    (SETQ POSS (CDAR POSS)))
				  (T (SETQ POSS (CAR POSS))))
				(SELECTQ (CAR (fetch
 SOUGHT of
 POSS))
					 ((SETPHRASE
 PREDICATE DOESPHRASE)
					   (MSJOINSET
 (fetch
 C of
 X)
						      (fetch
 ITEM of
 POSS)
						      (fetch
 ITEM of
 (fetch
 PARSED of
 X))))
					 (VERB
 (replace
 VPART of
 (fetch
 ITEM of
 POSS)
						  with
 (create
 CVERB
							       C ←(fetch
 C of
 X)
							       VB1 ←(fetch
 VPART
								       of
 (fetch
 ITEM of
 POSS))
							       VB2 ←(fetch
 VPART
								       of
 (fetch
 ITEM
									     of
 (fetch
 PARSED
										   of
 X))))))
					 (SHOULDNT)))))
          (COND
	    (SPELLING                                       (* I.e. succeeded after spelling correction)

		      (LISPXPRIN2 SPELLING T T)
		      (LISPXPRIN1 "->" T)
		      (COND
			((CAR RESPELL)
			  (LISPXPRIN2 (CAR RESPELL)
				      T T)
			  (LISPXSPACES 1 T)))
		      (LISPXPRINT (CADR RESPELL)
				  T T)))
          (RETURN (COND
		    (OUTPUTFILE (CONS (QUOTE OUTPUT)
				      (CONS OUTPUTFILE VAL)))
		    (T VAL)))
      FAIL(COND
	    (NOSPELLFLG (FAIL
))
	    ((NULL SPELLING)
	      (SETQ SPELLING (LIST (LIST SENTENCE)))
	      (GO REPARSE))
	    ((LISTP SPELLING)
	      (for
 X in
 SPELLING when
 (CDR X) do
 (COND
						   ((SETQ RESPELL (MSRESPELL
 (SETQ NEXTWORD
									       (CAAR X))
									     (CAR X)
									     (CDR X)))
						     (SETQ SPELLING NEXTWORD)
						     (GO REPARSE))))
	                                                    (* That didn't work, try to respell things as adverbs)

	      (for
 X in
 SPELLING when
 (CDR X) do
 (COND
						   ((SETQ RESPELL (MSRESPELL
 (SETQ SPELLING
									       (CAAR X))
									     (CAR X)
									     (MSSPLST
)))
						     (GO REPARSE))))
	                                                    (* If can't, fall through)

	      (FAIL
))
	    (T (COND
		 ((CAR RESPELL)
		   (FRPLNODE RESPELL SPELLING (CDDR RESPELL)))
		 (T (FRPLACA (CDR RESPELL)
			     SPELLING)))
	                                                    (* UNDO the spelling correcting since it was wrong)

	       (FAIL
)))
      REPARSE
          (SETQ NEXTWORD (SETQ LASTADVERB (SETQ PARSED (SETQ CONJUNCTIONS (SETQ VAL (SETQ RESETS
		      (SETQ LASTPARSED (SETQ SEEKING))))))))
          (SETQ S SENTENCE)
          (GO PARSE))))

(FIXUPTYPES

  (LAMBDA (PRSD FLG)                                        (* lmm "19-NOV-77 21:39")

    (for
 X in
 (REVERSE PRSD)
       do
 (SELECTQ (CAR (fetch
 SOUGHT of
 X))
		   (COMMAND
 (SELECTQ (fetch
 ID of
 (fetch
 (PARSED ITEM) of
 X))
				     ((? EDIT SHOW)
				       (SETSETTYPE
 (fetch
 SUBJECT of
 (fetch
 (PARSED ITEM)
									of
 X))
						   (OR (fetch
 TYPE of
 (fetch
 PREDICATE
									 of
 (fetch
 (PARSED ITEM)
									       of
 X)))
						       (fetch
 DEFAULTTYPE
							  of
 (fetch
 PREDICATE
								of
 (fetch
 (PARSED ITEM) of
 X)))))
				       (SETSETTYPE
 (fetch
 PREDICATE of
 (fetch
 (PARSED ITEM)
									  of
 X))
						   (OR (fetch
 TYPE of
 (fetch
 SUBJECT
									 of
 (fetch
 (PARSED ITEM)
									       of
 X)))
						       (fetch
 DEFAULTTYPE
							  of
 (fetch
 SUBJECT
								of
 (fetch
 (PARSED ITEM) of
 X))))))
				     NIL))
		   ((PREDICATE
 SETPHRASE DOESPHRASE)
		     (COND
		       ((type?
 THAT (fetch
 REP of
 (fetch
 (PARSED ITEM) of
 X)))
			 (FIXVERBSETTYPE
 (fetch
 (PARSED ITEM) of
 X)))
		       ((type?
 NOT (fetch
 REP of
 (fetch
 (PARSED ITEM) of
 X)))
			 (PROG ((NS (fetch
 NEGATED of
 (fetch
 REP of
 (fetch
 (PARSED ITEM)
								       of
 X)))))
			       (COND
				 ((type?
 THAT (fetch
 REP of
 NS))
				   (FIXVERBSETTYPE
 NS)
				   (SETSETTYPE
 (fetch
 (PARSED ITEM) of
 X)
					       (OR (fetch
 TYPE of
 NS)
						   (fetch
 DEFAULTTYPE of
 NS)))
				   (AND (fetch
 KNOWN of
 NS)
					(SETKNOWN
 (fetch
 (PARSED ITEM) of
 X)))))))))
		   NIL))))

(VERBTYPE

  (LAMBDA (VERB
 SUBJECT OBJECT)                             (* lmm "21-SEP-78 05:01")

    (COND
      ((type?
 CVERB (fetch
 VPART of
 VERB))
	(VERBTYPE
 (fetch
 (CVERB VB1) of
 (fetch
 VPART of
 VERB))
		  SUBJECT OBJECT)
	(VERBTYPE
 (fetch
 (CVERB VB2) of
 (fetch
 VPART of
 VERB))
		  SUBJECT OBJECT))
      (T (PROG (TYPE)
	       (COND
		 ((EQ (fetch
 TENSE of
 VERB)
		      (QUOTE ED))
		   (SETQ OBJECT (PROG1 SUBJECT (SETQ SUBJECT OBJECT)))))
	       (SETQ TYPE (OR (fetch
 TYPE of
 OBJECT)
			      (fetch
 DEFAULTTYPE of
 OBJECT)))
	       (SELECTQ (fetch
 (VERB
 ROOT) of
 VERB)
			(CONTAIN (SETSETTYPE
 SUBJECT (QUOTE FILES)))
			((USE SET REFERENCE SMASH TEST)
			  (SELECTQ (fetch
 (VERB
 MODIFIER) of
 VERB)
				   (NIL (AND (EQMEMB (fetch
 (VERB
 ROOT) of
 VERB)
						     (CDR (GETWORDTYPE TYPE (QUOTE AS))))
					     (replace
 (VERB
 MODIFIER) of
 VERB with
 TYPE)))
				   ((FREELY LOCALLY)
				     (SETSETTYPE
 OBJECT (QUOTE VARS)))
				   (SETSETTYPE
 OBJECT (fetch
 (VERB
 MODIFIER) of
 VERB)))
			  (SETKNOWN
 SUBJECT))
			(CALL (SETKNOWN
 SUBJECT)
			      (SETSETTYPE
 OBJECT (QUOTE FNS)))
			(CREATE (SETKNOWN
 SUBJECT)
				(SETSETTYPE
 OBJECT (QUOTE RECORDS)))
			((FETCH
 REPLACE
)
			  (SETKNOWN
 SUBJECT)
			  (SETSETTYPE
 OBJECT (QUOTE FIELDS)))
			(PROGN (SETKNOWN
 SUBJECT)
			       (SETSETTYPE
 OBJECT (QUOTE VARS)))))))))

(SETREP

  (LAMBDA (LISTOKFLG)                                       (* lmm "24-DEC-78 14:45")

    (PROG ((NEG (SEEKWORD
 NOT))
	   (VAL (COND
		  ((NULL S)
		    NIL)
		  ((SEEKWORD
 IN)
		    (OR (SEEK
 BLOCKER)
			(create
 IN
				EXPRESSION ←(EATWORD
))))
		  ((SEEKWORD
 ' QUOTE)
		    (QUOTEDWORD
))
		  ((SEEKWORD
 @)
		    (create
 APPLY
			    PRED ←(PROG ((X (EATWORD
)))
				        (RETURN (COND
						  ((NLISTP X)
						    X)
						  ((EQ (CAR X)
						       (QUOTE LAMBDA))
						    X)
						  (T (LIST (QUOTE LAMBDA)
							   (QUOTE (X))
							   X)))))))
		  ((SEEKWORD
 ONPATH)
		    (create
 PATHS
			    PATHOPTIONS ←(OR (SEEK
 PATHOPTIONS T)
					     (CAN'T
))))
		  ((SEEK
 VERB ING)
		    (create
 THAT
			    VERB ← LASTPARSED
			    OTHERSET ←(OR (SEEK
 SETPHRASE)
					  (CAN'T
))))
		  ((SEEK
 VERBED))
		  ((AND (EQ SETTYPE (QUOTE FIELDS))
			(SEEKWORD
 OF))
		    (create
 FIELDS
			    RECS ←(OR (SEEK
 SETPHRASE RECORDS)
				      (CAN'T
))))
		  ((SEEKWORD
 LIKE)
		    (create
 APPLY
			    PRED ←(PROG ((PAT (EDITFPAT (EATWORD
))))
				        (SETQ EDITQUIETFLG T)
				        (RETURN (LIST (QUOTE LAMBDA)
						      (QUOTE (X))
						      (LIST (QUOTE EDIT4E)
							    (KWOTE PAT)
							    (QUOTE X)))))))
		  ((SEEKWORD
 THOSE)
		    (create
 IN
			    EXPRESSION ←(QUOTE MSTHOSE)))
		  ((SEEKWORD
 KNOWN)
		    (create
 THAT
			    VERB ←(create
 VERB
					  ROOT ←(QUOTE IS
)
					  MODIFIER ←(QUOTE KNOWN))
			    OTHERSET ←(create
 SETPHRASE)))
		  ((AND LISTOKFLG (NOTANY S (FUNCTION MSWORD?)))
		    (PROG1 (create
 QUOTE
				   QUOTED ← S)
			   (SETQ S)))
		  ((SEEK
 BLOCKER))
		  ((OR (SEEKWORD
 THAT)
		       (AND (OR SETDET SETTYPE)
			    (SEEKWORD
 WHO WHICH)))
		    (fetch
 REP of
 (OR (SEEK
 PREDICATE)
				      (CAN'T
))))
		  ((COND
		      ((EQ SETDET (QUOTE THE)))
		      ((AND (NULL SETDET)
			    (OR (NULL SETTYPE)
				(LISTP SETTYPE)))
			(COND
			  ((MSWORD?
 (GETNEXTWORD
))
			    (AND (LISTP SPELLING)
				 (MSTRYSPELL
 (CONS (CAR S)
						   (KWOTE (CAR S)))
					     S))
			    NIL)
			  (T T))))
		    (QUOTEDWORD
)))))
          (RETURN (COND
		    (NEG (create
 NOT
				 NEGATED ←(create
 SETPHRASE
						  REP ← VAL)))
		    (T VAL))))))

(MSSEEKPHRASE

  (LAMBDA (SOUGHT FORCONJUNCTION)                           (* lmm " 2-DEC-78 16:39")

    (PROG ((OS S)
	   (OLA LASTADVERB)
	   (ORS RESETS)
	   (OC CONJUNCTIONS)
	   (OP PARSED)
	   THIS
	   (SEEKING (CONS (create
 PARSED
				  SOUGHT ← SOUGHT)
			  SEEKING)))
          (SETQ THIS (CAR SEEKING))
          (SETQ LASTPARSED)
      LP  (COND
	    ((LISTP (GETNEXTWORD
))
	      (COND
		((PROG ((S (GETNEXTWORD
))
			(SEEKING))
		       (RETURN (AND (SETQ LASTPARSED (MSSEEKPHRASE
 (COND
								     ((EQ (CAR SOUGHT)
									  (QUOTE SETREP))
								       (LIST (QUOTE SETREP)
									     T))
								     (T SOUGHT))))
				    (NOT (GETNEXTWORD
)))))
		  (SETQ S (CDR S))
		  (GO GOTIT)))))
          (OR (SETQ LASTPARSED (MSTRYPARSE
 (CAR SOUGHT)
					   (CDR SOUGHT)))
	      (GO FAIL))
      GOTIT
          (replace
 ITEM of
 THIS with
 LASTPARSED)
          (SETQ PARSED (CONS THIS PARSED))
          (COND
	    ((AND (NOT FORCONJUNCTION)
		  (FMEMB (CAR SOUGHT)
			 CONJUNCTABLE))
	      (PROG (LASTPARSED OLDS TEM C (SK SEEKING)
				(MARKER (CONS)))
		LP  (GETNEXTWORD
)                           (* So that S won't be reset to something before a 

							    adverb)

		    (SETQ OLDS S)
		    (COND
		      ((SETQ C (SEEKTYPE
 (QUOTE C)))
			(COND
			  ((EQ C (QUOTE AND))
			    (AND (SEEKWORD
 NOT)
				 (SETQQ C ANDNOT))))
			(COND
			  ((SETQ TEM (MSSEEKPHRASE
 (COND
						     ((EQ (CAR SOUGHT)
							  (QUOTE SETPHRASE))
						            (* kludge. Implicit types should not carry along)

						       (QUOTE (SETPHRASE
)))
						     (T SOUGHT))
						   T))
			    (SETQ CONJUNCTIONS (CONS (create
 CONJUNCTION
							     C ← C
							     PARSED ←(CAR PARSED)
							     POSSIBLES ← SK
							     START ← MARKER)
						     CONJUNCTIONS))
			    (GO LP))
			  (T (SETQ S OLDS)))))
		    (for
 X in
 CONJUNCTIONS when
 (EQ (fetch
 START of
 X)
						    MARKER)
		       do
 (replace
 START of
 X with
 S)))))
          (replace
 ENDING of
 THIS with
 S)
          (RETURN LASTPARSED)
      FAIL(SETQ S OS)
          (SETQ LASTADVERB OLA)
          (SETQ CONJUNCTIONS OC)
          (SETQ PARSED OP)
          (while
 (NEQ RESETS ORS) do
 (replace
 (VERB
 MODIFIER) of
 (CAR RESETS) with
 NIL)
				     (SETQ RESETS (CDR RESETS))))))

(TYPEMATCHRATING

  (LAMBDA (X Y)                                             (* lmm "19-SEP-78 05:40")

                                                            (* Returns the NEGATIVE of a rating of how much two 

							    types agree; the values will be sorted and the minimum 

							    taken)

    (COND
      ((OR (NULL X)
	   (NULL Y)
	   (EQ (COND
		 ((LISTP X)
		   (SETQ X (CAR X)))
		 (T X))
	       (COND
		 ((LISTP Y)
		   (SETQ Y (CAR Y)))
		 (T Y)))
	   (AND (EQ X (QUOTE KNOWN))
		(EQ Y (QUOTE FNS)))
	   (AND (EQ Y (QUOTE KNOWN))
		(EQ X (QUOTE FNS))))
	-100)
      (T 0))))

(MSTRYSPELL

  (LAMBDA (WORD TAIL)                                       (* lmm "21-SEP-78 05:28")

    (AND TAIL (NLISTP (CAR TAIL))
	 (LISTP SPELLING)
	 (PROG ((PTR (OR (FASSOC TAIL SPELLING)
			 (CAR (SETQ SPELLING (CONS (LIST TAIL)
						   SPELLING))))))
	   LP  (COND
		 ((NULL (CDR PTR))
		   (FRPLACD PTR (LIST WORD)))
		 ((NEQ (CAR (SETQ PTR (CDR PTR)))
		       WORD)
		   (GO LP)))))
    NIL))

(MSTRYPARSE

  (LAMBDA (FN ARGS)                                         (* lmm: 17-FEB-76 20 49)


          (* CAN'T does a RETFROM (MSTRYPARSE). The idea is that, no matter how deeply embedded parser is in a particular 

	  SEEK, the CAN'T will back up to the current att)



    (BLKAPPLY FN ARGS)))

(COMMAND

  [LAMBDA (TEM)                                              (* lmm "15-Aug-84 00:39")

    (COND
      ((SEEKWORD
 DESCRIBE)
	(CONS LASTPARSED (SEEK
 SETPHRASE FNS T)))
      ((SEEKWORD
 ANALYZE REANALYZE)
	(CONS LASTPARSED (SEEK
 SETPHRASE FNS)))
      ((SEEKWORD
 ERASE FORGET)
	(CONS (QUOTE ERASE)
	      (SEEK
 SETPHRASE FNS)))
      [(SEEKWORD
 SHOW)
	(COND
	  ((SEEKWORD
 PATHS)
	    (CONS (QUOTE PATHS)
		  (SEEK
 PATHOPTIONS)))
	  [(SEEK
 VERB S)                                     (* e.g. SHOW USE OF X)

	    (create
 SENTENCE
		    ID ←(QUOTE SHOW)
		    PREDICATE ←(create
 SETPHRASE
				       REP ←(create
 THAT
						    VERB ← LASTPARSED
						    OTHERSET ←(PROGN (OR (SEEKWORD
 OF)
									 (CAN'T
))
								     (OR (SEEK
 SETPHRASE)
									 (CAN'T
]
	  (T (SEEKWORD
 WHERE)
	     (create
 SENTENCE
		     ID ←(QUOTE SHOW)
		     SUBJECT ←(OR (SEEK
 SETPHRASE)
				  (CAN'T
))
		     PREDICATE ←(SEEK
 PREDICATE]
      [(SEEKWORD
 EDIT)
	(SEEKWORD
 WHERE)
	(create
 SENTENCE
		ID ←(QUOTE EDIT)
		SUBJECT ←(OR (SEEK
 SETPHRASE)
			     (CAN'T
))
		PREDICATE ←(SEEK
 PREDICATE)
		OTHERSTUFF ←(COND
		  ((SEEKWORD
 -)
		    (PROG1 S (SETQ S]
      [(SEEKWORD
 FOR)
	(CONS (QUOTE FOR)
	      (CONS (EATWORD
)
		    (CONS (QUOTE IN)
			  (CONS (OR (SEEK
 SETPHRASE)
				    (CAN'T
))
				(COND
				  ((EQ (CAR (GETP (CAR S)
						  (QUOTE CLISPWORD)))
				       (QUOTE FORWORD))
				    (PROG1 S (SETQ S NIL)))
				  (T (CAN'T
]
      ((SEEKWORD
 CHECK)
	(SEEKWORD
 BLOCKS)
	(SEEKWORD
 ON)
	(CONS (QUOTE CHECK)
	      (SEEK
 SETPHRASE FILES)))
      [(SEEKWORD
 ARE IS)                                     (* IS FOO CALLED BY X)

	(create
 SENTENCE
		ID ←(QUOTE ?)
		SUBJECT ←(OR (SEEK
 SETPHRASE)
			     (CAN'T
))
		PREDICATE ←(OR (MSSEEKPHRASE
 (LIST (QUOTE SETPHRASE)
						   (fetch
 TYPE of
 LASTPARSED)
						   (fetch
 KNOWN of
 LASTPARSED)))
			       (CAN'T
]
      ((PROGN (SETQ TEM (SEEKWORD
 DOES DO))
	      (SEEK
 SETPHRASE))
	(create
 SENTENCE
		ID ←(QUOTE ?)
		SUBJECT ← LASTPARSED
		PREDICATE ←(PROG ((TYPE (fetch
 TYPE of
 LASTPARSED))
				  (KNOWN (fetch
 KNOWN of
 LASTPARSED))
				  SET)
			         (SETQ SET (OR (SEEK
 PREDICATE)
					       (AND (NOT TEM)
						    (SEEK
 DOESPHRASE))
					       (CAN'T
)))
			         (COND
				   (KNOWN (SETKNOWN
 SET))
				   (TYPE (SETSETTYPE
 SET TYPE)))
			         (RETURN SET])

(SUBJTYPE

  (LAMBDA (VERB
)                                            (* lmm: 16-DEC-75 1 41)

    (COND
      ((type?
 CVERB (fetch
 VPART of
 VERB))
	(JOINTYPES
 (fetch
 (CVERB C) of
 (fetch
 VPART of
 VERB))
		   (SUBJTYPE
 (fetch
 (CVERB VB1) of
 (fetch
 VPART of
 VERB)))
		   (SUBJTYPE
 (fetch
 (CVERB VB2) of
 (fetch
 VPART of
 VERB)))))
      ((EQ (fetch
 (VERB
 ROOT) of
 VERB)
	   (QUOTE CONTAIN))
	(QUOTE FILES))
      (T (QUOTE KNOWN)))))

(OBJTYPE

  (LAMBDA (VERB
)                                            (* lmm "24-DEC-78 12:53")

    (COND
      ((type?
 CVERB (fetch
 VPART of
 VERB))
	(JOINTYPES
 (fetch
 (CVERB C) of
 (fetch
 VPART of
 VERB))
		   (OBJTYPE
 (fetch
 (CVERB VB1) of
 (fetch
 VPART of
 VERB)))
		   (OBJTYPE
 (fetch
 (CVERB VB2) of
 (fetch
 VPART of
 VERB)))))
      ((EQ (fetch
 (VERB
 ROOT) of
 VERB)
	   (QUOTE CALL))
	(QUOTE (FNS)))
      ((EQ (fetch
 (VERB
 ROOT) of
 VERB)
	   (QUOTE CONTAIN))
	NIL)
      ((EQ (fetch
 (VERB
 ROOT) of
 VERB)
	   (QUOTE USE))
	(SELECTQ (fetch
 (VERB
 MODIFIER) of
 VERB)
		 ((FREELY LOCALLY NIL)
		   (QUOTE (VARS)))
		 ((RECORDS FIELDS PROPNAMES I.S.OPRS)
		   (LIST (fetch
 (VERB
 MODIFIER) of
 VERB)))
		 (SHOULDNT)))
      (T (QUOTE (VARS))))))

(VERB

  (LAMBDA (TENSE)                                           (* lmm "23-SEP-78 03:39")

    (PROG ((ROOT (SEEKTYPE
 TENSE))
	   C)
          (COND
	    ((NULL ROOT)
	      (COND
		((AND (EQ TENSE (QUOTE ED))
		      (SEEKWORD
 ON))
		  (SETQ S (CONS (QUOTE BY)
				S))
		  (SETQQ ROOT CONTAIN))
		(T (RETURN)))))
          (RETURN (create
 VERB
			  ROOT ← ROOT
			  TENSE ← TENSE
			  MODIFIER ←(COND
			    ((AND LASTADVERB (FMEMB ROOT (CDR LASTADVERB)))
			      (PROG1 (CAR LASTADVERB)
				     (SETQ LASTADVERB NIL)))))))))

(MSSPLST

  (LAMBDA NIL                                               (* lmm "23-DEC-78 15:16")

    (OR MSSPLST (PROGN (SETQ MSSPLST (QUOTE (AS FOR)))
		       (MAPHASH MSWORDS (FUNCTION (LAMBDA (MEANING WORD)
				    (AND (find
 Y in
 MEANING suchthat
 (FMEMB (CAR Y)
									    (QUOTE (V PHRASE))))
					 (SETQ MSSPLST (CONS WORD MSSPLST))))))
		       MSSPLST))))

(MSWORD?

  (LAMBDA (X)                                               (* lmm "23-DEC-78 15:15")

                                                            (* lmm: 24-JAN-76 6 14)

    (OR (NOT (LITATOM X))
	(GETHASH X MSWORDS))))

(SEEKTYPE

  (LAMBDA (TYPE)                                            (* lmm: 24-JAN-76 6 45)

    (COND
      ((SETQ LASTPARSED (GETWORDTYPE (GETNEXTWORD
)
				     TYPE))
	(SETQ S (CDR S))
	LASTPARSED)
      ((LISTP SPELLING)
	(TRYSPELLTYPE
 TYPE)))))

(MSRESPELL

  (LAMBDA (WORD TAIL SPLST)                                 (* lmm: 22-FEB-76 3 6)

    (AND (LITATOM WORD)
	 WORD
	 (SETQ SPLST (CHOOZ WORD 70 SPLST TAIL))
	 (COND
	   ((LITATOM SPLST)
	     (COND
	       ((NEQ SPLST WORD)
		 (SETQ SPLST (CONS NIL (FRPLACA TAIL SPLST))))))
	   ((LISTP (CDR SPLST))
	                                                    (* Alias)

	     (SETQ SPLST (CONS NIL (FRPLACA TAIL (CAR (FLAST SPLST))))))
	   ((CAR SPLST)
	     (SETQ SPLST (FRPLNODE TAIL (CAR SPLST)
				   (CONS (CDR SPLST)
					 (CDR TAIL))))))
	 SPLST)))

(JOINTYPES

  (LAMBDA (C X Y)                                           (* lmm "21-SEP-78 05:23")

    (COND
      ((OR (EQ X Y)
	   (NULL Y))
	X)
      ((NULL X)
	Y)
      (T (UNION (MKLIST X)
		(MKLIST Y))))))

(SIMPLESET

  (LAMBDA (X)                                               (* lmm "31-JUL-78 03:19")

    (OR (NULL X)
	(AND (EQ (fetch
 ID of
 X)
		 (QUOTE QUOTE))
	     (OR (NLISTP (fetch
 QUOTED of
 X))
		 (NULL (CDR (fetch
 QUOTED of
 X))))))))

(MATCHRATING

  (LAMBDA (X Y CONJ)                                        (* lmm "21-SEP-78 05:37")

    (IPLUS (COND
	     ((EQUAL (fetch
 SOUGHT of
 X)
		     (fetch
 SOUGHT of
 Y))
	       -200)
	     (T 0))
	   (SELECTQ (CAR (fetch
 SOUGHT of
 X))
		    (VERB
 (COND
			    ((EQUAL (CDR (fetch
 SOUGHT of
 X))
				    (CDR (fetch
 SOUGHT of
 Y)))
			      (IPLUS (TYPEMATCHRATING
 (SUBJTYPE
 (fetch
 ITEM of
 X))
						      (SUBJTYPE
 (fetch
 ITEM of
 Y)))
				     (TYPEMATCHRATING
 (OBJTYPE
 (fetch
 ITEM of
 X))
						      (OBJTYPE
 (fetch
 ITEM of
 Y)))))
			    (T 100)))
		    (SETPHRASE
 (IPLUS (COND
					((EQUAL (fetch
 TYPE of
 (fetch
 ITEM of
 X))
						(fetch
 TYPE of
 (fetch
 ITEM of
 Y)))
					  -100)
					(T 0))
				      (COND
					((OR (SIMPLESET
 (fetch
 REP of
 (fetch
 ITEM of
 X)))
					     (SIMPLESET
 (fetch
 REP of
 (fetch
 ITEM of
 Y))))
					  (SELECTQ CONJ
						   (OR 50)
						   600))
					(T 0))))
		    T))))

(SEEK

  (NLAMBDA SOUGHT                                           (* lmm " 8-AUG-77 06:31")

    (MSSEEKPHRASE
 SOUGHT)))

(VERBED

  (LAMBDA NIL                                               (* lmm "19-NOV-77 21:29")

                                                            (* Handled separately SOLELY for the verb SET, which is 

							    both present and past tense)

    (AND (SEEK
 VERB ED)
	 (create
 THAT
		 VERB ← LASTPARSED
		 OTHERSET ←(COND
		   ((SEEKWORD
 BY IN)
		     (OR (SEEK
 SETPHRASE)
			 (CAN'T
)))
		   ((GETNEXTWORD
)
		     (CAN'T
))
		   (T                                       (* Setphrase of ANY)

		      (create
 SETPHRASE
			      DET ←(QUOTE ANY))))))))

(CAN'T

  (LAMBDA NIL                                               (* lmm " 8-AUG-77 08:28")

    (RETFROM (QUOTE MSTRYPARSE))))

(JOINDETS

  (LAMBDA (C X Y)                                           (* lmm "24-DEC-78 12:53")

    (COND
      ((NULL X)
	Y)
      ((NULL Y)
	X)
      ((EQ X Y)
	X)
      ((OR (EQ X (QUOTE WHICH))
	   (EQ Y (QUOTE WHICH)))
	(QUOTE WHICH))
      (T (SHOULDNT)))))

(NEGATESET

  (LAMBDA (X)                                               (* lmm "21-SEP-78 05:39")

    (replace
 (SETPHRASE
 REP) of
 X with
 (create
 NOT
					       NEGATED ←(create
 SETPHRASE using
 X REP ←(fetch

										  (SETPHRASE
 REP)
											  of
 X))))))

(GETNEXTWORD

  (LAMBDA NIL                                               (* lmm "22-OCT-78 15:39")

                                                            (* lmm: 16-MAR-76 15 8)

    (PROG (TEM ADV)
      LPX (COND
	    ((EQ NEXTWORD S)
	      (RETURN (CAR NEXTWORD))))
          (COND
	    ((NULL (CAR S))
	                                                    (* i.e. either at end of sentence or at a NIL)

	      (RETURN NIL)))
          (COND
	    ((NEQ S SENTENCE)
	                                                    (* No adverbs or AS words allowed at beginning of 

							    sentence)

	      (COND
		((SETQ TEM (GETWORDTYPE (CAR S)
					(QUOTE V)))
		                                            (* V means ADVERB)

		  (SETQ ADV (CAR TEM))
		  (GO ADV)))
	      (SELECTQ (SETQ TEM (CAR S))
		       ((AS
 FOR
)
			 (SELECTQ (CAR (SETQ S (CDR S)))
				  ((A AN)
				                            (* Skip over A and AN)

				    (SETQ S (CDR S)))
				  NIL)
			 (CHECKSYNONYM
)
			 (SETQ TEM (OR (GETWORDTYPE (CAR S)
						    TEM)
				       (COND
					 ((AND (EQ TEM (QUOTE AS))
					       (SOME PARSED (FUNCTION (LAMBDA (X)
							 (EQ (CAR (fetch
 (PARSED SOUGHT)
								     of
 X))
							     (QUOTE VERB))
							 (EQ (fetch
 (VERB
 ROOT)
								of
 (fetch
 (PARSED ITEM) of
 X))
							     (QUOTE CONTAIN)))))
					       (SETQ TEM (GETFILEPKGTYPE (CAR S)
									 NIL T)))
					   (SETWORDTYPE
 (CAR S)
							(QUOTE AS)
							(SETQ TEM (CONS TEM (QUOTE (CONTAIN)))))
					   TEM)
					 (T (FAIL
 T)))))
			 (SETQ ADV (CAR TEM))
			 (GO ADV))
		       NIL)))
          (COND
	    ((CHECKSYNONYM
)
	      (GO LPX)))
          (RETURN (CAR (SETQ NEXTWORD S)))
      ADV (SETQ TEM (CDR TEM))
          (SETQ S (CDR S))
          (for
 X in
 PARSED when
 (AND (EQ (CAR (fetch
 (PARSED SOUGHT) of
 X))
					 (QUOTE VERB))
				     (NULL (fetch
 (VERB
 MODIFIER) of
 (fetch
 (PARSED ITEM)
									of
 X)))
				     (FMEMB (fetch
 (VERB
 ROOT) of
 (fetch
 (PARSED ITEM) of
 X))
					    TEM))
	     do
 (replace
 (VERB
 MODIFIER) of
 (fetch
 (PARSED ITEM) of
 X) with
 ADV)
		(SETQ RESETS (CONS (fetch
 (PARSED ITEM) of
 X)
				   RESETS))
		(GO LPX))
          (COND
	    (LASTADVERB (FAIL
 T))
	    (T (SETQ LASTADVERB (CONS ADV TEM))))
          (GO LPX))))

(PREDICATE

  (LAMBDA (FLG)                                             (* lmm "19-NOV-77 21:39")

                                                            (* FLG is used in calls from EDIT/SHOW where passive is 

							    not allowed)

    (AND (SEEKWORD
 DOES
 DO
)
	 (SETQ FLG T))
    (COND
      ((SEEKWORD
 NOT)
	(create
 SETPHRASE
		REP ←(create
 NOT
			     NEGATED ←(create
 SETPHRASE
					      REP ←(create
 THAT
							   VERB ←(OR (SEEK
 VERB S)
								     (CAN'T
))
							   OTHERSET ←(OR (SEEK
 SETPHRASE)
									 (CAN'T
)))))))
      ((SEEK
 VERB S)
	(create
 SETPHRASE
		REP ←(create
 THAT
			     VERB ← LASTPARSED
			     OTHERSET ←(OR (SEEK
 SETPHRASE)
					   (CAN'T
)))))
      ((AND (NULL FLG)
	    (SEEKWORD
 ARE
 IS
))
	(SEEK
 SETPHRASE)))))

(CHECKSYNONYM

  (LAMBDA NIL                                               (* lmm "15-JUL-78 02:40")

                                                            (* lmm: 22-FEB-76 3 10)

                                                            (* Returns T if a synonym is found.

							    Resets S to be sentence with synonym substituted)

    (PROG (KEYLST (STAIL S)
		  NXT
		  (CNT 0))
          (COND
	    ((NOT (SETQ KEYLST (GETWORDTYPE (CAR S)
					    (QUOTE PHRASE))))
	      (RETURN)))                                    (* See SETSYNONYM for def of synonym format)

      PHLOOP
          (SETQ STAIL (CDR STAIL))
      LPX (COND
	    ((SETQ NXT (FASSOC (CAR STAIL)
			       (CDR KEYLST)))
	      (SETQ KEYLST (CDR NXT))
	      (GO PHLOOP))
	    ((CAR KEYLST)
	      (RETURN (NOT (EQUAL S (SETQ S (APPEND (CAR KEYLST)
						    STAIL))))))
	    ((SETQ NXT (FASSOC (QUOTE &)
			       (CDR KEYLST)))
	      

          (* A & in a synonym will match any word; the word will be substituted for N in the "new" phrase where N is the 

	  number of &'s which have been matched -

	  e.g. SETSYNONYM ((FOO & &) (IN 1 OR ON 2)) will take FOO FIE FUM into IN FIE OR ON FUM)



	      (SETQ KEYLST (SUBST (CAR STAIL)
				  (SETQ CNT (ADD1 CNT))
				  (CDR NXT)))
	      (GO PHLOOP))
	    ((SETQ NXT (FASSOC (QUOTE *)
			       (CDR KEYLST)))
	                                                    (* Just to make a lot of things easier, a * will match 

							    either (NAME) (NAMES) or nothing)

	      (SETQ KEYLST (CDR NXT))
	      (COND
		((OR (EQ (CAR STAIL)
			 (QUOTE NAME))
		     (EQ (CAR STAIL)
			 (QUOTE NAMES)))
		  (SETQ STAIL (CDR STAIL))))
	      (GO LPX))
	    (T                                              (* If some words match and others don't, try to correct 

							    on the rest)

	       (AND (LISTP STAIL)
		    (LISTP SPELLING)
		    (NOT (MSWORD?
 (CAR STAIL)))
		    (MAPC (CDR KEYLST)
			  (FUNCTION (LAMBDA (X)
			      (MSTRYSPELL
 X STAIL)))))
	       (RETURN))))))

(SEEKWORD

  (NLAMBDA LST                                              (* lmm "15-JUL-78 02:40")

    (COND
      ((FMEMB (GETNEXTWORD
)
	      LST)
	(SETQ LASTPARSED (CAR S))
	(SETQ S (CDR S))
	LASTPARSED)
      ((AND (LISTP SPELLING)
	    (LISTP S)
	    (NOT (MSWORD?
 (CAR S))))
	(MAPC LST (FUNCTION (LAMBDA (WORD)
		  (MSTRYSPELL
 WORD S))))))))

(SETWORDTYPE

  (LAMBDA (WORD TYPE SYN)                                   (* lmm "24-DEC-78 12:50")

    (PUTHASH WORD (NCONC1 (GETHASH WORD MSWORDS)
			  (CONS TYPE SYN))
	     MSWORDS)))

(EATWORD

  (LAMBDA NIL                                               (* lmm: 5-DEC-75 11 24)

    (PROG1 (CAR S)
	   (SETQ S (CDR S)))))

(TRYSPELLTYPE

  (LAMBDA (TYPE)                                            (* lmm "23-DEC-78 15:16")

    (DECLARE
 (SPECVARS TYPE))
    (AND (LISTP SPELLING)
	 (LITATOM (CAR S))
	 (NOT (MSWORD?
 (CAR S)))
	 (MAPHASH MSWORDS (FUNCTION (LAMBDA (INTERP WORD)
		      (AND (FASSOC TYPE INTERP)
			   (MSTRYSPELL
 WORD S))))))
    NIL))

(SETPHRASE

  (LAMBDA (TYPE KNOWN)                                      (* lmm "19-NOV-77 18:22")

    (PROG (SETDET REP NOTYP SETTYPE VAL (NEG (SEEKWORD
 NOT)))
          (SETQ VAL (SETSETTYPE
 (create
 SETPHRASE
					DET ←(SETQ SETDET (COND
					    ((SETQ NOTYP (SEEKWORD
 WHO WHOM))
					      (QUOTE WHICH))
					    ((SEEKWORD
 WHAT WHICH)
					      (QUOTE WHICH))
					    (T (SEEKWORD
 ANY THE A))))
					TYPE ←(SETQ SETTYPE (AND (NOT NOTYP)
								 (SEEKTYPE
 (QUOTE TYPE))))
					REP ←(SETQ REP (SEEK
 SETREP))
					KNOWN ← KNOWN)
				TYPE))
          (OR SETDET SETTYPE REP (CAN'T
))
          (AND NEG (NEGATESET
 VAL))
          (RETURN VAL))))

(QUOTEDWORD

  (LAMBDA NIL                                               (* lmm "25-JUN-78 01:00")

    (create
 QUOTE
	    QUOTED ←(MKLIST (EATWORD
)))))

(FIXVERBSETTYPE

  (LAMBDA (SETPHRSE)                                        (* lmm: 16-MAR-76 15 31)

    (COND
      ((NULL (fetch
 TYPE of
 SETPHRSE))
	(VERBTYPE
 (fetch
 VERB of
 (fetch
 REP of
 SETPHRSE))
		  SETPHRSE
		  (fetch
 OTHERSET of
 (fetch
 REP of
 SETPHRSE)))))))

(SETSYNONYM

  (LAMBDA (OLDPHRASE NEWPHRASE FLG)                         (* lmm "24-DEC-78 12:52")

    (OR (LISTP OLDPHRASE)
	(SETQ OLDPHRASE (LIST OLDPHRASE)))
    (AND NEWPHRASE (OR (LISTP NEWPHRASE)
		       (SETQ NEWPHRASE (LIST NEWPHRASE))))
    (OR (ATOM (CAR OLDPHRASE))
	(ERRORX (LIST 14 (CAR OLDPHRASE))))
    (PROG ((KEYLST (GETWORDTYPE (CAR OLDPHRASE)
				(QUOTE PHRASE)))
	   NXT)                                             (* The keylist is of the form 

							    (VALUE (WORD . KEYLST) (WORD . KEYLST) ...))

          (COND
	    ((NULL KEYLST)
	      (SETWORDTYPE
 (CAR OLDPHRASE)
			   (QUOTE PHRASE)
			   (SETQ KEYLST (LIST NIL)))))
      LP  (COND
	    ((NLISTP KEYLST)
	      (SHOULDNT))
	    ((NULL (SETQ OLDPHRASE (CDR OLDPHRASE)))
	      (FRPLACA KEYLST NEWPHRASE)
	      (RETURN))
	    ((SETQ NXT (FASSOC (CAR OLDPHRASE)
			       KEYLST))
	      (SETQ KEYLST (CDR NXT)))
	    (T (FRPLACD KEYLST (CONS (CONS (CAR OLDPHRASE)
					   (SETQ NXT (LIST NIL)))
				     (CDR KEYLST)))
	       (SETQ KEYLST NXT)))
          (GO LP))))

(MSSETUP

  [LAMBDA (V A AS F SYN TYPES OTHERS INITFLG)                (* lmm "26-Sep-84 15:07")

    (
OR
 (
AND
 (
NULL
 INITFLG)
	     (
HASHARRAYP
 MSWORDS))
	(
SETQ
 MSWORDS (
HASHARRAY
 150)))
    [
MAPC
 V (
FUNCTION
 (LAMBDA (X)
	      (SETWORDTYPE
 (
CAR
 X)
			   (
QUOTE
 S)
			   (
CAR
 X))
	      (SETWORDTYPE
 (
CADR
 X)
			   (
QUOTE
 S)
			   (
CAR
 X))
	      (SETWORDTYPE
 (
CADDR
 X)
			   (
QUOTE
 ING)
			   (
CAR
 X))
	      (SETWORDTYPE
 (
CADDDR
 X)
			   (
QUOTE
 ED)
			   (
CAR
 X]
    [
MAPC
 A (
FUNCTION
 (LAMBDA (X P)
	      (
SETQ
 P (
CONS
 (
CAAR
 X)
			    (
CDR
 X)))
	      (
MAPC
 (
CAR
 X)
		    (
FUNCTION
 (LAMBDA (Y)
			(SETWORDTYPE
 Y (
QUOTE
 V)
				     P]
    [
MAPC
 AS (
FUNCTION
 (LAMBDA (X P)
	      (
SETQ
 P (
CONS
 (
CAAR
 X)
			    (
CDR
 X)))
	      (
MAPC
 (
CAR
 X)
		    (
FUNCTION
 (LAMBDA (Y)
			(SETWORDTYPE
 Y (
QUOTE
 AS)
				     P]
    [
MAPC
 F (
FUNCTION
 (LAMBDA (X P)
	      (
SETQ
 P (
CONS
 (
CAAR
 X)
			    (
CDR
 X)))
	      (
MAPC
 (
CAR
 X)
		    (
FUNCTION
 (LAMBDA (Y)
			(SETWORDTYPE
 Y (
QUOTE
 FOR)
				     P]
    [
MAPC
 SYN (
FUNCTION
 (LAMBDA (X)
	      (SETSYNONYM
 (
CAR
 X)
			  (
CADR
 X)
			  T]
    [
MAPC
 TYPES (
FUNCTION
 (LAMBDA (L)
	      (
MAPC
 L (
FUNCTION
 (LAMBDA (X)
			(SETWORDTYPE
 X (
QUOTE
 TYPE)
				     (
CAR
 L]
    [
MAPC
 OTHERS (
FUNCTION
 (LAMBDA (X)
	      (SETWORDTYPE
 (
CAR
 X)
			   (
CADR
 X)
			   (
OR
 (
CADDR
 X)
			       (
CAR
 X]                       (* I.e. all the things that can occur almost anywhere -

							     synonyms, adverbs, and the word AS)

    NIL])
)
(DECLARE: EVAL@COMPILE DONTCOPY 

(RPAQQ PARSERRECORDS
 (SENTENCE CONJUNCTION PARSED SETPHRASE VERB VPART CVERB THAT QUOTE IN NOT PATHS 
			       APPLY CSET BLOCKS FIELDS))
[DECLARE: EVAL@COMPILE 

(RECORD SENTENCE
 (ID SUBJECT PREDICATE . OTHERSTUFF))

(RECORD CONJUNCTION
 (C START PARSED . POSSIBLES))

(RECORD PARSED
 (SOUGHT ITEM . ENDING))

(RECORD SETPHRASE
 (DET (TYPE KNOWN . DEFAULTTYPE) . REP)     (* represents a set of things)

		  (TYPE?
 (
EQLENGTH
 (
CADR
 DATUM)
				   2)))

(RECORD VERB
 (TENSE . VPART)
	     (SUBRECORD VPART))

(RECORD VPART
 (ROOT . MODIFIER))

(RECORD CVERB
 (C VB1 . VB2)
	      [TYPE?
 (
FMEMB
 (
CAR
 DATUM)
			    (
QUOTE
 (
OR
 AND
 ANDNOT])

(RECORD THAT
 (ID VERB . OTHERSET)
	     ID ←(
QUOTE
 THAT)
	     (TYPE?
 (
EQ
 (
CAR
 DATUM)
			(
QUOTE
 THAT))))

(RECORD QUOTE
 (ID . QUOTED)
	      ID ←(
QUOTE
 QUOTE))

(RECORD IN
 (ID . EXPRESSION)
	   ID ←(
QUOTE
 IN))

(RECORD NOT
 (ID . NEGATED)
	    ID ←(
QUOTE
 NOT)
	    (TYPE?
 (
EQ
 (
CAR
 DATUM)
		       (
QUOTE
 NOT))))

(RECORD PATHS
 (ID . PATHOPTIONS)
	      ID ←(
QUOTE
 PATHS))

(RECORD APPLY
 (ID . PRED)
	      ID ←(
QUOTE
 APPLY))

(RECORD CSET
 (ID SET1 . SET2))

(RECORD BLOCKS
 (ID TYPES FNS . FILES)
	       ID ←(
QUOTE
 BLOCKS)                            (* e.g. ENTRIES ON FOO)

	       )

(RECORD FIELDS
 (ID . RECS)
	       ID ←(
QUOTE
 FIELDS))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS GETWORDTYPE MACRO
 [(WORD TYPE)
			     (
CDR
 (
FASSOC
 TYPE (
GETHASH
 WORD MSWORDS])
)
)

(RPAQQ CONJUNCTABLE
 (SETPHRASE PREDICATE DOESPHRASE VERB))

(RPAQQ MSSPLST
 NIL)

(RPAQQ INITWORDLIST
 (((CONTAIN CONTAINS CONTAINING CONTAINED)
		      (BIND BINDS BINDING BOUND)
		      (CALL CALLS CALLING CALLED)
		      (SET SETS SETTING SET)
		      (SMASH SMASHES SMASHING SMASHED)
		      (TEST TESTS TESTING TESTED)
		      (USE USES USING USED)
		      (REFERENCE REFERENCES REFERENCING REFERENCED)
		      (CREATE CREATES CREATING CREATED)
		      (FETCH FETCHES FETCHING FETCHED)
		      (REPLACE REPLACES REPLACING REPLACED)
		      (DECLARE DECLARES DECLARING DECLARED))
		     (((FREELY FREE)
		       USE SET SMASH TEST)
		      ((LOCALLY LOCAL)
		       USE SET SMASH BIND DECLARE REFERENCE)
		      ((SOMEHOW)
		       CALL)
		      ((DIRECTLY)
		       CALL)
		      ((INDIRECTLY)
		       CALL USE))
		     (((LOCALVARS LOCALVAR)
		       DECLARE)
		      ((SPECVARS SPECVAR)
		       DECLARE)
		      ((RECORDS RECORD)
		       USE)
		      ((FIELDS FIELD)
		       USE SET SMASH REFERENCE)
		      ((PROPNAMES PROPERTIES PROPERTY PROP PROPS)
		       USE)
		      ((I.S.OPRS I.S.OPR CLISPWORD CLISPWORDS)
		       USE)
		      ((PREDICATE)
		       CALL USE)
		      ((TYPE)
		       USE))
		     (((VALUE)
		       CALL USE)
		      ((TESTING)
		       CALL USE)
		      ((EFFECT)
		       CALL))
		     (((RECORD FIELD *)
		       FIELD)
		      ((RECORD FIELDS)
		       FIELDS)
		      ((FIELD *)
		       FIELD)
		      ((RECORD *)
		       RECORD)
		      ((CLISP WORD)
		       CLISPWORD)
		      ((CLISP WORDS)
		       CLISPWORD)
		      ((PROP *)
		       PROPNAMES)
		      ((PROPERTY *)
		       PROPNAMES)
		      ((ON PATH)
		       ONPATH)
		      ((ON THE PATH)
		       ONPATH)
		      ((ON A PATH)
		       ONPATH)
		      ((LOOK AT)
		       ANALYZE)
		      [(CHANGED ON &)
		       (IN (PROGN (UPDATEFILES)
				  (CDR (GETPROP (QUOTE 1)
						(QUOTE FILE]
		      (AMONG (AVOIDING NOT))
		      (DOESN'T (DOES NOT))
		      (DON'T (DO NOT))
		      (ISN'T (IS NOT))
		      (AREN'T (ARE NOT))
		      ((ALL PATHS)
		       PATHS)
		      (SOME ANY)
		      (ALL ANY)
		      (ANYONE ANY)
		      ((ALL PATHS)
		       PATHS)
		      (UNDEFINED (FNS NOT @ GETD)))
		     ((FNS FN FUNCTIONS FUNCTION)
		      (VARS VAR VARIABLES VARIABLE)
		      (RECORDS RECORD)
		      (FILES FILE)
		      (I.S.OPRS I.S.OPR CLISPWORD CLISPWORDS)
		      (FIELDS FIELD)
		      (PROPNAMES PROPERTIES PROPS PROP))
		     ((FROM PATH)
		      (TO PATH)
		      (AVOIDING PATH)
		      (NOTRACE PATH)
		      (MARKING PATH)
		      (OUTPUT PATH)
		      (LINELENGTH PATH)
		      (DOES X DO)
		      (DO X)
		      (IS X)
		      (ARE X IS)
		      (AND C)
		      (OR C)
		      (SEPARATE PATH)
		      (LOCALFREEVARS BLOCKS)
		      (SPECVARS BLOCKS)
		      (LOCALVARS BLOCKS)
		      (GLOBALVARS BLOCKS)
		      (BLOCKS BLOCKS BLKFNS)
		      (BLOCK BLOCKS BLKFNS)
		      (ENTRY BLOCKS ENTRIES)
		      (ENTRIES BLOCKS)
		      (BLKAPPLYFNS BLOCKS)
		      (BLKLIBRARY BLOCKS)
		      (BLKFNS BLOCKS))
		     T))
(APPLY (QUOTE MSSETUP)
       INITWORDLIST)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: MSPARSEBLOCK SETKNOWN DOESPHRASE SETSETTYPE FAIL MSJOINSET BLOCKER PATHOPTIONS MSPARSE 
	FIXUPTYPES VERBTYPE SETREP MSSEEKPHRASE TYPEMATCHRATING MSTRYSPELL MSTRYPARSE COMMAND 
	SUBJTYPE OBJTYPE VERB MSSPLST MSWORD? SEEKTYPE MSRESPELL JOINTYPES SIMPLESET MATCHRATING SEEK 
	VERBED CAN'T JOINDETS NEGATESET GETNEXTWORD PREDICATE CHECKSYNONYM SEEKWORD EATWORD 
	TRYSPELLTYPE SETPHRASE QUOTEDWORD FIXVERBSETTYPE (ENTRIES MSPARSE MSJOINSET MSTRYSPELL 
								  SETSYNONYM MSSETUP)
	(RETFNS MSTRYPARSE)
	(SPECVARS SPELLING)
	(LOCALFREEVARS CONJUNCTIONS LASTADVERB LASTPARSED NEXTWORD PARSED S SEEKING SENTENCE RESETS)
	(BLKAPPLYFNS DOESPHRASE VERBED BLOCKER PATHOPTIONS SETREP COMMAND VERB PREDICATE SETPHRASE)
	(LOCALFREEVARS SETTYPE SETDET)
	(NOLINKFNS . T)
	(GLOBALVARS MSWORDS MSSPLST CONJUNCTABLE)
	MSSETUP SETWORDTYPE SETSYNONYM)
(BLOCK: NIL (LOCALVARS . T)
	(GLOBALVARS MSWORDS))
]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 SEEKWORD SEEK)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS MSPARSE COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2112 40243 (SETKNOWN 2122 . 2691) (DOESPHRASE 2693 . 3131) (SETSETTYPE 3133 . 4135) (
FAIL 4137 . 4595) (MSJOINSET 4597 . 6361) (BLOCKER 6363 . 7044) (PATHOPTIONS 7046 . 7553) (MSPARSE 
7555 . 11415) (FIXUPTYPES 11417 . 13202) (VERBTYPE 13204 . 14732) (SETREP 14734 . 17104) (MSSEEKPHRASE
 17106 . 19497) (TYPEMATCHRATING 19499 . 20110) (MSTRYSPELL 20112 . 20520) (MSTRYPARSE 20522 . 20835) 
(COMMAND 20837 . 23406) (SUBJTYPE 23408 . 23930) (OBJTYPE 23932 . 24810) (VERB 24812 . 25359) (MSSPLST
 25361 . 25743) (MSWORD? 25745 . 25983) (SEEKTYPE 25985 . 26249) (MSRESPELL 26251 . 26819) (JOINTYPES 
26821 . 27036) (SIMPLESET 27038 . 27305) (MATCHRATING 27307 . 28393) (SEEK 28395 . 28524) (VERBED 
28526 . 29132) (CAN'T 29134 . 29267) (JOINDETS 29269 . 29538) (NEGATESET 29540 . 29844) (GETNEXTWORD 
29846 . 32266) (PREDICATE 32268 . 33116) (CHECKSYNONYM 33118 . 35172) (SEEKWORD 35174 . 35536) (
SETWORDTYPE 35538 . 35730) (EATWORD 35732 . 35873) (TRYSPELLTYPE 35875 . 36220) (SETPHRASE 36222 . 
36915) (QUOTEDWORD 36917 . 37081) (FIXVERBSETTYPE 37083 . 37399) (SETSYNONYM 37401 . 38469) (MSSETUP 
38471 . 40241)))))
STOP