From: Andrea Griffini <agriff@tin.it>
Date: Tue, 30 Apr 2013 19:41:43 +0000 (+0200)
Subject: quoted symbols, better handling of dotted pairs
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ca49459c0d6de45c45171af22e268db9ce14e31a;p=jscl.git

quoted symbols, better handling of dotted pairs
---

diff --git a/src/read.lisp b/src/read.lisp
index c99604a..6d015f7 100644
--- a/src/read.lisp
+++ b/src/read.lisp
@@ -57,6 +57,19 @@
       (setq ch (%peek-char stream)))
     string))
 
+(defun read-escaped-until (stream func)
+  (let ((string "")
+        (ch))
+    (setq ch (%peek-char stream))
+    (while (and ch (not (funcall func ch)))
+      (setq string (concat string (string ch)))
+      (%read-char stream)
+      (when (char= ch #\\)
+        ;; Note... escape char has been left in the string!
+        (setq string (concat string (string (%read-char stream)))))
+      (setq ch (%peek-char stream)))
+    string))
+
 (defun skip-whitespaces-and-comments (stream)
   (let (ch)
     (skip-whitespaces stream)
@@ -75,14 +88,21 @@
       ((char= ch #\))
        (%read-char stream)
        nil)
-      ((char= ch #\.)
-       (%read-char stream)
-       (prog1 (ls-read-1 stream)
-         (skip-whitespaces-and-comments stream)
-         (unless (char= (%read-char stream) #\))
-           (error "')' was expected."))))
       (t
-       (cons (ls-read-1 stream) (%read-list stream))))))
+       (let ((car (ls-read-1 stream)))
+         (skip-whitespaces-and-comments stream)
+         (cons car
+               (if (char= (%peek-char stream) #\.)
+                   (progn
+                     (%read-char stream)
+                     (if (terminalp (%peek-char stream))
+                         (ls-read-1 stream) ; Dotted pair notation
+                         (cons (let ((string (concat "." (read-escaped-until stream #'terminalp))))
+                                 (or (values (!parse-integer string nil))
+                                     (read-float string)
+                                     (read-symbol string)))
+                               (%read-list stream))))
+                   (%read-list stream))))))))
 
 (defun read-string (stream)
   (let ((string "")
@@ -124,6 +144,13 @@
          (t
           (error "Unknown reader form.")))))))
 
+(defun unescape (x)
+  (let ((result ""))
+    (dotimes (i (length x))
+      (unless (char= (char x i) #\\)
+        (setq result (concat result (string (char x i))))))
+    result))
+
 ;;; Parse a string of the form NAME, PACKAGE:NAME or
 ;;; PACKAGE::NAME and return the name. If the string is of the
 ;;; form 1) or 3), but the symbol does not exist, it will be created
@@ -134,23 +161,25 @@
     (setq index 0)
     (while (and (< index size)
                 (not (char= (char string index) #\:)))
+      (when (char= (char string index) #\\)
+        (incf index))
       (incf index))
     (cond
       ;; No package prefix
       ((= index size)
-       (setq name string)
+       (setq name (unescape string))
        (setq package *package*)
        (setq internalp t))
       (t
        ;; Package prefix
        (if (zerop index)
            (setq package "KEYWORD")
-           (setq package (string-upcase (subseq string 0 index))))
+           (setq package (string-upcase (unescape (subseq string 0 index)))))
        (incf index)
        (when (char= (char string index) #\:)
          (setq internalp t)
          (incf index))
-       (setq name (subseq string index))))
+       (setq name (unescape (subseq string index)))))
     ;; Canonalize symbol name and package
     (when (not (eq package "JS"))
       (setq name (string-upcase name)))
@@ -229,7 +258,7 @@
             (incf index))))
       (unless (= index size) (return))
       ;; Everything went ok, we have a float
-      (/ (* sign (expt 10 (* exponent-sign exponent)) number) divisor))))
+      (/ (* sign (expt 10.0 (* exponent-sign exponent)) number) divisor))))
 
 
 (defun !parse-integer (string junk-allow)
@@ -272,9 +301,9 @@
 (defun parse-integer (string &key junk-allowed)
   (multiple-value-bind (num index)
       (!parse-integer string junk-allowed)
-    (when num
-      (values num index)
-      (error "junk detected."))))
+    (if num
+        (values num index)
+        (error "junk detected."))))
 
 (defvar *eof* (gensym))
 (defun ls-read-1 (stream)
@@ -302,8 +331,13 @@
            (list 'unquote (ls-read-1 stream))))
       ((char= ch #\#)
        (read-sharp stream))
+      ((char= ch #\|)
+       (%read-char stream)
+       (let ((string (read-escaped-until stream (lambda (x) (char= x #\|)))))
+         (%read-char stream)
+         (read-symbol string)))
       (t
-       (let ((string (read-until stream #'terminalp)))
+       (let ((string (read-escaped-until stream #'terminalp)))
          (or (values (!parse-integer string nil))
              (read-float string)
              (read-symbol string)))))))
diff --git a/tests/read.lisp b/tests/read.lisp
index b8e851c..516790e 100644
--- a/tests/read.lisp
+++ b/tests/read.lisp
@@ -3,3 +3,9 @@
 ;; (test (equal (read-from-string " 1 3 5" t nil :start 2) (values 3 5)))
 (expected-failure
  (equal (read-from-string "(a b c)") (values '(A B C) 7)))
+
+(test (equal (read-from-string "|.|") '\.))
+(test (equal (read-from-string "(1 .25)") '(1 0.25)))
+(test (equal (read-from-string ".25") 0.25))
+(test (equal (read-from-string "(1 |.| 25)") '(1 |.| 25)))
+(test (equal (read-from-string "(1 . 25)") '(1 . 25)))