(FILECREATED " 2-Jul-85 20:13:33" {ERIS}<ROACH>MISC>ARITHTEST.FPKG;1 33077
changes to: (FNS AT.TEST AT.INIT AT.EVAL AT.ASSERT AT.ASSERTVARS AT.ASSERTVARS1 AT.QUICK.TEST
AT.QUICK.PLUS AT.QUICK.MINUS AT.QUICK.DIFFERENCE AT.QUICK.ADD1.SUB1
AT.QUICK.TIMES AT.QUICK.QUOTIENT AT.QUICK.REMAINDER.MOD.GCD AT.QUICK.MIN.MAX
AT.QUICK.PREDS AT.QUICK.LOGICAL AT.QUICK.POWEROFTWO AT.BOUNDARY.TEST
AT.BOUNDARY.LIST AT.RANDOM.TEST AT.RANDOM.NUMBERS AT.RANDOM.NUMBER
AT.RANDOM.ELEMENT AT.RANDOM.SUBSET AT.RANDOM.BOUNDARY.TEST AT.GENERAL.TEST
AT.GENERAL.PLUS AT.GENERAL.MINUS AT.GENERAL.DIFFERENCE AT.GENERAL.ADD1.SUB1
AT.GENERAL.TIMES AT.GENERAL.QUOTIENT AT.GENERAL.REMAINDER.MOD.GCD
AT.GENERAL.MIN.MAX AT.GENERAL.PREDS AT.GENERAL.LOGICAL AT.GENERAL.POWEROFTWO
AT.SYSTEM.TEST))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT ARITHTESTCOMS)
(RPAQQ ARITHTESTCOMS ((PROPS (AT.EVAL ARGNAMES)
(AT.ASSERT ARGNAMES))
(INITVARS (AT.BIG1S NIL)
(AT.BIG2S NIL)
(AT.BIG3S NIL)
(AT.BIG4S NIL)
(AT.ASSERTVARS NIL)
(AT.THETA 10000)
(AT.BETA (EXPT 2 14))
(AT.BOUNDARIES (LIST MAX.SMALLP MIN.SMALLP MAX.FIXP MIN.FIXP AT.THETA (IMINUS
AT.THETA)
AT.BETA
(IMINUS AT.BETA))))
(FNS AT.TEST AT.INIT AT.EVAL AT.ASSERT AT.ASSERTVARS AT.ASSERTVARS1 AT.QUICK.TEST
AT.QUICK.PLUS AT.QUICK.MINUS AT.QUICK.DIFFERENCE AT.QUICK.ADD1.SUB1 AT.QUICK.TIMES
AT.QUICK.QUOTIENT AT.QUICK.REMAINDER.MOD.GCD AT.QUICK.MIN.MAX AT.QUICK.PREDS
AT.QUICK.LOGICAL AT.QUICK.POWEROFTWO AT.BOUNDARY.TEST AT.BOUNDARY.LIST AT.RANDOM.TEST
AT.RANDOM.NUMBERS AT.RANDOM.NUMBER AT.RANDOM.ELEMENT AT.RANDOM.SUBSET
AT.RANDOM.BOUNDARY.TEST AT.GENERAL.TEST AT.GENERAL.PLUS AT.GENERAL.MINUS
AT.GENERAL.DIFFERENCE AT.GENERAL.ADD1.SUB1 AT.GENERAL.TIMES AT.GENERAL.QUOTIENT
AT.GENERAL.REMAINDER.MOD.GCD AT.GENERAL.MIN.MAX AT.GENERAL.PREDS AT.GENERAL.LOGICAL
AT.GENERAL.POWEROFTWO AT.SYSTEM.TEST)))
(PUTPROPS AT.EVAL ARGNAMES (FORM))
(PUTPROPS AT.ASSERT ARGNAMES (FORM))
(RPAQ? AT.BIG1S NIL)
(RPAQ? AT.BIG2S NIL)
(RPAQ? AT.BIG3S NIL)
(RPAQ? AT.BIG4S NIL)
(RPAQ? AT.ASSERTVARS NIL)
(RPAQ? AT.THETA 10000)
(RPAQ? AT.BETA (EXPT 2 14))
(RPAQ? AT.BOUNDARIES (LIST MAX.SMALLP MIN.SMALLP MAX.FIXP MIN.FIXP AT.THETA (IMINUS AT.THETA)
AT.BETA
(IMINUS AT.BETA)))
(DEFINEQ
(AT.TEST
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.INIT)
(AT.QUICK.TEST)
(AT.BOUNDARY.TEST)
(DO (AT.RANDOM.TEST)
(AT.RANDOM.BOUNDARY.TEST)) (* AT.SYSTEM.TEST)
)))
(AT.INIT
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(SETQ AT.BIG1S (MKATOM "111111111111"))
(SETQ AT.BIG2S (MKATOM "222222222222"))
(SETQ AT.BIG3S (MKATOM "333333333333"))
(SETQ AT.BIG4S (MKATOM "444444444444")))))
(AT.EVAL
(NLAMBDA $FEXPR$ (* kbr: " 2-Jul-85 20:12")
((LAMBDA (FORM) (* EVAL FORM for effect. Print any error msg that
occurs under NLSETQ. *)
(COND
((NULL (APPLY* 'NLSETQ FORM))
(printout T FORM T " " (ERRORSTRING (CAR (ERRORN)))
" "
(CDR (ERRORN))
T))))
(pop $FEXPR$))))
(AT.ASSERT
(NLAMBDA $FEXPR$ (* kbr: " 2-Jul-85 20:12")
((LAMBDA (FORM) (* FORM should EVAL to T. *)
(DECLARE (LOCALVARS . T))
(PROG (VALUE)
(SETQ VALUE (APPLY* 'NLSETQ FORM))
(COND
((AND VALUE (EQ (CAR VALUE)
T))
(RETURN)))
(printout T FORM T)
(FOR VAR IN (AT.ASSERTVARS FORM) DO (printout T " " VAR " = " (EVAL VAR)
T))
(COND
((NULL VALUE)
(printout T " " (ERRORSTRING (CAR (ERRORN)))
" "
(CDR (ERRORN))
T))
(T (printout T " " "should EVAL to T" T)))))
(pop $FEXPR$))))
(AT.ASSERTVARS
(LAMBDA (FORM) (* kbr: " 2-Jul-85 20:12")
(* Assumes FORM is a vanilla expression.
Returns free variables in FORM.
*)
(PROG NIL
(SETQ AT.ASSERTVARS NIL)
(AT.ASSERTVARS1 FORM)
(SORT AT.ASSERTVARS)
(RETURN AT.ASSERTVARS))))
(AT.ASSERTVARS1
(LAMBDA (FORM) (* kbr: " 2-Jul-85 20:12")
(COND
((LITATOM FORM)
(PUSHNEW AT.ASSERTVARS FORM))
((LISTP FORM)
(FOR ELEMENT IN (CDR FORM) DO (AT.ASSERTVARS1 ELEMENT))))))
(AT.QUICK.TEST
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.QUICK.PLUS)
(AT.QUICK.MINUS)
(AT.QUICK.DIFFERENCE)
(AT.QUICK.ADD1.SUB1)
(AT.QUICK.TIMES)
(AT.QUICK.QUOTIENT)
(AT.QUICK.REMAINDER.MOD.GCD)
(AT.QUICK.MIN.MAX)
(AT.QUICK.PREDS)
(AT.QUICK.LOGICAL)
(AT.QUICK.POWEROFTWO))))
(AT.QUICK.PLUS
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (IEQP (IPLUS AT.BIG1S AT.BIG1S)
AT.BIG2S))
(AT.ASSERT (IEQP (IPLUS AT.BIG1S AT.BIG3S)
(IPLUS AT.BIG2S AT.BIG2S)))
(AT.ASSERT (IEQP (IPLUS AT.BIG1S AT.BIG2S AT.BIG3S)
(IPLUS AT.BIG3S AT.BIG2S AT.BIG1S)))
(AT.ASSERT (IEQP (IPLUS AT.BIG1S MIN.FIXP)
(IPLUS MIN.FIXP AT.BIG1S)))
(AT.ASSERT (IEQP (IPLUS AT.BIG1S 0)
AT.BIG1S))
(AT.ASSERT (IEQP (IPLUS 0 AT.BIG1S)
AT.BIG1S)))))
(AT.QUICK.MINUS
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (IEQP (IMINUS (IMINUS AT.BIG1S))
AT.BIG1S))
(AT.ASSERT (IEQP (IABS (IMINUS AT.BIG1S))
AT.BIG1S)))))
(AT.QUICK.DIFFERENCE
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (EQ (IDIFFERENCE AT.BIG1S AT.BIG1S)
0))
(AT.ASSERT (IEQP (IDIFFERENCE AT.BIG2S AT.BIG1S)
AT.BIG1S))
(AT.ASSERT (IEQP (IDIFFERENCE 0 AT.BIG1S)
(IMINUS AT.BIG1S)))
(AT.ASSERT (IEQP (IDIFFERENCE AT.BIG1S AT.BIG2S)
(IMINUS AT.BIG1S))))))
(AT.QUICK.ADD1.SUB1
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (IEQP (ADD1 AT.BIG1S)
(IPLUS AT.BIG1S 1)))
(AT.ASSERT (IEQP (SUB1 AT.BIG1S)
(IDIFFERENCE AT.BIG1S 1))))))
(AT.QUICK.TIMES
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (IEQP (ITIMES AT.BIG1S AT.BIG1S)
(EXPT AT.BIG1S 2)))
(AT.ASSERT (IEQP (ITIMES AT.BIG1S AT.BIG4S)
(ITIMES AT.BIG2S AT.BIG2S)))
(AT.ASSERT (IEQP (ITIMES AT.BIG1S AT.BIG2S AT.BIG3S)
(ITIMES AT.BIG3S AT.BIG2S AT.BIG1S)))
(AT.ASSERT (IEQP (ITIMES AT.BIG1S MIN.FIXP)
(ITIMES MIN.FIXP AT.BIG1S)))
(AT.ASSERT (EQ (ITIMES AT.BIG1S 0)
0))
(AT.ASSERT (EQ (ITIMES 0 AT.BIG1S)
0))
(AT.ASSERT (IEQP (ITIMES -1 AT.BIG1S)
(IMINUS AT.BIG1S)))
(AT.ASSERT (IEQP (ITIMES (IMINUS AT.BIG1S)
(IMINUS AT.BIG1S))
(ITIMES AT.BIG1S AT.BIG1S))))))
(AT.QUICK.QUOTIENT
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (IEQP (IQUOTIENT AT.BIG4S AT.BIG1S)
4))
(AT.ASSERT (IEQP (IQUOTIENT (ITIMES AT.BIG1S AT.BIG4S)
AT.BIG1S)
AT.BIG4S))
(AT.ASSERT (IEQP (IQUOTIENT (IPLUS AT.BIG4S MAX.SMALLP)
AT.BIG1S)
4))
(AT.ASSERT (IEQP (IQUOTIENT (IPLUS (ITIMES AT.BIG1S AT.BIG4S)
MAX.SMALLP)
AT.BIG1S)
AT.BIG4S))
(AT.ASSERT (IEQP (IQUOTIENT (IDIFFERENCE AT.BIG4S MAX.SMALLP)
AT.BIG1S)
3))
(AT.ASSERT (IEQP (IQUOTIENT (IDIFFERENCE (ITIMES AT.BIG1S AT.BIG4S)
MAX.SMALLP)
AT.BIG1S)
(SUB1 AT.BIG4S))))))
(AT.QUICK.REMAINDER.MOD.GCD
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (EQ (IREMAINDER AT.BIG4S AT.BIG1S)
0))
(AT.ASSERT (IEQP (IREMAINDER (IPLUS AT.BIG4S MAX.SMALLP)
AT.BIG1S)
MAX.SMALLP))
(AT.ASSERT (IEQP (IREMAINDER (IDIFFERENCE AT.BIG4S MAX.SMALLP)
AT.BIG1S)
(IDIFFERENCE AT.BIG1S MAX.SMALLP)))
(AT.ASSERT (EQ (IREMAINDER (IMINUS AT.BIG4S)
AT.BIG1S)
0))
(AT.ASSERT (IEQP (IREMAINDER (IMINUS (IPLUS AT.BIG4S MAX.SMALLP))
AT.BIG1S)
(IMINUS MAX.SMALLP)))
(AT.ASSERT (IEQP (IREMAINDER (IMINUS (IDIFFERENCE AT.BIG4S MAX.SMALLP))
AT.BIG1S)
(IMINUS (IDIFFERENCE AT.BIG1S MAX.SMALLP))))
(AT.ASSERT (EQ (IMOD AT.BIG4S AT.BIG1S)
0))
(AT.ASSERT (IEQP (IMOD (IPLUS AT.BIG4S MAX.SMALLP)
AT.BIG1S)
MAX.SMALLP))
(AT.ASSERT (IEQP (IMOD (IDIFFERENCE AT.BIG4S MAX.SMALLP)
AT.BIG1S)
(IDIFFERENCE AT.BIG1S MAX.SMALLP)))
(AT.ASSERT (EQ (IMOD (IMINUS AT.BIG4S)
AT.BIG1S)
0))
(AT.ASSERT (IEQP (IMOD (IMINUS (IPLUS AT.BIG4S MAX.SMALLP))
AT.BIG1S)
(IDIFFERENCE AT.BIG1S MAX.SMALLP)))
(AT.ASSERT (IEQP (IMOD (IMINUS (IDIFFERENCE AT.BIG4S MAX.SMALLP))
AT.BIG1S)
(IDIFFERENCE AT.BIG1S (IDIFFERENCE AT.BIG1S MAX.SMALLP))))
(AT.ASSERT (IEQP (GCD (IPLUS MAX.FIXP 100)
(IPLUS MAX.FIXP 101))
1))
(AT.ASSERT (IEQP (GCD AT.BIG4S AT.BIG1S)
AT.BIG1S))
(AT.ASSERT (IEQP (GCD (ITIMES (EXPT 2 5)
(EXPT 3 5)
(EXPT 11 5)
(EXPT 13 4))
(ITIMES (EXPT 2 5)
(EXPT 3 4)
(EXPT 11 5)
(EXPT 13 5)))
(ITIMES (EXPT 2 5)
(EXPT 3 4)
(EXPT 11 5)
(EXPT 13 4)))))))
(AT.QUICK.MIN.MAX
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (IEQP (IMIN)
MAX.INTEGER))
(AT.ASSERT (IEQP (IMAX)
MIN.INTEGER))
(AT.ASSERT (IEQP (IMIN MAX.FIXP MAX.INTEGER)
MAX.FIXP))
(AT.ASSERT (IEQP (IMAX MIN.FIXP MIN.INTEGER)
MIN.FIXP))
(AT.ASSERT (IEQP (IMIN MAX.FIXP MIN.INTEGER)
MIN.INTEGER))
(AT.ASSERT (IEQP (IMAX MIN.FIXP MAX.INTEGER)
MAX.INTEGER))
(AT.ASSERT (IEQP (IMAX AT.BIG1S AT.BIG4S)
AT.BIG4S))
(AT.ASSERT (IEQP (IMAX (IMINUS AT.BIG1S)
(IMINUS AT.BIG4S))
(IMINUS AT.BIG1S))))))
(AT.QUICK.PREDS
(LAMBDA NIL (* kbr: " 2-Jul-85 20:12")
(PROG NIL
(AT.ASSERT (IEQP AT.BIG1S AT.BIG1S))
(AT.ASSERT (ZEROP (IDIFFERENCE AT.BIG1S AT.BIG1S)))
(AT.ASSERT (MINUSP (IMINUS AT.BIG1S)))
(AT.ASSERT (IGREATERP AT.BIG1S 0))
(AT.ASSERT (IGREATERP AT.BIG4S AT.BIG1S))
(AT.ASSERT (ILESSP AT.BIG1S 0))
(AT.ASSERT (ILESSP AT.BIG1S AT.BIG4S))
(AT.ASSERT (IGEQ AT.BIG1S AT.BIG1S))
(AT.ASSERT (IGEQ AT.BIG1S 0))
(AT.ASSERT (IGEQ AT.BIG4S AT.BIG1S))
(AT.ASSERT (ILEQ AT.BIG4S AT.BIG4S))
(AT.ASSERT (ILEQ AT.BIG1S 0))
(AT.ASSERT (ILEQ AT.BIG1S AT.BIG4S)))))
(AT.QUICK.LOGICAL
(LAMBDA NIL (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(* See section 12.7 of the Common Lisp manual for more detail. An infinite vector of 0 bits is 0.0 An infinite
vector of 1 bits is -1.0 Logical functions should error when passed either MAX.INTEGER or MIN.INTEGER as neither can
be represented by a vector. *)
(AT.ASSERT (IEQP (LOGAND AT.BIG1S AT.BIG1S)
AT.BIG1S))
(AT.ASSERT (IEQP (LOGAND -1 AT.BIG1S)
AT.BIG1S))
(AT.ASSERT (IEQP (LOGAND -1 (IMINUS AT.BIG1S))
(IMINUS AT.BIG1S)))
(AT.ASSERT (IEQP (LOGAND (IMINUS AT.BIG1S)
(IMINUS AT.BIG1S))
(IMINUS AT.BIG1S)))
(AT.ASSERT (IEQP (LOGOR AT.BIG1S AT.BIG1S)
AT.BIG1S))
(AT.ASSERT (IEQP (LOGOR -1 AT.BIG1S)
-1))
(AT.ASSERT (IEQP (LOGOR -1 (IMINUS AT.BIG1S))
-1))
(AT.ASSERT (IEQP (LOGOR (IMINUS AT.BIG1S)
(IMINUS AT.BIG1S))
(IMINUS AT.BIG1S)))
(AT.ASSERT (IEQP (LOGXOR AT.BIG1S AT.BIG1S)
0))
(AT.ASSERT (IEQP (LOGXOR -1 AT.BIG1S)
(SUB1 AT.BIG1S)))
(AT.ASSERT (IEQP (LOGXOR -1 (IMINUS AT.BIG1S))
(SUB1 (IMINUS AT.BIG1S))))
(AT.ASSERT (IEQP (LOGXOR (IMINUS AT.BIG1S)
(IMINUS AT.BIG1S))
0))
(AT.ASSERT (IEQP (LOGXOR (LOGXOR AT.BIG1S -1)
-1)
AT.BIG1S))
(AT.ASSERT (IEQP (LOGXOR (LOGXOR AT.BIG1S -1)
AT.BIG1S)
-1)))))
(AT.QUICK.POWEROFTWO
(LAMBDA NIL (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(AT.ASSERT (IEQP (LSH 1 100)
(EXPT 2 100)))
(AT.ASSERT (IEQP (RSH (LSH 1 100)
100)
1))
(AT.ASSERT (IEQP (RSH (LSH AT.BIG1S 20)
18)
AT.BIG4S))
(AT.ASSERT (IEQP (INTEGERLENGTH (SUB1 (LSH 1 50)))
50))
(AT.ASSERT (IEQP (INTEGERLENGTH (LSH 1 50))
51))
(AT.ASSERT (IEQP (INTEGERLENGTH (IMINUS (SUB1 (LSH 1 50))))
50))
(AT.ASSERT (IEQP (INTEGERLENGTH (IMINUS (LSH 1 50))
51)))
(AT.ASSERT (POWEROFTWOP (LSH 1 50)))
(AT.ASSERT (NOT (POWEROFTWOP AT.BIG1S)))
(AT.ASSERT (NOT (POWEROFTWOP (ADD1 (LSH 1 50)))))
(AT.ASSERT (NOT (POWEROFTWOP (IMINUS (LSH 1 50)))))
(AT.ASSERT (EVENP (LSH 1 50)))
(AT.ASSERT (EVENP (EXPT 10 20)
10))
(AT.ASSERT (EVENP (IMINUS (EXPT 10 20))
(EXPT 10 10)))
(AT.ASSERT (EVENP AT.BIG4S AT.BIG1S))
(AT.ASSERT (ODDP AT.BIG1S))
(AT.ASSERT (ODDP AT.BIG1S 10))
(AT.ASSERT (ODDP AT.BIG1S (ADD1 AT.BIG1S))))))
(AT.BOUNDARY.TEST
(LAMBDA NIL (* kbr: " 2-Jul-85 20:13")
(* Perform general test on boundary constants known to
be used by Interlisp arithmetic functions.
*)
(PROG NIL
(FOR BOUNDARY IN AT.BOUNDARIES DO (AT.GENERAL.TEST (AT.BOUNDARY.LIST BOUNDARY))))))
(AT.BOUNDARY.LIST
(LAMBDA (BOUNDARY) (* kbr: " 2-Jul-85 20:13")
(* Return list of numbers computationally close to
BOUNDARY. *)
(LIST BOUNDARY (ADD1 BOUNDARY)
(SUB1 BOUNDARY)
(IMINUS BOUNDARY)
(IMINUS (ADD1 BOUNDARY))
(IMINUS (SUB1 BOUNDARY))
(IPLUS BOUNDARY 10)
(IDIFFERENCE BOUNDARY 100)
(IQUOTIENT BOUNDARY 2)
(IQUOTIENT (ITIMES 2 BOUNDARY)
3)
(ITIMES BOUNDARY BOUNDARY)
(ADD1 (ITIMES BOUNDARY BOUNDARY))
(SUB1 (ITIMES BOUNDARY BOUNDARY)))))
(AT.RANDOM.TEST
(LAMBDA NIL (* kbr: " 2-Jul-85 20:13")
(* Perform general test on random list of integers.
*)
(PROG NIL
(AT.GENERAL.TEST (AT.RANDOM.NUMBERS (RAND 2 4))))))
(AT.RANDOM.NUMBERS
(LAMBDA (N) (* kbr: " 2-Jul-85 20:13")
(* Generate a list of large random numbers.
The bigger N is%, the bigger the allowed range.
*)
(PROG (N LIST)
(SETQ N (RAND 2 4))
(SETQ LIST (FOR I FROM 1 TO 10 COLLECT (ITIMES (AT.RANDOM.NUMBER N))))
(RETURN LIST))))
(AT.RANDOM.NUMBER
(LAMBDA (N) (* kbr: " 2-Jul-85 20:13")
(* Generate a large random number.
The bigger N is%, the bigger the allowed range.
*)
(PROG (ANSWER)
(SETQ ANSWER 1)
(FOR I FROM 1 TO N DO (SETQ ANSWER (ITIMES (RAND MIN.FIXP MAX.FIXP)
ANSWER)))
(RETURN ANSWER))))
(AT.RANDOM.ELEMENT
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(* Choose an element out of LIST at random.
*)
(CAR (NTH LIST (RAND 1 (LENGTH LIST))))))
(AT.RANDOM.SUBSET
(LAMBDA (LIST SIZE) (* kbr: " 2-Jul-85 20:13")
(* Generate random subset with size SIZE from LIST.
*)
(FOR I FROM 1 TO SIZE COLLECT (AT.RANDOM.ELEMENT LIST))))
(AT.RANDOM.BOUNDARY.TEST
(LAMBDA NIL (* kbr: " 2-Jul-85 20:13")
(PROG (LIST)
(SETQ LIST (APPEND (AT.RANDOM.SUBSET (AT.BOUNDARY.LIST (AT.RANDOM.ELEMENT AT.BOUNDARIES))
4)
(AT.RANDOM.SUBSET (AT.BOUNDARY.LIST (AT.RANDOM.ELEMENT AT.BOUNDARIES))
4)
(AT.RANDOM.SUBSET (AT.RANDOM.NUMBERS (RAND 2 4))
4)))
(AT.GENERAL.TEST LIST))))
(AT.GENERAL.TEST
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(AT.GENERAL.PLUS LIST)
(AT.GENERAL.MINUS LIST)
(AT.GENERAL.DIFFERENCE LIST)
(AT.GENERAL.ADD1.SUB1 LIST)
(AT.GENERAL.TIMES LIST)
(AT.GENERAL.QUOTIENT LIST)
(AT.GENERAL.REMAINDER.MOD.GCD LIST)
(AT.GENERAL.MIN.MAX LIST)
(AT.GENERAL.PREDS LIST)
(AT.GENERAL.LOGICAL LIST))))
(AT.GENERAL.PLUS
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST
DO (AT.ASSERT (IEQP (IPLUS X 0)
X))
(AT.ASSERT (IEQP (IPLUS 0 X)
X))
(AT.ASSERT (IEQP (IPLUS X (IMINUS X))
0))
(AT.ASSERT (IEQP (IPLUS (IPLUS X 1)
-1)
X))
(FOR Y IN LIST
DO (AT.ASSERT (IEQP (IPLUS X Y)
(IPLUS Y X)))
(AT.ASSERT (IEQP (IPLUS X Y)
(IMINUS (IPLUS (IMINUS X)
(IMINUS Y)))))
(AT.ASSERT (IEQP (IPLUS X X Y)
(IPLUS Y X X))))))))
(AT.GENERAL.MINUS
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST
DO (AT.ASSERT (IEQP (IMINUS (IMINUS X))
X))
(AT.ASSERT (IEQP (IABS (IMINUS X))
(IABS X)))))))
(AT.GENERAL.DIFFERENCE
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST
DO (AT.ASSERT (IEQP (IDIFFERENCE X 0)
X))
(AT.ASSERT (IEQP (IDIFFERENCE X X)
0))
(AT.ASSERT (IEQP (IMINUS X)
(IDIFFERENCE 0 X)))
(FOR Y IN LIST
DO (AT.ASSERT (IEQP (IDIFFERENCE X Y)
(IMINUS (IDIFFERENCE Y X))))
(AT.ASSERT (IEQP (IDIFFERENCE X Y)
(IMINUS (IDIFFERENCE (IMINUS X)
(IMINUS Y))))))))))
(AT.GENERAL.ADD1.SUB1
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST
DO (AT.ASSERT (IEQP (ADD1 X)
(IPLUS X 1)))
(AT.ASSERT (IEQP (SUB1 X)
(IDIFFERENCE X 1)))
(AT.ASSERT (IEQP (ADD1 (SUB1 X))
X))
(AT.ASSERT (IEQP (SUB1 (ADD1 X))
X))))))
(AT.GENERAL.TIMES
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST
DO (AT.ASSERT (IEQP (ITIMES 0 X)
0))
(AT.ASSERT (IEQP (ITIMES X 0)
0))
(AT.ASSERT (IEQP (ITIMES 1 X)
X))
(AT.ASSERT (IEQP (ITIMES X 1)
X))
(AT.ASSERT (IEQP (ITIMES -1 X)
(IMINUS X)))
(AT.ASSERT (IEQP (ITIMES X -1)
(IMINUS X)))
(AT.ASSERT (IEQP (ITIMES 2 X)
(IPLUS X X)))
(FOR Y IN LIST
DO (AT.ASSERT (IEQP (ITIMES X Y)
(ITIMES Y X)))
(AT.ASSERT (IEQP (ITIMES X Y)
(IMINUS (ITIMES (IMINUS X)
Y))))
(AT.ASSERT (IEQP (ITIMES X Y)
(ITIMES (IMINUS Y)
(IMINUS X))))
(AT.ASSERT (IEQP (ITIMES X X Y)
(ITIMES Y X X))))))))
(AT.GENERAL.QUOTIENT
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST WHEN (NOT (EQ X 0))
DO (AT.ASSERT (IEQP (IQUOTIENT X X)
1))
(AT.ASSERT (IEQP (IQUOTIENT 0 X)
0))
(AT.ASSERT (IEQP (IQUOTIENT X 1)
X))
(FOR Y IN LIST
DO (AT.ASSERT (IEQP (IQUOTIENT (ITIMES X Y)
X)
Y))
(AT.ASSERT (IEQP (IQUOTIENT Y X)
(IMINUS (IQUOTIENT Y (IMINUS X)))))
(AT.ASSERT (IEQP (IQUOTIENT Y X)
(IQUOTIENT (IMINUS Y)
(IMINUS X)))))))))
(AT.GENERAL.REMAINDER.MOD.GCD
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST WHEN (NOT (EQ X 0))
DO (AT.ASSERT (EQ (IREMAINDER X X)
0))
(AT.ASSERT (EQ (IREMAINDER (IMINUS X)
X)
0))
(AT.ASSERT (EQ (IMOD (ITIMES X X)
X)
0))
(AT.ASSERT (IEQP (IMOD (IPLUS X X)
X)
0))
(AT.ASSERT (EQ (IMOD (IMINUS X)
X)
0))
(AT.ASSERT (EQ (IMOD (ADD1 X)
X)
1))
(AT.ASSERT (EQ (IMOD (SUB1 X)
X)
(SUB1 (IABS X))))
(AT.ASSERT (IEQP (GCD X (ITIMES X X))
(IABS X)))
(AT.ASSERT (IEQP (GCD (ITIMES 2 X)
(ITIMES 3 X)
(ITIMES 5 X))
(IABS X)))))))
(AT.GENERAL.MIN.MAX
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST
DO (AT.ASSERT (IEQP (IMIN X)
X))
(AT.ASSERT (IEQP (IMAX X)
X))
(AT.ASSERT (IEQP (IMIN X MAX.INTEGER)
X))
(AT.ASSERT (IEQP (IMAX X MIN.INTEGER)
X))
(AT.ASSERT (IEQP (IMIN X MIN.INTEGER)
MIN.INTEGER))
(AT.ASSERT (IEQP (IMAX X MAX.INTEGER)
MAX.INTEGER))
(AT.ASSERT (IEQP (IMIN X X)
X))
(AT.ASSERT (IEQP (IMAX X X)
X))
(AT.ASSERT (IEQP (IMAX X (IMINUS X))
(IABS X)))
(FOR Y IN LIST
DO (AT.ASSERT (IEQP (IMIN X Y)
(IMIN Y X)))
(AT.ASSERT (IEQP (IMAX X Y)
(IMAX Y X)))
(AT.ASSERT (IEQP (IMAX X Y)
(IMINUS (IMIN (IMINUS X)
(IMINUS Y)))))
(AT.ASSERT (IEQP (IMAX X X Y)
(IMAX Y X X)))
(AT.ASSERT (IEQP (IMIN X X Y)
(IMIN Y X X))))))))
(AT.GENERAL.PREDS
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST
DO (AT.ASSERT (IEQP X X))
(AT.ASSERT (ZEROP (IDIFFERENCE X X)))
(AT.ASSERT (MINUSP (IMINUS (IABS X))))
(AT.ASSERT (IGREATERP (IABS X)
-1))
(AT.ASSERT (IGREATERP (ADD1 X)
X))
(AT.ASSERT (ILESSP X (ADD1 X)))
(AT.ASSERT (ILESSP (SUB1 X)
(IABS X)))
(AT.ASSERT (IGEQ X X))
(AT.ASSERT (IGEQ (IABS X)
0))
(FOR Y IN LIST
DO (AT.ASSERT (IGEQ (IABS (ITIMES X Y))
(ITIMES X Y)))
(AT.ASSERT (ILEQ (IABS (IDIFFERENCE X Y))
(IPLUS (IABS X)
(IABS Y))))
(AT.ASSERT (ILEQ (IABS (IPLUS X Y))
(IPLUS (IABS X)
(IABS Y)))))))))
(AT.GENERAL.LOGICAL
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(* See section 12.7 of the Common Lisp manual for more detail. An infinite vector of 0 bits is 0.0 An infinite
vector of 1 bits is -1.0 Logical functions should error when passed either MAX.INTEGER or MIN.INTEGER as neither can
be represented by a vector. *)
(FOR X IN LIST
DO (AT.ASSERT (IEQP (LOGAND X X)
X))
(AT.ASSERT (IEQP (LOGAND -1 X)
X))
(AT.ASSERT (IEQP (LOGAND -1 (IMINUS X))
(IMINUS X)))
(AT.ASSERT (IEQP (LOGAND (IMINUS X)
(IMINUS X))
(IMINUS X)))
(AT.ASSERT (IEQP (LOGOR X X)
X))
(AT.ASSERT (IEQP (LOGOR -1 X)
-1))
(AT.ASSERT (IEQP (LOGOR -1 (IMINUS X))
-1))
(AT.ASSERT (IEQP (LOGOR (IMINUS X)
(IMINUS X))
(IMINUS X)))
(AT.ASSERT (IEQP (LOGXOR X X)
0))
(AT.ASSERT (IEQP (LOGXOR -1 X)
(SUB1 X)))
(AT.ASSERT (IEQP (LOGXOR -1 (IMINUS X))
(SUB1 (IMINUS X))))
(AT.ASSERT (IEQP (LOGXOR (IMINUS X)
(IMINUS X))
0))
(AT.ASSERT (IEQP (LOGXOR (LOGXOR X -1)
-1)
X))
(AT.ASSERT (IEQP (LOGXOR (LOGXOR X -1)
X)
-1))))))
(AT.GENERAL.POWEROFTWO
(LAMBDA (LIST) (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(FOR X IN LIST WHEN (AND (IGEQ X 0)
(ILEQ X 50))
DO (AT.ASSERT (IEQP (LSH 1 100)
(EXPT 2 100)))
(AT.ASSERT (IEQP (RSH (LSH 1 100)
100)
1))
(AT.ASSERT (IEQP (INTEGERLENGTH (SUB1 (LSH 1 X)))
X))
(AT.ASSERT (IEQP (INTEGERLENGTH (LSH 1 X))
(ADD1 X)))
(AT.ASSERT (IEQP (INTEGERLENGTH (IMINUS (SUB1 (LSH 1 X))))
X))
(AT.ASSERT (IEQP (INTEGERLENGTH (IMINUS (LSH 1 X))
(ADD1 X))))
(AT.ASSERT (POWEROFTWOP (LSH 1 X)))
(AT.ASSERT (NOT (POWEROFTWOP AT.BIG1S)))
(AT.ASSERT (NOT (POWEROFTWOP (ADD1 (LSH 1 X)))))
(AT.ASSERT (NOT (POWEROFTWOP (IMINUS (LSH 1 X)))))
(AT.ASSERT (EVENP (LSH 1 X)))
(AT.ASSERT (EVENP (LSH 1 X)
(LSH 1 (IQUOTIENT X 2))))
(AT.ASSERT (EVENP (EXPT 10 (ADD1 X))
10))
(AT.ASSERT (EVENP (IMINUS (EXPT 10 (ADD1 X)))
10))
(AT.ASSERT (ODDP (ADD1 (LSH 1 X))))))))
(AT.SYSTEM.TEST
(LAMBDA NIL (* kbr: " 2-Jul-85 20:13")
(PROG NIL
(AT.EVAL (GENSYM 'FOO AT.BIG1S))
(AT.EVAL (UNPACKFILENAME '{HOST}<DIRECTORY>NAME.EXTENSION;111111111111))
(AT.EVAL (PACKFILENAME (LIST 'HOST 'HOST 'DIRECTORY 'DIRECTORY 'NAME 'NAME 'EXTENSION
'EXTENSION
'VERSION AT.BIG1S)))
(AT.EVAL (UNPACKFILENAME '{HOST}<111111111111>222222222222.333333333333;444444444444))
(AT.EVAL (PACKFILENAME (LIST 'HOST 'HOST 'DIRECTORY AT.BIG1S 'NAME AT.BIG2S 'EXTENSION
AT.BIG3S 'VERSION AT.BIG4S)))
(AT.EVAL (GDATE (IPLUS MAX.FIXP MAX.FIXP)))
(AT.EVAL (GDATE (IPLUS MIN.FIXP MIN.FIXP)))
(AT.EVAL (IDATE " 1-JAN-4000 12:00:00"))
(AT.ASSERT (IGREATERP (IDATE " 1-JAN-4000 12:00:00")
(IDATE " 1-JAN-2000 12:00:00")))
(* Wonder what datestring to use for BC dates? *)
)))
)
(PRETTYCOMPRINT ARITHTESTCOMS)
(RPAQQ ARITHTESTCOMS ((PROPS (AT.EVAL ARGNAMES)
(AT.ASSERT ARGNAMES))
(INITVARS (AT.BIG1S NIL)
(AT.BIG2S NIL)
(AT.BIG3S NIL)
(AT.BIG4S NIL)
(AT.ASSERTVARS NIL)
(AT.THETA 10000)
(AT.BETA (EXPT 2 14))
(AT.BOUNDARIES (LIST MAX.SMALLP MIN.SMALLP MAX.FIXP MIN.FIXP AT.THETA (IMINUS
AT.THETA)
AT.BETA
(IMINUS AT.BETA))))
(FNS AT.TEST AT.INIT AT.EVAL AT.ASSERT AT.ASSERTVARS AT.ASSERTVARS1 AT.QUICK.TEST
AT.QUICK.PLUS AT.QUICK.MINUS AT.QUICK.DIFFERENCE AT.QUICK.ADD1.SUB1 AT.QUICK.TIMES
AT.QUICK.QUOTIENT AT.QUICK.REMAINDER.MOD.GCD AT.QUICK.MIN.MAX AT.QUICK.PREDS
AT.QUICK.LOGICAL AT.QUICK.POWEROFTWO AT.BOUNDARY.TEST AT.BOUNDARY.LIST AT.RANDOM.TEST
AT.RANDOM.NUMBERS AT.RANDOM.NUMBER AT.RANDOM.ELEMENT AT.RANDOM.SUBSET
AT.RANDOM.BOUNDARY.TEST AT.GENERAL.TEST AT.GENERAL.PLUS AT.GENERAL.MINUS
AT.GENERAL.DIFFERENCE AT.GENERAL.ADD1.SUB1 AT.GENERAL.TIMES AT.GENERAL.QUOTIENT
AT.GENERAL.REMAINDER.MOD.GCD AT.GENERAL.MIN.MAX AT.GENERAL.PREDS AT.GENERAL.LOGICAL
AT.GENERAL.POWEROFTWO AT.SYSTEM.TEST)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA AT.ASSERT
AT.EVAL)
(NLAML)
(LAMA)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA AT.ASSERT AT.EVAL)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS ARITHTEST.FPKG COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2446 31535 (AT.TEST 2456 . 2795) (AT.INIT 2797 . 3154) (AT.EVAL 3156 . 3624) (AT.ASSERT
3626 . 4391) (AT.ASSERTVARS 4393 . 4844) (AT.ASSERTVARS1 4846 . 5137) (AT.QUICK.TEST 5139 . 5643) (
AT.QUICK.PLUS 5645 . 6335) (AT.QUICK.MINUS 6337 . 6637) (AT.QUICK.DIFFERENCE 6639 . 7136) (
AT.QUICK.ADD1.SUB1 7138 . 7452) (AT.QUICK.TIMES 7454 . 8373) (AT.QUICK.QUOTIENT 8375 . 9255) (
AT.QUICK.REMAINDER.MOD.GCD 9257 . 11460) (AT.QUICK.MIN.MAX 11462 . 12276) (AT.QUICK.PREDS 12278 .
13136) (AT.QUICK.LOGICAL 13138 . 14904) (AT.QUICK.POWEROFTWO 14906 . 16373) (AT.BOUNDARY.TEST 16375 .
16819) (AT.BOUNDARY.LIST 16821 . 17513) (AT.RANDOM.TEST 17515 . 17854) (AT.RANDOM.NUMBERS 17856 .
18363) (AT.RANDOM.NUMBER 18365 . 18874) (AT.RANDOM.ELEMENT 18876 . 19184) (AT.RANDOM.SUBSET 19186 .
19521) (AT.RANDOM.BOUNDARY.TEST 19523 . 20035) (AT.GENERAL.TEST 20037 . 20581) (AT.GENERAL.PLUS 20583
. 21325) (AT.GENERAL.MINUS 21327 . 21639) (AT.GENERAL.DIFFERENCE 21641 . 22289) (AT.GENERAL.ADD1.SUB1
22291 . 22730) (AT.GENERAL.TIMES 22732 . 23759) (AT.GENERAL.QUOTIENT 23761 . 24500) (
AT.GENERAL.REMAINDER.MOD.GCD 24502 . 25462) (AT.GENERAL.MIN.MAX 25464 . 26652) (AT.GENERAL.PREDS 26654
. 27617) (AT.GENERAL.LOGICAL 27619 . 29095) (AT.GENERAL.POWEROFTWO 29097 . 30410) (AT.SYSTEM.TEST
30412 . 31533)))))
STOP