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))