home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / XLISP 2.0 / XLISP Tools / Utility (UL) / PRED.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-04-07  |  1.0 KB  |  35 lines  |  [TEXT/ttxt]
  1. ;; Larry Mulcahy 1988
  2. ;; predicates
  3.  
  4. (provide 'predicate)
  5. (require 'character "char")
  6. (require 'array)
  7.  
  8. (defconstant *FUNCTION-TYPES* '(subr fsubr closure))
  9.  
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11. ; functionp 
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (defun functionp (x) (member (type-of x) *FUNCTION-TYPES*))
  15.  
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ; char-equal
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19.  
  20. (defun char-equal (x y)    ; strip away shift & control bits
  21.   (= (logand (char-int x) *NOT-SHIFT-CONTROL-BITS*)
  22.      (logand (char-int y) *NOT-SHIFT-CONTROL-BITS*)))
  23.  
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25. ; equalp
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. (defun equalp (x y)
  29.   (cond
  30.     ((and (stringp x) (stringp y)) (string-equal x y))
  31.     ((and (characterp x) (characterp y)) (char-equal x y))
  32.     ((and (arrayp x) (arrayp y)) (vector-equal x y))
  33.     ((equal x y))
  34.     ))
  35.