From: David Vázquez <davazp@gmail.com>
Date: Thu, 25 Apr 2013 12:47:33 +0000 (+0100)
Subject: Add !prin1-to-string and prin1-to-string refers it
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a0dc32245b7d2e9340d48dfd162be3c490654f3a;p=jscl.git

Add !prin1-to-string and prin1-to-string refers it
---

diff --git a/print.lisp b/print.lisp
index f9e2630..c63e736 100644
--- a/print.lisp
+++ b/print.lisp
@@ -20,45 +20,49 @@
 
 (defvar *newline* (string (code-char 10)))
 
+(defun !print1-to-string (form)
+  (cond
+    ((symbolp form)
+     (multiple-value-bind (symbol foundp)
+         (find-symbol (symbol-name form) *package*)
+       (if (and foundp (eq symbol form))
+           (symbol-name form)
+           (let ((package (symbol-package form))
+                 (name (symbol-name form)))
+             (concat (cond
+                       ((null package) "#")
+                       ((eq package (find-package "KEYWORD")) "")
+                       (t (package-name package)))
+                     ":" name)))))
+    ((integerp form) (integer-to-string form))
+    ((stringp form) (concat "\"" (escape-string form) "\""))
+    ((functionp form)
+     (let ((name (oget form "fname")))
+       (if name
+           (concat "#<FUNCTION " name ">")
+           (concat "#<FUNCTION>"))))
+    ((listp form)
+     (concat "("
+             (join-trailing (mapcar #'prin1-to-string (butlast form)) " ")
+             (let ((last (last form)))
+               (if (null (cdr last))
+                   (prin1-to-string (car last))
+                   (concat (prin1-to-string (car last)) " . " (prin1-to-string (cdr last)))))
+             ")"))
+    ((arrayp form)
+     (concat "#" (if (zerop (length form))
+                     "()"
+                     (prin1-to-string (vector-to-list form)))))
+    ((packagep form)
+     (concat "#<PACKAGE " (package-name form) ">"))
+    (t
+     (concat "#<javascript object>"))))
+
+
 #+ecmalisp
 (progn
   (defun prin1-to-string (form)
-    (cond
-      ((symbolp form)
-       (multiple-value-bind (symbol foundp)
-           (find-symbol (symbol-name form) *package*)
-         (if (and foundp (eq symbol form))
-             (symbol-name form)
-             (let ((package (symbol-package form))
-                   (name (symbol-name form)))
-               (concat (cond
-                         ((null package) "#")
-                         ((eq package (find-package "KEYWORD")) "")
-                         (t (package-name package)))
-                       ":" name)))))
-      ((integerp form) (integer-to-string form))
-      ((stringp form) (concat "\"" (escape-string form) "\""))
-      ((functionp form)
-       (let ((name (oget form "fname")))
-         (if name
-             (concat "#<FUNCTION " name ">")
-             (concat "#<FUNCTION>"))))
-      ((listp form)
-       (concat "("
-               (join-trailing (mapcar #'prin1-to-string (butlast form)) " ")
-               (let ((last (last form)))
-                 (if (null (cdr last))
-                     (prin1-to-string (car last))
-                     (concat (prin1-to-string (car last)) " . " (prin1-to-string (cdr last)))))
-               ")"))
-      ((arrayp form)
-       (concat "#" (if (zerop (length form))
-                       "()"
-                       (prin1-to-string (vector-to-list form)))))
-      ((packagep form)
-       (concat "#<PACKAGE " (package-name form) ">"))
-      (t
-       (concat "#<javascript object>"))))
+    (!print1-to-string form))
 
   (defun write-line (x)
     (write-string x)