X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler.lisp;h=2edc334699e41f54bea329509a1c848fd9077929;hb=a0811544fcd5f5b1bd04e23a3cf52b76e04229b1;hp=f82bda4ba3a7e6ea023ac92cdc51837b6128b444;hpb=d1c8c65022514f6c4c8d24447299c7039b88b802;p=jscl.git diff --git a/src/compiler.lisp b/src/compiler.lisp index f82bda4..2edc334 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 @@ -56,7 +58,10 @@ ;;; It could be defined as function, but we could do some ;;; preprocessing in the future. (defmacro js!selfcall (&body body) - ``(code "(function(){" (code ,,@body) "})()")) + ``(code "(function(){" ,*newline* + (code ,,@body) + ,*newline* + "})()")) ;;; Like CODE, but prefix each line with four spaces. Two versions ;;; of this function are available, because the Ecmalisp version is @@ -111,7 +116,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) @@ -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,12 +1321,12 @@ (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) @@ -1343,10 +1347,10 @@ (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,8 +1451,9 @@ `(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) (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp) @@ -1499,18 +1504,20 @@ (let ((*toplevel-compilations* nil)) (cond ((and (consp sexp) (eq (car sexp) 'progn)) - (mapcar (lambda (s) - (ls-compile-toplevel s t)) - (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 ";")))))))) (defun ls-compile-toplevel (sexp &optional multiple-value-p) - (js (convert-toplevel sexp multiple-value-p))) + (with-output-to-string (*standard-output*) + (js (convert-toplevel sexp multiple-value-p))))