3 ;;; Parsers for expressions with binary operators
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensble Object Design, an object system for C.
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26 (cl:in-package #:sod-parser)
28 ;;;--------------------------------------------------------------------------
31 (export 'push-operator)
32 (defgeneric push-operator (operator state)
34 "Push an OPERATOR onto the STATE's operator stack.
36 This should apply existing stacked operators as necessary to obey the
37 language's precedence rules."))
40 (defgeneric push-value (value state)
42 "Push VALUE onto the STATE's value stack.
44 The default message just does that without any fuss. It's unlikely that
45 this will need changing unless you invent some really weird values."))
47 (export 'apply-operator)
48 (defgeneric apply-operator (operator state)
50 "Apply the OPERATOR to argument on the STATE's value stack.
52 This should pop any necessary arguments, and push the result."))
54 (export 'operator-push-action)
55 (defgeneric operator-push-action (left right)
57 "Determine relative precedence between LEFT and RIGHT operators.
59 Returns one of three possible values:
61 * `:push' means to push the RIGHT operator onto the stack, above the
62 LEFT operator -- i.e., RIGHT has higher precedence than LEFT.
64 * `:apply' means to apply the LEFT operator to arguments immediately
65 and try again, comparing RIGHT to the new topmost operator -- i.e.,
66 LEFT has higher precedence than RIGHT.
68 * `:error' means that the situation is erroneous: a continuable error is
69 signalled and the situation resolved by applying the LEFT operator and
70 then pushing the RIGHT one -- i.e., treating them as having similar
71 precedence and left associativity).
73 There is a default method which decides between `:push' and `:apply' by
74 comparing numerical precedence values."))
77 (defparse expr ((&key (nestedp (gensym "NESTEDP-")))
78 operand binop preop postop)
79 "Parse an expression involving unary and binary operators."
82 (declare (ignorable ,nestedp))
84 `(parse-expression ,(wrap operand)
89 ;;;--------------------------------------------------------------------------
90 ;;; Numerical precedence.
92 (export '(operator-left-precedence operator-right-precedence))
93 (defgeneric operator-left-precedence (operator)
95 "Return the OPERATOR's left-precedence.
97 Higher precedence numbers indicate tighter leftward binding. Under the
98 default method for `operator-push-action', the OPERATOR's left precedence
99 is compared to the existing operators' right precedences to determine the
100 parser's behaviour: if it is higher, then the OPERATOR is pushed;
101 otherwise the existing operator is applied. Thus, equal precedences cause
102 left-associative parsing."))
103 (defgeneric operator-right-precedence (operator)
105 "Return the OPERATOR's right-precedence.
107 Higher precedence numbers indicate tighter rightward binding. Under the
108 default method for `operator-push-action', a new operator's left
109 precedence may be compared to the existing OPERATOR'S right precedences to
110 determine the parser's behaviour: if it is higher, then the new operator
111 is pushed; otherwise the existing OPERATOR is applied. Thus, equal
112 precedences cause left-associative parsing."))
114 (defgeneric operator-associativity (operator)
116 "Returns an OPERATOR's associativity, as a symbol.
118 The return value is one of `:left', `:right' or `nil'. If two adjacent
119 operators have the same precedence, their associativities are compared.
120 If both associativities are `:left' then the left-hand operator is
121 considered to have higher precedence; if both are `:right' then the
122 right-hand operator is considered to have higher precedence. If they're
123 inconsistent or `nil', then an error is reported and the behaviour is as
124 if both were `:left'.")
125 (:method (operator) :left))
127 ;;;--------------------------------------------------------------------------
128 ;;; Basic operator protocol.
130 (export 'prefix-operator)
131 (defclass prefix-operator ()
134 "Prefix operator base class.
136 Prefix operators are special because they are pushed at a time when the
137 existing topmost operator on the stack may not have its operand
138 available. It is therefore incorrect to attempt to apply any existing
139 operators without careful checking. This class provides a method on
140 `push-operator' which immediately pushes the new operator without
141 inspecting the existing stack."))
143 (export 'simple-operator)
144 (defclass simple-operator ()
145 ((function :initarg :function :reader operator-function)
146 (name :initarg :name :initform "<unnamed operator>"
147 :reader operator-name))
149 "A simple operator applies a FUNCTION to arguments when it is applied.
151 The precise details of the function are left to subclasses to sort out."))
153 (export 'simple-unary-operator)
154 (defclass simple-unary-operator (simple-operator)
157 "A unary operator works on the topmost value on the value stack.
159 The topmost item is popped, the FUNCTION is applied to it, and the result
160 is pushed back on."))
162 (export 'simple-binary-operator)
163 (defclass simple-binary-operator (simple-operator)
164 ((lprec :initarg :left-precedence :initarg :precedence
165 :reader operator-left-precedence)
166 (rprec :initarg :right-precedence :reader operator-right-precedence)
167 (associativity :initarg :associative :initform :left
168 :reader operator-associativity))
170 "A binary operator works on the two topmost values on the value stack.
172 The function's arguments are the two topmost items in /reverse/ order --
173 so the topmost item is second. This is usually what you want.
175 The left and right precedences are settable independently. Usually (and
176 this is the default) you will set them equal, and use the `:associativity'
177 initarg to determine associativity; however, right-associativity can also
178 be obtained by setting the right-precedence lower than the left. Special
179 effects can be obtained by setting them in other ways. Use your
182 (export 'simple-postfix-operator)
183 (defclass simple-postfix-operator (simple-unary-operator)
184 ((lprec :initarg :left-precedence :initarg :precedence
185 :reader operator-left-precedence)
186 (rprec :initarg :right-precedence :reader operator-right-precedence))
188 "A postfix operator is applied to a single operand.
190 The left and right precedences are settable independently. Usually you
191 will want to set them equal (this is the default) and quite high. Special
192 effects can be obtained by doing other things instead; but note that you
193 will get an incorrect parse if the right precedence is lower than the left
194 precedence of a binary operator because the postfix operator will be
195 applied to the result of the binary operator."))
197 (export 'simple-prefix-operator)
198 (defclass simple-prefix-operator (prefix-operator simple-unary-operator)
199 ((rprec :initarg :precedence :reader operator-right-precedence))
201 "A prefix operator is applied to a single operand.
203 There is only one precedence value for a prefix operator: the
204 `prefix-operator' superclass arranges that the left precedence is
205 effectively minus infinity."))
208 (defmacro preop (name (x prec) &body body)
209 `(make-instance 'simple-prefix-operator
212 :function (lambda (,x) ,@body)))
215 (defmacro postop (name (x prec &key rprec) &body body)
216 (once-only (name prec rprec)
217 `(make-instance 'simple-postfix-operator
219 :left-precedence ,prec
220 :right-precedence ,(or rprec prec)
221 :function (lambda (,x) ,@body))))
224 (defmacro binop (name (x y prec &key rprec (assoc :left)) &body body)
225 (once-only (name prec rprec assoc)
226 `(make-instance 'simple-binary-operator
228 :left-precedence ,prec
229 :right-precedence ,(or rprec prec)
231 :function (lambda (,x ,y) ,@body))))
233 ;;;--------------------------------------------------------------------------
236 (defclass parenthesis ()
237 ((tag :initarg :tag :initform nil))
239 "Base class for parenthesis operators."))
241 (export 'open-parenthesis)
242 (defclass open-parenthesis (parenthesis prefix-operator) ())
244 (export 'close-parenthesis)
245 (defclass close-parenthesis (parenthesis) ())
247 (export '(lparen rparen))
249 (make-instance 'open-parenthesis :tag tag))
251 (make-instance 'close-parenthesis :tag tag))
253 ;;;----- That's all, folks --------------------------------------------------