(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