From 89b354a55e30978444ada5d388e18f5e06bde583 Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Fri, 26 Sep 2014 08:15:21 +0800 Subject: [PATCH] Add cl-parse-integer based on parse-integer * doc/misc/cl.texi (Predicates on Numbers): Document cl-digit-char-p. (Numerical Functions): Document cl-parse-integer. * lisp/calendar/parse-time.el (parse-time-digits): Remove. (digit-char-p, parse-integer) Moved to cl-lib.el. (parse-time-tokenize, parse-time-rules, parse-time-string): Use cl-parse-integer. * lisp/emacs-lisp/cl-extra.el (cl-parse-integer): New function. * lisp/emacs-lisp/cl-lib.el (cl-digit-char-table): New var. (cl-digit-char-p): New function. * test/automated/cl-lib.el (cl-digit-char-p, cl-parse-integer): New tests. Fixes: debbugs:18557 --- doc/misc/ChangeLog | 5 ++++ doc/misc/cl.texi | 15 ++++++++++++ lisp/ChangeLog | 13 +++++++++++ lisp/calendar/parse-time.el | 46 ++++++------------------------------- lisp/emacs-lisp/cl-extra.el | 35 ++++++++++++++++++++++++++++ lisp/emacs-lisp/cl-lib.el | 19 +++++++++++++++ test/ChangeLog | 5 ++++ test/automated/cl-lib.el | 19 +++++++++++++++ 8 files changed, 118 insertions(+), 39 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 2963bde04e1..a7244f12aba 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2014-09-26 Leo Liu + + * cl.texi (Predicates on Numbers): Document cl-digit-char-p. + (Numerical Functions): Document cl-parse-integer. (Bug#18557) + 2014-09-24 Ulf Jasper * newsticker.texi: Reworked. Document new treeview group diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index b2914adc062..04a0e5725e8 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -2929,6 +2929,12 @@ This predicate tests whether @var{integer} is even. It is an error if the argument is not an integer. @end defun +@defun cl-digit-char-p char radix +Test if @var{char} is a digit in the specified @var{radix} (default is +10). If true return the decimal value of digit @var{char} in +@var{radix}. +@end defun + @node Numerical Functions @section Numerical Functions @@ -3011,6 +3017,15 @@ This function returns the same value as the second return value of @code{cl-truncate}. @end defun +@defun cl-parse-integer string &key start end radix junk-allowed +This function implements the Common Lisp @code{parse-integer} +function. It parses an integer in the specified @var{radix} from the +substring of @var{string} between @var{start} and @var{end}. Any +leading and trailing whitespace chars are ignored. It signals an error +if the substring between @var{start} and @var{end} cannot be parsed as +an integer unless @var{junk-allowed} is non-nil. +@end defun + @node Random Numbers @section Random Numbers diff --git a/lisp/ChangeLog b/lisp/ChangeLog index eb52886a4a9..4c4941d982d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2014-09-26 Leo Liu + + Add cl-parse-integer based on parse-integer (Bug#18557) + * calendar/parse-time.el (parse-time-digits): Remove. + (digit-char-p, parse-integer) Moved to cl-lib.el. + (parse-time-tokenize, parse-time-rules, parse-time-string): Use + cl-parse-integer. + + * emacs-lisp/cl-extra.el (cl-parse-integer): New function. + + * emacs-lisp/cl-lib.el (cl-digit-char-table): New var. + (cl-digit-char-p): New function. + 2014-09-25 Juri Linkov * vc/add-log.el (change-log-next-buffer): Don't create an empty diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 6c88210030b..142e69ecfe6 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -34,21 +34,12 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - -(defvar parse-time-digits (make-vector 256 nil)) +(require 'cl-lib) ;; Byte-compiler warnings (defvar parse-time-elt) (defvar parse-time-val) -(unless (aref parse-time-digits ?0) - (cl-loop for i from ?0 to ?9 - do (aset parse-time-digits i (- i ?0)))) - -(defsubst digit-char-p (char) - (aref parse-time-digits char)) - (defsubst parse-time-string-chars (char) (save-match-data (let (case-fold-search str) @@ -59,30 +50,6 @@ ((string-match "[[:lower:]]" str) ?a) ((string-match "[[:digit:]]" str) ?0))))) -(put 'parse-error 'error-conditions '(parse-error error)) -(put 'parse-error 'error-message "Parsing error") - -(defsubst parse-integer (string &optional start end) - "[CL] Parse and return the integer in STRING, or nil if none." - (let ((integer 0) - (digit 0) - (index (or start 0)) - (end (or end (length string)))) - (when (< index end) - (let ((sign (aref string index))) - (if (or (eq sign ?+) (eq sign ?-)) - (setq sign (parse-time-string-chars sign) - index (1+ index)) - (setq sign 1)) - (while (and (< index end) - (setq digit (digit-char-p (aref string index)))) - (setq integer (+ (* integer 10) digit) - index (1+ index))) - (if (/= index end) - (signal 'parse-error `("not an integer" - ,(substring string (or start 0) end))) - (* sign integer)))))) - (defun parse-time-tokenize (string) "Tokenize STRING into substrings." (let ((start nil) @@ -100,7 +67,7 @@ (setq c (parse-time-string-chars (aref string index)))) (setq all-digits (and all-digits (eq c ?0)))) (if (<= index end) - (push (if all-digits (parse-integer string start index) + (push (if all-digits (cl-parse-integer string :start start :end index) (substring string start index)) list))) (nreverse list))) @@ -147,8 +114,8 @@ (= 5 (length parse-time-elt)) (or (= (aref parse-time-elt 0) ?+) (= (aref parse-time-elt 0) ?-)))) - ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5) - (* 60 (parse-integer parse-time-elt 1 3))) + ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5) + (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3))) (if (= (aref parse-time-elt 0) ?-) -1 1)))) ((5 4 3) ,#'(lambda () (and (stringp parse-time-elt) @@ -210,9 +177,10 @@ unknown are returned as nil." (let ((new-val (if rule (let ((this (pop rule))) (if (vectorp this) - (parse-integer + (cl-parse-integer parse-time-elt - (aref this 0) (aref this 1)) + :start (aref this 0) + :end (aref this 1)) (funcall this))) parse-time-val))) (rplaca (nthcdr (pop slots) time) new-val)))))))) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 3761d04c2c2..c8404e0bc2d 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -383,6 +383,41 @@ With two arguments, return rounding and remainder of their quotient." "Return 1 if X is positive, -1 if negative, 0 if zero." (cond ((> x 0) 1) ((< x 0) -1) (t 0))) +;;;###autoload +(cl-defun cl-parse-integer (string &key start end radix junk-allowed) + "Parse integer from the substring of STRING from START to END. +STRING may be surrounded by whitespace chars (chars with syntax ` '). +Other non-digit chars are considered junk. +RADIX is an integer between 2 and 36, the default is 10. Signal +an error if the substring between START and END cannot be parsed +as an integer unless JUNK-ALLOWED is non-nil." + (cl-check-type string string) + (let* ((start (or start 0)) + (len (length string)) + (end (or end len)) + (radix (or radix 10))) + (or (<= start end len) + (error "Bad interval: [%d, %d)" start end)) + (cl-flet ((skip-whitespace () + (while (and (< start end) + (= 32 (char-syntax (aref string start)))) + (setq start (1+ start))))) + (skip-whitespace) + (let ((sign (cl-case (and (< start end) (aref string start)) + (?+ (cl-incf start) +1) + (?- (cl-incf start) -1) + (t +1))) + digit sum) + (while (and (< start end) + (setq digit (cl-digit-char-p (aref string start) radix))) + (setq sum (+ (* (or sum 0) radix) digit) + start (1+ start))) + (skip-whitespace) + (cond ((and junk-allowed (null sum)) sum) + (junk-allowed (* sign sum)) + ((/= start end) (error "Not an integer string: %s" string)) + (t (* sign sum))))))) + ;; Random numbers. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index c4b9673aa2a..09cc3eee985 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -279,6 +279,25 @@ so that they are registered at compile-time as well as run-time." "Return t if INTEGER is even." (eq (logand integer 1) 0)) +(defconst cl-digit-char-table + (let* ((digits (make-vector 256 nil)) + (populate (lambda (start end base) + (mapc (lambda (i) + (aset digits i (+ base (- i start)))) + (number-sequence start end))))) + (funcall populate ?0 ?9 0) + (funcall populate ?A ?Z 10) + (funcall populate ?a ?z 10) + digits)) + +(defun cl-digit-char-p (char &optional radix) + "Test if CHAR is a digit in the specified RADIX (default 10). +If true return the decimal value of digit CHAR in RADIX." + (or (<= 2 (or radix 10) 36) + (signal 'args-out-of-range (list 'radix radix '(2 36)))) + (let ((n (aref cl-digit-char-table char))) + (and n (< n (or radix 10)) n))) + (defvar cl--random-state (vector 'cl--random-state-tag -1 30 (cl--random-time))) diff --git a/test/ChangeLog b/test/ChangeLog index 6d64da10a33..041ed7c1754 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2014-09-26 Leo Liu + + * automated/cl-lib.el (cl-digit-char-p, cl-parse-integer): New + tests. (Bug#18557) + 2014-09-24 Ulf Jasper * automated/newsticker-tests.el diff --git a/test/automated/cl-lib.el b/test/automated/cl-lib.el index 6bbd9a5e81d..e4c6e914ee2 100644 --- a/test/automated/cl-lib.el +++ b/test/automated/cl-lib.el @@ -223,6 +223,25 @@ (should (= (cl-the integer (cl-incf side-effect)) 1)) (should (= side-effect 1)))) +(ert-deftest cl-digit-char-p () + (should (cl-digit-char-p ?3)) + (should (cl-digit-char-p ?a 11)) + (should-not (cl-digit-char-p ?a)) + (should (cl-digit-char-p ?w 36)) + (should-error (cl-digit-char-p ?a 37)) + (should-error (cl-digit-char-p ?a 1))) + +(ert-deftest cl-parse-integer () + (should-error (cl-parse-integer "abc")) + (should (null (cl-parse-integer "abc" :junk-allowed t))) + (should (null (cl-parse-integer "" :junk-allowed t))) + (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t))) + (should-error (cl-parse-integer "0123456789" :radix 8)) + (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t))) + (should-error (cl-parse-integer "efz" :radix 16)) + (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) + (should (= -123 (cl-parse-integer " -123 ")))) + (ert-deftest cl-loop-destructuring-with () (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) -- 2.39.5