X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=806c9e0810d086846adcebed4d8c093e76602c52;hb=b2de12c4e1a6e77e7f3f22d056adcfeda79d085b;hp=fb9f62d5d0475f1b675fe6b1bc77236e04d65f1f;hpb=41f31884e0be58584c3ec47f78e32f305833d3a0;p=jscl.git diff --git a/src/compiler.lisp b/src/compiler.lisp index fb9f62d..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))) @@ -482,12 +482,23 @@ ;;; 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 ((%escape-string (string escape-single-quote-p) + (flet ((%js-escape-string (string escape-single-quote-p) (let ((output "") (index 0)) (while (< index size) @@ -513,10 +524,25 @@ ;; Then pick the appropriate way to escape the quotes (cond ((not seen-single-quote) - (concat "'" (%escape-string string nil) "'")) + (concat "'" (%js-escape-string string nil) "'")) ((not seen-double-quote) - (concat "\"" (%escape-string string nil) "\"")) - (t (concat "'" (%escape-string string t) "'")))))) + (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))) + (while (< index size) + (let ((ch (char string index))) + (when (or (char= ch #\") (char= ch #\\)) + (setq output (concat output "\\"))) + (when (or (char= ch #\newline)) + (setq output (concat output "\\")) + (setq ch #\n)) + (setq output (concat output (string ch)))) + (incf index)) + (concat "\"" output "\""))) ;;; BOOTSTRAP MAGIC: We record the macro definitions as lists during ;;; the bootstrap. Once everything is compiled, we want to dump the @@ -570,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) (escape-string (string sexp))) + ((characterp sexp) (js-escape-string (string sexp))) (t (or (cdr (assoc sexp *literal-table* :test #'eql)) (let ((dumped (typecase sexp @@ -1210,12 +1236,6 @@ "var x = " x ";" *newline* "return (typeof(" x ") == \"string\") && (x.length == 1 || x.length == 2);"))) -(define-builtin char-to-string (x) - (js!selfcall - "var r = [" x "];" *newline* - "r.type = 'character';" - "return r")) - (define-builtin char-upcase (x) (code "safe_char_upcase(" x ")")) @@ -1226,30 +1246,7 @@ (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 @@ -1323,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()")