(FILECREATED "16-Jul-85 17:29:28" {ERIS}<LISPCORE>LIBRARY>CMLARITH.;1
 8148   

      changes to:  (VARS CMLARITHCOMS)
		   (RECORDS RATIO)
		   (FNS PLUSP = /= < > <= >= %%= - / %%/)
		   (MACROS = /= < > <= >= + CL:* - /))


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

(PRETTYCOMPRINT CMLARITHCOMS)

(RPAQQ CMLARITHCOMS
 ((RECORDS RATIO COMPLEX)
		     (FNS PLUSP)
		     (* MINUSP ODDP EVENP are close enough)
		     (FNS = /= < > <= >=)
		     (MACROS = /= < > <= >=)
		     (FNS %%=)
		     (MACROS =)
		     (* MAX and MIN are OK)
		     (P (MOVD (QUOTE PLUS)
			      (QUOTE +))
			(MOVD (QUOTE TIMES)
			      (QUOTE CL:*)))
		     (PROP DMACRO + CL:*)
		     (FNS - / %%/)
		     (PROP DMACRO - /)
		     (FNS 1+ 1-)
		     (MACROS 1+ 1-)))
[DECLARE: EVAL@COMPILE 

(DATATYPE RATIO
 (NUMERATOR DENOMINATOR))
(
QUOTE
 (no RECORD declaration for COMPLEX))
]
(/DECLAREDATATYPE (QUOTE RATIO)
		  (QUOTE (POINTER POINTER))
		  (QUOTE ((RATIO 0 POINTER)
			  (RATIO 2 POINTER)))
		  (QUOTE 4))
(DEFINEQ

(PLUSP

  (CL:LAMBDA (NUMBER)
    (
GREATERP
 NUMBER 0)))
)



(* MINUSP ODDP EVENP are close enough)


