X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=806c9e0810d086846adcebed4d8c093e76602c52;hb=b2de12c4e1a6e77e7f3f22d056adcfeda79d085b;hp=3a743990de18370c3954c8383d40ce6598d68f59;hpb=c59536501d4a2f8c161e12194deea0f3f345d666;p=jscl.git diff --git a/src/compiler.lisp b/src/compiler.lisp index 3a74399..806c9e0 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -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))) @@ -483,7 +483,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 +542,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 +596,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 @@ -1178,58 +1224,29 @@ (define-builtin char-code (x) (type-check (("x" "string" x)) - "x.charCodeAt(0)")) + "char_to_codepoint(x)")) (define-builtin code-char (x) (type-check (("x" "number" x)) - "String.fromCharCode(x)")) + "char_from_codepoint(x)")) (define-builtin characterp (x) (js!bool (js!selfcall "var x = " x ";" *newline* - "return (typeof(" x ") == \"string\") && x.length == 1;"))) - -(define-builtin char-to-string (x) - (js!selfcall - "var r = [" x "];" *newline* - "r.type = 'character';" - "return r")) + "return (typeof(" x ") == \"string\") && (x.length == 1 || x.length == 2);"))) (define-builtin char-upcase (x) - (code x ".toUpperCase()")) + (code "safe_char_upcase(" x ")")) (define-builtin char-downcase (x) - (code x ".toLowerCase()")) + (code "safe_char_downcase(" x ")")) (define-builtin stringp (x) (js!bool (js!selfcall "var x = " x ";" *newline* - "return typeof(x) == 'object' && 'length' in x && x.type == 'character';"))) - -(define-builtin string-upcase (x) - (code "make_lisp_string(xstring(" x ").toUpperCase())")) - -(define-builtin string-length (x) - (code x ".length")) - -(define-raw-builtin slice (vector a &optional b) - (js!selfcall - "var vector = " (ls-compile vector) ";" *newline* - "var a = " (ls-compile a) ";" *newline* - "var b;" *newline* - (when b (code "b = " (ls-compile b) ";" *newline*)) - "return vector.slice(a,b);" *newline*)) - -(define-builtin char (string index) - (code string "[" index "]")) - -(define-builtin concat-two (string1 string2) - (js!selfcall - "var r = " string1 ".concat(" string2 ");" *newline* - "r.type = 'character';" - "return r;" *newline*)) + "return typeof(x) == 'object' && 'length' in x && x.stringp == 1;"))) (define-raw-builtin funcall (func &rest args) (js!selfcall @@ -1303,51 +1320,48 @@ (define-builtin write-string (x) (code "lisp.write(" x ")")) -(define-builtin make-array (n) - (js!selfcall - "var r = [];" *newline* - "for (var i = 0; i < " n "; i++)" *newline* - (indent "r.push(" (ls-compile nil) ");" *newline*) - "return r;" *newline*)) -;;; FIXME: should take optional min-extension. -;;; FIXME: should use fill-pointer instead of the absolute end of array -(define-builtin vector-push-extend (new vector) - (js!selfcall - "var v = " vector ";" *newline* - "v.push(" new ");" *newline* - "return v;")) +;;; Storage vectors. They are used to implement arrays and (in the +;;; future) structures. -(define-builtin arrayp (x) +(define-builtin storage-vector-p (x) (js!bool (js!selfcall "var x = " x ";" *newline* "return typeof x === 'object' && 'length' in x;"))) -(define-builtin aref (array n) +(define-builtin make-storage-vector (n) (js!selfcall - "var x = " "(" array ")[" n "];" *newline* + "var r = [];" *newline* + "r.length = " n ";" *newline* + "return r;" *newline*)) + +(define-builtin storage-vector-size (x) + (code x ".length")) + +(define-builtin resize-storage-vector (vector new-size) + (code "(" vector ".length = " new-size ")")) + +(define-builtin storage-vector-ref (vector n) + (js!selfcall + "var x = " "(" vector ")[" n "];" *newline* "if (x === undefined) throw 'Out of range';" *newline* "return x;" *newline*)) -(define-builtin aset (array n value) +(define-builtin storage-vector-set (vector n value) (js!selfcall - "var x = " array ";" *newline* + "var x = " vector ";" *newline* "var i = " n ";" *newline* "if (i < 0 || i >= x.length) throw 'Out of range';" *newline* "return x[i] = " value ";" *newline*)) -(define-builtin afind (value array) +(define-builtin concatenate-storage-vector (sv1 sv2) (js!selfcall - "var v = " value ";" *newline* - "var x = " array ";" *newline* - "return x.indexOf(v);" *newline*)) - -(define-builtin aresize (array new-size) - (js!selfcall - "var x = " array ";" *newline* - "var n = " new-size ";" *newline* - "return x.length = n;" *newline*)) + "var sv1 = " sv1 ";" *newline* + "var r = sv1.concat(" sv2 ");" *newline* + "r.type = sv1.type;" *newline* + "r.stringp = sv1.stringp;" *newline* + "return r;" *newline*)) (define-builtin get-internal-real-time () "(new Date()).getTime()")