Case-insensitive character-list less-than test.
(icharlist< x y) determines whether the character list
Function:
(defun icharlist< (x y) (declare (xargs :guard (and (character-listp x) (character-listp y)))) (mbe :logic (cond ((atom y) nil) ((atom x) t) ((ichar< (car x) (car y)) t) ((ichar< (car y) (car x)) nil) (t (icharlist< (cdr x) (cdr y)))) :exec (cond ((atom y) nil) ((atom x) t) (t (let* ((xc (the (unsigned-byte 8) (char-code (the character (car x))))) (yc (the (unsigned-byte 8) (char-code (the character (car y))))) (xc-fix (if (and (<= (big-a) (the (unsigned-byte 8) xc)) (<= (the (unsigned-byte 8) xc) (big-z))) (the (unsigned-byte 8) (+ (the (unsigned-byte 8) xc) 32)) (the (unsigned-byte 8) xc))) (yc-fix (if (and (<= (big-a) (the (unsigned-byte 8) yc)) (<= (the (unsigned-byte 8) yc) (big-z))) (the (unsigned-byte 8) (+ (the (unsigned-byte 8) yc) 32)) (the (unsigned-byte 8) yc)))) (cond ((< (the (unsigned-byte 8) xc-fix) (the (unsigned-byte 8) yc-fix)) t) ((< (the (unsigned-byte 8) yc-fix) (the (unsigned-byte 8) xc-fix)) nil) (t (icharlist< (cdr x) (cdr y)))))))))
Theorem:
(defthm icharlist<-irreflexive (equal (icharlist< x x) nil))
Theorem:
(defthm icharlist<-antisymmetric (implies (icharlist< x y) (not (icharlist< y x))))
Theorem:
(defthm icharlist<-transitive (implies (and (icharlist< x y) (icharlist< y z)) (icharlist< x z)))
Theorem:
(defthm icharlist<-trichotomy-weak (implies (and (not (icharlist< x y)) (not (icharlist< y x))) (equal (icharlisteqv x y) t)))
Theorem:
(defthm icharlisteqv-implies-equal-icharlist<-1 (implies (icharlisteqv x x-equiv) (equal (icharlist< x y) (icharlist< x-equiv y))) :rule-classes (:congruence))
Theorem:
(defthm icharlisteqv-implies-equal-icharlist<-2 (implies (icharlisteqv y y-equiv) (equal (icharlist< x y) (icharlist< x y-equiv))) :rule-classes (:congruence))
Theorem:
(defthm icharlist<-trichotomy-strong (equal (icharlist< x y) (and (not (icharlisteqv x y)) (not (icharlist< y x)))) :rule-classes ((:rewrite :loop-stopper ((x y)))))