Added the 'chain' convenience macro for method call chaining (ex:

[clinton/parenscript.git] / src / lib / ps-macro-lib.lisp

diff --git a/src/lib/ps-macro-lib.lisp b/src/lib/ps-macro-lib.lisp
index e6c32be..1013939 100644 (file)
--- a/src/lib/ps-macro-lib.lisp
+++ b/src/lib/ps-macro-lib.lisp
@@ -1,4 +1,4 @@
-(in-package :parenscript)
+(in-package "PARENSCRIPT")
 
 ;;; Handy utilities for doing common tasks found in many web browser
 ;;; JavaScript implementations
@@ -12,17 +12,17 @@
   `(progn ,@(mapcar (lambda (def) (cons 'defpsmacro def)) mathdefs)))
 
 (def-js-maths
-    (max (&rest nums) `(*math.max ,@nums))
-    (min (&rest nums) `(*math.min ,@nums))
-    (floor (n &optional divisor) `(*math.floor ,(if divisor `(/ ,n ,divisor) n)))
-    (ceiling (n &optional divisor) `(*math.ceil ,(if divisor `(/ ,n ,divisor) n)))
-    (round (n &optional divisor) `(*math.round ,(if divisor `(/ ,n ,divisor) n)))
-    (sin (n) `(*math.sin ,n))
-    (cos (n) `(*math.cos ,n))
-    (tan (n) `(*math.tan ,n))
-    (asin (n) `(*math.asin ,n))
-    (acos (n) `(*math.acos ,n))
-    (atan (y &optional x) (if x `(*math.atan2 ,y ,x) `(*math.atan ,y)))
+    (max (&rest nums) `((@ *math max) ,@nums))
+    (min (&rest nums) `((@ *math min) ,@nums))
+    (floor (n &optional divisor) `((@ *math floor) ,(if divisor `(/ ,n ,divisor) n)))
+    (ceiling (n &optional divisor) `((@ *math ceil) ,(if divisor `(/ ,n ,divisor) n)))
+    (round (n &optional divisor) `((@ *math round) ,(if divisor `(/ ,n ,divisor) n)))
+    (sin (n) `((@ *math sin) ,n))
+    (cos (n) `((@ *math cos) ,n))
+    (tan (n) `((@ *math tan) ,n))
+    (asin (n) `((@ *math asin) ,n))
+    (acos (n) `((@ *math acos) ,n))
+    (atan (y &optional x) (if x `((@ *math atan2) ,y ,x) `((@ *math atan) ,y)))
     (sinh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) 2))) ,n))
     (cosh (n) `((lambda (x) (return (/ (+ (exp x) (exp (- x))) 2))) ,n))
     (tanh (n) `((lambda (x) (return (/ (- (exp x) (exp (- x))) (+ (exp x) (exp (- x)))))) ,n))
@@ -31,21 +31,21 @@
     (atanh (n) `((lambda (x) (return (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) ,n))
     (1+ (n) `(+ ,n 1))
     (1- (n) `(- ,n 1))
-    (abs (n) `(*math.abs ,n))
+    (abs (n) `((@ *math abs) ,n))
     (evenp (n) `(not (oddp ,n)))
     (oddp (n) `(% ,n 2))
-    (exp (n) `(*math.exp ,n))
-    (expt (base power) `(*math.pow ,base ,power))
+    (exp (n) `((@ *math exp) ,n))
+    (expt (base power) `((@ *math pow) ,base ,power))
     (log (n &optional base)
-      (or (and (null base) `(*math.log ,n))
-          (and (numberp base) (= base 10) `(* (log ,n) *math.*log10e*))
+      (or (and (null base) `((@ *math log) ,n))
+          (and (numberp base) (= base 10) `(* (log ,n) (@ *math *log10e*)))
           `(/ (log ,n) (log ,base))))
-    (sqrt (n) `(*math.sqrt ,n))
+    (sqrt (n) `((@ *math sqrt) ,n))
     (random (&optional upto) (if upto
-                                 `(floor (* ,upto (*math.random)))
-                                 '(*math.random))))
+                                 `(floor (* ,upto ((@ *math random))))
+                                 '((@ *math random)))))
 
-(define-ps-symbol-macro pi *math.*pi*)
+(define-ps-symbol-macro pi (@ *math *pi*))
 
 ;;; Exception handling
 
@@ -81,6 +81,14 @@
       `(@ (slot-value ,obj ,(if (symbolp (car props)) `',(car props) (car props))) ,@(cdr props))
       obj))
 
+(defpsmacro chain (&rest method-calls)
+  (labels ((do-chain (method-calls)
+             (if (cdr method-calls)
+                 `((@ ,(do-chain (cdr method-calls)) ,(caar method-calls)) ,@(cdar method-calls))
+                 (car method-calls))))
+    (do-chain (reverse method-calls))))
+
+
 (defpsmacro concatenate (result-type &rest sequences)
   (assert (equal result-type ''string) () "Right now Parenscript 'concatenate' only support strings.")
   (cons '+ sequences))
@@ -137,10 +145,13 @@
     `((@ ,fn :apply) this ,arglist)))
 
 (defpsmacro destructuring-bind (vars expr &body body)
-  ;; a simple implementation that for now only supports flat lists
+  ;; a simple implementation that for now only supports flat lists,
+  ;; but does allow NIL bindings to indicate ignore (a la LOOP)
   (let* ((arr (if (complex-js-expr? expr) (ps-gensym) expr))
          (n -1)
          (bindings
           (append (unless (equal arr expr) `((,arr ,expr)))
-                  (mapcar (lambda (var) `(,var (aref ,arr ,(incf n)))) vars))))
-    `(let ,bindings ,@body)))
+                  (mapcan (lambda (var)
+                            (incf n)
+                            (when var `((,var (aref ,arr ,n))))) vars))))
+    `(let* ,bindings ,@body)))