home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e051 / 3.ddi / COMMON / CREATEOP.COM next >
Encoding:
Text File  |  1980-01-01  |  1.6 KB  |  59 lines
  1. ile efficiently
  2.  
  3.        
  4. ;* The function == is machine dependent!
  5. ;* This function compares small integers for equality.  It uses EQ
  6. ;* so that it will be fast, and it will consequently not work on all
  7. ;* Lisps.  It works in Franz Lisp for integers in [-128, 127]
  8. ;(system::macro == (z) `(eq ,(cadr z) ,(caddr z)))
  9. ;;;
  10. ;;; Dario Giuse - made a macro. This is going to be faster than anything else.
  11. ;;;
  12. (defmacro == (x y)
  13.   `(equal ,x ,y))
  14.  
  15. ;;; =ALG returns T if A and B are algebraically equal.
  16. ;;; This corresponds to equalp - Dario Giuse
  17. ;;;
  18. (defmacro =alg (a b)
  19.   `(equalp ,a ,b))
  20.  
  21. #| @@@ gdw Mon Jul 23 00:48:19 1984
  22. ;; not used, since all calls to fast-symeval have been replaced by
  23. ;; calls to symbol-value
  24.        
  25. (defmacro fast-symeval (&body z)
  26.   `(cond ((eq ,(car z) '*c1*) *c1*)
  27.      ((eq ,(car z) '*c2*) *c2*)
  28.      ((eq ,(car z) '*c3*) *c3*)
  29.      ((eq ,(car z) '*c4*) *c4*)
  30.      ((eq ,(car z) '*c5*) *c5*)
  31.      ((eq ,(car z) '*c6*) *c6*)
  32.      ((eq ,(car z) '*c7*) *c7*)
  33.      (t (eval ,(car z)))))
  34. |#
  35. ; getvector and putvector are fast routines for using ONE-DIMENSIONAL
  36. ; arrays.  these routines do no checking; they assume
  37. ;    1. the array is a vector with 0 being the index of the first
  38. ;       element
  39. ;    2. the vector holds arbitrary list values
  40.  
  41. ; Example call: (putvector array index value)
  42. ;;; Dario Giuse - 6/20/84
  43.  
  44. (defmacro putvector (array index value)
  45.   `(setf (aref ,array ,index) ,value))
  46.  
  47. ;;; Example call: (getvector name index)
  48. ;;;
  49. (defmacro getvector (array index)
  50.   `(aref ,array ,index))
  51.  
  52.  
  53. ;;; Dario Giuse  6/21/84
  54. (defmacro putprop (atom value property)
  55.   `(setf (get ,atom ,property) ,value))
  56.  
  57.  
  58. (defun ce-gelm (x k)
  59.