Added (defun (setf...

diff --git a/src/package.lisp b/src/package.lisp
index 2f4a77b..812cc37 100644 (file)
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -183,6 +183,9 @@ is defined as macros on top of Javascript special forms"))
 
        ;; html generator for javascript
        #:html
+
+       ;; utils
+       #:do-set-timeout
        ))
     "List of (uninterned) symbols. Contains all symbols considerred
 part of the Parenscript language.  These should be exported within

diff --git a/src/ps-macrology.lisp b/src/ps-macrology.lisp
index c55ea88..a4b1294 100644 (file)
--- a/src/ps-macrology.lisp
+++ b/src/ps-macrology.lisp
@@ -356,11 +356,27 @@ lambda-list::=
   [&rest var] 
   [&key {var | ({var | (keyword-name var)} [init-form [supplied-p-parameter]])}* [&allow-other-keys]] 
   [&aux {var | (var [init-form])}*])"
+  (if (symbolp name)
+      `(defun-normal ,name ,lambda-list ,@body)
+      (progn (assert (and (= (length name) 2) (eql 'setf (car name))) ()
+                     "(defun ~s ~s ...) needs to have a symbol or (setf symbol) for a name." name lambda-list)
+             `(defun-setf ,name ,lambda-list ,@body))))
+
+(ps:defscriptmacro defun-normal (name lambda-list &body body)
   (multiple-value-bind (effective-args effective-body)
       (parse-extended-function lambda-list body name)
     `(%js-defun ,name ,effective-args
       ,@effective-body)))
 
+(defvar *defun-setf-name-prefix* "__setf_")
+
+(ps:defscriptmacro defun-setf (setf-name lambda-list &body body)
+  (let ((mangled-function-name (intern (concatenate 'string *defun-setf-name-prefix* (symbol-name (second setf-name)))
+                                       (symbol-package (second setf-name))))
+        (function-args (cdr (ordered-set-difference lambda-list lambda-list-keywords))))
+    `(progn (defsetf ,(second setf-name) ,(cdr lambda-list) (store-var)
+              `(,',mangled-function-name ,store-var ,@(list ,@function-args)))
+            (defun ,mangled-function-name ,lambda-list ,@body))))
 
 (ps:defscriptmacro lambda (lambda-list &body body)
   "An extended defun macro that allows cool things like keyword arguments.
@@ -375,7 +391,7 @@ lambda-list::=
     `(%js-lambda ,effective-args
       ,@effective-body)))
 
-(defpsmacro defsetf-long (access-fn lambda-list (store-var) form)
+(ps:defscriptmacro defsetf-long (access-fn lambda-list (store-var) form)
   (setf (find-macro-spec access-fn *script-setf-expanders*)
         (compile nil
                  (let ((var-bindings (ordered-set-difference lambda-list lambda-list-keywords)))
@@ -392,7 +408,7 @@ lambda-list::=
                              ,,form))))))))
   nil)
 
-(defpsmacro defsetf-short (access-fn update-fn &optional docstring)
+(ps:defscriptmacro defsetf-short (access-fn update-fn &optional docstring)
   (declare (ignore docstring))
   (setf (find-macro-spec access-fn *script-setf-expanders*)
         (lambda (access-fn-args store-form)

diff --git a/t/ps-tests.lisp b/t/ps-tests.lisp
index a2328a0..edaedc0 100644 (file)
--- a/t/ps-tests.lisp
+++ b/t/ps-tests.lisp
@@ -246,6 +246,13 @@ x = 2 + sideEffect() + x + 5;")
   (ps (defsetf baz set-baz "blah"))
   (is (string= "setBaz(1, 2, 3, 'foo');" (normalize-js-code (ps (setf (baz 1 2 3) "foo"))))))
 
+(test defun-setf1
+  (is (and (string= (normalize-js-code (ps:ps (defun (setf some-thing) (new-val i1 i2)
+                                           (setf (aref *some-thing* i1 i2) new-val))))
+               "null; function __setf_someThing(newVal, i1, i2) { SOMETHING[i1][i2] = newVal; };")
+           (string= (let ((ps::*gen-script-name-counter* 0)) (normalize-js-code (ps:ps (setf (some-thing 1 2) "foo"))))
+               "var PS_GS_2 = 1; var PS_GS_3 = 2; var PS_GS_1 = 'foo'; __setf_someThing(PS_GS_1, PS_GS_2, PS_GS_3);"))))
+
 (test-ps-js defun-optional1
   (defun test-opt (&optional x) (return (if x "yes" "no")))
   "function testOpt(x) {
@@ -256,3 +263,9 @@ x = 2 + sideEffect() + x + 5;")
 (test-ps-js return-nothing
   (return)
   "return null")
+
+(test-ps-js set-timeout
+  (do-set-timeout (10) (alert "foo"))
+  "setTimeout (function () { alert('foo'); }, 10)")
+
+ 
\ No newline at end of file