infix
Infix reader-macro by Mark Kantrowitz.
Available from:
The Changelog from the cclan version reads
2005-06-06:
* infix.cl: bind *read-suppress* in infix-reader to support the
use of infix notation when *read-suppress* is true.
Christophe Rhodes
2002-03-04:
* infix.cl: moved definition of infix-error macro to before its
first use.
Christophe Rhodes .
Download ASDF package from http://ww.telent.net/cclan/infix.tar.gz
This is not the most volatile piece of software.
Incidentally, it's probably non-free — there's a non-commercial clause in the licence.
There is also a Debian package.
Another package by Alan Manuel Gloria can be found here, but it's buggy on expressions like
(nfx 55 - 3 * 4 + 2000000)
(giving -1999957 instead of the correct result 2000043. There seems to be a problem with different operators of the same precedence.
Here's a corrected version of the macro implementation:
;; infix.lisp
;; by AmkG
;; Title : Infix notation macro
;; Filename : infix.lisp
;; Written by : Alan Manuel K. Gloria
;; Corrected by : Bruno Daniel
;; Copyright status:
;; Err. I don't care? Okay, I do care. To be honest, I'll just
;; be plain happy if somebody ELSE uses this. Drop me a line,
;; or something. Or don't. I built this for my own amusement,
;; so if anyone else is amused too, well, drop me a line!
;; tested on:
;; clisp
;; gcl
;; sbcl
;; ecl
;; infix notation:
;; Lisp has traditionally used prefix notation for all formulae: in this
;; notation, the operation to be performed is specified before the
;; operands it is to be performed on. This simple notation gives a
;; consistent, regular syntax which greatly facilitates
;; metaprogramming.
;; However, one weakness of prefix notation is that some simple
;; algebraic/arithmetic operations do not and cannot follow the
;; traditional syntax taught to us during elementary - that is, the
;; notation we are used to in arithmetic is not prefix, but infix
;; notation:
;; 1 + 2 - 4 * 5
;; In Lisp this would be:
;; (- (+ 1 2) (* 4 5)))
;; Despite the inherent advantages of prefix notation, sometimes
;; it's just much easier to write mathematical formulae a little more
;; like the way we actually write them on paper.
;; This file contains a macro, 'nfx, which allows for such an infix
;; notation. There are limitations: you need to put a LOT of spaces
;; in the formula:
;; (nfx 1+2-3) ;would confuse the Lisp parser
;; (nfx 1 + 2 - 3) ;would be understood
;; You can't use certain symbols as variable names:
;; (setf + 42)
;; (nfx (max + 3)) ; would look awfully like +(max,3), not max(+,3)
;; ...but you can embed prefix notation in it!
;; (nfx 1 + (- x 100)) ;it's valid!
;; (nfx 1 + (- x (3 * 3))) ;it's ALSO valid!
;; (nfx 1 + (- x 3 * 3)) ;err... this can give you unexpected behavior
;; ...also, you can define your own infix symbols using definfix:
;; (definfix my-infix-symbol
;; :precedence 40
;; :function-name +)
;; (nfx 1 my-infix-symbol 2)
;; => 3
;; send any feedback, bugreports, bugfixes, and cute girls to:
;; almkglor@gmail.com
;; This file defines a macro of the form (nfx ...) whose
;; parameters are a stream of LISP "tokens" (either symbols,
;; constants, or lists). The stream of tokens is interpreted
;; in infix notation. The macro then expands to the prefix
;; form equivalent to the infix form
;; Ex.
;; (macroexpand-1 '(nfx foo = 32))
;; => (setf foo 32)
;; (macroexpand-1 '(nfx bar == (3 + foo) * quux ))
;; => (equal bar (* (+ 3 foo) quux))
;; NOTE: detection of function calls
;; function call forms should be supported:
;; (macroexpand-1 '(nfx foo = (max (bar + 32) quux niaw) ))
;; => (setf foo (max (+ bar 32) quux niaw))
;; (macroexpand-1 '(nfx (cdr foo) = (cons (qux + 1) nil)))
;; => (setf (cdr foo) (cons (+ qux 1) nil))
;; If any infix notation is in a function call within an
;; nfx form, it should be within a parentheses:
;; (macroexpand-1 '(nfx (max (bar + foo) (quux + quuux)) ))
;; => (max (+ bar foo) (+ quux quuux))
;; (macroexpand-1 '(nfx (max bar + foo quux + quuux) ))
;; => (max bar + foo quux + quuux)
;; function calls are detected in the following manner:
;; if nfx detects a list in the input stream,
;; if the second item is not a registered infix,
;; function call, for each element recurse and replace the element
;; not a function call, recurse on the list as a new stream
;; this allows us to use prefix operators (such as -) as-is:
;; (macroexpand-1 '(nfx (- bar) == (/ (foo + 1)) ))
;; => (equal (- bar) (/ (+ foo 1)))
;; (nfx-operator-base ...)
;; Handles the operator database
(let ((nfx-data (make-hash-table :test 'eq)))
(defun nfx-operator-base (action &rest params)
(labels
((getval (sym)
(gethash sym nfx-data) )
(add (params)
(setf (gethash (car params) nfx-data)
(apply #'vector params))))
(case action
(:get (getval (car params)))
(:add (add params))))))
;;; the nfx macro
(defun nfx-impl (s)
(let (opstack
curop tmp
(bldg (cons nil nil)))
(labels
( ;; tconc = a cons with pointers to the head and the last element of
;; a list. This function appends an element to such a tconc.
(tconc-append (l v)
(if (car l)
(setf (cdr l) (setf (cddr l) (cons v nil)))
(setf (car l) (setf (cdr l) (cons v nil))) ))
;; top-of-stack query
(top-opstack ()
(caaar opstack))
;; handles any sub-lists
(enlist (l)
(when l
(cond ((getop (cadr l))
(cons 'nfx l))
(t (mapcar #'(lambda (o) (if (listp o) (enlist o) o))
l)))))
;; pushes an operation onto the stack - used when the currently
;; being built operation is of lower precedence than the
;; operation being considered
(push-oper ()
(push bldg opstack)
(setf bldg (cons nil nil)))
;; pops off an operation from the stack,
;; - used before collapsing the call
(pop-oper ()
(let ((top (pop opstack)) )
(tconc-append top (car bldg))
(setf bldg top)))
;; sub-expression handling code
(expr (o)
(if (listp o)
(enlist o)
o))
;; determine if the specified operation has precedence over the
;; operation currently being built
(precedes? (op1 op2 associativity)
(or (< (precedence op1) (precedence op2))
(and (= (precedence op1) (precedence op2))
(eq (associativity op1) associativity))))
;; funges bldg: collapses fungible operations into one form
(fungebldg (bldg)
(mapcan
#'(lambda (o)
(cond ((listp o)
(setf o (fungebldg o))
(cond ((and (fungible (car bldg))
(eq (car o) (car bldg)))
(cdr o))
(t (cons o nil))))
(t (cons o nil))))
bldg))
;; fixes bldg: changes operation objects to their functions
(fixbldg (bldg)
(when (vectorp (car bldg))
(setf (car bldg) (function-name (car bldg))) )
(mapc
#'(lambda (o)
(when (listp o)
(fixbldg o) ))
bldg ))
;; error-handling function
(err (l)
(error "improper nfx expression:~%~s" l))
(print-expr-list (l)
(format t "(")
(loop :for x in l
:for i from 0 :do
(when (plusp i)
(format t " "))
(cond ((vectorp x)
(format t "~s" (aref x 0)))
((listp x)
(print-expr-list x))
(t
(format t "~s" x))))
(format t ")"))
;; (print-tconc (tc)
;; (print-expr-list (car tc))
;; (format t "~%"))
;; accessor functions
(precedence (op) (if op (aref op 1) 99999))
(associativity (op) (aref op 2))
(function-name (op) (aref op 3))
(fungible (op) (when (vectorp op) (aref op 4)))
;; get the data for a (presumed) infix operator
(getop (op)
(nfx-operator-base :get op)))
(case (length s)
(1 (expr (car s)))
(2 (err s))
(t
(do ( ;; variable and step list
(oL s (cddr oL)) )
( ;; termination condition
(null (cddr oL))
(tconc-append bldg (expr (car oL)))
(when (cdr oL)
(err oL) )
(loop :while opstack :do
(pop-oper))
(fixbldg (fungebldg (caar bldg))))
(setf curop (getop (cadr oL)))
(cond (curop
(cond ((precedes? curop (caar bldg) :right)
(push-oper)
(tconc-append bldg curop)
(tconc-append bldg (expr (car oL))) )
(t
(tconc-append bldg (expr (car oL)))
;; collapse while the stacktop is precedent over the
;; current op
(loop :while (precedes? (top-opstack) curop :left) :do
(pop-oper))
(setf tmp (car bldg))
(setf bldg (cons nil nil))
(tconc-append bldg curop)
(tconc-append bldg tmp) )))
(t
(err oL)))))))))
(defmacro nfx (&rest s)
(nfx-impl s))
;; (definfix
;; :precedence
;; [:associativity <:left | :right>]
;; [:function-name ]
;; [:fungible ])
;; - defines an infix operator with the symbol ,
;; with a precedence of . The smaller the precedence
;; number, the more precedence it has: * and / have smaller
;; precedence number than + and -.
;; - associativity defaults to :left, which means that if two
;; operators of the same precedence are encountered, the first
;; one resolves first: 1 x 2 x 3 becomes ((1 x 2) x 3). This
;; is appropriate for most maths. :right associativity means
;; that 1 x 2 x 3 becomes (1 x (2 x 3)). This is appropriate
;; for assignment. IMPORTANT: operators with the same
;; precedence must have the same associativities!
;; - function-name defaults to the same symbol as the operator.
;; For example, the function-name of = is setf.
;; - fungible means that if the same operator is encountered
;; several times, then all inputs are funged into one function
;; call. For example, 1 + 2 + 3 becomes (+ 1 2 3), 1 < 2 < 3
;; becomes (< 1 2 3). This is not true for assignment:
;; x = y = z should become (setf x (setf y z)), not (setf x y z)
;; - fungible defaults to t because I noticed that nearly every
;; single darned operator was fungible. Except assignment.
;; Saved some dozen lines of code too.
(defmacro definfix (operator
&key precedence (associativity :left)
function-name (fungible t))
`(nfx-operator-base :add ',operator
,precedence ,associativity
',(if function-name function-name operator )
,fungible))
;; Predefined operators
;; Note: precedences are divisibles of 10, in case you
;; want to insert precedence levels between levels.
;; since we expect infix notation only (not infix-postfix),
;; our array accessor is a single infix @
(definfix @ :precedence 10 :function-name aref)
(definfix ** :precedence 20 :function-name expt)
(definfix * :precedence 30)
(definfix / :precedence 29)
(definfix % :precedence 28 :function-name mod)
(definfix + :precedence 40)
(definfix - :precedence 40)
(definfix <= :precedence 60)
(definfix < :precedence 60)
(definfix >= :precedence 60)
(definfix > :precedence 60)
(definfix = :precedence 70 :fungible nil)
(definfix /= :precedence 70)
;; 80-100 should be for the bitwise operators (&, |, ^),
;; once I figure out how CL handles bitops.
(definfix && :precedence 110 :function-name and)
(definfix || :precedence 120 :function-name or)
(set-dispatch-macro-character
#\# #\n
#'(lambda (stream c1 c2)
(declare (ignorable c1 c2))
(let ((rd (read stream t nil t)))
(if (listp rd)
`(nfx ,@rd)
(progn
(print 'invalid-#n-usage)
(print rd)
(error 'error) )))))
;; (nfx 55 - 3 * 4 + 2000000) used to give -1999957
;; instead of the correct result 2000043. This is now corrected. -- Bruno Daniel
The program is in the public domain. A later version with an MIT license attached is here.
This page is linked from: Macro Characters
CLiki pages can be edited by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively