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	
01000	[PROG ()
01100	
01200	
01300	[DE CONVERSE () (PROG (F TREE)
01400	
01500		(SETQ REPLY @HELLO)
01600	      A (PRINT REPLY)
01700		(LISTEN)
01800		(COND ((ATOM STRING) (TERPRI) (RETURN @BYE)))
01900		(SETQ TREE NIL)
02000		(SETQ QUES NIL)
02100		(SETQ ATR NIL)
02200		(PARSE STRING @<S> @((NIL NIL)))
02300		(COND ((NULL TREE) (SETQ REPLY @(I CANT PARSE YOUR INPUT)) (GO A)))
02400		(SETQ F FACTS)
02500		(COND (FACT-TRACE (TERPRI)
02600			(PRINC @"THE FACT LIST IS INITIALLY:")
02700			(PRINT FACTS)
02800			(TERPRI)))
02900		(COND ((NULL (INTERPRET-S TREE)) (SETQ FACTS F)))
03000		(GO A)
03100	]
03200	
03300	[DE LISTEN () (PROG2
03400	
03500		(TERPRI) (TERPRI) (PRINC @"**")
03600		(SETQ STRING (READ))
03700	]
03800	
03900	[DF SAY: (L) (SETQ STRING L)]
04000	
04100	[DE PS () (PROG2 (SETQ TREE NIL)
04200	                 (PARSE STRING @<S> @((NIL NIL)))
04300			 (PRINTREE TREE)))
04400	
04500	[DE I () (INTERPRET-S TREE)]
04600	
04700	[DE PSI () (PROG2 (PS) (I))]
04800	
04900	[SETQ TREE-TRACE NIL]
05000	
05100	[SETQ TF-TRACE NIL]
05200	
05300	[DE ATTR (NAME) (INTERN (MAKNAM (CONS @% (EXPLODE NAME))))]
05400	
     

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> ! <SLEQ>)
02300	<SD>	(<NP> <VP>)
02400	<VP>	(<COP> <PRED>)
02500	<COP>	(%BE <NEG>)
02600	<PRED>	(<PP> ! <ADJ>)
02700	<SE>	(THERE <COP> <NP> <PP>)
02800	<SQ>	(%BE <NP> <PRED>)
02900	<SEQ>	(%BE THERE <NP> <PP>)
03000	<SWH>	(%WH <COP> <PRED>)
03100	<SAQ>	(%WH %ATTR %BE <NP>)
03200	<SLQ>	(WHERE %BE <NP>)
03300	<SLEQ>	(WHERE %BE THERE <NP>)
03400	<NEG>	(NOT !)
03500	<PP>	(%PREP <NP>)
03600	<NP>	(%DET <NP1>)
03700	<NP1>	(<MOD1> %NOUN <MOD2>)
03800	<MOD1>	(<ADJ> <MOD1> !)
03900	<ADJ>	(%COLOR ! %SIZE)
04000	<MOD2>	(<SWH> !)
04100	]
04200	
04300	(DEFPROP %BE (IS ARE) SET)
04400	(DEFPROP %PREP (IN ON UNDER NEAR) SET)
04500	(DEFPROP %DET (THE A) SET)
04600	(DEFPROP %SIZE (BIG SMALL) SET)
04700	(DEFPROP %COLOR (RED BLUE GREEN BLACK) SET)
04800	(DEFPROP %NOUN (BOX BALL BLOCK TABLE FLOOR) SET)
04900	(DEFPROP %WH (WHICH WHAT) SET)
05000	(DEFPROP %ATTR (COLOR SIZE) SET)
05100	
05200	
05300	
05400	(DE PARSE (* G STACK) (PROG (ALTS CLASS)
05500		(COND ((SETQ ALTS (GET G @PRULE))
05600			(RPLACD (CDAR STACK) (LIST (LIST G)))
05700			(RETURN (PAR * (CDR ALTS) (CONS (CADDAR STACK) (CONS
05800				(CONS (CAAR STACK) (CDDAR STACK)) (CDR STACK))))))
05900		  ((SETQ CLASS (GET G @SET))
06000			(COND ((MEMQ (CAR *) CLASS)
06100				(RPLACD (CDAR STACK) (LIST (LIST G (CAR *)))))
06200			  (T (RETURN))))
06300		  ((EQ (CAR *) G) (RPLACD (CDAR STACK) (LIST G)))
06400		  (T (RETURN)))
06500		(NEXT (CDR *) (CONS (CONS (CAAR STACK)(CDDAR STACK))(CDR STACK)))))
06600	
06700	(DE PAR (* ALTS STACK)
06800		(COND ((NULL ALTS))
06900		  ((NULL (CAR ALTS)) (RPLACD (CAR STACK) (LIST NIL))
07000			(NEXT * (CDR STACK)))
07100		  (T (PARSE * (CAAR ALTS) (CONS (CONS (CDAR ALTS) (CAR STACK))
07200			(CDR STACK)))
07300			(PAR * (CDR ALTS) STACK))))
07400	
07500	(DE NEXT (* STACK)
07600		(COND ((AND (NULL *) (NULL (CDR STACK))) (SETQ TREE (CONS
07700			(SUBST 0 0 (CADAR STACK)) TREE)))
07800		  ((NULL (CDR STACK)))
07900		  ((NULL (CAAR STACK)) (NEXT * (CDR STACK)))
08000		  (T (PARSE * (CAAAR STACK) (CONS (CONS (CDAAR STACK) (CDAR STACK))
08100			(CDR STACK))))) )
     

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

00100	[DE PRINTREE (TREE) (PROG2 (PRINTR (CAR TREE) (LIST NIL)) @*)]
00200	
00300	[DE PRINTR (X M) (PROG ()
00400		(COND ((NULL X) (PRINC @")") (RETURN NIL)))
00500		(TERPRI)
00600		(MAPC (FUNCTION (LAMBDA (Z) (PRINC @"  "))) M)
00700		(COND ((ATOM X) (PRINC X) (RETURN NIL)))
00800		(COND ((AND (ATOM (CADR X)) (OR (NULL (CDDR X)) (AND
00900			(NULL (CDDDR X)) (ATOM (CADDR X))))) (PRINC X) (RETURN)))
01000		(PRINC @"(") (PRINC (CAR X))
01100		(SETQ M (CONS NIL M))
01200		(MAPC (FUNCTION (LAMBDA (Y) (PRINTR Y M))) (APPEND (CDR X) @(NIL)))
01300	]
01400	
01500	[DE WORDS (X) (PROG (W Z)
01600	
01700		(SETQ Z (LIST NIL))
01800		(SETQ W Z)
01900		(WORD (CAR X))
02000		(RETURN (CDR Z))
02100	]
02200	
02300	[DE WORD (X) (COND
02400	
02500		((ATOM X) (COND ((NULL X) NIL)
02600				((GET X @PRULE) NIL)
02700				((GET X @SET) NIL)
02800				(T (RPLACD W (LIST X)) (SETQ W (CDR W)))))
02900		(T (WORD (CAR X)) (WORD (CDR X)))
03000	]
03100	
03200	
03300	[DE SETV (N X) (SETQ V (CONS (CONS N X) V))]
03400	
03500	[DE NEWNUM () (SETQ NEWNUM (ADD1 NEWNUM))]
03600	
03700	(SETQ NEWNUM 100)
03800	
03900	[DF FINDNODE (N) (PROG (%TREE Y)
04000	
04100		(SETQ %TREE (EVAL (CADR N)))
04200		(SETQ N (CAR N))
04300		(COND ((EQ (CAAR %TREE) N) (RETURN (SETQ SUBTREE %TREE)))
04400		      (T (RETURN (SETQ SUBTREE (FINDNODE1 (CAR %TREE))))))
04500	]
04600	
04700	[DE FINDNODE1 (X) (COND
04800	
04900		((ATOM X) NIL)
05000		((ATOM (CAR X)) (FINDNODE1 (CDR X)))
05100		((EQ (CAAR X) N) (RETURN X))
05200		((SETQ Y (FINDNODE1 (CAR X))) (RETURN Y))
05300		(T (FINDNODE1 (CDR X)))
05400	]
05500	
05600	
05700	
05800	[DE MATCH (V F E) (PROG (X) (RETURN (COND ((NULL (MACH F E)) NIL) (V V) (T T))))]
05900	
06000	[DE MACH (F E) (COND
06100	
06200		((EQ F E) T)
06300		((NUMBERP F) (COND ((ZEROP F) T)
06400				   ((SETQ X (ASSOC F V)) (EQUAL (CDR X) E))
06500				   (T (SETQ V (CONS (CONS F E) V)) T)))
06600		((ATOM F) NIL)
06700		((ATOM E) NIL)
06800		(T (AND (MACH (CAR F) (CAR E))
06900			(MACH (CDR F) (CDR E))))
07000	]
07100	
07200	[DE SUBSTITUTE (V X) (PROG (Y) (RETURN (SUBS X)))]
07300	
07400	[DE SUBS (X) (COND
07500	
07600		((NUMBERP X) (COND ((SETQ Y (ASSOC X V)) (CDR Y)) (T X)))
07700		((ATOM X) X)
07800		(T (CONS (SUBS (CAR X)) (SUBS (CDR X))))
07900	]
08000	
08100	
08200	
08300	[SETQ FACTS NIL]
08400	
08500	[SETQ FACT-TRACE NIL]
08600	
08700	[DE RECORD (S) (COND
08800	
08900		((EQ (CAR S) @AND) (MAPC (FUNCTION RECORD) (CDR S)))
09000		(FACT-TRACE (TERPRI)
09100			(PRINC @"ADDING TO FACT LIST:")
09200			(PRINT S)
09300			(SETQ FACTS (CONS S FACTS))
09400			(TERPRI))
09500		(T (SETQ FACTS (CONS S FACTS)))
09600	]
09700	
09800	[DF CREATE (L) (PROG (X)
09900	
10000		(SETQ X (GENSYM))
10100		(RECORD (SUBSTITUTE (LIST (CONS (CAR L) X)) (CADR L)))
10200		(RETURN X)
10300	]
10400	
10500	[DE VERIFY (S) (PROG (X)
10600	
10700		(COND ((EQ (CAR S) @AND) (GO A))
10800		      ((EQ (CAR S) @OR) (GO B))
10900		      (T (RETURN (VERIFY1 S))))
11000	      A (COND ((NULL (SETQ S (CDR S))) (RETURN @TRUE))
11100		      ((NOT (EQ (SETQ X (VERIFY1 (CAR S))) @TRUE)) (RETURN X)))
11200		(GO A)
11300	      B (COND ((NULL (SETQ S (CDR S))) (RETURN @FALSE))
11400		      ((EQ (VERIFY1 (CAR S)) @TRUE) (RETURN @TRUE)))
11500		(GO B)
11600	]
11700	
11800	[DE VERIFY1 (S) (PROG (F N Y1 Z1 PR L)
11900	
12000		(SETQ F FACTS)
12100		(COND ((EQ (CAR S) @NOT) (SETQ N (SETQ K (CADR S)))
12200					 (SETQ PR @NOT))
12300		      (T (SETQ N (LIST @NOT S)) (SETQ K S)))
12400		(SETQ Y1 (CADR K))
12500		(SETQ Z1 (CADDR K))
12600		(COND ((AND (ATOM Y1)(ATOM Z1)) (GO A))
12700		      ((ATOM Y1) (SETQ Y1 (LIST Y1)))
12800		      ((ATOM Z1) (SETQ Z1 (LIST Z1))))
12900		(GO B)
13000	     A  (COND ((NULL F) (RETURN NIL))
13100		      ((EQUAL (CAR F) S) (RETURN @TRUE))
13200		      ((EQUAL (CAR F) N) (RETURN @FALSE)))
13300		(SETQ F (CDR F))
13400		(GO A)
13500	     B	(SETQ L (COMBINE (CAR K) Y1 Z1))
13600		(COND (PR (SETQ L (MAPCAR (FUNCTION (LAMBDA (X)
13700					  (CONS PR (LIST X)))) L))))
13800		(RETURN (VERIFY (CONS @OR L)))
13900	]
14000	
14100	[DF FIND (L) (PROG (V X Z)
14200	
14300		(SETQ V (CAR L))
14400		(SETQ L (CADR L))
14500		(SETQ L (COND ((EQ (CAR L) @AND) (CDR L))
14600			      (T (LIST L))))
14700		(SETQ X (FIND1 V (CAR L)))
14800		(COND ((NULL (SETQ L (CDR L))) (RETURN X)))
14900		(SETQ L (CONS @AND L))
15000	      A (COND ((NULL X) (RETURN Z))
15100		      ((EQ (VERIFY (SUBSTITUTE (LIST (CONS V (CAR X))) L)) @TRUE)
15200		       (SETQ Z (CONS (CAR X) Z))))
15300		(SETQ X (CDR X))
15400		(GO A)
15500	]
15600	
15700	[DE FIND1 (M S) (PROG (F X Z PR S1 S2)
15800	
15900		(COND ((EQ (CAR S) @NOT) (SETQ PR @NOT)(SETQ S (CADR S))))
16000		(COND ((ATOM (CADDR S)) (GO C)))
16100		(SETQ S1 (SUBST (CAADDR S) (CADDR S) S))
16200		(SETQ S2 (SUBST (CDADDR S) (CADDR S) S))
16300		(GO D)
16400	     C  (COND ((ATOM (CADR S)) (GO B)))
16500		(SETQ S1 (SUBST (CAADR S)(CADR S) S))
16600		(SETQ S2 (SUBST (CDADR S)(CADR S) S))
16700	     D  (COND (PR (SETQ S1 (CONS PR (LIST S1)))
16800		          (SETQ S2 (CONS PR (LIST S2)))))
16900		(RETURN (UNION (FIND1 M S1) (FIND1 M S2)))
17000	     B	(COND (PR (SETQ S (CONS PR (LIST S)))))
17100		(SETQ F FACTS)
17200	     A  (COND ((NULL F) (RETURN Z)))
17300		(SETQ X (MATCH NIL S (CAR F)))
17400		(SETQ X (ASSOC M X))
17500		(COND (X (SETQ Z (CONS (CDR X) Z))))
17600		(SETQ F (CDR F))
17700		(GO A)
17800	]
17900	
18000	[DE DESCRIBE (L) (PROG (Z)
18100	
18200		(COND ((NULL L) (RETURN @(NOTHING))))
18300		(MAPC (FUNCTION DESCRIBE1) L)
18400		(RETURN (CDR Z))
18500	]
18600	
18700	[DE DESCRIBE1 (X) (PROG (Y)
18800	
18900		(SETQ Y (FIND1 99 (LIST @ISA X 99)))
19000		(SETQ Y (NCONC (FIND1 99 (LIST @%COLOR X 99)) Y))
19100		(SETQ Y (NCONC (FIND1 99 (LIST @%SIZE X 99)) Y))
19200		(SETQ Z (NCONC Y Z))
19300		(SETQ Z (NCONC (LIST @AND @THE) Z))
19400		(RETURN (CDR Z))
19500	]
19600	
19700	[DF LOCATE (X)  (PROG (F Y Z)
19800	
19900		(COND ((ATOM (CAR X))(SETQ X (LIST X))))
20000		(SETQ F FACTS)
20100		(SETQ PREPS (GET @%PREP @SET))
20200	     A	(COND ((NULL F) (RETURN Z)))
20300		(SETQ Y (CAR F))
20400		(COND ((NOT (MEMQ (CAR Y) PREPS)) (GO B))
20500		      ((MEMQ (CADR Y) (CAR X)) (SETQ Z (CONS Y Z))))
20600	     B	(SETQ F (CDR F))
20700		(GO A)
20800	]
20900	
21000	[DE LOCATIONS (L) (PROG (Z)
21100	
21200		(COND ((NULL L) (RETURN @(I DONT KNOW))))
21300		(MAPC (FUNCTION LOC1) L)
21400		(RETURN (CDR Z))
21500	]
21600	
21700	[DE LOC1 (X) (PROG (Y)
21800	
21900		(SETQ Y (DESCRIBE1 (CADDR X)))
22000		(SETQ Y (NCONC (LIST (CAR X)) Y))
22100		(SETQ Z (NCONC (LIST @AND) Y))
22200	]
22300	
22400	[DE COMBINE (SP L1 L2)
22500	
22600		(COND ((NULL L2) NIL)
22700		      (T (APPEND (COMBINE SP L1 (CDR L2))
22800			         (COMBINE1 L1 (CAR L2)))))
22900	]
23000	
23100	[DE COMBINE1 (L X)
23200	
23300		(COND ((NULL L) NIL)
23400		      (T (CONS (LIST SP (CAR L) X) (COMBINE1 (CDR L) X))))
23500	]
23600	
23700	
23800	[DE UNION (U V)
23900	
24000		(COND ((NULL U) V)
24100		      ((MEMQ (CAR U) V) (UNION (CDR U) V))
24200		      (T (CONS (CAR U) (UNION (CDR U) V))))
24300	]
24400	
     

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