X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fprint.lisp;h=8a3fd1daf0f8723943a03acaaf674e0f4f58e55e;hb=68cd2db6542fa3442d46b0331ecf8be8f86c09c2;hp=39ea95e781bfef3652db9c1a2c275edff66dd606;hpb=4287e80f214812778b3923364918ce3c01c94957;p=jscl.git

diff --git a/src/print.lisp b/src/print.lisp
index 39ea95e..8a3fd1d 100644
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -33,48 +33,58 @@
           (return-from escape-symbol-name-p t))))
     dots-only))
 
-(defun potential-number-p (s)
-  (let ((i 0)
-        (n (length s))
-        (ch nil))
-    (flet ((next ()
-                 (setf ch (and (< i n) (char s (1- (incf i)))))))
-      (next)
+;;; Return T if the specified string can be read as a number
+;;; In case such a string is the name of a symbol then escaping
+;;; is required when printing to ensure correct reading.
+(defun potential-number-p (string)
+  ;; The four rules for being a potential number are described in
+  ;; 2.3.1.1 Potential Numbers as Token
+  ;;
+  ;; First Rule
+  (dotimes (i (length string))
+    (let ((char (char string i)))
       (cond
-       ((null ch) (return-from potential-number-p))
-       ((digit-char-p ch))
-       ((char= ch #\.))
-       ((char= ch #\+) (next))
-       ((char= ch #\-) (next))
-       (t (return-from potential-number-p)))
-      (when ch
-        (while (and ch (digit-char-p ch)) (next))
-        (when (null ch)
-          (return-from potential-number-p t)))
-      (when (char= ch #\.)
-        (next)
-        (when ch
-          (while (and ch (digit-char-p ch)) (next))))
-      (when (or (char= ch #\E) (char= ch #\e)
-                (char= ch #\D) (char= ch #\d)
-                (char= ch #\F) (char= ch #\f)
-                (char= ch #\L) (char= ch #\l))
-        (next)
-        (cond
-         ((null ch) (return-from potential-number-p))
-         ((digit-char-p ch))
-         ((char= ch #\+) (next))
-         ((char= ch #\-) (next))
-         (t (return-from potential-number-p)))
-        (unless (and ch (digit-char-p ch))
-          (return-from potential-number-p))
-        (while (and ch (digit-char-p ch)) (next)))
-      (null ch))))
+        ;; Digits TODO: DIGIT-CHAR-P should work with the current
+        ;; radix here. If the radix is not decimal, then we have to
+        ;; make sure there is not a decimal-point in the string.
+        ((digit-char-p char))
+        ;; Signs, ratios, decimal point and extension mark
+        ((find char "+-/._^"))
+        ;; Number marker
+        ((alpha-char-p char)
+         (when (and (< i (1- (length string)))
+                    (alpha-char-p (char string (1+ i))))
+           ;; fail: adjacent letters are not number marker, or
+           ;; there is a decimal point in the string.
+           (return-from potential-number-p)))
+        (t
+         ;; fail: there is a non-allowed character
+         (return-from potential-number-p)))))
+  (and
+   ;; Second Rule. In particular string is not empty.
+   (find-if #'digit-char-p string)
+   ;; Third rule
+   (let ((first (char string 0)))
+     (and (not (char= first #\:))
+          (or (digit-char-p first)
+              (find first "+-._^"))))
+   ;; Fourth rule
+   (not (find (char string (1- (length string))) "+-)"))))
+
+#+nil
+(mapcar #'potential-number-p
+        '("1b5000" "777777q" "1.7J" "-3/4+6.7J" "12/25/83" "27^19"
+          "3^4/5" "6//7" "3.1.2.6" "^-43^" "3.141_592_653_589_793_238_4"
+          "-3.7+2.6i-6.17j+19.6k"))
+
+#+nil
+(mapcar #'potential-number-p '("/" "/5" "+" "1+" "1-" "foo+" "ab.cd" "_" "^" "^/-"))
 
 (defun escape-token-p (string &optional uppercase)
   (or (potential-number-p string)
       (escape-symbol-name-p string uppercase)))
 
+;;; Returns the token in a form that can be used for reading it back.
 (defun escape-token (s &optional uppercase)
   (if (escape-token-p s uppercase)
       (let ((result "|"))
@@ -87,7 +97,6 @@
         (concat result "|"))
       s))
 
-
 (defvar *print-escape* t)
 
 (defun write-to-string (form)
@@ -96,19 +105,25 @@
     ((symbolp form)
      (let ((name (symbol-name form))
            (package (symbol-package form)))
-       (if (eq package *package*)
+       ;; Check if the symbol is accesible from the current package. It
+       ;; is true even if the symbol's home package is not the current
+       ;; package, because it could be inherited.
+       (if (eq form (find-symbol (symbol-name form)))
            (escape-token (symbol-name form) (not (eq package *js-package*)))
+           ;; Symbol is not accesible from *PACKAGE*, so let us prefix
+           ;; the symbol with the optional package or uninterned mark.
            (concat (cond
                      ((null package) "#")
                      ((eq package (find-package "KEYWORD")) "")
                      (t (escape-token (package-name package) t)))
                    ":"
-                   (if (or (null package)
-                           (multiple-value-bind (_ status)
-                               (find-symbol name package)
-                             (eq status :external)))
-                       "" ":")
-                   (escape-token name (not (eq (symbol-package form) *js-package*)))))))
+                   (if (and package
+                            (eq (second (multiple-value-list
+                                         (find-symbol name package)))
+                                :internal))
+                       ":"
+                       "")
+                   (escape-token name (not (eq package *js-package*)))))))
     ((integerp form) (integer-to-string form))
     ((floatp form) (float-to-string form))
     ((characterp form)