3 ;; Copyright (C) 2012, 2013 David Vazquez
4 ;; Copyright (C) 2012 Raimon Grau
6 ;; This program is free software: you can redistribute it and/or
7 ;; modify it under the terms of the GNU General Public License as
8 ;; published by the Free Software Foundation, either version 3 of the
9 ;; License, or (at your option) any later version.
11 ;; This program is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details.
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
21 (defun prin1-to-string (form)
24 (multiple-value-bind (symbol foundp)
25 (find-symbol (symbol-name form) *package*)
26 (if (and foundp (eq symbol form))
28 (let ((package (symbol-package form))
29 (name (symbol-name form)))
32 ((eq package (find-package "KEYWORD")) "")
33 (t (package-name package)))
35 ((integerp form) (integer-to-string form))
36 ((floatp form) (float-to-string form))
37 ((stringp form) (concat "\"" (escape-string form) "\""))
39 (let ((name (oget form "fname")))
41 (concat "#<FUNCTION " name ">")
42 (concat "#<FUNCTION>"))))
45 (join-trailing (mapcar #'prin1-to-string (butlast form)) " ")
46 (let ((last (last form)))
48 (prin1-to-string (car last))
49 (concat (prin1-to-string (car last)) " . " (prin1-to-string (cdr last)))))
52 (concat "#" (if (zerop (length form))
54 (prin1-to-string (vector-to-list form)))))
56 (concat "#<PACKAGE " (package-name form) ">"))
58 (concat "#<javascript object>"))))
62 (write-string *newline*)
66 (write-string "WARNING: ")
70 (write-line (prin1-to-string x))