X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=c98805021d3e3b39d14576a1097a20fcbb015a1f;hb=1be162e1ed191a148ef302a3b1ee93eae6700890;hp=15379f7c7cfe8ccc7292bf4eb00dbc0e80754ead;hpb=d210b7307f20daad1bfd5171a513ed173bd6d938;p=jscl.git

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 15379f7..c988050 100644
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -207,7 +207,7 @@
   `(push (list ',name (lambda ,args (block ,name ,@body)))
          *compilations*))
 
-(define-compilation if (condition true false)
+(define-compilation if (condition true &optional false)
   (code "(" (ls-compile condition) " !== " (ls-compile nil)
         " ? " (ls-compile true *multiple-value-p*)
         " : " (ls-compile false *multiple-value-p*)
@@ -266,9 +266,9 @@
       (js!selfcall
         "var func = " (join strs) ";" *newline*
         (when name
-          (code "func.fname = \"" (escape-string name) "\";" *newline*))
+          (code "func.fname = " (js-escape-string name) ";" *newline*))
         (when docstring
-          (code "func.docstring = \"" (escape-string docstring) "\";" *newline*))
+          (code "func.docstring = " (js-escape-string docstring) ";" *newline*))
         "return func;" *newline*)
       (apply #'code strs)))
 
@@ -468,9 +468,12 @@
 
 (define-compilation setq (&rest pairs)
   (let ((result ""))
+    (when (null pairs)
+      (return-from setq (ls-compile nil)))
     (while t
       (cond
-	((null pairs) (return))
+	((null pairs)
+         (return))
 	((null (cdr pairs))
 	 (error "Odd pairs in SETQ"))
 	(t
@@ -483,7 +486,53 @@
 
 ;;; Compilation of literals an object dumping
 
-(defun escape-string (string)
+;;; Two seperate functions are needed for escaping strings:
+;;;  One for producing JavaScript string literals (which are singly or
+;;;   doubly quoted)
+;;;  And one for producing Lisp strings (which are only doubly quoted)
+;;;
+;;; The same function would suffice for both, but for javascript string
+;;; literals it is neater to use either depending on the context, e.g:
+;;;  foo's => "foo's"
+;;;  "foo" => '"foo"'
+;;; which avoids having to escape quotes where possible
+(defun js-escape-string (string)
+  (let ((index 0)
+        (size (length string))
+        (seen-single-quote nil)
+        (seen-double-quote nil))
+    (flet ((%js-escape-string (string escape-single-quote-p)
+             (let ((output "")
+                   (index 0))
+               (while (< index size)
+                 (let ((ch (char string index)))
+                   (when (char= ch #\\)
+                     (setq output (concat output "\\")))
+                   (when (and escape-single-quote-p (char= ch #\'))
+                     (setq output (concat output "\\")))
+                   (when (char= ch #\newline)
+                     (setq output (concat output "\\"))
+                     (setq ch #\n))
+                   (setq output (concat output (string ch))))
+                 (incf index))
+               output)))
+      ;; First, scan the string for single/double quotes
+      (while (< index size)
+        (let ((ch (char string index)))
+          (when (char= ch #\')
+            (setq seen-single-quote t))
+          (when (char= ch #\")
+            (setq seen-double-quote t)))
+        (incf index))
+      ;; Then pick the appropriate way to escape the quotes
+      (cond
+        ((not seen-single-quote)
+         (concat "'"   (%js-escape-string string nil) "'"))
+        ((not seen-double-quote)
+         (concat "\""  (%js-escape-string string nil) "\""))
+        (t (concat "'" (%js-escape-string string t)   "'"))))))
+
+(defun lisp-escape-string (string)
   (let ((output "")
         (index 0)
         (size (length string)))
@@ -496,7 +545,7 @@
           (setq ch #\n))
         (setq output (concat output (string ch))))
       (incf index))
-    output))
+    (concat "\"" output "\"")))
 
 ;;; BOOTSTRAP MAGIC: We record the macro definitions as lists during
 ;;; the bootstrap. Once everything is compiled, we want to dump the
@@ -550,13 +599,13 @@
     (concat "[" (join (mapcar #'literal elements) ", ") "]")))
 
 (defun dump-string (string)
-  (code "make_lisp_string(\"" (escape-string string) "\")"))
+  (code "make_lisp_string(" (js-escape-string string) ")"))
 
 (defun literal (sexp &optional recursive)
   (cond
     ((integerp sexp) (integer-to-string sexp))
     ((floatp sexp) (float-to-string sexp))
-    ((characterp sexp) (code "\"" (escape-string (string sexp)) "\""))
+    ((characterp sexp) (js-escape-string (string sexp)))
     (t
      (or (cdr (assoc sexp *literal-table* :test #'eql))
          (let ((dumped (typecase sexp