[parenscript-devel] [PATCH] Define bit-shifting special forms >> and <<, and ASH as a macro.

[sblist at me.com]

I'm not sure how you feel about adding >> and << as special forms, but
this seems to allow for a simpler implementation of ASH since it needs
to do some higher-level transformations such as optimizing forms with a
a constant COUNT argument along with avoiding multiple evaluation.

	Scott

---
 src/macros.lisp        |   14 ++++++++++++++
 src/package.lisp       |    4 ++++
 src/printer.lisp       |    2 +-
 src/special-forms.lisp |    4 +++-
 4 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/src/macros.lisp b/src/macros.lisp
index 2014330..2c0c295 100644
--- a/src/macros.lisp
+++ b/src/macros.lisp
@@ -59,6 +59,20 @@
 
 (define-ps-symbol-macro pi (getprop *math '*pi*))
 
+(defpsmacro ash (integer count)
+  (let ((count (ps-macroexpand count)))
+    (cond ((and (numberp count) (> count 0)) `(<< ,integer ,count))
+          ((numberp count) `(>> ,integer ,(- count)))
+          ((complex-js-expr? count)
+           (let ((count-var (ps-gensym)))
+             `(let ((,count-var ,count))
+                (if (> ,count-var 0)
+                    (<< ,integer ,count-var)
+                    (>> ,integer (- ,count-var))))))
+          (t `(if (> ,count 0)
+                  (<< ,integer ,count)
+                  (>> ,integer (- ,count)))))))
+
 ;;; Types
 
 (defpsmacro stringp (x)
diff --git a/src/package.lisp b/src/package.lisp
index 7921a37..92922e7 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -99,6 +99,10 @@
    #:logxor
    #:lognot
 
+   #:ash
+   #:>>
+   #:<<
+
    #:*
    #:/
    #:rem
diff --git a/src/printer.lisp b/src/printer.lisp
index 73df146..5f119b7 100644
--- a/src/printer.lisp
+++ b/src/printer.lisp
@@ -169,7 +169,7 @@ vice-versa.")
 (defprinter js:post-- (x)
   (ps-print x)"--")
 
-(defprinter (js:+ js:- js:* js:/ js:% js:&& js:\|\| js:& js:\| js:-= js:+= js:*= js:/= js:%= js:^ js:&= js:^= js:\|= js:= js:== js:=== js:!== js:in js:!= js:> js:>= js:< js:<=)
+(defprinter (js:+ js:- js:* js:/ js:% js:&& js:\|\| js:& js:\| js:-= js:+= js:*= js:/= js:%= js:^ js:&= js:^= js:\|= js:= js:== js:=== js:!== js:in js:!= js:> js:>= js:< js:<= js:<< js:>>)
     (&rest args)
   (loop for (arg . remaining) on args do
        (print-op-argument op arg)
diff --git a/src/special-forms.lisp b/src/special-forms.lisp
index 6633b2f..5ca7a52 100644
--- a/src/special-forms.lisp
+++ b/src/special-forms.lisp
@@ -25,7 +25,9 @@
     logior     js:\|
     logxor     js:^
     lognot     js:~
-    ;; todo: ash for shifts
+
+    >>         js:>>
+    <<         js:<<
 
     throw      js:throw
     array      js:array
-- 
1.7.2.1