From bd0d1d6f9faaf4e8cc43f3c4fbf5469f65674e6f Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 20 Dec 1991 02:29:00 +0000 Subject: [PATCH] Changed EQUAL and EQUALP to compare pathnames with PATHNAME=. Deleted some unnecessary C:: qualifiers. --- code/pred.lisp | 57 +++++++++++++++++--------------------------------- 1 file changed, 19 insertions(+), 38 deletions(-) diff --git a/code/pred.lisp b/code/pred.lisp index ab918b2ff..8e9f617d2 100644 --- a/code/pred.lisp +++ b/code/pred.lisp @@ -7,12 +7,10 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.19 1991/11/09 02:47:23 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.20 1991/12/20 02:29:00 ram Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.19 1991/11/09 02:47:23 wlott Exp $ -;;; ;;; Predicate functions for CMU Common Lisp. ;;; ;;; Written by William Lott. @@ -84,15 +82,15 @@ system-area-pointer-p weak-pointer-p vectorp - c::unsigned-byte-32-p - c::signed-byte-32-p - c::simple-array-unsigned-byte-2-p - c::simple-array-unsigned-byte-4-p - c::simple-array-unsigned-byte-8-p - c::simple-array-unsigned-byte-16-p - c::simple-array-unsigned-byte-32-p - c::simple-array-single-float-p - c::simple-array-double-float-p + unsigned-byte-32-p + signed-byte-32-p + simple-array-unsigned-byte-2-p + simple-array-unsigned-byte-4-p + simple-array-unsigned-byte-8-p + simple-array-unsigned-byte-16-p + simple-array-unsigned-byte-32-p + simple-array-single-float-p + simple-array-double-float-p ))) (macrolet @@ -150,7 +148,7 @@ (symbol-package :foo)) 'keyword 'symbol)) - (structure (c::structure-ref object 0)) + (structure (structure-ref object 0)) (array (type-specifier (ctype-of object))) (system-area-pointer 'system-area-pointer) (weak-pointer 'weak-pointer) @@ -331,7 +329,7 @@ (let ((info (info type defined-structure-info type))) (if info (and (structurep object) - (let ((obj-name (c::structure-ref object 0))) + (let ((obj-name (structure-ref object 0))) (or (eq obj-name type) (if (member obj-name (c::dd-included-by info) :test #'eq) @@ -366,26 +364,7 @@ ((stringp x) (and (stringp y) (string= x y))) ((pathnamep x) - (and (pathnamep y) - (do* ((i 1 (1+ i)) - (len (c::structure-length x))) - ((>= i len) t) - (declare (fixnum i len)) - (let ((x-el (c::structure-ref x i)) - (y-el (c::structure-ref y i))) - (if (and (simple-vector-p x-el) - (simple-vector-p y-el)) - (let ((lx (length x-el)) - (ly (length y-el))) - (declare (fixnum lx ly)) - (if (/= lx ly) (return nil)) - (do ((i 0 (1+ i))) - ((>= i lx)) - (declare (fixnum i)) - (if (not (equal (svref x-el i) (svref y-el i))) - (return-from equal nil)))) - (unless (equal x-el y-el) - (return nil))))))) + (and (pathnamep y) (pathname= x y))) ((bit-vector-p x) (and (bit-vector-p y) (= (the fixnum (length x)) @@ -414,13 +393,15 @@ (and (consp y) (equalp (car x) (car y)) (equalp (cdr x) (cdr y)))) + ((pathnamep x) + (and (pathnamep y) (pathname= x y))) ((structurep x) - (let ((length (c::structure-length x))) + (let ((length (structure-length x))) (and (structurep y) - (= length (c::structure-length y)) + (= length (structure-length y)) (dotimes (i length t) - (let ((x-el (c::structure-ref x i)) - (y-el (c::structure-ref y i))) + (let ((x-el (structure-ref x i)) + (y-el (structure-ref y i))) (unless (or (eq x-el y-el) (equalp x-el y-el)) (return nil))))))) -- GitLab