From: David Vázquez Date: Fri, 21 Jun 2013 11:44:41 +0000 (+0200) Subject: Some fixes X-Git-Url: http://repo.macrolet.net/gitweb/?p=jscl.git;a=commitdiff_plain;h=bdf672312657b00576cdd26367c2b0ef2a340b27 Some fixes --- diff --git a/jscl.lisp b/jscl.lisp index 8818677..7abeb3e 100644 --- a/jscl.lisp +++ b/jscl.lisp @@ -88,7 +88,8 @@ (defun dump-global-environment (stream) (flet ((late-compile (form) - (write-string (ls-compile-toplevel form) stream))) + (let ((*standard-output* stream)) + (write-string (ls-compile-toplevel form))))) ;; We assume that environments have a friendly list representation ;; for the compiler and it can be dumped. (dolist (b (lexenv-function *environment*)) @@ -99,8 +100,8 @@ ;; not collide with the compiler itself. (late-compile `(progn - ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s)))) - (remove-if-not #'symbolp *literal-table* :key #'car)) + (progn ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s)))) + (remove-if-not #'symbolp *literal-table* :key #'car))) (setq *literal-table* ',*literal-table*) (setq *variable-counter* ,*variable-counter*) (setq *gensym-counter* ,*gensym-counter*))) diff --git a/src/compiler-codegen.lisp b/src/compiler-codegen.lisp index 129f892..2d8f11d 100644 --- a/src/compiler-codegen.lisp +++ b/src/compiler-codegen.lisp @@ -211,6 +211,7 @@ (let ((op1 (car args)) (op2 (cadr args))) (case op + ;; Transactional compatible operator (code (js-format "~a" (apply #'code args))) ;; Function call diff --git a/src/compiler.lisp b/src/compiler.lisp index f82bda4..3b3d0c9 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -56,7 +56,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 +114,7 @@ (defun gvarname (symbol) (declare (ignore symbol)) - `(code "v" ,(incf *variable-counter*))) + (format nil "v~d" (incf *variable-counter*))) (defun translate-variable (symbol) (awhen (lookup-in-lexenv symbol *environment* 'variable) @@ -244,7 +247,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 +330,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 +1306,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 +1317,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 +1343,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 +1447,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 +1500,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))))