(DEFINEQ

(=

  (CL:LAMBDA (NUMBER &REST MORE-NUMBERS)                     (* lmm "16-Jul-85 16:51")

    (for
 X in
 MORE-NUMBERS always
 (%%=
 NUMBER X))))

(/=

  [CL:LAMBDA (&REST NUMBERS)                                 (* lmm "16-Jul-85 16:56")

    (for
 X on
 NUMBERS always
 (for
 Y in
 (
CDR
 X) always
 (
NOT
 (=
 (
CAR
 X)
							      Y])

(<

  [CL:LAMBDA (&REST MORE-NUMBERS)                            (* lmm "16-Jul-85 17:03")

    (for
 X on
 MORE-NUMBERS while
 (
CDR
 X) always
 (
LESSP
 (
CAR
 X)
						       (
CADR
 X])

(>

  [CL:LAMBDA (&REST MORE-NUMBERS)                            (* lmm "16-Jul-85 17:04")

    (for
 X on
 MORE-NUMBERS while
 (
CDR
 X) always
 (
GREATERP
 (
CAR
 X)
							  (
CADR
 X])

(<=

  [CL:LAMBDA (&REST MORE-NUMBERS)                            (* lmm "16-Jul-85 17:18")

    (for
 X on
 MORE-NUMBERS while
 (
CDR
 X) always
 (
LEQ
 (
CAR
 X)
						     (
CADR
 X])

(>=

  [CL:LAMBDA (&REST MORE-NUMBERS)                            (* lmm "16-Jul-85 17:19")

    (for
 X on
 MORE-NUMBERS while
 (
CDR
 X) always
 (
GEQ
 (
CAR
 X)
						     (
CADR
 X])
)
(DECLARE: EVAL@COMPILE 
[PUTPROPS = DMACRO (DEFMACRO (N &REST NS)
			     (COND ((CDR NS)
				    (BQUOTE ([OPENLAMBDA (N)
							 (AND (= N (\, (CAR NS)))
							      (= N (\,@ (CDR NS]
					     , N)))
				   (T (BQUOTE (%%= (\, N)
						   (\, (CAR NS]
[PUTPROPS
  /= DMACRO
  (DEFMACRO
    (N &REST NS)
    (COND
      [NS
	(IF
	  (CDR NS)
	  THEN
	  [LET [(VARS (FOR X IN (CONS N NS)
			   COLLECT
			   (LIST (GENSYM (QUOTE /=))
				 X]
	       (BQUOTE ([OPENLAMBDA
			  (\, (MAPCAR VARS (QUOTE CAR)))
			  (AND (\,@ (for X on VARS join
					 (for Y on (CDR VARS)
					      collect
					      (BQUOTE (NOT (= (\, (CAAR X))
							      (\, (CAAR Y]
			(\,@ (MAPCAR VARS (QUOTE CADR]
	  ELSE
	  (BQUOTE (NOT (= , N , (CAR NS]
      (T T]
[PUTPROPS < DMACRO
	  (DEFMACRO (N &REST NS)
		    (COND
		      ((NULL NS)
		       T)
		      [(CDR NS)
		       (LET [(VARS (FOR X IN (CONS N NS)
					COLLECT
					(LIST (GENSYM (QUOTE /=))
					      X]
			    (BQUOTE ([OPENLAMBDA
				       (\, (MAPCAR VARS (QUOTE CAR)))
				       (AND (\,@ (for X on VARS while (CDR X)
						      collect
						      (BQUOTE (LESSP (\, (CAAR X))
								     (\, (CAADR X]
				     (\,@ (MAPCAR VARS (QUOTE CADR]
		      (T (BQUOTE (LESSP (\, N)
					(\, (CAR NS]
[PUTPROPS > DMACRO
	  (DEFMACRO (N &REST NS)
		    (COND
		      ((NULL NS)
		       T)
		      [(CDR NS)
		       (LET [(VARS (FOR X IN (CONS N NS)
					COLLECT
					(LIST (GENSYM (QUOTE /=))
					      X]
			    (BQUOTE ([OPENLAMBDA
				       (\, (MAPCAR VARS (QUOTE CAR)))
				       (AND (\,@ (for X on VARS while (CDR X)
						      collect
						      (BQUOTE (GREATERP (\, (CAAR X))
									(\, (CAADR X]
				     (\,@ (MAPCAR VARS (QUOTE CADR]
		      (T (BQUOTE (GREATERP (\, N)
					   (\, (CAR NS]
[PUTPROPS <= DMACRO
	  (DEFMACRO (N &REST NS)
		    (COND
		      ((NULL NS)
		       T)
		      [(CDR NS)
		       (LET [(VARS (FOR X IN (CONS N NS)
					COLLECT
					(LIST (GENSYM (QUOTE /=))
					      X]
			    (BQUOTE ([OPENLAMBDA
				       (\, (MAPCAR VARS (QUOTE CAR)))
				       (AND (\,@ (for X on VARS while (CDR X)
						      collect
						      (BQUOTE (LEQ (\, (CAAR X))
								   (\, (CAADR X]
				     (\,@ (MAPCAR VARS (QUOTE CADR]
		      (T (BQUOTE (LEQ (\, N)
				      (\, (CAR NS]
[PUTPROPS >= DMACRO
	  (DEFMACRO (N &REST NS)
		    (COND
		      ((NULL NS)
		       T)
		      [(CDR NS)
		       (LET [(VARS (FOR X IN (CONS N NS)
					COLLECT
					(LIST (GENSYM (QUOTE /=))
					      X]
			    (BQUOTE ([OPENLAMBDA
				       (\, (MAPCAR VARS (QUOTE CAR)))
				       (AND (\,@ (for X on VARS while (CDR X)
						      collect
						      (BQUOTE (GEQ (\, (CAAR X))
								   (\, (CAADR X]
				     (\,@ (MAPCAR VARS (QUOTE CADR]
		      (T (BQUOTE (GEQ (\, N)
				      (\, (CAR NS]
)
(DEFINEQ

(%%=

  [LAMBDA (X Y)                                              (* lmm "16-Jul-85 17:01")

                                                             (* sort of like EQP)

    (if
 (
AND
 (
FIXP
 X)
	     (
FIXP
 Y))
	then
 (
IEQP
 X Y)
      else
 (
FEQP
 X Y])
)
(DECLARE: EVAL@COMPILE 
[PUTPROPS = DMACRO (DEFMACRO (N &REST NS)
			     (COND ((CDR NS)
				    (BQUOTE ([OPENLAMBDA (N)
							 (AND (= N (\, (CAR NS)))
							      (= N (\,@ (CDR NS]
					     , N)))
				   (T (BQUOTE (%%= (\, N)
						   (\, (CAR NS]
)



(* MAX and MIN are OK)


(MOVD (QUOTE PLUS)
      (QUOTE +))
(MOVD (QUOTE TIMES)
      (QUOTE CL:*))

(PUTPROPS + DMACRO
 (= . PLUS))

(PUTPROPS CL:* DMACRO
 (= . TIMES))
(DEFINEQ

(-

  (CL:LAMBDA (NUMBER &REST NUMBERS)
    (IF
 (
NULL
 NUMBERS)
	THEN
 (
DIFFERENCE
 0 NUMBER)
      ELSE
 (LET ((RESULT NUMBER))
	        (FOR
 X IN
 NUMBERS DO
 (
SETQ
 RESULT (
DIFFERENCE
 RESULT X)))
	    RESULT))))

(/

  [LAMBDA (NUMBER &REST NUMBERS)
    (IF
 (
NULL
 NUMBERS)
	THEN
 (%%/
 1 NUMBER)
      ELSE
 (FOR
 X IN
 NUMBERS DO
 (
SETQ
 NUMBER (%%/
 NUMBER X)) FINALLY
 (
RETURN
 X])

(%%/

  [LAMBDA (X Y)
    (IF
 (
EVENP
 X Y)
	THEN
 (
QUOTIENT
 X Y)
      ELSE
 (
ERROR
 "Ratios not implemented"])
)

(PUTPROPS - DMACRO
 [DEFMACRO (NUMBER &REST NUMBERS)
			     (IF (NULL NUMBERS)
				 THEN
				 (BQUOTE (DIFFERENCE 0 (\, NUMBER)))
				 ELSE
				 (FOR X IN NUMBERS DO [SETQ NUMBER (BQUOTE (DIFFERENCE (\, NUMBER)
										       (\, X]
				      FINALLY
				      (RETURN NUMBER])

(PUTPROPS / DMACRO
 [DEFMACRO (NUMBER &REST NUMBERS)
			     (IF (NULL NUMBERS)
				 THEN
				 (BQUOTE (%%/ 0 (\, NUMBER)))
				 ELSE
				 (FOR X IN NUMBERS DO [SETQ NUMBER (BQUOTE (%%/ (\, NUMBER)
										(\, X]
				      FINALLY
				      (RETURN NUMBER])
(DEFINEQ

(1+

  [LAMBDA (X)
    (
PLUS
 X 1])

(1-

  [LAMBDA (X)
    (
DIFFERENCE
 X 1])
)
(DECLARE: EVAL@COMPILE 
(PUTPROPS 1+ DMACRO ((X)
	   (PLUS X 1)))
(PUTPROPS 1- DMACRO ((X)
	   (DIFFERENCE X 1)))
)
(PRETTYCOMPRINT CMLARITHCOMS)

(RPAQQ CMLARITHCOMS
 [(RECORDS RATIO COMPLEX)
		     (FNS PLUSP)
		     (* MINUSP ODDP EVENP are close enough)
		     (FNS = /= < > <= >=)
		     (MACROS = /= < > <= >=)
		     (FNS %%=)
		     (MACROS =)
		     (* MAX and MIN are OK)
		     (P (MOVD (QUOTE PLUS)
			      (QUOTE +))
			(MOVD (QUOTE TIMES)
			      (QUOTE CL:*)))
		     (PROP DMACRO + CL:*)
		     (FNS - / %%/)
		     (PROP DMACRO - /)
		     (FNS 1+ 1-)
		     (MACROS 1+ 1-)
		     (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
			       (ADDVARS (NLAMA)
					(NLAML)
					(LAMA /= =])
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 /= =)
)
(PUTPROPS CMLARITH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1033 1107 (PLUSP 1043 . 1105)) (1155 2420 (= 1165 . 1330) (/= 1332 . 1557) (< 1559 . 
1774) (> 1776 . 1990) (<= 1992 . 2204) (>= 2206 . 2418)) (5197 5504 (%%= 5207 . 5502)) (5947 6559 (- 
5957 . 6207) (/ 6209 . 6421) (%%/ 6423 . 6557)) (7109 7211 (1+ 7119 . 7160) (1- 7162 . 7209)))))
STOP