Merge branch 'origin-master' into origin-format

Conflicts:
	jscl.lisp
	src/print.lisp
	src/toplevel.lisp

diff --git a/README.org b/README.org
index d6b5ebd..3197b14 100644 (file)
--- a/README.org
+++ b/README.org
@@ -2,7 +2,7 @@
 
   JSCL is a Common Lisp to Javascript compiler, which is bootstrapped
   from Common Lisp and executed from the browser.
-  
+
 ** Getting started
 
 You can try a demo [[http://davazp.net/jscl/jscl.html][here]]. But if you want to hack JSCL, you will have
@@ -32,7 +32,7 @@ operators, functions and macros. In particular:
   - Optional and keyword arguments
   - SETF places
   - Packages
-    
+
 The compiler is very verbose, some simple optimizations or
 /minification/ could help to deal with it.
 
@@ -42,3 +42,13 @@ just enough compliant to include a [[http://www.cs.cmu.edu/afs/cs/project/ai-rep
 implementation, or even [[http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/oop/0.html][CLOS]] or non-CLOS OOP.
 
 /Feel free to hack it yourself/
+
+
+** Hacking
+
+*** Newbie guide
+    - load slime from the root directory.
+    - c-c c-l jscl.lisp  to load the whole project
+    - (bootstrap) will generate jscl.js
+    - add tests
+    - open tests.html in your browser to see your failed tests

diff --git a/jscl.lisp b/jscl.lisp
index aae6ee9..6d907a3 100644 (file)
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -83,7 +83,7 @@
   (with-open-file (out "tests.js" :direction :output :if-exists :supersede)
     (dolist (input (append (directory "tests.lisp")
                            (directory "tests/*.lisp")
-                           (directory "tests-report.lisp"))) 
+                           (directory "tests-report.lisp")))
       (ls-compile-file input out))))
 
 

diff --git a/src/print.lisp b/src/print.lisp
index dfa1b69..9db5354 100644 (file)
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -1,4 +1,4 @@
-;;; print.lisp --- 
+;;; print.lisp ---
 
 ;; Copyright (C) 2012, 2013 David Vazquez
 ;; Copyright (C) 2012 Raimon Grau
@@ -18,7 +18,9 @@
 
 ;;; Printer
 
-(defun prin1-to-string (form)
+(defvar *print-escape* t)
+
+(defun write-to-string (form)
   (cond
     ((symbolp form)
      (multiple-value-bind (symbol foundp)
@@ -35,7 +37,7 @@
     ((integerp form) (integer-to-string form))
     ((floatp form) (float-to-string form))
     ((characterp form)
-     (concat "#\\" 
+     (concat "#\\"
              (case form
                (#\newline "newline")
                (#\space "space")
@@ -48,21 +50,29 @@
            (concat "#<FUNCTION>"))))
     ((listp form)
      (concat "("
-             (join-trailing (mapcar #'prin1-to-string (butlast form)) " ")
+             (join-trailing (mapcar #'write-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)))))
+                   (write-to-string (car last))
+                   (concat (write-to-string (car last)) " . " (write-to-string (cdr last)))))
              ")"))
     ((arrayp form)
      (concat "#" (if (zerop (length form))
                      "()"
-                     (prin1-to-string (vector-to-list form)))))
+                     (write-to-string (vector-to-list form)))))
     ((packagep form)
      (concat "#<PACKAGE " (package-name form) ">"))
     (t
      (concat "#<javascript object>"))))
 
+(defun prin1-to-string (form)
+  (let ((*print-escape* t))
+    (write-to-string form)))
+
+(defun princ-to-string (form)
+  (let ((*print-escape* nil))
+    (write-to-string form)))
+
 (defun write-line (x)
   (write-string x)
   (write-string *newline*)
@@ -75,3 +85,34 @@
 (defun print (x)
   (write-line (prin1-to-string x))
   x)
+
+(defun format (destination fmt &rest args)
+  (let ((len (length fmt))
+       (i 0)
+       (res "")
+       (arguments args))
+    (while (< i len)
+      (let ((c (char fmt i)))
+       (if (char= c #\~)
+           (let ((next (char fmt (incf i))))
+             (cond
+              ((char= next #\~)
+               (setq res (concat res "~")))
+              ((char= next #\%)
+               (setq res (concat res *newline*)))
+              (t
+               (setq res (concat res (format-special next (car arguments))))
+               (setq arguments (cdr arguments)))))
+         (setq res (concat res (char-to-string c))))
+       (incf i)))
+    (if destination
+       (progn
+         (write-string res)
+         nil)
+      res)))
+
+
+(defun format-special (chr arg)
+  (case chr
+    (#\S (prin1-to-string arg))
+    (#\a (princ-to-string arg))))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index c32dfbb..d6f8cb4 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -59,7 +59,7 @@
           define-symbol-macro defmacro defparameter defun defvar
           digit-char digit-char-p disassemble do do* documentation
           dolist dotimes ecase eq eql equal error eval every export expt
-          fdefinition find-package find-symbol first flet fourth fset
+          fdefinition find-package find-symbol first flet format fourth fset
           funcall function functionp gensym get-internal-real-time
           get-setf-expansion get-universal-time go identity if in-package
           incf integerp intern keywordp labels lambda last length let let* list

diff --git a/tests/format.lisp b/tests/format.lisp
new file mode 100644 (file)
index 0000000..3491010
--- /dev/null
+++ b/tests/format.lisp
@@ -0,0 +1,12 @@
+(test (string= "a" (format nil "a")))
+
+(test (string= "~" (format nil "~~")))
+
+(test (string= "a~a" (format nil "a~~a")))
+
+(test (string= "a
+a" (format nil "a~%a")))
+
+(test (string= "this is foo" (format nil "this is ~a" "foo")))
+
+(test (string= "this is \"foo\"" (format nil "this is ~S" "foo")))