00100	~    MILISY: THE MINI-LINGUISTIC SYSTEM
00200	~    WRITTEN JANUARY 1972 BY TOM MORAN,
00300	~    COMPUTER SCIENCE DEPARTMENT, CARNEGIE-MELLON UNIVERSITY, PITTSBURGH, PENNSYLVANIA
00400	~    REVISED JULY 1972
00500	~    DOCUMENTATION ON REVISIONS FOUND ON PRDOC[206,CCG],TRACE.DOC[206,CCG]
00600	
00700	~	ADDITIONAL REVISIONS FEBRUARY 1973 BY ARTHUR FLEXSER
00800	~	PSYCHOLOGY DEPARTMENT, STANFORD UNIVERSITY
00900	~	DOCUMENTATION FOUND ON MILDOC[206,AF5]
01000	
01100	~  RECOMMENDED STORAGE ALLOCATION:  CORE=20K; SPEC PDL=3000;
01200	~   REG PDL=3000.
01300	
01400	~    FOR FASTER OPERATION, DSKIN THE FILE MILFNS.LAP[206,AF5],
01500	~    WHICH CONTAINS COMPILED CODE FOR SOME OF THE MORE TIME
01600	~    CONSUMING FUNCTIONS.  THIS SHOULD BE FOLLOWED BY
01700	~    (CSYM OBJ00) TO RESET THE GENSYM COUNTER.
01800	
01900	[PROG ()
02000	
02100	
02200	[DE CONVERSE () (PROG (F TREE)
02300	
02400		(SETQ REPLY @HELLO)
02500	      A (TERPRI)
02600		(PRINC REPLY)
02700		(LISTEN)
02800		(COND ((ATOM STRING) (TERPRI) (RETURN @BYE))
02900		      ((EQ (CAR STRING) @HOW) (SINGULARIZE (CDDR STRING))))
03000		(SETQ TREE NIL)
03100		(PARSE STRING @<S> @((NIL NIL)))
03200		(COND ((NULL TREE) (SETQ REPLY @(I CAN'T PARSE YOUR INPUT)) (GO A)))
03300		(SETQ F FACTS)
03400		(COND (FACT-TRACE (TERPRI)
03500			(PRINC @"THE FACT LIST IS INITIALLY:")
03600			(PRINT FACTS)
03700			(TERPRI)))
03800		(COND ((NULL (INTERPRET-S TREE))
03900			(COND ((AND (NOT (EQ FACTS F)) FACT-TRACE)
04000	                  (TERPRI)
04100			  (PRINC @"RESTORING FACT LIST TO:")
04200			  (PRINT F) (SETQ FACTS F) (TERPRI))
04300		      (T (SETQ FACTS F)))))
04400		(GO A)
04500	]
04600	
04700	[DE LISTEN () (PROG2
04800	
04900		(TERPRI) (TERPRI) (PRINC @"**")
05000		(SETQ STRING (READ))
05100	]
05200	
05300	[DF SAY: (L) (SETQ STRING L)]
05400	
05500	[DE PS () (PROG2 (SETQ TREE NIL)
05600	                 (PARSE STRING @<S> @((NIL NIL)))
05700			 (PRINTREE TREE)))
05800	
05900	[DE I () (INTERPRET-S TREE)]
06000	
06100	[DE PSI() (PROG() (PS) (I) (TERPRI) (RETURN REPLY))]
06200	
06300	[SETQ TREE-TRACE NIL]
06400	
06500	[SETQ TF-TRACE NIL]
06600	
06700	[DE ATTR (NAME) (READLIST (CONS @% (EXPLODE NAME)))]
06800	
06900	[DE CADDADR (L) (CAR (CDDADR L))]
07000	
     

00100	[DF P-RULES (L) (PROG (X Y Z)
00200	
00300	      A (COND ((NULL L) (RETURN NIL)))
00400		(SETQ X (REVERSE (CADR L)))
00500		(SETQ Y NIL)
00600		(SETQ Z NIL)
00700	      B (COND ((NULL X)
00800			(SETQ Z (NCONC (LIST @! Y) Z))
00900			(PUTPROP (CAR L) Z @PRULE)
01000			(SETQ L (CDDR L))
01100			(GO A))
01200		      ((EQ (CAR X) @!)
01300			(SETQ Z (CONS Y Z))
01400			(SETQ Y NIL))
01500		      (T (SETQ Y (CONS (CAR X) Y))))
01600		(SETQ X (CDR X))
01700		(GO B)
01800	]
01900	
02000	[P-RULES
02100	
02200	<S> 	(<SD> ! <SE> ! <SQ> ! <SEQ> ! <SWH> ! <SAQ> ! <SLQ>
02300	         ! <SLEQ> ! <SCQ> ! <SCEQ>)
02400	<SD>	(<NP> <VP>)
02500	<VP>	(<COP> <PRED>)
02600	<COP>	(%BE <NEG>)
02700	<PRED>	(<PP> ! <ADJ>)
02800	<SE>	(THERE <COP> <NP> <PP>)
02900	<SQ>	(%BE <NP> <PRED>)
03000	<SEQ>	(%BE THERE <NP> <PP>)
03100	<SWH>	(WHAT <COP> <PRED>)
03200	<SAQ>	(WHAT %ATTR %BE <NP>)
03300	<SLQ>	(WHERE %BE <NP>)
03400	<SLEQ>	(WHERE %BE THERE <NP>)
03500	<SCQ>	(HOW MANY <NP1> <COP> <PRED>)
03600	<SCEQ>	(HOW MANY <NP1> %BE THERE)
03700	<NEG>	(NOT !)
03800	<PP>	(%PREP <NP>)
03900	<NP>	(%DET <NP1>)
04000	<NP1>	(<MOD1> %NOUN <REL-CL>)
04100	<MOD1>	(<ADJ> <MOD1> !)
04200	<ADJ>	(%COLOR ! %SIZE)
04300	<REL-CL>(%WH <COP> <PRED> !)
04400	]
04500	
04600	(DEFPROP %BE (IS ARE) SET)
04700	(DEFPROP %PREP (IN ON UNDER NEAR) SET)
04800	(DEFPROP %DET (THE A) SET)
04900	(DEFPROP %SIZE (BIG SMALL) SET)
05000	(DEFPROP %COLOR (RED BLUE GREEN BLACK) SET)
05100	(DEFPROP %NOUN (BOX BALL BLOCK TABLE FLOOR) SET)
05200	(DEFPROP %WH (WHICH THAT) SET)
05300	(DEFPROP %ATTR (COLOR SIZE) SET)
05400	
05500	[SETQ ATTRLIST @(%COLOR %SIZE)]
05600	
05700	[SETQ PLURALS @((BOXES . BOX)(BALLS . BALL)(BLOCKS . BLOCK)
05800	   (TABLES . TABLE)(FLOORS . FLOOR))]
05900	
06000	[DE SINGULARIZE (L) (PROG (X)
06100	    (RETURN
06200		(COND ((SETQ X (ASSOC (CAR L) PLURALS))(RPLACA L (CDR X)))
06300		      ((NULL L) NIL)
06400		      (T (SINGULARIZE (CDR L)))))
06500	]
06600	
06700	(DE PARSE (* G STACK) (PROG (ALTS CLASS)
06800		(COND ((SETQ ALTS (GET G @PRULE))
06900			(RPLACD (CDAR STACK) (LIST (LIST G)))
07000			(RETURN (PAR * (CDR ALTS) (CONS (CADDAR STACK) (CONS
07100				(CONS (CAAR STACK) (CDDAR STACK)) (CDR STACK))))))
07200		  ((SETQ CLASS (GET G @SET))
07300			(COND ((MEMQ (CAR *) CLASS)
07400				(RPLACD (CDAR STACK) (LIST (LIST G (CAR *)))))
07500			  (T (RETURN))))
07600		  ((EQ (CAR *) G) (RPLACD (CDAR STACK) (LIST G)))
07700		  (T (RETURN)))
07800		(NEXT (CDR *) (CONS (CONS (CAAR STACK)(CDDAR STACK))(CDR STACK)))))
07900	
08000	(DE PAR (* ALTS STACK)
08100		(COND ((NULL ALTS))
08200		  ((NULL (CAR ALTS)) (RPLACD (CAR STACK) (LIST NIL))
08300			(NEXT * (CDR STACK)))
08400		  (T (PARSE * (CAAR ALTS) (CONS (CONS (CDAR ALTS) (CAR STACK))
08500			(CDR STACK)))
08600			(PAR * (CDR ALTS) STACK))))
08700	
08800	(DE NEXT (* STACK)
08900		(COND ((AND (NULL *) (NULL (CDR STACK))) (SETQ TREE (CONS
09000			(SUBST 0 0 (CADAR STACK)) TREE)))
09100		  ((NULL (CDR STACK)))
09200		  ((NULL (CAAR STACK)) (NEXT * (CDR STACK)))
09300		  (T (PARSE * (CAAAR STACK) (CONS (CONS (CDAAR STACK) (CDAR STACK))
09400			(CDR STACK))))) )
     

00100	[DE INTERPRET-S (TREE) (PROG (X SUBTREE QUES ATR ABORT)
00200	
00300		(COND (TREE-TRACE (PRINTREE TREE)))
00400		(FINDNODE <S> TREE)
00500		(COND ((NOT (OR (T-SD) (T-SE)
00600	   	   (SETQ QUES (OR (T-SEQ) (T-SQ) (T-SWH)
00700		     (SETQ ATR (T-SAQ)) (T-SLQ) (T-SLEQ)(T-SCQ)(T-SCEQ)))))
00800	               (ERROR1) (RETURN NIL))
00900		      (ABORT (RETURN NIL)))
01000	    NP  (COND ((NULL (FINDNODE <NP> TREE)) NIL)
01100		      ((INTERPRET-NP SUBTREE QUES) (GO NP))
01200		      (T (RETURN NIL)))
01300		(FINDNODE SS TREE)
01400		(COND ((NULL SUBTREE) (GO S))
01500		      ((NOT (OR (T-PRED-ADJ) (T-PRED-PP))) (ERROR1) (RETURN NIL))
01600		      ((NOT (OR (T-NNEG) (T-NEG))) (ERROR1) (RETURN NIL)))
01700	     S  (FINDNODE <S> TREE)
01800		(SETQ X (CDAR SUBTREE))
01900		(COND ((EQ (CAR X) @FIND) (GO FIND))
02000		      ((EQ (CAR X) @RECORD)
02100			(RECORD (CADR X))
02200			(COND ((NOT ABORT) (SETQ REPLY @(OKAY)))))
02300		      ((EQ (CAR X) @VERIFY)
02400			(SETQ X (VERIFY (CADR X)))
02500			(SETQ REPLY (COND ((NULL X) @(I DON'T KNOW)) ((EQ X @TRUE) @(YES)) (T @(NO)))))
02600	              ((EQ (CAR X) @LOCATE) (GO LOCATE))
02700		      ((EQ (CAR X) @COUNT) (GO COUNT))
02800		      (T (ERROR1) (RETURN NIL)))
02900		(RETURN (NOT ABORT))
03000	   FIND (SETQ X (EVAL X))
03100		(SETQ REPLY (COND (ATR (COND ((NULL X) @(I DON'T KNOW))
03200					     (T X)))
03300				  (T (DESCRIBE X))))
03400		(RETURN T)
03500	 LOCATE	(SETQ X (EVAL X))
03600		(SETQ REPLY (LOCATIONS X))
03700		(RETURN T)
03800	  COUNT (COND ((FINDNODE AND TREE) (T-AND)))
03900		(SETQ X (EVAL X))
04000		(SETQ REPLY (LIST X))
04100		(RETURN T)
04200	]
04300	
04400	[DE INTERPRET-NP (TREE *ANY) (PROG (SUBTREE W X)
04500	
04600		(COND ((EQ (CAR (CDADAR TREE)) @THE) (SETQ *ANY T)))
04700		(FINDNODE <NP1> TREE)
04800		(SETQ W (WORDS SUBTREE))
04900		(COND ((NULL (INTERPRET-NP1 SUBTREE *ANY))(RETURN NIL)))
05000		(SETQ SUBTREE TREE)
05100		(T-NP)
05200		(COND ((T-INDEF) (RETURN (COND ((NULL (CAR SUBTREE))
05300						  (ERROR2) NIL)
05400					       (T (CAR SUBTREE))))))
05500		(T-DEF)
05600		(SETQ X (CAR SUBTREE))
05700		(COND ((NULL X) (ERROR2))
05800		      ((NULL (CDR X)) (RPLACA SUBTREE (CAR X)) (RETURN (CAR X)))
05900		      (T (ERROR3)))
06000	]
06100	
06200	[DE INTERPRET-NP1 (TREE *ANY) (PROG (SUBTREE)
06300	
06400		(SETQ SUBTREE TREE)
06500		(T-NP1)
06600	    ADJ (COND ((T-ADJ) (GO ADJ)))
06700		(T-MOD1)
06800	  BACK	(COND ((T-NREL-CL) (GO ON))
06900		      ((FINDNODE <NP> SUBTREE) (COND
07000			  ((NULL (INTERPRET-NP SUBTREE *ANY)) (RETURN NIL))
07100		          (T (GO BACK))))
07200		      (T (FINDNODE <NP1> TREE)
07300			 (COND ((NULL (T-REL-CL))(ERROR1)(RETURN NIL)))
07400			 (FINDNODE SS SUBTREE)
07500			 (COND ((NOT (OR (T-PRED-ADJ) (T-PRED-PP)))
07600					(ERROR1) (RETURN NIL))
07700			       ((NOT (OR (T-NNEG) (T-NEG)))
07800					(ERROR1) (RETURN NIL)))))
07900	    ON  (FINDNODE AND TREE)
08000	    AND (COND ((T-AND) (GO AND)))
08100		(RETURN T)
08200	]
08300	
08400	[DE ERROR1 () (SETQ REPLY @(I CAN'T INTERPRET YOUR SENTENCE))]
08500	[DE ERROR2 () (SETQ REPLY (APPEND @(THERE IS NO) W))]
08600	[DE ERROR3 () (SETQ REPLY (APPEND (APPEND @(I DON'T KNOW WHICH) W) @(YOU MEAN)))]
08700	
08800	[DF TF (L) (PROG2
08900	
09000		(PUTPROP (CAR L) (CDR L) @TF)
09100		(PUTPROP (CAR L) (LIST @LAMBDA NIL (LIST @TFX (LIST @QUOTE (CAR L)))) @EXPR)
09200	]
09300	
09400	[TF T-SD
09500		(<S> (<SD> 1 (<VP> (<COP> 0 2) 3)))
09600		(<S> RECORD (SS 2 1 3))
09700	]
09800	[TF T-SE
09900		(<S> (<SE> THERE (<COP> 0 1) 2 3))
10000		(<S> RECORD (SS 1 2 (<PRED> 3)))
10100	]
10200	[TF T-SEQ
10300		(<S> (<SEQ> 0 THERE 1 2))
10400		(<S> VERIFY (SS (<NEG> NIL) 1 (<PRED> 2)))
10500	]
10600	[TF T-SQ
10700		(<S> (<SQ> 0 1 2))
10800		(<S> VERIFY (SS (<NEG> NIL) 1 2))
10900	]
11000	[TF T-SWH
11100		(<S> (<SWH> 0 (<COP> 0 1) 2))
11200		(<S> FIND 3 (SS 1 3 2))
11300		(SETV 3 (NEWNUM))
11400	]
11500	[TF T-SAQ
11600		(<S> (<SAQ> WHAT (%ATTR 1) 0 2))
11700		(<S> FIND 3 (4 2 3))
11800		(SETV 4 (ATTR (QUOTE 1)))
11900	]
12000	[TF T-SLQ
12100		(<S> (<SLQ> WHERE 0 1))
12200		(<S> LOCATE 1)
12300	]
12400	[TF T-SLEQ
12500		(<S> (<SLEQ> WHERE 0 THERE 1))
12600		(<S> LOCATE 1)
12700	]
12800	[TF T-SCQ
12900		(<S> (<SCQ> HOW MANY 1 (<COP> 0 2) 3))
13000		(<S> COUNT 4 (AND 5 (SS 2 4 3)))
13100		(PROG2 (COND ((NULL (INTERPRET-NP1 (FINDNODE <NP1> TREE) T))
13200			      (SETQ ABORT T)))
13300		       (SETV 4 (CADAR SUBTREE))
13400		       (SETV 5 (CADDAR SUBTREE))
13500		       (FINDNODE <S> TREE))
13600	]
13700	[TF T-SCEQ
13800		(<S> (<SCEQ> HOW MANY 1 0 THERE))
13900		(<S> COUNT 2 3)
14000		(PROG2 (COND ((NULL (INTERPRET-NP1 (FINDNODE <NP1> TREE) T))
14100			      (SETQ ABORT T)))
14200		       (SETV 2 (CADAR SUBTREE))
14300		       (SETV 3 (CADDAR SUBTREE))
14400		       (FINDNODE <S> TREE))
14500	]
14600	[TF T-PRED-ADJ
14700		(SS 1 2 (<PRED> (<ADJ> (3 4))))
14800		(SS 1 (3 2 4))
14900	]
15000	[TF T-PRED-PP
15100		(SS 1 2 (<PRED> (<PP> (%PREP 3) 4)))
15200		(SS 1 (3 2 4))
15300	]
15400	[TF T-NNEG
15500		(SS (<NEG> NIL) 1)
15600		1
15700	]
15800	[TF T-NEG
15900		(SS (<NEG> NOT) 1)
16000		(NOT 1)
16100	]
16200	[TF T-NP1
16300		(<NP1> 1 (%NOUN 2) 3)
16400		(<NP1> 4 1 3 (ISA 4 2))
16500		(SETV 4 (NEWNUM))
16600	]
16700	[TF T-ADJ
16800		(<NP1> 1 (<MOD1> (<ADJ> (2 3)) 4) 5 6)
16900		(<NP1> 1 4 5 (AND 6 (2 1 3)))
17000	]
17100	[TF T-MOD1
17200		(<NP1> 1 (<MOD1> NIL) 2 3)
17300		(<NP1> 1 2 3)
17400	]
17500	[TF T-NREL-CL
17600		(<NP1> 1 (<REL-CL> NIL) 2)
17700		(<NP1> 1 2)
17800	]
17900	[TF T-REL-CL
18000		(<NP1> 1 (<REL-CL> 0 (<COP> 0 2) 3) 4)
18100		(<NP1> 1 (AND 4 (SS 2 1 3)))
18200	]
18300	[TF T-AND
18400		(AND (AND 1 2) . 3)
18500		(AND 1 2 . 3)
18600	]
18700	[TF T-NP
18800		(<NP> (%DET 1) (<NP1> 2 3))
18900		(<NP> 1 2 3)
19000	]
19100	[TF T-INDEF
19200		(<NP> A 1 2)
19300		3
19400		(PROG2 (SETV 3 (COND (*ANY (FIND 1 2))
19500	                             (T (CREATE 1 2)))) T)
19600	]
19700	[TF T-DEF
19800		(<NP> THE 1 2)
19900		3
20000		(PROG2 (SETV 3 (FIND 1 2)) T)
20100	]
20200	
20300	[DE TFX (R) (PROG (N V X)
20400	
20500		(SETQ N R)
20600		(SETQ R (GET R @TF))
20700		(SETQ V (MATCH NIL (CAR R) (CAR SUBTREE)))
20800		(COND ((NULL V) (RETURN NIL))
20900		      ((NULL (CDDR R)) (GO A)))
21000		(SETQ X (SUBSTITUTE V (CADDR R)))
21100		(COND ((NULL (EVAL X)) (RETURN NIL)))
21200	      A (SETQ X (SUBSTITUTE V (CADR R)))
21300		(RPLACA SUBTREE X)
21400		(COND (TREE-TRACE (PRINT (LIST @APPLY N)) (PRINTREE TREE))
21500		      (TF-TRACE (PRINT N)))
21600		(RETURN T)
21700	]
     

00100	[DE PRINTREE (TREE) (PROG2 (PRINTR (CAR TREE) (LIST NIL)) @*)]
00200	
00300	[DE PRINTR (X M) (PROG ()
00400	
00500		(COND ((NULL X) (PRINC @")") (RETURN NIL)))
00600		(TERPRI)
00700		(MAPC (FUNCTION (LAMBDA (Z) (PRINC @"  "))) M)
00800		(COND ((ATOM X) (PRINC X) (RETURN NIL))
00900		      ((AND (ATOM (CADR X)) (OR (NULL (CDDR X)) (AND
01000			(NULL (CDDDR X)) (ATOM (CADDR X))))) (PRINC X) (RETURN)))
01100		(PRINC @"(") (PRINC (CAR X))
01200		(SETQ M (CONS NIL M))
01300		(MAPC (FUNCTION (LAMBDA (Y) (PRINTR Y M))) (APPEND (CDR X) @(NIL)))
01400	]
01500	
01600	[DE WORDS (X) (PROG (W Z)
01700	
01800		(SETQ Z (LIST NIL))
01900		(SETQ W Z)
02000		(WORD (CAR X))
02100		(RETURN (CDR Z))
02200	]
02300	
02400	[DE WORD (X) (COND
02500	
02600		((ATOM X) (COND ((NULL X) NIL)
02700				((GET X @PRULE) NIL)
02800				((GET X @SET) NIL)
02900				(T (RPLACD W (LIST X)) (SETQ W (CDR W)))))
03000		(T (WORD (CAR X)) (WORD (CDR X)))
03100	]
03200	
03300	
03400	[DE SETV (N X) (SETQ V (CONS (CONS N X) V))]
03500	
03600	[DE NEWNUM () (SETQ NEWNUM (ADD1 NEWNUM))]
03700	
03800	(SETQ NEWNUM 100)
03900	
04000	[DF FINDNODE (N) (PROG (%TREE Y)
04100	
04200		(SETQ %TREE (EVAL (CADR N)))
04300		(SETQ N (CAR N))
04400		(COND ((EQ (CAAR %TREE) N) (RETURN (SETQ SUBTREE %TREE)))
04500		      (T (RETURN (SETQ SUBTREE (FINDNODE1 (CAR %TREE))))))
04600	]
04700	
04800	[DE FINDNODE1 (X) (COND
04900	
05000		((ATOM X) NIL)
05100		((ATOM (CAR X)) (FINDNODE1 (CDR X)))
05200		((EQ (CAAR X) N) X)
05300		((SETQ Y (FINDNODE1 (CAR X))) Y)
05400		(T (FINDNODE1 (CDR X)))
05500	]
05600	
05700	
05800	
05900	[DE MATCH (V F E) (PROG (X) (RETURN (COND ((NULL (MACH F E)) NIL) (V V) (T T))))]
06000	
06100	[DE MACH (F E) (COND
06200	
06300		((EQ F E) T)
06400		((NUMBERP F) (COND ((ZEROP F) T)
06500				   ((SETQ X (ASSOC F V)) (EQUAL (CDR X) E))
06600				   (T (SETQ V (CONS (CONS F E) V)) T)))
06700		((ATOM F) NIL)
06800		((ATOM E) NIL)
06900		(T (AND (MACH (CAR F) (CAR E))
07000			(MACH (CDR F) (CDR E))))
07100	]
07200	
07300	[DE SUBSTITUTE (V X) (PROG (Y) (RETURN (SUBS X)))]
07400	
07500	[DE SUBS (X) (COND
07600	
07700		((NUMBERP X) (COND ((SETQ Y (ASSOC X V)) (CDR Y)) (T X)))
07800		((ATOM X) X)
07900		(T (CONS (SUBS (CAR X)) (SUBS (CDR X))))
08000	]
08100	
08200	[SETQ FACTS NIL]
08300	
08400	[SETQ FACT-TRACE NIL]
08500	
08600	[DE RECORD (S) (COND
08700	
08800		((EQ (CAR S) @AND) (MAPC (FUNCTION RECORD) (CDR S)))
08900		((CHECK S) (SETQ FACTS (CONS S FACTS))
09000		  (COND (FACT-TRACE (TERPRI) 
09100				   (PRINC @"ADDING TO FACT LIST:")
09200				   (PRINT S) (TERPRI))))
09300		(T (SETQ ABORT T))
09400	]
09500	
09600	[DE CHECK (S) (PROG (Y1 V) (RETURN (COND
09700	
09800		((EQ (CAR S) @ISA) T)
09900		((EQ (SETQ V (VERIFY1 S)) @TRUE)
10000		   (SETQ REPLY @"(YES, I KNOW)") NIL)
10100		((EQ V @FALSE)
10200		   (COND ((EQ Y1 @C1) (CONTRADICT1))
10300			 ((EQ Y1 @C2) (CONTRADICT2))
10400			 (T (CONTRADICT3))) NIL)
10500		(T T)
10600	]
10700	
10800	[DE CONTRADICT1() (SETQ REPLY @(YES IT IS))]
10900	[DE CONTRADICT2() (SETQ REPLY @(NO IT ISN'T))]
11000	[DE CONTRADICT3() (PROG (X)
11100		(SETQ X (FIND2 (LIST @ISA (CADR S) 99) FACTS NIL))
11200		(SETQ X (NCONC (LIST @THE) X))
11300		(SETQ Y1 (NCONC (LIST @IS) Y1))
11400		(SETQ REPLY (NCONC (LIST @NOT @TRUE!) (NCONC X Y1)))
11500	]
11600	
11700	
11800	[DF CREATE (L) (PROG (X)
11900	
12000		(SETQ X (GENSYM))
12100		(RECORD (SUBSTITUTE (LIST (CONS (CAR L) X)) (CADR L)))
12200		(RETURN X)
12300	]
12400	
12500	[DE VERIFY (S) (PROG (X Y Y1)
12600	
12700		(COND ((EQ (CAR S) @AND) (GO A))
12800		      ((EQ (CAR S) @OR) (GO B))
12900		      (T (RETURN (VERIFY1 S))))
13000	      A (COND ((NULL (SETQ S (CDR S))) (RETURN @TRUE))
13100		      ((NOT (EQ (SETQ X (VERIFY1 (CAR S))) @TRUE)) (RETURN X)))
13200		(GO A)
13300	     B	(SETQ X @FALSE)
13400	     C	(COND ((NULL (SETQ S (CDR S))) (RETURN X))
13500		      ((EQ (SETQ Y (VERIFY1 (CAR S))) @TRUE) (RETURN @TRUE))
13600		      ((NULL Y) (SETQ X NIL)))
13700		(GO C)
13800	]
13900	
14000	[DE VERIFY1 (S) (PROG (F N K PP PR L R1 R2)
14100	
14200		(SETQ F FACTS)
14300		(COND ((EQ (CAR S) @NOT) (SETQ N (SETQ K (CADR S)))
14400					 (SETQ PR @NOT)(SETQ PP @AND))
14500		      (T (SETQ N (LIST @NOT S)) (SETQ K S)(SETQ PP @OR)))
14600		(COND ((NOT (AND (ATOM (CADR K))(ATOM (CADDR K))))(GO B))
14700		      ((MEMQ (CAR K) ATTRLIST)
14800			(SETQ R1 (COND (PR @FALSE)(T @TRUE)))
14900			(SETQ R2 (COND (PR @TRUE) (T @FALSE)))
15000			(SETQ Y1 (FIND2 (LIST (CAR K) (CADR K) 99) FACTS NIL))
15100			(COND ((NULL Y1) (GO A))
15200			      ((EQ (CAR Y1) (CADDR K)) (RETURN R1))
15300			      (T (RETURN R2)))))
15400	     A	(COND ((NULL F) (RETURN NIL))
15500		      ((EQUAL (CAR F) S) (RETURN @TRUE))
15600		      ((EQUAL (CAR F) N) (SETQ Y1 (COND (PR @C1)(T @C2)))
15700					 (RETURN @FALSE)))
15800		(SETQ F (CDR F))
15900		(GO A)
16000	     B	(RETURN (VERIFY (REWRITE PP PR K)))
16100	]
16200	
16300	[DE REWRITE (PP PR S) (PROG (L)
16400	
16500		(SETQ L (COMBINE (CAR S) (LIS (CADR S)) (LIS (CADDR S))))
16600		(COND (PR (SETQ L (MAPCAR (FUNCTION (LAMBDA (X)
16700				    (CONS PR (LIST X)))) L))))
16800		(RETURN (CONS PP L))
16900	]
17000	
17100	[DE LIS (X) (COND ((ATOM X) (LIST X)) (T X))]
17200	
17300	[DF FIND (L) (PROG (V X Z)
17400	
17500		(SETQ V (CAR L))
17600		(SETQ L (CADR L))
17700		(SETQ L (COND ((EQ (CAR L) @AND) (CDR L))
17800			      (T (LIST L))))
17900		(SETQ X (FIND1 (CAR L)))
18000		(COND ((NULL (SETQ L (CDR L))) (RETURN X)))
18100		(SETQ L (CONS @AND L))
18200	      A (COND ((NULL X) (RETURN Z))
18300		      ((EQ (VERIFY (SUBSTITUTE (LIST (CONS V (CAR X))) L)) @TRUE)
18400		       (SETQ Z (CONS (CAR X) Z))))
18500		(SETQ X (CDR X))
18600		(GO A)
18700	]
18800	
18900	[DE CONS1 (X L) (COND ((MEMQ X L) L) (T (CONS X L)))]
19000	
19100	[DE MEQ (X L) (COND ((ATOM L) (EQ X L)) (T (MEMQ X L)))]
19200	
19300	[DE FIND1 (S) (PROG (S1 L) (RETURN (COND
19400	
19500		((NOT (EQ (CAR S) @NOT)) (FIND2 S FACTS NIL))
19600		((MEMQ (CAADR S) ATTRLIST) (SETQ S1
19700		   (LIST (CAADR S) (CADADR S) (DELETE (CADDADR S)
19800						(GET (CAADR S) @SET))))
19900		  (UNION (FIND2 S FACTS NIL) (FIND2 S1 FACTS NIL)))
20000		((AND (ATOM (CADADR S))(ATOM (CADDADR S)))
20100		  (FIND2 S FACTS NIL))
20200		(T (SETQ L (REWRITE @AND @NOT (CADR S)))
20300		   (EVAL (LIST @FIND V L))))
20400	]
20500	
20600	[DE FIND2 (S F Z) (PROG (X)
20700	
20800		(COND ((NULL F) (RETURN Z))
20900		      ((NOT (EQ (CAR S) @NOT))
21000			(SETQ X (MATCHUP (CAR F) S)) (GO A))
21100		      ((NOT (EQ (CAAR F) @NOT)) (GO B))
21200		      (T (SETQ X (MATCHUP (CADAR F) (CADR S)))))
21300	     A	(COND (X (RETURN (FIND2 S (CDR F) (CONS1 X Z)))))
21400	     B	(RETURN (FIND2 S (CDR F) Z))
21500	]
21600	
21700	[DE MATCHUP (F S) (COND
21800	
21900		((NOT (EQ (CAR F) (CAR S))) NIL)
22000		((NUMBERP (CADR S)) (COND
22100		  ((MEQ (CADDR F) (CADDR S)) (CADR F))))
22200		((MEQ (CADR F) (CADR S)) (CADDR F))
22300	]
22400	
22500	[DE DESCRIBE (L) (PROG (Z)
22600	
22700		(COND ((NULL L) (RETURN @(NOTHING))))
22800		(MAPC (FUNCTION DESCRIBE1) L)
22900		(RETURN (CDR Z))
23000	]
23100	
23200	[DE DESCRIBE1 (X) (PROG (Y)
23300	
23400		(SETQ Y (FIND2 (LIST @ISA X 99) FACTS NIL))
23500		(SETQ Y (NCONC (FIND2 (LIST @%COLOR X 99) FACTS NIL) Y))
23600		(SETQ Y (NCONC (FIND2 (LIST @%SIZE X 99) FACTS NIL) Y))
23700		(SETQ Z (NCONC Y Z))
23800		(SETQ Z (NCONC (LIST @AND @THE) Z))
23900		(RETURN (CDR Z))
24000	]
24100	
24200	[SETQ PREPS (GET @%PREP @SET)]
24300	
24400	[DF LOCATE (X)  (PROG (F Y Z)
24500	
24600		(COND ((ATOM (CAR X))(SETQ X (LIST X))))
24700		(SETQ F FACTS)
24800	     A	(COND ((NULL F) (RETURN Z)))
24900		(SETQ Y (CAR F))
25000		(COND ((NOT (MEMQ (CAR Y) PREPS)) (GO B))
25100		      ((MEMQ (CADR Y) (CAR X)) (SETQ Z (CONS Y Z))))
25200	     B	(SETQ F (CDR F))
25300		(GO A)
25400	]
25500	
25600	[DE LOCATIONS (L) (PROG (Z)
25700	
25800		(COND ((NULL L) (RETURN @(I DON'T KNOW))))
25900		(MAPC (FUNCTION LOC1) L)
26000		(RETURN (CDR Z))
26100	]
26200	
26300	[DE LOC1 (X) (PROG (Y)
26400	
26500		(SETQ Y (DESCRIBE1 (CADDR X)))
26600		(SETQ Y (NCONC (LIST (CAR X)) Y))
26700		(SETQ Z (NCONC (LIST @AND) Y))
26800	]
26900	
27000	[DE COMBINE (SP L1 L2)
27100	
27200		(COND ((NULL L2) NIL)
27300		      (T (APPEND (COMBINE SP L1 (CDR L2))
27400			         (COMBINE1 L1 (CAR L2)))))
27500	]
27600	
27700	[DE COMBINE1 (L X)
27800	
27900		(COND ((NULL L) NIL)
28000		      (T (CONS (LIST SP (CAR L) X) (COMBINE1 (CDR L) X))))
28100	]
28200	
28300	[SETQ NUMBERS @((0 . NONE)(1 . ONE)(2 . TWO)(3 . THREE)
28400	     (4 . FOUR)]
28500	
28600	[DF COUNT (L)
28700	
28800		(COND ((*LESS (SETQ L (LENGTH(EVAL (CONS @FIND L)))) 5)
28900			(CDR (ASSOC L NUMBERS)))
29000		      (T L))
29100	]
29200	
29300	[DE UNION (U V) (COND
29400	
29500		((NULL U) V)
29600		(T (UNION (CDR U) (CONS1 (CAR U) V)))
29700	]
29800	
29900	[DE DELETE (X L) (COND
30000	
30100		((EQ X (CAR L)) (CDR L))
30200		(T (CONS (CAR L) (DELETE X (CDR L))))
30300	]
30400	
     

00100	
00200	(SETQ *NOPOINT T)
00300	(CSYM OBJ00)
00400	(RETURN @"MINI-LINGUISTIC SYSTEM READY")    ]