/[cmucl]/src/code/bignum-test.lisp
ViewVC logotype

Diff of /src/code/bignum-test.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by ram, Fri Feb 8 13:30:53 1991 UTC revision 1.3 by wlott, Fri May 24 19:35:48 1991 UTC
# Line 18  Line 18 
18    
19  (defvar *in-bignum-wrapper* nil)  (defvar *in-bignum-wrapper* nil)
20    
21  (defmacro def-bignum-wrapper (name args &body body)  (defmacro def-bignum-wrapper (name lambda-list &body body)
22    (let ((var-name (ext:symbolicate "*OLD-" name "*"))    (let ((var-name (ext:symbolicate "*OLD-" name "*"))
23          (wrap-name (ext:symbolicate "WRAP-" name)))          (wrap-name (ext:symbolicate "WRAP-" name))
24            (args (mapcar #'(lambda (x)
25                              (if (listp x) (car x) x))
26                          (remove-if #'(lambda (x)
27                                         (member x lambda-list-keywords))
28                                     lambda-list))))
29      `(progn      `(progn
30         (defvar ,var-name (fdefinition ',name))         (defvar ,var-name (fdefinition ',name))
31         (defun ,wrap-name ,args         (defun ,wrap-name ,lambda-list
32           (if *in-bignum-wrapper*           (if *in-bignum-wrapper*
33               (funcall ,var-name ,@args)               (funcall ,var-name ,@args)
34               (let ((*in-bignum-wrapper* t))               (let ((*in-bignum-wrapper* t))
# Line 51  Line 56 
56            (assert (and (zerop r) (big= q y)))))            (assert (and (zerop r) (big= q y)))))
57      res))      res))
58    
59  (def-bignum-wrapper negate-bignum (x)  (def-bignum-wrapper negate-bignum (x &optional (fully-normalized t))
60    (let ((res (funcall *old-negate-bignum* x)))    (let ((res (funcall *old-negate-bignum* x fully-normalized)))
61      (assert (big= (- res) x))      (assert (big= (- res) x))
62      res))      res))
63    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5