Lex a hexadecimal integer or floating constant.
(lex-hex-iconst/fconst hprefix prefix-last-pos parstate) → (mv erp const last-pos new-parstate)
This is called when we expect a hexadecimal constant,
after reading the hexadecimal prefix
First we read zero or more hexadecimal digits.
If there are none, we check if the next character is a dot,
because we may have a constant like
If instead there are hexadecimal digits after the prefix,
we check whether the next character is a dot.
If it is, we read zero or more hexadecimal digits,
then a binary exponent
(which must be present, otherwise it is an error),
and finally a suffix if present;
we return an appropriate hexadecimal floating constant.
If instead there is no dot,
we check whether there is
the starting
Just before returning the constant, we use check-full-ppnumber, for the reasons explained there.
Function:
(defun lex-hex-iconst/fconst (hprefix prefix-last-pos parstate) (declare (xargs :stobjs (parstate))) (declare (xargs :guard (and (hprefixp hprefix) (positionp prefix-last-pos) (parstatep parstate)))) (let ((__function__ 'lex-hex-iconst/fconst)) (declare (ignorable __function__)) (b* (((reterr) (irr-const) (irr-position) parstate) ((erp hexdigs hexdigs-last-pos & parstate) (lex-*-hexadecimal-digit prefix-last-pos parstate))) (cond ((not hexdigs) (b* (((erp char pos parstate) (read-char parstate))) (cond ((not char) (reterr-msg :where (position-to-msg pos) :expected "a hexadecimal digit or a dot" :found (char-to-msg char))) ((= char (char-code #\.)) (b* (((erp hexdigs2 & hexdigs2-next-pos parstate) (lex-*-hexadecimal-digit pos parstate))) (cond ((not hexdigs2) (reterr-msg :where (position-to-msg hexdigs2-next-pos) :expected "a hexadecimal digit or a dot" :found (char-to-msg nil))) (t (b* (((erp expo expo-last-pos parstate) (lex-bin-expo parstate))) (b* (((erp fsuffix? suffix-last/next-pos parstate) (lex-fsuffix-if-present parstate)) ((erp parstate) (check-full-ppnumber nil parstate))) (retok (const-float (make-fconst-hex :prefix hprefix :core (make-hex-core-fconst-frac :significand (make-hex-frac-const :before nil :after hexdigs2) :expo expo) :suffix? fsuffix?)) (cond (fsuffix? suffix-last/next-pos) (t expo-last-pos)) parstate))))))) (t (reterr-msg :where (position-to-msg pos) :expected "a hexadecimal digit or a dot" :found (char-to-msg char)))))) (t (b* (((erp char pos parstate) (read-char parstate))) (cond ((not char) (retok (const-int (make-iconst :core (make-dec/oct/hex-const-hex :prefix hprefix :digits hexdigs) :suffix? nil)) hexdigs-last-pos parstate)) ((= char (char-code #\.)) (b* (((erp hexdigs2 & & parstate) (lex-*-hexadecimal-digit pos parstate))) (cond ((not hexdigs2) (b* (((erp expo expo-last-pos parstate) (lex-bin-expo parstate)) ((erp fsuffix? suffix-last/next-pos parstate) (lex-fsuffix-if-present parstate)) ((erp parstate) (check-full-ppnumber nil parstate))) (retok (const-float (make-fconst-hex :prefix hprefix :core (make-hex-core-fconst-frac :significand (make-hex-frac-const :before hexdigs :after nil) :expo expo) :suffix? fsuffix?)) (cond (fsuffix? suffix-last/next-pos) (t expo-last-pos)) parstate))) (t (b* (((erp expo expo-last-pos parstate) (lex-bin-expo parstate)) ((erp fsuffix? suffix-last/next-pos parstate) (lex-fsuffix-if-present parstate)) ((erp parstate) (check-full-ppnumber nil parstate))) (retok (const-float (make-fconst-hex :prefix hprefix :core (make-hex-core-fconst-frac :significand (make-hex-frac-const :before hexdigs :after hexdigs2) :expo expo) :suffix? fsuffix?)) (cond (fsuffix? suffix-last/next-pos) (t expo-last-pos)) parstate)))))) ((or (= char (char-code #\p)) (= char (char-code #\P))) (b* ((parstate (unread-char parstate)) ((erp expo expo-last-pos parstate) (lex-bin-expo parstate)) ((erp fsuffix? suffix-last/next-pos parstate) (lex-fsuffix-if-present parstate)) ((erp parstate) (check-full-ppnumber nil parstate))) (retok (const-float (make-fconst-hex :prefix hprefix :core (make-hex-core-fconst-int :significand hexdigs :expo expo) :suffix? fsuffix?)) (cond (fsuffix? suffix-last/next-pos) (t expo-last-pos)) parstate))) (t (b* ((parstate (unread-char parstate)) ((erp isuffix? suffix-last/next-pos parstate) (lex-isuffix-if-present parstate)) ((erp parstate) (check-full-ppnumber (and (member (car (last hexdigs)) '(#\e #\E)) t) parstate))) (retok (const-int (make-iconst :core (make-dec/oct/hex-const-hex :prefix hprefix :digits hexdigs) :suffix? isuffix?)) (cond (isuffix? suffix-last/next-pos) (t hexdigs-last-pos)) parstate))))))))))
Theorem:
(defthm constp-of-lex-hex-iconst/fconst.const (b* (((mv acl2::?erp ?const ?last-pos ?new-parstate) (lex-hex-iconst/fconst hprefix prefix-last-pos parstate))) (constp const)) :rule-classes :rewrite)
Theorem:
(defthm positionp-of-lex-hex-iconst/fconst.last-pos (b* (((mv acl2::?erp ?const ?last-pos ?new-parstate) (lex-hex-iconst/fconst hprefix prefix-last-pos parstate))) (positionp last-pos)) :rule-classes :rewrite)
Theorem:
(defthm parstatep-of-lex-hex-iconst/fconst.new-parstate (implies (parstatep parstate) (b* (((mv acl2::?erp ?const ?last-pos ?new-parstate) (lex-hex-iconst/fconst hprefix prefix-last-pos parstate))) (parstatep new-parstate))) :rule-classes :rewrite)
Theorem:
(defthm parsize-of-lex-hex-iconst/fconst-uncond (b* (((mv acl2::?erp ?const ?last-pos ?new-parstate) (lex-hex-iconst/fconst hprefix prefix-last-pos parstate))) (<= (parsize new-parstate) (parsize parstate))) :rule-classes :linear)
Theorem:
(defthm parsize-of-lex-hex-iconst/fconst-cond (b* (((mv acl2::?erp ?const ?last-pos ?new-parstate) (lex-hex-iconst/fconst hprefix prefix-last-pos parstate))) (implies (and (not erp) const?) (<= (parsize new-parstate) (1- (parsize parstate))))) :rule-classes :linear)