Fix test

[jscl.git] / src / read.lisp

diff --git a/src/read.lisp b/src/read.lisp
index 39aa7f5..ad25704 100644 (file)
--- 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 <http://www.gnu.org/licenses/>.
+;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
 
 
 ;;;; Reader
@@ -119,7 +119,7 @@
          ((string= feature "common-lisp")
           (ls-read-1 stream)              ;ignore
           (ls-read-1 stream))
-         ((string= feature "ecmalisp")
+         ((string= feature "jscl")
           (ls-read-1 stream))
          (t
           (error "Unknown reader form.")))))))
@@ -163,6 +163,93 @@
         (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)
+          (integer-part nil)
+          (fractional-part nil)
+          (number 0)
+          (divisor 1)
+          (exponent-sign 1)
+          (exponent 0)
+          (size (length string))
+          (index 0))
+      (when (zerop size) (return))
+      ;; Optional sign
+      (case (char string index)
+        (#\+ (incf index))
+        (#\- (setq sign -1)
+             (incf index)))
+      (unless (< index size) (return))
+      ;; Optional integer part
+      (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))
+      ;; Optional fractional part
+      (when (char= #\. (char string index))
+        (incf index)
+        (unless (< index size) (return))
+        (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
+      (when (and (= index size) (not fractional-part)) (return))
+      ;; Optional exponent part
+      (when (< index size)
+        ;; Exponent-marker
+        (unless (member (string-upcase (string (char string index)))
+                        '("E" "S" "F" "D" "L"))
+          (return))
+        (incf index)
+        (unless (< index size) (return))
+        ;; Optional exponent sign
+        (case (char string index)
+          (#\+ (incf index))
+          (#\- (setq exponent-sign -1)
+               (incf index)))
+        (unless (< index size) (return))
+        ;; Exponent digits
+        (let ((value (digit-char-p (char string index))))
+          (unless value (return))
+          (while (and (< index size)
+                      (setq value (digit-char-p (char string index))))
+            (setq exponent (+ (* exponent 10) value))
+            (incf index))))
+      (unless (= index size) (return))
+      ;; Everything went ok, we have a float
+      ;; XXX: Use FLOAT when implemented.
+      (/ (* sign (expt 10.0d0 (* exponent-sign exponent)) number) divisor))))
+
 
 (defun !parse-integer (string junk-allow)
   (block nil
@@ -200,7 +287,7 @@
           (values (* sign value) index)
           (values nil index)))))
 
-#+ecmalisp
+#+jscl
 (defun parse-integer (string &key junk-allowed)
   (multiple-value-bind (num index)
       (!parse-integer string junk-allowed)
@@ -236,8 +323,9 @@
        (read-sharp stream))
       (t
        (let ((string (read-until stream #'terminalp)))
-        (or (values (!parse-integer string nil))
-            (read-symbol string)))))))
+         (or (read-integer string)
+             (read-float string)
+             (read-symbol string)))))))
 
 (defun ls-read (stream &optional (eof-error-p t) eof-value)
   (let ((x (ls-read-1 stream)))
@@ -247,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))