Lex an integer suffix, if present.
(lex-isuffix-if-present parstate) → (mv erp isuffix? last/next-pos new-parstate)
If a suffix is found,
the
We read the next character. If there is no next character, there is no integer suffix.
If the next character is
If the next character is
This code turned out to be verbose.
We could shorten it by merging the treatment of
lowercase
Function:
(defun lex-isuffix-if-present (parstate) (declare (xargs :stobjs (parstate))) (declare (xargs :guard (parstatep parstate))) (let ((__function__ 'lex-isuffix-if-present)) (declare (ignorable __function__)) (b* (((reterr) nil (irr-position) parstate) ((erp char pos parstate) (read-char parstate))) (cond ((not char) (retok nil pos parstate)) ((= char (char-code #\l)) (b* (((erp char2 pos2 parstate) (read-char parstate))) (cond ((not char2) (retok (isuffix-l (lsuffix-locase-l)) pos parstate)) ((= char2 (char-code #\l)) (b* (((erp char3 pos3 parstate) (read-char parstate))) (cond ((not char3) (retok (isuffix-l (lsuffix-locase-ll)) pos2 parstate)) ((= char3 (char-code #\u)) (retok (make-isuffix-lu :length (lsuffix-locase-ll) :unsigned (usuffix-locase-u)) pos3 parstate)) ((= char3 (char-code #\U)) (retok (make-isuffix-lu :length (lsuffix-locase-ll) :unsigned (usuffix-upcase-u)) pos3 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (isuffix-l (lsuffix-locase-ll)) pos2 parstate)))))) ((= char2 (char-code #\u)) (retok (make-isuffix-lu :length (lsuffix-locase-l) :unsigned (usuffix-locase-u)) pos2 parstate)) ((= char2 (char-code #\U)) (retok (make-isuffix-lu :length (lsuffix-locase-l) :unsigned (usuffix-upcase-u)) pos2 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (isuffix-l (lsuffix-locase-l)) pos parstate)))))) ((= char (char-code #\L)) (b* (((erp char2 pos2 parstate) (read-char parstate))) (cond ((not char2) (retok (isuffix-l (lsuffix-upcase-l)) pos parstate)) ((= char2 (char-code #\L)) (b* (((erp char3 pos3 parstate) (read-char parstate))) (cond ((not char3) (retok (isuffix-l (lsuffix-upcase-ll)) pos2 parstate)) ((= char3 (char-code #\u)) (retok (make-isuffix-lu :length (lsuffix-upcase-ll) :unsigned (usuffix-locase-u)) pos3 parstate)) ((= char3 (char-code #\U)) (retok (make-isuffix-lu :length (lsuffix-upcase-ll) :unsigned (usuffix-upcase-u)) pos3 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (isuffix-l (lsuffix-upcase-ll)) pos2 parstate)))))) ((= char2 (char-code #\u)) (retok (make-isuffix-lu :length (lsuffix-upcase-l) :unsigned (usuffix-locase-u)) pos2 parstate)) ((= char2 (char-code #\U)) (retok (make-isuffix-lu :length (lsuffix-upcase-l) :unsigned (usuffix-upcase-u)) pos2 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (isuffix-l (lsuffix-upcase-l)) pos parstate)))))) ((= char (char-code #\u)) (b* (((erp char2 pos2 parstate) (read-char parstate))) (cond ((not char2) (retok (isuffix-u (usuffix-locase-u)) pos parstate)) ((= char2 (char-code #\l)) (b* (((erp char3 pos3 parstate) (read-char parstate))) (cond ((not char3) (retok (make-isuffix-ul :unsigned (usuffix-locase-u) :length (lsuffix-locase-l)) pos2 parstate)) ((= char3 (char-code #\l)) (retok (make-isuffix-ul :unsigned (usuffix-locase-u) :length (lsuffix-locase-ll)) pos3 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (make-isuffix-ul :unsigned (usuffix-locase-u) :length (lsuffix-locase-l)) pos2 parstate)))))) ((= char2 (char-code #\L)) (b* (((erp char3 pos3 parstate) (read-char parstate))) (cond ((not char3) (retok (make-isuffix-ul :unsigned (usuffix-locase-u) :length (lsuffix-upcase-l)) pos2 parstate)) ((= char3 (char-code #\L)) (retok (make-isuffix-ul :unsigned (usuffix-locase-u) :length (lsuffix-upcase-ll)) pos3 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (make-isuffix-ul :unsigned (usuffix-locase-u) :length (lsuffix-upcase-l)) pos2 parstate)))))) (t (b* ((parstate (unread-char parstate))) (retok (isuffix-u (usuffix-locase-u)) pos parstate)))))) ((= char (char-code #\U)) (b* (((erp char2 pos2 parstate) (read-char parstate))) (cond ((not char2) (retok (isuffix-u (usuffix-upcase-u)) pos parstate)) ((= char2 (char-code #\l)) (b* (((erp char3 pos3 parstate) (read-char parstate))) (cond ((not char3) (retok (make-isuffix-ul :unsigned (usuffix-upcase-u) :length (lsuffix-locase-l)) pos2 parstate)) ((= char3 (char-code #\l)) (retok (make-isuffix-ul :unsigned (usuffix-upcase-u) :length (lsuffix-locase-ll)) pos3 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (make-isuffix-ul :unsigned (usuffix-upcase-u) :length (lsuffix-locase-l)) pos2 parstate)))))) ((= char2 (char-code #\L)) (b* (((erp char3 pos3 parstate) (read-char parstate))) (cond ((not char3) (retok (make-isuffix-ul :unsigned (usuffix-upcase-u) :length (lsuffix-upcase-l)) pos2 parstate)) ((= char3 (char-code #\L)) (retok (make-isuffix-ul :unsigned (usuffix-upcase-u) :length (lsuffix-upcase-ll)) pos3 parstate)) (t (b* ((parstate (unread-char parstate))) (retok (make-isuffix-ul :unsigned (usuffix-upcase-u) :length (lsuffix-upcase-l)) pos2 parstate)))))) (t (b* ((parstate (unread-char parstate))) (retok (isuffix-u (usuffix-upcase-u)) pos parstate)))))) (t (b* ((parstate (unread-char parstate))) (retok nil pos parstate)))))))
Theorem:
(defthm isuffix-optionp-of-lex-isuffix-if-present.isuffix? (b* (((mv acl2::?erp ?isuffix? ?last/next-pos ?new-parstate) (lex-isuffix-if-present parstate))) (isuffix-optionp isuffix?)) :rule-classes :rewrite)
Theorem:
(defthm positionp-of-lex-isuffix-if-present.last/next-pos (b* (((mv acl2::?erp ?isuffix? ?last/next-pos ?new-parstate) (lex-isuffix-if-present parstate))) (positionp last/next-pos)) :rule-classes :rewrite)
Theorem:
(defthm parstatep-of-lex-isuffix-if-present.new-parstate (implies (parstatep parstate) (b* (((mv acl2::?erp ?isuffix? ?last/next-pos ?new-parstate) (lex-isuffix-if-present parstate))) (parstatep new-parstate))) :rule-classes :rewrite)
Theorem:
(defthm parsize-of-lex-isuffix-if-present-uncond (b* (((mv acl2::?erp ?isuffix? ?last/next-pos ?new-parstate) (lex-isuffix-if-present parstate))) (<= (parsize new-parstate) (parsize parstate))) :rule-classes :linear)
Theorem:
(defthm parsize-of-lex-isuffix-if-present-cond (b* (((mv acl2::?erp ?isuffix? ?last/next-pos ?new-parstate) (lex-isuffix-if-present parstate))) (implies (and (not erp) isuffix?) (<= (parsize new-parstate) (1- (parsize parstate))))) :rule-classes :linear)