X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fread.lisp;h=ad25704a4c51d18284003924296f88488e5ecba1;hb=3e1f7cb45ac17e7f133474c0c62197d118f09614;hp=d513ef33f5a4b65211db0e5560714e6211a9973b;hpb=54de4d4abbeb7f99e5f5702ad93e815cae7a0b3b;p=jscl.git
diff --git a/src/read.lisp b/src/read.lisp
index d513ef3..ad25704 100644
--- a/src/read.lisp
+++ b/src/read.lisp
@@ -3,18 +3,18 @@
;; Copyright (C) 2012, 2013 David Vazquez
;; Copyright (C) 2012 Raimon Grau
-;; This program is free software: you can redistribute it and/or
+;; JSCL is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
-;; This program is distributed in the hope that it will be useful, but
+;; JSCL is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see .
+;; along with JSCL. If not, see .
;;;; Reader
@@ -163,6 +163,24 @@
(intern name package)
(find-symbol name package))))
+(defun read-integer (string)
+ (let ((sign 1)
+ (number nil)
+ (size (length string)))
+ (dotimes (i size)
+ (let ((elt (char string i)))
+ (cond
+ ((digit-char-p elt)
+ (setq number (+ (* (or number 0) 10) (digit-char-p elt))))
+ ((zerop i)
+ (case elt
+ (#\+ nil)
+ (#\- (setq sign -1))
+ (otherwise (return-from read-integer))))
+ ((and (= i (1- size)) (char= elt #\.)) nil)
+ (t (return-from read-integer)))))
+ (and number (* sign number))))
+
(defun read-float (string)
(block nil
(let ((sign 1)
@@ -182,13 +200,12 @@
(incf index)))
(unless (< index size) (return))
;; Optional integer part
- (let ((value (digit-char-p (char string index))))
- (when value
- (setq integer-part t)
- (while (and (< index size)
- (setq value (digit-char-p (char string index))))
- (setq number (+ (* number 10) value))
- (incf index))))
+ (awhen (digit-char-p (char string index))
+ (setq integer-part t)
+ (while (and (< index size)
+ (setq it (digit-char-p (char string index))))
+ (setq number (+ (* number 10) it))
+ (incf index)))
(unless (< index size) (return))
;; Decimal point is mandatory if there's no integer part
(unless (or integer-part (char= #\. (char string index))) (return))
@@ -196,14 +213,13 @@
(when (char= #\. (char string index))
(incf index)
(unless (< index size) (return))
- (let ((value (digit-char-p (char string index))))
- (when value
- (setq fractional-part t)
- (while (and (< index size)
- (setq value (digit-char-p (char string index))))
- (setq number (+ (* number 10) value))
- (setq divisor (* divisor 10))
- (incf index)))))
+ (awhen (digit-char-p (char string index))
+ (setq fractional-part t)
+ (while (and (< index size)
+ (setq it (digit-char-p (char string index))))
+ (setq number (+ (* number 10) it))
+ (setq divisor (* divisor 10))
+ (incf index))))
;; Either left or right part of the dot must be present
(unless (or integer-part fractional-part) (return))
;; Exponent is mandatory if there is no fractional part
@@ -231,7 +247,8 @@
(incf index))))
(unless (= index size) (return))
;; Everything went ok, we have a float
- (/ (* sign (expt 10 (* exponent-sign exponent)) number) divisor))))
+ ;; XXX: Use FLOAT when implemented.
+ (/ (* sign (expt 10.0d0 (* exponent-sign exponent)) number) divisor))))
(defun !parse-integer (string junk-allow)
@@ -306,7 +323,7 @@
(read-sharp stream))
(t
(let ((string (read-until stream #'terminalp)))
- (or (values (!parse-integer string nil))
+ (or (read-integer string)
(read-float string)
(read-symbol string)))))))
@@ -318,3 +335,7 @@
(defun ls-read-from-string (string &optional (eof-error-p t) eof-value)
(ls-read (make-string-stream string) eof-error-p eof-value))
+
+#+jscl
+(defun read-from-string (string &optional (eof-errorp t) eof-value)
+ (ls-read-from-string string eof-errorp eof-value))