X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fread.lisp;h=ad25704a4c51d18284003924296f88488e5ecba1;hb=3e1f7cb45ac17e7f133474c0c62197d118f09614;hp=bbd258693f9b7ebd6ed0d70a5dd04f4b070f34fd;hpb=261c79ce0f1b20b7f917a4139239facbd3e89eed;p=jscl.git
diff --git a/src/read.lisp b/src/read.lisp
index bbd2586..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
@@ -77,12 +77,12 @@
nil)
((char= ch #\.)
(%read-char stream)
- (prog1 (ls-read stream)
+ (prog1 (ls-read-1 stream)
(skip-whitespaces-and-comments stream)
(unless (char= (%read-char stream) #\))
(error "')' was expected."))))
(t
- (cons (ls-read stream) (%read-list stream))))))
+ (cons (ls-read-1 stream) (%read-list stream))))))
(defun read-string (stream)
(let ((string "")
@@ -101,7 +101,7 @@
(%read-char stream)
(ecase (%read-char stream)
(#\'
- (list 'function (ls-read stream)))
+ (list 'function (ls-read-1 stream)))
(#\( (list-to-vector (%read-list stream)))
(#\: (make-symbol (string-upcase (read-until stream #'terminalp))))
(#\\
@@ -117,10 +117,10 @@
(let ((feature (read-until stream #'terminalp)))
(cond
((string= feature "common-lisp")
- (ls-read stream) ;ignore
- (ls-read stream))
- ((string= feature "ecmalisp")
- (ls-read stream))
+ (ls-read-1 stream) ;ignore
+ (ls-read-1 stream))
+ ((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)
@@ -209,7 +296,7 @@
(error "junk detected."))))
(defvar *eof* (gensym))
-(defun ls-read (stream)
+(defun ls-read-1 (stream)
(skip-whitespaces-and-comments stream)
(let ((ch (%peek-char stream)))
(cond
@@ -220,24 +307,35 @@
(%read-list stream))
((char= ch #\')
(%read-char stream)
- (list 'quote (ls-read stream)))
+ (list 'quote (ls-read-1 stream)))
((char= ch #\`)
(%read-char stream)
- (list 'backquote (ls-read stream)))
+ (list 'backquote (ls-read-1 stream)))
((char= ch #\")
(%read-char stream)
(read-string stream))
((char= ch #\,)
(%read-char stream)
(if (eql (%peek-char stream) #\@)
- (progn (%read-char stream) (list 'unquote-splicing (ls-read stream)))
- (list 'unquote (ls-read stream))))
+ (progn (%read-char stream) (list 'unquote-splicing (ls-read-1 stream)))
+ (list 'unquote (ls-read-1 stream))))
((char= ch #\#)
(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)))
+ (if (eq x *eof*)
+ (if eof-error-p (error "EOF") eof-value)
+ x)))
+
+(defun ls-read-from-string (string &optional (eof-error-p t) eof-value)
+ (ls-read (make-string-stream string) eof-error-p eof-value))
-(defun ls-read-from-string (string)
- (ls-read (make-string-stream string)))
+#+jscl
+(defun read-from-string (string &optional (eof-errorp t) eof-value)
+ (ls-read-from-string string eof-errorp eof-value))