X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler.lisp;h=6605ddebfe67f526cfc744a532980da8d27a195c;hb=fdff53251d15ceeb567dc7faa06736de0e8c5ed2;hp=a81de2f46705c9690f672bc32076b55d3585ad8e;hpb=81acf0d435f13d0850a0fa48b7502e8b3ea8f2d0;p=jscl.git diff --git a/src/compiler.lisp b/src/compiler.lisp index a81de2f..6605dde 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -18,6 +18,8 @@ ;;;; Compiler +(/debug "loading compiler.lisp!") + ;;; Translate the Lisp code to Javascript. It will compile the special ;;; forms. Some primitive functions are compiled as special forms ;;; too. The respective real functions are defined in the target (see @@ -48,7 +50,7 @@ ;;; Wrap X with a Javascript code to convert the result from ;;; Javascript generalized booleans to T or NIL. (defun js!bool (x) - `(code "(" ,x "?" ,(ls-compile t) ": " ,(ls-compile nil) ")")) + `(if ,x ,(ls-compile t) ,(ls-compile nil))) ;;; Concatenate the arguments and wrap them with a self-calling ;;; Javascript anonymous function. It is used to make some Javascript @@ -56,7 +58,11 @@ ;;; It could be defined as function, but we could do some ;;; preprocessing in the future. (defmacro js!selfcall (&body body) - ``(code "(function(){" (code ,,@body) "})()")) + ``(call (function nil (code ,,@body)))) + +(defmacro js!selfcall* (&body body) + ``(call (function nil ,,@body))) + ;;; Like CODE, but prefix each line with four spaces. Two versions ;;; of this function are available, because the Ecmalisp version is @@ -111,7 +117,7 @@ (defun gvarname (symbol) (declare (ignore symbol)) - `(code "v" ,(incf *variable-counter*))) + (code "v" (incf *variable-counter*))) (defun translate-variable (symbol) (awhen (lookup-in-lexenv symbol *environment* 'variable) @@ -188,10 +194,9 @@ *compilations*)) (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*) - ")")) + `(if (!== ,(ls-compile condition) ,(ls-compile nil)) + ,(ls-compile true *multiple-value-p*) + ,(ls-compile false *multiple-value-p*))) (defvar *ll-keywords* '(&optional &rest &key)) @@ -244,7 +249,7 @@ (defun lambda-name/docstring-wrapper (name docstring &rest code) (if (or name docstring) (js!selfcall - "var func = " `(code ,code) ";" + "var func = " `(code ,@code) ";" (when name `(code "func.fname = " ,(js-escape-string name) ";")) (when docstring @@ -327,43 +332,40 @@ ,(flet ((parse-keyword (keyarg) ;; ((keyword-name var) init-form) `(code "for (i=" ,(+ n-required-arguments n-optional-arguments) - "; i= x.length) throw 'Out of range';" + "var x = " vector ";" + "var i = " n ";" + "if (i < 0 || i >= x.length) throw 'Out of range';" "return x[i] = " value ";" )) (define-builtin concatenate-storage-vector (sv1 sv2) (js!selfcall - "var sv1 = " sv1 ";" - "var r = sv1.concat(" sv2 ");" - "r.type = sv1.type;" - "r.stringp = sv1.stringp;" + "var sv1 = " sv1 ";" + "var r = sv1.concat(" sv2 ");" + "r.type = sv1.type;" + "r.stringp = sv1.stringp;" "return r;" )) (define-builtin get-internal-real-time () @@ -1306,10 +1310,10 @@ (define-raw-builtin oget* (object key &rest keys) (js!selfcall - "var tmp = (" (ls-compile object) ")[xstring(" (ls-compile key) ")];" + "var tmp = (" (ls-compile object) ")[xstring(" (ls-compile key) ")];" `(code ,@(mapcar (lambda (key) - `(code "if (tmp === undefined) return " ,(ls-compile nil) ";" + `(code "if (tmp === undefined) return " ,(ls-compile nil) ";" "tmp = tmp[xstring(" ,(ls-compile key) ")];" )) keys)) "return tmp === undefined? " (ls-compile nil) " : tmp;" )) @@ -1317,36 +1321,36 @@ (define-raw-builtin oset* (value object key &rest keys) (let ((keys (cons key keys))) (js!selfcall - "var obj = " (ls-compile object) ";" + "var obj = " (ls-compile object) ";" `(code ,@(mapcar (lambda (key) `(code "obj = obj[xstring(" ,(ls-compile key) ")];" "if (obj === undefined) throw 'Impossible to set Javascript property.';" )) (butlast keys))) - "var tmp = obj[xstring(" (ls-compile (car (last keys))) ")] = " (ls-compile value) ";" + "var tmp = obj[xstring(" (ls-compile (car (last keys))) ")] = " (ls-compile value) ";" "return tmp === undefined? " (ls-compile nil) " : tmp;" ))) (define-raw-builtin oget (object key &rest keys) - `(code "js_to_lisp(" ,(ls-compile `(oget* ,object ,key ,@keys)) ")")) + `(call |js_to_lisp| ,(ls-compile `(oget* ,object ,key ,@keys)))) (define-raw-builtin oset (value object key &rest keys) (ls-compile `(oset* (lisp-to-js ,value) ,object ,key ,@keys))) (define-builtin objectp (x) - (js!bool `(code "(typeof (" ,x ") === 'object')"))) + (js!bool `(=== (typeof ,x) "object"))) -(define-builtin lisp-to-js (x) `(code "lisp_to_js(" ,x ")")) -(define-builtin js-to-lisp (x) `(code "js_to_lisp(" ,x ")")) +(define-builtin lisp-to-js (x) `(call |lisp_to_js| ,x)) +(define-builtin js-to-lisp (x) `(call |js_to_lisp| ,x)) (define-builtin in (key object) - (js!bool `(code "(xstring(" ,key ") in (" ,object "))"))) + (js!bool `(in (call |xstring| ,key) ,object))) (define-builtin map-for-in (function object) (js!selfcall - "var f = " function ";" - "var g = (typeof f === 'function' ? f : f.fvalue);" - "var o = " object ";" - "for (var key in o){" + "var f = " function ";" + "var g = (typeof f === 'function' ? f : f.fvalue);" + "var o = " object ";" + "for (var key in o){" `(code "g(" ,(if *multiple-value-p* "values" "pv") ", 1, o[key]);" ) "}" " return " (ls-compile nil) ";" )) @@ -1447,13 +1451,14 @@ `(code ,(ls-compile-block (butlast sexps) nil decls-allowed-p) "return " ,(ls-compile (car (last sexps)) *multiple-value-p*) ";") `(code - ,@(mapcar #'ls-compile sexps) - ";")))) + ,@(interleave (mapcar #'ls-compile sexps) "; +" *newline*) + ";" ,*newline*)))) -(defun ls-compile (sexp &optional multiple-value-p) +(defun ls-compile* (sexp &optional multiple-value-p) (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp) (when expandedp - (return-from ls-compile (ls-compile sexp multiple-value-p))) + (return-from ls-compile* (ls-compile sexp multiple-value-p))) ;; The expression has been macroexpanded. Now compile it! (let ((*multiple-value-p* multiple-value-p)) (cond @@ -1487,6 +1492,9 @@ (t (error "How should I compile `~S'?" sexp)))))) +(defun ls-compile (sexp &optional multiple-value-p) + `(code "(" ,(ls-compile* sexp multiple-value-p) ")")) + (defvar *compile-print-toplevels* nil) @@ -1495,20 +1503,27 @@ (min width (length string))))) (subseq string 0 n))) -(defun ls-compile-toplevel (sexp &optional multiple-value-p) +(defun convert-toplevel (sexp &optional multiple-value-p) (let ((*toplevel-compilations* nil)) (cond - ((and (consp sexp) (eq (car sexp) 'progn)) - (let ((subs (mapcar (lambda (s) - (ls-compile-toplevel s t)) - (cdr sexp)))) - (join subs))) + ;; Non-empty toplevel progn + ((and (consp sexp) + (eq (car sexp) 'progn) + (cdr sexp)) + `(progn + ,@(mapcar (lambda (s) (convert-toplevel s t)) + (cdr sexp)))) (t (when *compile-print-toplevels* (let ((form-string (prin1-to-string sexp))) (format t "Compiling ~a..." (truncate-string form-string)))) (let ((code (ls-compile sexp multiple-value-p))) `(code - ,@(interleave (get-toplevel-compilations) ";" t) + ,@(interleave (get-toplevel-compilations) "; +" t) ,(when code - `(code ,code ";")))))))) + `(code ,code ";")))))))) + +(defun ls-compile-toplevel (sexp &optional multiple-value-p) + (with-output-to-string (*standard-output*) + (js (convert-toplevel sexp multiple-value-p))))