infix: Reader macros for infix expressions.

[lisp] / infix-ext.lisp

diff --git a/infix-ext.lisp b/infix-ext.lisp
new file mode 100644 (file)
index 0000000..34d5981
--- /dev/null
+++ b/infix-ext.lisp
@@ -0,0 +1,46 @@
+;;; -*-lisp-*-
+;;;
+;;; Extensions for more infix operators
+;;;
+;;; (c) 2006 Mark Wooding
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(defpackage #:infix-ext
+  (:use #:common-lisp #:mdw.base #:mdw.factorial #:infix-keywords #:infix))
+(in-package #:infix-ext)
+
+(defun assignop-apply (op)
+  (let ((y (popval))
+       (x (popval)))
+    (pushval (list 'update-place op x y))))
+
+(definfix *= (120 . 5) (assignop-apply '*))
+(definfix %= (120 . 5) (assignop-apply 'mod))
+(definfix //= (120 . 5) (assignop-apply 'floor))
+(definfix &= (120 . 5) (assignop-apply 'logand))
+(definfix \|= (120 . 5) (assignop-apply 'logior))
+(definfix <<= (120 . 5) (assignop-apply 'ash))
+(definfix >>= (120 . 5) (unop-apply-toggle '-) (assignop-apply '*))
+
+(defpostfix ++ 120 (unop-apply 'incf-after))
+(defpostfix -- 120 (unop-apply 'decf-after))
+
+(defpostfix ! 120 (unop-apply 'factorial))
+
+;;;----- That's all, folks --------------------------------------------------