July 2009 - parenscript-devel - mailman3.common-lisp.net

[parenscript-devel] Added REPEAT clauses to PS loop
by Daniel Gackle 01 Aug '09

01 Aug '09

I added the simple REPEAT clause that's supported by CL's LOOP to PS's pseudo-LOOP: (ps (loop repeat 3 do (alert "hi"))) => "for (var _js3691 = 0; _js3691 < 3; _js3691 += 1) { alert('hi'); };" Daniel >From 043a85a1f155068af509e05fd32ae2adcfb0f30f Mon Sep 17 00:00:00 2001 From: Daniel Gackle <danielgackle(a)gmail.com> Date: Fri, 31 Jul 2009 14:20:15 -0600 Subject: [PATCH] Added :REPEAT clauses to PS's LOOP. --- src/lib/ps-loop.lisp | 7 ++++++- 1 files changed, 6 insertions(+), 1 deletions(-) diff --git a/src/lib/ps-loop.lisp b/src/lib/ps-loop.lisp index c7334fa..38ea78c 100644 --- a/src/lib/ps-loop.lisp +++ b/src/lib/ps-loop.lisp @@ -9,7 +9,7 @@ (defvar *loop-keywords* '(:for :do :when :unless :initially :finally :first-time :last-time :while :until :from :to :below :downto :above :by :in :across :on :index := :then :sum :collect - :count :minimize :maximize :into)) + :count :minimize :maximize :into :repeat)) (defun normalize-loop-keywords (args) (mapcar @@ -146,10 +146,15 @@ ((:in :across) (for-in var)) (:on (for-on var)) (otherwise (error "FOR ~s ~s is not valid in PS-LOOP." var term))))) + (repeat-clause () + (let ((index (ps-gensym))) + (setf terms (append `(:for ,index :from 0 :below ,(consume)) terms)) + (clause))) (clause () (let ((term (consume-atom))) (case term (:for (for-clause)) + (:repeat (repeat-clause)) (:while (push `(unless ,(consume) break) body)) (:until (push `(when ,(consume) break) body)) (:initially (push (consume-progn) initially)) -- 1.6.1

2 1

[parenscript-devel] patch to export chain macro
by Kelly McDonald 01 Aug '09

01 Aug '09

The chain macro was defined @ d9d9a9705bdfd0559ee1bbf9ca, but wasn't exported Kelly diff --git a/src/package.lisp b/src/package.lisp index dee537f..a41ce1e 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -185,6 +185,7 @@ #:defined #:undefined #:@ + #:chain #:with-lambda #:stringp #:numberp

2 1

[parenscript-devel] Inconsistency between (slot-value obj :keyword-symbol) and :keyword-symbol. Patch attached
by Red Daly 27 Jul '09

27 Jul '09

Dear Parenscripters, I found an inconsistency in how symbols are translated into Javascript. The issue is similar to an earlier issue: CL-USER> (ps:ps (let ((sym :my-function)) (slot-value object sym) (slot-value object :my-function))) "var sym = 'my-function'; object[sym]; object.myFunction;" One would expect object[sym] and object.myFunction to evaluate to the same value, but right now they do not. This bug only affects keywords: CL-USER> (ps:ps (let ((sym 'my-function)) (slot-value object sym) (slot-value object 'my-function))) "var sym = 'myFunction'; object[sym]; object.myFunction;" The above output is sensible. A patch is attached to fix this issue. A few test cases have also been added to prevent future breakage. The old DEFUN-KEYWORD4 test function failed with this patch because it expected a keyword to translate to 'my-name-key'. I patched it to expect 'myNameKey' Best, Red >From 904be1cc2eee598491557132e8ed1569a90f27a3 Mon Sep 17 00:00:00 2001 From: Red Daly <reddaly(a)gmail.com> Date: Sun, 26 Jul 2009 20:22:54 +0000 Subject: [PATCH] Fixed eval-when special form and added tests to prevent future breakage. --- src/compiler.lisp | 50 ++++++++++++++++++++++++++++---------------------- t/ps-tests.lisp | 40 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+), 22 deletions(-) diff --git a/src/compiler.lisp b/src/compiler.lisp index 4fed094..e72fb4e 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -162,17 +162,20 @@ compiled to an :expression (the default), a :statement, or a :symbol.")) (defun adjust-ps-compilation-level (form level) - (cond ((or (and (consp form) (eq 'progn (car form))) - (and (symbolp form) (eq :toplevel level))) - level) - ((eq :toplevel level) :inside-toplevel-form))) + "Given the current *ps-compilation-level*, LEVEL, and the fully macroexpanded +form, FORM, returns the new value for *ps-compilation-level*." + (cond ((or (and (consp form) (member (car form) + '(progn locally macrolet symbol-macrolet compile-file))) + (and (symbolp form) (eq :toplevel level))) + level) + ((eq :toplevel level) :inside-toplevel-form))) + (defmethod compile-parenscript-form :around (form &key expecting) (assert (if expecting (member expecting '(:expression :statement :symbol)) t)) (if (eq expecting :symbol) (compile-to-symbol form) - (let ((*ps-compilation-level* (adjust-ps-compilation-level form *ps-compilation-level*))) - (call-next-method)))) + (call-next-method))) (defun compile-to-symbol (form) "Compiles the given Parenscript form and guarantees that the @@ -226,22 +229,25 @@ the form cannot be compiled to a symbol." (defmethod compile-parenscript-form ((form cons) &key (expecting :statement)) (multiple-value-bind (form expanded-p) (ps-macroexpand form) - (cond (expanded-p (compile-parenscript-form form :expecting expecting)) - ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) - ((op-form-p form) - `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) - ,@(mapcar (lambda (form) - (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) - (cdr form)))) - ((funcall-form-p form) - `(js:funcall ,(compile-parenscript-form (if (symbolp (car form)) - (maybe-rename-local-function (car form)) - (ps-macroexpand (car form))) - :expecting :expression) - ,@(mapcar (lambda (arg) - (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) - (cdr form)))) - (t (error "Cannot compile ~S to a ParenScript form." form))))) + (let ((*ps-compilation-level* (if expanded-p + *ps-compilation-level* + (adjust-ps-compilation-level form *ps-compilation-level*)))) + (cond (expanded-p (compile-parenscript-form form :expecting expecting)) + ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) + ((op-form-p form) + `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) + ,@(mapcar (lambda (form) + (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) + (cdr form)))) + ((funcall-form-p form) + `(js:funcall ,(compile-parenscript-form (if (symbolp (car form)) + (maybe-rename-local-function (car form)) + (ps-macroexpand (car form))) + :expecting :expression) + ,@(mapcar (lambda (arg) + (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) + (cdr form)))) + (t (error "Cannot compile ~S to a ParenScript form." form)))))) (defvar *ps-gensym-counter* 0) diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index cd9d4f2..0324c09 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -1129,3 +1129,43 @@ x1 - x1; --x1; ++x1;") +(test-ps-js eval-when-ps-side + (eval-when (:execute) + 5) + "5;") + +(defvar *lisp-output* nil) + +(test eval-when-lisp-side () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(eval-when (:compile-toplevel) + (setf *lisp-output* 'it-works)))))) + (is (eql 'it-works *lisp-output*)) + (is (string= "" js-output)))) + +(defpsmacro my-in-package (package-name) + `(eval-when (:compile-toplevel) + (setf *lisp-output* ,package-name))) + +(test eval-when-macro-expansion () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(progn + (my-in-package :cl-user) + 3))))) + (declare (ignore js-output)) + (is (eql :cl-user *lisp-output*)))) + ;(is (string= "" js-output)))) + +(test eval-when-macrolet-expansion () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(macrolet ((my-in-package2 (package-name) + `(eval-when (:compile-toplevel) + (setf *lisp-output* ,package-name)))) + (my-in-package2 :cl-user) + 3))))) + (declare (ignore js-output)) + (is (eql :cl-user *lisp-output*)))) + ;(is (string= "" js-output)))) -- 1.5.4.3 >From d6748a5cfc8c4b9300884e9e5061db19cb0407cd Mon Sep 17 00:00:00 2001 From: Red Daly <reddaly(a)gmail.com> Date: Sun, 26 Jul 2009 20:49:59 +0000 Subject: [PATCH] Fixed keyword translation inconsistency between (slot-value object :key-thing) and :key-thing. --- src/printer.lisp | 2 +- src/special-forms.lisp | 2 +- t/ps-tests.lisp | 18 +++++++++++++++++- 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/src/printer.lisp b/src/printer.lisp index b649dae..edf74b2 100644 --- a/src/printer.lisp +++ b/src/printer.lisp @@ -43,7 +43,7 @@ arguments, defines a printer for that form using the given body." (defmethod ps-print ((s symbol)) (assert (keywordp s)) - (ps-print (string-downcase s))) + (ps-print (symbol-to-js-string s))) (defmethod ps-print ((compiled-form cons)) (ps-print% (car compiled-form) (cdr compiled-form))) diff --git a/src/special-forms.lisp b/src/special-forms.lisp index 802dc28..e96a6d4 100644 --- a/src/special-forms.lisp +++ b/src/special-forms.lisp @@ -34,7 +34,7 @@ (typecase x (cons `(array ,@(mapcar (lambda (x) (when x `',x)) x))) (null '(array)) - (keyword x) + (keyword (symbol-to-js-string x)) (symbol (symbol-to-js-string x)) (number x) (string x)) diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index 0324c09..540d1a6 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -455,7 +455,7 @@ __setf_someThing(_js1, _js2, _js3);") var _js2 = arguments.length; for (var n1 = 0; n1 < _js2; n1 += 2) { switch (arguments[n1]) { - case 'my-name-key': + case 'myNameKey': { myName = arguments[n1 + 1]; }; @@ -1169,3 +1169,19 @@ x1 - x1; (declare (ignore js-output)) (is (eql :cl-user *lisp-output*)))) ;(is (string= "" js-output)))) + +(test-ps-js keyword-conversion1 + :alpha-omega + "'alphaOmega';") + +(test-ps-js keyword-conversion2 + (slot-value object :alpha-omega) + "object.alphaOmega;") + +(test keyword-conversion2 () + (let ((js-output1 (normalize-js-code + (ps-doc* '(slot-value object :alpha-omega)))) + (js-output2 (normalize-js-code + (ps-doc* :alpha-omega))) + (declare (ignore js-output)) + (is (eql :cl-user *lisp-output*)))) -- 1.5.4.3

3 5

[parenscript-devel] eval-when bug fix patch
by Red Daly 27 Jul '09

27 Jul '09

The parenscript form EVAL-WHEN was broken due to macroexpansion issues. I have attached a patch that should fix this issue: >From 904be1cc2eee598491557132e8ed1569a90f27a3 Mon Sep 17 00:00:00 2001 From: Red Daly <reddaly(a)gmail.com> Date: Sun, 26 Jul 2009 20:22:54 +0000 Subject: [PATCH] Fixed eval-when special form and added tests to prevent future breakage. --- src/compiler.lisp | 50 ++++++++++++++++++++++++++++---------------------- t/ps-tests.lisp | 40 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+), 22 deletions(-) diff --git a/src/compiler.lisp b/src/compiler.lisp index 4fed094..e72fb4e 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -162,17 +162,20 @@ compiled to an :expression (the default), a :statement, or a :symbol.")) (defun adjust-ps-compilation-level (form level) - (cond ((or (and (consp form) (eq 'progn (car form))) - (and (symbolp form) (eq :toplevel level))) - level) - ((eq :toplevel level) :inside-toplevel-form))) + "Given the current *ps-compilation-level*, LEVEL, and the fully macroexpanded +form, FORM, returns the new value for *ps-compilation-level*." + (cond ((or (and (consp form) (member (car form) + '(progn locally macrolet symbol-macrolet compile-file))) + (and (symbolp form) (eq :toplevel level))) + level) + ((eq :toplevel level) :inside-toplevel-form))) + (defmethod compile-parenscript-form :around (form &key expecting) (assert (if expecting (member expecting '(:expression :statement :symbol)) t)) (if (eq expecting :symbol) (compile-to-symbol form) - (let ((*ps-compilation-level* (adjust-ps-compilation-level form *ps-compilation-level*))) - (call-next-method)))) + (call-next-method))) (defun compile-to-symbol (form) "Compiles the given Parenscript form and guarantees that the @@ -226,22 +229,25 @@ the form cannot be compiled to a symbol." (defmethod compile-parenscript-form ((form cons) &key (expecting :statement)) (multiple-value-bind (form expanded-p) (ps-macroexpand form) - (cond (expanded-p (compile-parenscript-form form :expecting expecting)) - ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) - ((op-form-p form) - `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) - ,@(mapcar (lambda (form) - (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) - (cdr form)))) - ((funcall-form-p form) - `(js:funcall ,(compile-parenscript-form (if (symbolp (car form)) - (maybe-rename-local-function (car form)) - (ps-macroexpand (car form))) - :expecting :expression) - ,@(mapcar (lambda (arg) - (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) - (cdr form)))) - (t (error "Cannot compile ~S to a ParenScript form." form))))) + (let ((*ps-compilation-level* (if expanded-p + *ps-compilation-level* + (adjust-ps-compilation-level form *ps-compilation-level*)))) + (cond (expanded-p (compile-parenscript-form form :expecting expecting)) + ((ps-special-form-p form) (apply (get-ps-special-form (car form)) (cons expecting (cdr form)))) + ((op-form-p form) + `(js:operator ,(ps-convert-op-name (compile-parenscript-form (car form) :expecting :symbol)) + ,@(mapcar (lambda (form) + (compile-parenscript-form (ps-macroexpand form) :expecting :expression)) + (cdr form)))) + ((funcall-form-p form) + `(js:funcall ,(compile-parenscript-form (if (symbolp (car form)) + (maybe-rename-local-function (car form)) + (ps-macroexpand (car form))) + :expecting :expression) + ,@(mapcar (lambda (arg) + (compile-parenscript-form (ps-macroexpand arg) :expecting :expression)) + (cdr form)))) + (t (error "Cannot compile ~S to a ParenScript form." form)))))) (defvar *ps-gensym-counter* 0) diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp index cd9d4f2..0324c09 100644 --- a/t/ps-tests.lisp +++ b/t/ps-tests.lisp @@ -1129,3 +1129,43 @@ x1 - x1; --x1; ++x1;") +(test-ps-js eval-when-ps-side + (eval-when (:execute) + 5) + "5;") + +(defvar *lisp-output* nil) + +(test eval-when-lisp-side () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(eval-when (:compile-toplevel) + (setf *lisp-output* 'it-works)))))) + (is (eql 'it-works *lisp-output*)) + (is (string= "" js-output)))) + +(defpsmacro my-in-package (package-name) + `(eval-when (:compile-toplevel) + (setf *lisp-output* ,package-name))) + +(test eval-when-macro-expansion () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(progn + (my-in-package :cl-user) + 3))))) + (declare (ignore js-output)) + (is (eql :cl-user *lisp-output*)))) + ;(is (string= "" js-output)))) + +(test eval-when-macrolet-expansion () + (setf *lisp-output* 'original-value) + (let ((js-output (normalize-js-code + (ps-doc* `(macrolet ((my-in-package2 (package-name) + `(eval-when (:compile-toplevel) + (setf *lisp-output* ,package-name)))) + (my-in-package2 :cl-user) + 3))))) + (declare (ignore js-output)) + (is (eql :cl-user *lisp-output*)))) + ;(is (string= "" js-output)))) -- 1.5.4.3

2 1

[parenscript-devel] Reserved keywords as object keys in (create)
by Alexey Lebedeff 25 Jul '09

25 Jul '09

(ps (create :default "test")) evaluates to: { default : 'test' }; It works in Firefox, but Chrome complains about syntax error as the 'default' is reserved javascript keyword. So object keys given as CL keywords must be always converted to string (or at least reserved ones).

2 1

[parenscript-devel] Javascript-side testing of Parenscript code
by Red Daly 25 Jul '09

25 Jul '09

Hi list, Does anybody recommend a framework for unit testing Javascript generated by Parenscript? Is there any particular framework that interacts well with Parenscript to give useful results. I have quite a few libraries, and none of them have unit testing right now. Fireunit[1] looks good. Best regards, Red [1] http://ejohn.org/blog/fireunit/

1 0

[parenscript-devel] Patch: destructuring-bind now supports dotted lists and nested lists
by Daniel Gackle 25 Jul '09

25 Jul '09

A couple of examples, followed by patch: (ps (destructuring-bind (a . rest) list (blah a rest))) => "var a = list[0]; var rest = list.length > 1 ? list.slice(1) : null; blah(a, rest);" (ps (destructuring-bind ((a (b c)) (d e)) list)) => "var _js42 = list[0]; var a = _js42[0]; var _js43 = _js42[1]; var b = _js43[0]; var c = _js43[1]; var _js44 = list[1]; var d = _js44[0]; var e = _js44[1];" >From 74d29fe528d40795071e61df4fb1e4b56b28f049 Mon Sep 17 00:00:00 2001 From: Daniel Gackle <danielgackle(a)gmail.com> Date: Fri, 10 Jul 2009 16:31:55 -0600 Subject: [PATCH 1/2] DESTRUCTURING-BIND can now handle dotted and nested binding lists. --- src/lib/ps-macro-lib.lisp | 31 +++++++++++++++++++++---------- 1 files changed, 21 insertions(+), 10 deletions(-) diff --git a/src/lib/ps-macro-lib.lisp b/src/lib/ps-macro-lib.lisp index 1013939..d70561c 100644 --- a/src/lib/ps-macro-lib.lisp +++ b/src/lib/ps-macro-lib.lisp @@ -144,14 +144,25 @@ (first args)))) `((@ ,fn :apply) this ,arglist))) -(defpsmacro destructuring-bind (vars expr &body body) - ;; a simple implementation that for now only supports flat lists, - ;; but does allow NIL bindings to indicate ignore (a la LOOP) +(defun destructuring-wrap (arr n bindings body) + (cond ((null bindings) + body) + ((atom bindings) + ;; dotted destructuring list + `(let ((,bindings (when (> (length ,arr) ,n) + ((@ ,arr :slice) ,n)))) + ,body)) + (t (let ((var (car bindings)) + (inner-body (destructuring-wrap arr (1+ n) (cdr bindings) body))) + (cond ((null var) inner-body) + ((atom var) `(let ((,var (aref ,arr ,n))) + ,inner-body)) + (t `(destructuring-bind ,var (aref ,arr ,n) + ,inner-body))))))) + +(defpsmacro destructuring-bind (bindings expr &body body) (let* ((arr (if (complex-js-expr? expr) (ps-gensym) expr)) - (n -1) - (bindings - (append (unless (equal arr expr) `((,arr ,expr))) - (mapcan (lambda (var) - (incf n) - (when var `((,var (aref ,arr ,n))))) vars)))) - `(let* ,bindings ,@body))) + (bound (destructuring-wrap arr 0 bindings (cons 'progn body)))) + (if (eq arr expr) + bound + `(let ((,arr ,expr)) ,bound)))) -- 1.6.1

2 1

[parenscript-devel] Patch: ps loop now supports :ON type of iteration over lists
by Daniel Gackle 25 Jul '09

25 Jul '09

Two examples followed by patch. Note that I haven't added any functions for #'cdr, #'cddr etc. (it's arguable whether those belong in PS proper, since the mapping of Lisp lists to JS arrays is only partly satisfactory), so if you want to write stuff like "(ps (loop for (a b) on list by #'cddr))", you can, but you have to define your own #'cddr. Dan (ps (loop for (a b) on y do (blah a b))) => "for (var _js46 = y; !(_js46 == null || _js46.length == 0); _js46 = _js46.slice(1)) { var a = _js46[0]; var b = _js46[1]; blah(a, b); };" (ps (loop for (a b . c) on list by somefn do (blah a b c))) => "for (var _js48 = list; !(_js48 == null || _js48.length == 0); _js48 = somefn(_js48)) { var a = _js48[0]; var b = _js48[1]; var c = _js48.length > 2 ? slice(_js48, 2) : null; blah(a, b, c); };" >From 4122fd1552b35f9bc46d723cf1651fdc8cf20748 Mon Sep 17 00:00:00 2001 From: Daniel Gackle <danielgackle(a)gmail.com> Date: Fri, 10 Jul 2009 19:17:39 -0600 Subject: [PATCH 2/2] PS LOOP now supports ON. --- src/lib/ps-loop.lisp | 22 +++++++++++++++++++--- 1 files changed, 19 insertions(+), 3 deletions(-) diff --git a/src/lib/ps-loop.lisp b/src/lib/ps-loop.lisp index 0e20c9c..c7334fa 100644 --- a/src/lib/ps-loop.lisp +++ b/src/lib/ps-loop.lisp @@ -2,12 +2,13 @@ (defun complex-js-expr? (expr) (if (symbolp expr) - (find #\. (symbol-name expr)) + (or (find #\. (symbol-name expr)) + (not (eq (ps-macroexpand expr) expr))) (consp expr))) (defvar *loop-keywords* '(:for :do :when :unless :initially :finally :first-time :last-time :while :until - :from :to :below :downto :above :by :in :across :index := :then :sum :collect + :from :to :below :downto :above :by :in :across :on :index := :then :sum :collect :count :minimize :maximize :into)) (defun normalize-loop-keywords (args) @@ -18,6 +19,11 @@ x)) args)) +(defun reduce-function-symbol (sym) + (if (and (consp sym) (eq 'function (first sym))) + (second sym) + sym)) + (defun parse-ps-loop (terms) (let (prologue init-step-forms end-test-forms @@ -115,6 +121,15 @@ (setf terms (append equiv terms)) (clause) (clause)))) + (for-on (var) + (with-local-var (arr (consume)) + (push `(or (null ,var) (= (length ,var) 0)) end-test-forms) + (let* ((by (aif (consume-if :by) + `(,(reduce-function-symbol it) ,var) + `((@ ,var :slice) 1))) + (equiv `(:for ,var := ,arr :then ,by))) + (setf terms (append equiv terms)) + (clause)))) (for-clause () (let* ((place (consume)) (var (when (atom place) place)) @@ -122,13 +137,14 @@ (term (consume-atom))) (when varlist (when (eq term :from) - (err "an atom after FROM" varlist)) + (err "an atom after FOR" varlist)) (setf var (ps-gensym)) (push (list varlist var) destructurings)) (case term (:from (for-from var)) (:= (for-= var)) ((:in :across) (for-in var)) + (:on (for-on var)) (otherwise (error "FOR ~s ~s is not valid in PS-LOOP." var term))))) (clause () (let ((term (consume-atom))) -- 1.6.1

2 1

Re: [parenscript-devel] long compile time
by Vladimir Sedach 07 Jul '09

07 Jul '09

Thanks for posting your results! This is really curious: (time (eval '(defun somefunction () (ps (form))))) 672.596 seconds of real time I'm not sure what's going on here. The two versions of 'ps' essentially do the same macroexpansion. As a matter of fact, the new one conses slightly more. My little test (form was a function call with 5000 dummy arguments) did not exhibit such a long eval time for the defun. I think what may be happening is that 'concatenate' in SBCL now (sometime between 1.0.22, which I'm running, and 1.0.29) has a compiler macro that attempts to do constant string concatenation at compile-time. That's just a guess though. ; ps with write-to-string (time (eval '(defun somefunction () (ps (form))))) Evaluation took: 32.524 seconds of real time That's a lot of time. How many tokens does your code have? What I need to do is figure out the best way available across most implementations to spit out strings (which just might be 'write-to-string') and to push that down to the Parenscript printer, instead of having it return a list of strings. That should close the gap between 'ps' and 'ps*' and provide a big improvement in speed, and if streams are involved, let you direct the output of Parenscript directly into one. Vladimir On Mon, Jul 6, 2009 at 8:50 PM, <Kelly.P.McDonald(a)gmail.com> wrote: > Vladimir, > > sorry about the truncated post earlier. > > I'm using sbcl 1.0.29 > > here are my results: > > (time (eval > '(defun somefunction () > (ps* '(form))))) > > Evaluation took: > 0.007 seconds of real time > 0.004000 seconds of total run time (0.004000 user, 0.000000 system) > 57.14% CPU > 9 forms interpreted > 3 lambdas converted > 7,264,237 processor cycles > 625,872 bytes consed > > > (time (somefunction)) > > Evaluation took: > 0.555 seconds of real time > 0.456028 seconds of total run time (0.412025 user, 0.044003 system) > [ Run times consist of 0.300 seconds GC time, and 0.157 seconds non-GC time. > ] > 82.16% CPU > 85 lambdas converted > 555,544,368 processor cycles > 6,404,784 bytes consed > > > ; ps with concatenate > (time (eval > '(defun somefunction () > (ps (form))))) > > Evaluation took: > 672.596 seconds of real time > 517.380334 seconds of total run time (501.967371 user, 15.412963 system) > [ Run times consist of 7.004 seconds GC time, and 510.377 seconds non-GC > time. ] > 76.92% CPU > 9 forms interpreted > 3 lambdas converted > 3,125,982,714,733 processor cycles > 5 page faults > 560,010,640 bytes consed > > (time (somefunction)) > > Evaluation took: > 0.651 seconds of real time > 0.548034 seconds of total run time (0.544034 user, 0.004000 system) > 84.18% CPU > 657,341,464 processor cycles > 826,672 bytes consed > > > ; ps with write-to-string > (time (eval > '(defun somefunction () > (ps (form))))) > > > Evaluation took: > 32.524 seconds of real time > 29.861866 seconds of total run time (29.461841 user, 0.400025 system) > [ Run times consist of 1.129 seconds GC time, and 28.733 seconds non-GC > time. ] > 91.82% CPU > 9 forms interpreted > 91 lambdas converted > 65,799,376,447 processor cycles > 135,977,120 bytes consed > > > (time (somefunction)) > Evaluation took: > 0.004 seconds of real time > 0.004000 seconds of total run time (0.004000 user, 0.000000 system) > 100.00% CPU > 3,869,482 processor cycles > 200,144 bytes consed > > > A huge improvement, and I understand what is going on much better. I had > been using compile-script previously. > > > Thanks, > Kelly

1 0

[parenscript-devel] ps-loop now allows accumulating "into"
by Daniel Gackle 07 Jul '09

07 Jul '09

I've extended PS-LOOP to allow CL-style explicit accumulation variables to be introduced by INTO. Two examples, followed by a patch, are below. (Side note: Lisp still surprises me from time to time. That this feature could be added with a net increase of only 3 lines of code is an indication of something.) Daniel (ps (loop for x from 1 to 10 sum x into total finally (alert total))) => "var total = 0; for (var x = 1; x <= 10; x += 1) { total += x; }; alert(total);" (ps (loop for x from 1 to 10 for y = (foo x) collect y into z collect x into z sum x into w sum y into w)) => "var z = []; var w = 0; for (var x = 1, y = foo(x); x <= 10; x += 1, y = foo(x)) { z.push(y); z.push(x); w += x; w += y; };" >From 293fc20445cd44731c82a845401a8c897c851f6d Mon Sep 17 00:00:00 2001 From: Daniel Gackle <danielgackle(a)gmail.com> Date: Tue, 30 Jun 2009 19:29:44 -0600 Subject: [PATCH] Extended PS-LOOP to allow explicit accumulation variables (declared by INTO as in "sum x into y"). --- src/lib/ps-loop.lisp | 37 ++++++++++++++++++++----------------- 1 files changed, 20 insertions(+), 17 deletions(-) diff --git a/src/lib/ps-loop.lisp b/src/lib/ps-loop.lisp index 87d2d84..1003b5d 100644 --- a/src/lib/ps-loop.lisp +++ b/src/lib/ps-loop.lisp @@ -7,7 +7,7 @@ (defvar *loop-keywords* '(:for :do :when :unless :initially :finally :first-time :last-time :while :until - :from :to :below :downto :above :by :in :across :index := :then :sum :collect)) + :from :to :below :downto :above :by :in :across :index := :then :sum :collect :into)) (defun normalize-loop-keywords (args) (mapcar @@ -22,7 +22,7 @@ init-step-forms end-test-forms initially finally first-time last-time - accum-var accum-kind + default-accum-var default-accum-kind destructurings body) (macrolet ((with-local-var ((name expr) &body body) (once-only (expr) @@ -55,22 +55,25 @@ (when (next? term) (consume) (consume))) - (establish-accum-var (kind initial-val) - (if accum-var - (error "PS-LOOP encountered illegal ~a: a ~a was previously declared, and there can only be one accumulation per loop." kind accum-kind) - (progn - (setf accum-var (ps-gensym kind) - accum-kind kind) - (push `(var ,accum-var ,initial-val) prologue)))) + (accumulate (kind term var) + (when (null var) + (when (and default-accum-kind (not (eq kind default-accum-kind))) + (error "PS-LOOP encountered illegal ~a: ~a was already declared, and there can only be one kind of default accumulation per loop." kind default-accum-kind)) + (unless default-accum-var + (setf default-accum-var (ps-gensym kind) + default-accum-kind kind)) + (setf var default-accum-var)) + (let ((initial (case kind (:sum 0) (:collect '(array))))) + (pushnew `(var ,var ,initial) prologue :key #'second)) + (case kind + (:sum `(incf ,var ,term)) + (:collect `((@ ,var :push) ,term)))) (body-clause (term) (case term ((:when :unless) (list (intern (symbol-name term)) (consume) (body-clause (consume-atom)))) - (:sum (establish-accum-var :sum 0) - `(incf ,accum-var ,(consume))) - (:collect (establish-accum-var :collect '(array)) - `((@ ,accum-var :push) ,(consume))) + ((:sum :collect) (accumulate term (consume) (consume-if :into))) (:do (consume-progn)) (otherwise (err "a PS-LOOP keyword" term)))) (for-from (var) @@ -149,7 +152,7 @@ (nreverse finally) (nreverse first-time) (nreverse last-time) - accum-var + default-accum-var (add-destructurings-to-body)))))) (defpsmacro loop (&rest args) @@ -157,12 +160,12 @@ init-step-forms end-test initially finally first-time last-time - accum-var + default-accum-var body) (parse-ps-loop (normalize-loop-keywords args)) (let ((first-guard (and first-time (ps-gensym))) (last-guard (and last-time (ps-gensym)))) - `(,@(if accum-var '(with-lambda ()) '(progn)) + `(,@(if default-accum-var '(with-lambda ()) '(progn)) ,@(when first-time `((var ,first-guard t))) ,@(when last-time `((var ,last-guard nil))) ,@prologue @@ -178,4 +181,4 @@ `((setf ,last-guard t)))) ,@(when last-time `((when ,last-guard ,@last-time))) ,@finally - ,@(when accum-var `((return ,accum-var))))))) + ,@(when default-accum-var `((return ,default-accum-var))))))) -- 1.6.1

2 1