Create JSCL package to keep the symbols in the host implementation

[jscl.git] / src / read.lisp

diff --git a/src/read.lisp b/src/read.lisp
index 0cfe563..3c352b3 100644 (file)
--- a/src/read.lisp
+++ b/src/read.lisp
@@ -45,7 +45,7 @@
       (setq ch (%peek-char stream)))))
 
 (defun terminalp (ch)
-  (or (null ch) (whitespacep ch) (char= #\) ch) (char= #\( ch)))
+  (or (null ch) (whitespacep ch) (char= #\" ch) (char= #\) ch) (char= #\( ch)))
 
 (defun read-until (stream func)
   (let ((string "")
@@ -99,33 +99,34 @@
   (skip-whitespaces-and-comments stream)
   (let ((ch (%peek-char stream)))
     (cond
-     ((null ch)
-      (error "Unspected EOF"))
-     ((char= ch #\))
-      (discard-char stream #\))
-      nil)
-     (t
-      (let* ((eof (gensym))
-             (next (ls-read stream nil eof)))
-        (skip-whitespaces-and-comments stream)
-        (cond
-         ((eq next eof)
-          (discard-char stream #\)))
-         (t
-          (cons next
-                (if (char= (%peek-char stream) #\.)
-                    (progn
-                      (discard-char stream #\.)
-                      (if (terminalp (%peek-char stream))
-                          (prog1 (ls-read stream) ; Dotted pair notation
-                            (skip-whitespaces-and-comments stream)
-                            (if (char= (%peek-char stream) #\) )
-                                (discard-char stream #\))
-                                (error "More than one object follows . in list")))
-                          (let ((token (concat "." (read-escaped-until stream #'terminalp))))
-                            (cons (interpret-token token)
-                                  (%read-list stream)))))
-                    (%read-list stream))))))))))
+      ((null ch)
+       (error "Unspected EOF"))
+      ((char= ch #\))
+       (discard-char stream #\))
+       nil)
+      (t
+       (let* ((eof (gensym))
+              (next (ls-read stream nil eof)))
+         (skip-whitespaces-and-comments stream)
+         (cond
+           ((eq next eof)
+            (discard-char stream #\)))
+           (t
+            (cons next
+                  (if (char= (%peek-char stream) #\.)
+                      (progn
+                        (discard-char stream #\.)
+                        (if (terminalp (%peek-char stream))
+                            (prog1 (ls-read stream) ; Dotted pair notation
+                              (skip-whitespaces-and-comments stream)
+                              (let ((ch (%peek-char stream)))
+                                (if (or (null ch) (char= #\) ch))
+                                    (discard-char stream #\))
+                                    (error "Multiple objects following . in a list"))))
+                            (let ((token (concat "." (read-escaped-until stream #'terminalp))))
+                              (cons (interpret-token token)
+                                    (%read-list stream)))))
+                      (%read-list stream))))))))))
 
 (defun read-string (stream)
   (let ((string "")
@@ -146,7 +147,10 @@
     (#\'
      (list 'function (ls-read stream)))
     (#\( (list-to-vector (%read-list stream)))
-    (#\: (make-symbol (string-upcase (read-until stream #'terminalp))))
+    (#\: (make-symbol
+          (unescape-token
+           (string-upcase-noescaped
+            (read-escaped-until stream #'terminalp)))))
     (#\\
      (let ((cname
             (concat (string (%read-char stream))
@@ -166,9 +170,12 @@
           (ls-read stream)
           (ls-read stream eof-error-p eof-value))
          (:jscl
+          (ls-read stream eof-error-p eof-value))
+         (:nil
+          (ls-read stream)
           (ls-read stream eof-error-p eof-value)))))))
 
-(defun unescape (x)
+(defun unescape-token (x)
   (let ((result ""))
     (dotimes (i (length x))
       (unless (char= (char x i) #\\)
@@ -220,7 +227,7 @@
        (setq name (subseq string index))))
     ;; Canonalize symbol name and package
     (setq name (if (equal package "JS")
-                   (setq name (unescape name))
+                   (setq name (unescape-token name))
                    (setq name (string-upcase-noescaped name))))
     (setq package (find-package package))
     (if (or internalp
@@ -297,8 +304,7 @@
       ;; Optional exponent part
       (when (< index size)
         ;; Exponent-marker
-        (unless (member (string-upcase (string (char string index)))
-                        '("E" "S" "F" "D" "L"))
+        (unless (find (char-upcase (char string index)) "ESFDL")
           (return))
         (incf index)
         (unless (< index size) (return))
@@ -318,7 +324,7 @@
       (unless (= index size) (return))
       ;; Everything went ok, we have a float
       ;; XXX: Use FLOAT when implemented.
-      (/ (* sign (expt 10.0 (* exponent-sign exponent)) number) divisor))))
+      (/ (* sign (expt 10.0 (* exponent-sign exponent)) number) divisor 1.0))))
 
 (defun !parse-integer (string junk-allow)
   (block nil