(FILECREATED "25-FEB-82 21:23:09" <NEWLISP>CLISPENG.;1
    9325

     changes to:  CLISPENGCOMS)


(* Copyright (c) 1982 by Xerox Corporation)

(PRETTYCOMPRINT CLISPENGCOMS)

(RPAQQ CLISPENGCOMS
 ((FNS CLISPIFYIS CLISPIFYIS1)
	(PROP CLISPIFYISPROP ARRAYP ATOM EQUAL FLOATP LISTP NLISTP LITATOM MINUSP NUMBERP SMALLP 
	      STRINGP TAILP GT LT MEMBER MEMB)
	(SPECVARS FORM LST CLTYP0 OPR0)
	(GLOBALVARS LCASEFLG CLISPIFYENGLSHFLG)
	(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
					       CLISPIFY))))
(DEFINEQ

(CLISPIFYIS

  [LAMBDA (FORM PROP)              (* wt: "24-MAR-78 15:07")

    (AND CLISPIFYENGLSHFLG (NEQ OPR0 (QUOTE :))
	 (NEQ CLTYP0 (QUOTE IS
))
	 (PROG (MATCHUP PHRASE SUBJ PLURALFLG SEGFLG TEM)
	       (COND
		 ((LISTP PROP)

          (* For most cases, PROP is an atom, namely the name of the KEY for the is phrase. but for some, there can be several

	  alternatives. e.g. suppose (A is the last element of B) translates to (EQ A (CAR (LAST B))) and 

	  (A is the first element of B) to (EQ A (CAR B)) then EQ will have a CLISPIFYISPROP property of 

	  (LAST FIRST))



		   [SOME PROP (FUNCTION (LAMBDA (PROP)
			     (SETQ TEM (CLISPIFYIS
 FORM PROP]
		   (RETURN TEM)))
	       (SETQ PROP (GETPROP PROP (QUOTE CLISPISFORM)))
	   LP  (COND
		 ([NULL (SETQ MATCHUP (CLISPIFYMATCHUP (CADDR PROP)
						       FORM
						       (CAR PROP]
		   (COND
		     ((SETQ PROP (CDDDR PROP))
		       (GO LP)))
		   (RETURN NIL)))
	       (SETQ PHRASE (CADR PROP))
	       [COND
		 (NEGFLG (SETQ PHRASE (CONS (CAR PHRASE)
					    (COND
					      ([SETQ TEM (CDDDR (GETPROP (CADR PHRASE)
									 (QUOTE CLISPISPROP]
                                   (* e.g. negation of HAS is DOESN'T HAVE)

						(APPEND TEM (CDDR PHRASE)))
					      (T (CONS (CADR PHRASE)
						       (COND
							 ((EQ (CAR (SETQ PHRASE (CDDR PHRASE)))
							      (QUOTE NOT))
                                   (* E.g. (NOT (NLISTP X)) clispifyies to (X IS A LIST) because the dobule negation

				   gets removed here.)

							   (CDR PHRASE))
							 (T (CONS (QUOTE NOT)
								  PHRASE]
	   FACTOR
	       (COND
		 [(OR (NULL CLISPISTATE)
		      (NULL OPR0)
		      (NEQ TAIL (CDR (fetch
 TAIL of
 CLISPISTATE]
		 ([AND (EQ PROP (fetch
 PROP of
 CLISPISTATE))
		       (EQ NEGFLG (fetch
 NEGFLG of
 CLISPISTATE))
		       (EQ (fetch
 OBJ of
 MATCHUP)
			   (fetch
 OBJ of
 (fetch
 MATCHUP of
 CLISPISTATE]
                                   (* Factor onrelation (AND (NUMBERP X) (NUMBERP Y)))


          (* New SUBJ. Will be clispified at CLISPIFY2a below. Thus if this is the third factoring, SUBJ would no be 

	  (AND (AND X Y) Z) but this goes to (X and Y and Z) which is what is wanted.)



		   (SETQ SUBJ (LIST (CAR PARENT)
				    (fetch
 SUBJ of
 (fetch
 MATCHUP of
 CLISPISTATE))
				    (fetch
 SUBJ of
 MATCHUP)))
		   (replace
 SUBJ of
 MATCHUP with
 SUBJ)
		   (SETQ LST (APPEND (fetch
 LST of
 CLISPISTATE)))

          (* LST is bound in clipify1. it is the clispified results being assembbled. Since the previous clause is being 

	  incorporated into the curren one, we backup LST to the value it had as of the previous is phrase.)



		   (SETQ PLURALFLG T)
                                   (* For MAPCONC below.)

		   (SETQ SEGFLG (fetch
 SEGFLG of
 CLISPISTATE))

          (* Indicates whether it is ok to remove parens or not, i.e. SEGFLG = T means ok. We cannot remove parens if there 

	  was a non-is form before this one, e.g. (AND X (NUMBERP Y) (NUMBER Z)) cannot go to (X and Y and Z are nummers) but 

	  instead must go to (X and (Y and Z are numbers)))



		   (replace
 TAIL of
 CLISPISTATE with
 TAIL)

          (* needed to notice if there were any non-is phrases intervening between last one and this one, e.g. 

	  (AND (NUMBERP X) Y (NUMBERP Z)) mustgo to (X is a number and Y and Z is a number))



		   (replace
 MATCHUP of
 CLISPISTATE with
 MATCHUP)
		   (GO SKIP))
		 ((EQUAL (fetch
 SUBJ of
 MATCHUP)
			 (fetch
 SUBJ of
 (fetch
 MATCHUP of
 CLISPISTATE)))
                                   (* Factor on subject, e.g. (AND (NUMBERP X) 

				   (ATOM X)))

		   (replace
 MATCHUP of
 CLISPISTATE with
 MATCHUP)
		   (SETQ PHRASE (CDDR PHRASE))
                                   (* Deletes the subject and the is/are word.)

		   (SETQ MATCHUP (CDR MATCHUP))
                                   (* removes the subject so that it isnt substituted for in call to clispifyis1 

				   below)

		   (replace
 TAIL of
 CLISPISTATE with
 TAIL)
		   (GO SKIP)))
	       (SETQ CLISPISTATE (create
 CLISPISTATE
					 PROP _ PROP
					 NEGFLG _ NEGFLG
					 LST _(APPEND LST)
					 SEGFLG _[EQ TAIL (CDR (COND
								 (CLISPISTATE 
                                   (* See comment about SEGFLG above.)

									      (fetch
 TAIL
										 of
 CLISPISTATE))
								 (T PARENT]
					 TAIL _ TAIL
					 MATCHUP _ MATCHUP))
	   SKIP[AND (OR LCASEFLG PLURALFLG)
		    (SETQ PHRASE (MAPCONC PHRASE (FUNCTION (LAMBDA (X)
                                   (* Goes through the phrase and replaces the canonical form by the aprorpriate 

				   expressions for upper or lower case, singular or plural.)

					      (COND
						([OR (FMEMB X (CAR PROP))
						     (NLISTP (SETQ TEM (GETPROP X (QUOTE CLISPISPROP]
						  (LIST X))
						((NULL PLURALFLG)
                                   (* lowercase singular.)

						  (LIST (CAR TEM)))
						[(NULL (CDR TEM))

          (* stored on the property list of these words under the CLISPISPROP property is a list of the form 

	  (lower-sing upper-plural lower-plural) e.g. for ATOM the property is (atom ATOMS atoms) If there is no second and 

	  third entry, means the singular and plural are the same. However, if the second or third entry are NIL, means they 

	  are not present for plural. E.g. this is how A and AN disappear in plural.)



						  (LIST (COND
							  (LCASEFLG (CAR TEM))
							  (T X]
						([SETQ TEM (COND
						      (LCASEFLG (CADDR TEM))
						      (T (CADR TEM]
						  (LIST TEM]
	       (SETQ NEGFLG NIL)   (* Negation has already been taken care of earlier.)

	       (PROG (LST (CLTYP0 (QUOTE IS
))
			  OPR0)
		     (SETQ PHRASE (CLISPIFYIS1
 [MAPCAR MATCHUP (FUNCTION (LAMBDA (X)
							   (CONS (CAR X)
								 (CLISPIFY2A (CDR X]
					       PHRASE)))
	       [COND
		 [(NULL OPR0)
		   (SETQ SEG (COND
		       ((NULL CLTYP0)
			 NIL)
		       ((EQ CLTYP0 (QUOTE COND))
			 T)
		       ((NLISTP CLTYP0)
			 (HELP))
		       ([AND (EQ TAIL (CDR CLTYP0))
			     [OR (NULL (CDR TAIL))
				 (EQ (CAR (GETPROP (CADR TAIL)
						   (QUOTE CLISPWORD)))
				     (CAR (GETPROP (CAR CLTYP0)
						   (QUOTE CLISPWORD]
			     (NULL (SOME PHRASE (FUNCTION (LAMBDA (X)
					     (LISTP (GETPROP X (QUOTE CLISPWORD]

          (* Says there is only one expression there so safe to remove parentehses, e.g. (IF A THEN (AND B C) ELSE D) The 

	  reason for the SOME is that cant remve parens if any of the words in L are also operators, e.g. user writes 

	  (WHILE (IGREATERP X COUNT) do --) can't remove parens because COUNT is also an operator)



			 T]
		 ((NULL PLURALFLG)
                                   (* Always safe to remove parens on simple singlur phras.)

		   (SETQ SEG T))
		 ((NULL (SETQ SEG SEGFLG))
                                   (* If we are not going to remove parens, we have to packup the operaaors.)

		   (SETQ PHRASE (CLISP3A PHRASE]
	       (RETURN PHRASE])

(CLISPIFYIS1

  [LAMBDA (ALST $EXPR)             (* wt: 13-FEB-76 20 34)

                                   (* essentially an LSUBLIS, except it knows that it is always substituting for 

				   atoms.)

    (PROG (TEM)
          (RETURN (COND
		    ((NULL $EXPR)
		      NIL)
		    ((NLISTP $EXPR)
		      (COND
			((SETQ TEM (FASSOC $EXPR ALST))
			  (CDR TEM))
			(T $EXPR)))
		    [(SETQ TEM (FASSOC (CAR $EXPR)
				       ALST))
		      (APPEND (CDR TEM)
			      (CLISPIFYIS1
 ALST (CDR $EXPR]
		    (T (CONS (CLISPIFYIS1
 ALST (CAR $EXPR))
			     (CLISPIFYIS1
 ALST (CDR $EXPR])
)

(PUTPROPS ARRAYP CLISPIFYISPROP
 ARRAY)

(PUTPROPS ATOM CLISPIFYISPROP
 ATOM)

(PUTPROPS EQUAL CLISPIFYISPROP
 EQUAL)

(PUTPROPS FLOATP CLISPIFYISPROP
 FLOATING)

(PUTPROPS LISTP CLISPIFYISPROP
 LIST)

(PUTPROPS NLISTP CLISPIFYISPROP
 LIST)

(PUTPROPS LITATOM CLISPIFYISPROP
 LITERAL)

(PUTPROPS MINUSP CLISPIFYISPROP
 NEGATIVE)

(PUTPROPS NUMBERP CLISPIFYISPROP
 NUMBER)

(PUTPROPS SMALLP CLISPIFYISPROP
 SMALL)

(PUTPROPS STRINGP CLISPIFYISPROP
 STRING)

(PUTPROPS TAILP CLISPIFYISPROP
 TAIL)

(PUTPROPS GT CLISPIFYISPROP
 GREATER)

(PUTPROPS LT CLISPIFYISPROP
 LESS)

(PUTPROPS MEMBER CLISPIFYISPROP
 MEMBER)

(PUTPROPS MEMB CLISPIFYISPROP
 MEMB)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS FORM LST CLTYP0 OPR0)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS LCASEFLG CLISPIFYENGLSHFLG)
)
(DECLARE: EVAL@COMPILE DONTCOPY 
(FILESLOAD (LOADCOMP)
	   CLISPIFY)
)
(DECLARE: DONTCOPY (PUTPROPS CLISPENG COPYRIGHT ("Xerox Corporation" 1982)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (515 8301 (CLISPIFYIS 525 . 7689) (CLISPIFYIS1 7691 . 8299)))))
STOP