Create JSCL package to keep the symbols in the host implementation
[jscl.git] / src / read.lisp
index 05074a4..3c352b3 100644 (file)
                         (discard-char stream #\.)
                         (if (terminalp (%peek-char stream))
                             (prog1 (ls-read stream) ; Dotted pair notation
-                              (discard-char stream #\)))
+                              (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)))))
      (list 'function (ls-read stream)))
     (#\( (list-to-vector (%read-list stream)))
     (#\: (make-symbol
-          (unescape
+          (unescape-token
            (string-upcase-noescaped
             (read-escaped-until stream #'terminalp)))))
     (#\\
           (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) #\\)
         (setq result (concat result (string (char x i))))))
     result))
 
-(defun escape-all (x)
-  (let ((result ""))
-    (dotimes (i (length x))
-      (setq result (concat result "\\"))
-      (setq result (concat result (string (char x i)))))
-    result))
-
 (defun string-upcase-noescaped (s)
   (let ((result "")
         (last-escape nil))
        (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
       ;; 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))
       (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