Add !prin1-to-string and prin1-to-string refers it
authorDavid Vázquez <davazp@gmail.com>
Thu, 25 Apr 2013 12:47:33 +0000 (13:47 +0100)
committerDavid Vázquez <davazp@gmail.com>
Thu, 25 Apr 2013 12:47:33 +0000 (13:47 +0100)
print.lisp

index f9e2630..c63e736 100644 (file)
 
 (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)