3 ;;; Parsers for expressions with binary operators
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible 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 method 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.
81 Within the parsers for operands and operators, the variable NESTEDP is
82 bound to a generalized boolean which is true if an unmatched open-
83 parenthesis has been seen.
85 The OPERAND parser should produce a value; the various operator parsers
86 (BINOP, PREOP, and POSTOP) should produce objects obeying the `operator'
87 protocol. The final output of the `expr' parse is the result of
88 evaluating the parsed expression. (Of course, the definition of
89 `evaluation' here is determined entirely by the methods on
90 `apply-operator', so the final value may be a parse tree, for example.)"
94 (declare (ignorable ,nestedp))
96 `(parse-expression ,(wrap operand)
101 ;;;--------------------------------------------------------------------------
102 ;;; Numerical precedence.
104 (export '(operator-left-precedence operator-right-precedence))
105 (defgeneric operator-left-precedence (operator)
107 "Return the OPERATOR's left-precedence.
109 Higher precedence numbers indicate tighter leftward binding. Under the
110 default method for `operator-push-action', the OPERATOR's left precedence
111 is compared to the existing operators' right precedences to determine the
112 parser's behaviour: if it is higher, then the OPERATOR is pushed;
113 otherwise the existing operator is applied. Thus, equal precedences cause
114 left-associative parsing."))
115 (defgeneric operator-right-precedence (operator)
117 "Return the OPERATOR's right-precedence.
119 Higher precedence numbers indicate tighter rightward binding. Under the
120 default method for `operator-push-action', a new operator's left
121 precedence may be compared to the existing OPERATOR's right precedences to
122 determine the parser's behaviour: if it is higher, then the new operator
123 is pushed; otherwise the existing OPERATOR is applied. Thus, equal
124 precedences cause left-associative parsing."))
126 (defgeneric operator-associativity (operator)
128 "Returns an OPERATOR's associativity, as a symbol.
130 The return value is one of `:left', `:right' or `nil'. If two adjacent
131 operators have the same precedence, their associativities are compared.
132 If both associativities are `:left' then the left-hand operator is
133 considered to have higher precedence; if both are `:right' then the
134 right-hand operator is considered to have higher precedence. If they're
135 inconsistent or `nil', then an error is reported and the behaviour is as
136 if both were `:left'.")
137 (:method (operator) :left))
139 ;;;--------------------------------------------------------------------------
140 ;;; Basic operator protocol.
142 (export 'prefix-operator)
143 (defclass prefix-operator ()
146 "Prefix operator base class.
148 Prefix operators are special because they are pushed at a time when the
149 existing topmost operator on the stack may not have its operand
150 available. It is therefore incorrect to attempt to apply any existing
151 operators without careful checking. This class provides a method on
152 `push-operator' which immediately pushes the new operator without
153 inspecting the existing stack."))
155 (export 'simple-operator)
156 (defclass simple-operator ()
157 ((%function :initarg :function :reader operator-function)
158 (name :initarg :name :initform "<unnamed operator>"
159 :reader operator-name))
161 "A simple operator applies a FUNCTION to arguments when it is applied.
163 The precise details of the function are left to subclasses to sort out."))
165 (export 'simple-unary-operator)
166 (defclass simple-unary-operator (simple-operator)
169 "A unary operator works on the topmost value on the value stack.
171 The topmost item is popped, the FUNCTION is applied to it, and the result
172 is pushed back on."))
174 (export 'simple-binary-operator)
175 (defclass simple-binary-operator (simple-operator)
176 ((lprec :initarg :left-precedence :initarg :precedence
177 :reader operator-left-precedence)
178 (rprec :initarg :right-precedence :reader operator-right-precedence)
179 (associativity :initarg :associative :initform :left
180 :reader operator-associativity))
182 "A binary operator works on the two topmost values on the value stack.
184 The function's arguments are the two topmost items in /reverse/ order --
185 so the topmost item is second. This is usually what you want.
187 The left and right precedences are settable independently. Usually (and
188 this is the default) you will set them equal, and use the `:associativity'
189 initarg to determine associativity; however, right-associativity can also
190 be obtained by setting the right-precedence lower than the left. Special
191 effects can be obtained by setting them in other ways. Use your
194 (export 'simple-postfix-operator)
195 (defclass simple-postfix-operator (simple-unary-operator)
196 ((lprec :initarg :left-precedence :initarg :precedence
197 :reader operator-left-precedence)
198 (rprec :initarg :right-precedence :reader operator-right-precedence))
200 "A postfix operator is applied to a single operand.
202 The left and right precedences are settable independently. Usually you
203 will want to set them equal (this is the default) and quite high. Special
204 effects can be obtained by doing other things instead; but note that you
205 will get an incorrect parse if the right precedence is lower than the left
206 precedence of a binary operator because the postfix operator will be
207 applied to the result of the binary operator."))
209 (export 'simple-prefix-operator)
210 (defclass simple-prefix-operator (prefix-operator simple-unary-operator)
211 ((rprec :initarg :precedence :reader operator-right-precedence))
213 "A prefix operator is applied to a single operand.
215 There is only one precedence value for a prefix operator: the
216 `prefix-operator' superclass arranges that the left precedence is
217 effectively minus infinity."))
220 (defmacro preop (name (x prec) &body body)
221 "Define a prefix operator.
223 The operator will be called NAME in error messages, and have right
224 precedence PREC. To apply the operator, BODY is evaluated with X bound to
227 `(make-instance 'simple-prefix-operator
230 :function (lambda (,x) ,@body)))
233 (defmacro postop (name (x prec &key rprec) &body body)
234 "Define a postfix operator.
236 The operator will be called NAME in error messages, and have left
237 precedence PREC and right precendence RPREC (defaulting to PREC). To
238 apply the operator, BODY is evaluated with X bound to the operand."
240 (once-only (name prec rprec)
241 `(make-instance 'simple-postfix-operator
243 :left-precedence ,prec
244 :right-precedence ,(or rprec prec)
245 :function (lambda (,x) ,@body))))
248 (defmacro binop (name (x y prec &key rprec (assoc :left)) &body body)
249 "Define a binary operator.
251 The operator will be called NAME in error messages, and have left
252 precedence PREC and right precedence RPREC (defaulting to PREC, implying
253 left associativity under the default `operator-push-action'
254 implementation. To apply the operator, BODY is evaluated with X and Y
255 bound to the operands in the order they were parsed"
257 (once-only (name prec rprec assoc)
258 `(make-instance 'simple-binary-operator
260 :left-precedence ,prec
261 :right-precedence ,(or rprec prec)
263 :function (lambda (,x ,y) ,@body))))
265 ;;;--------------------------------------------------------------------------
268 (defclass parenthesis ()
269 ((tag :initarg :tag :initform nil))
271 "Base class for parenthesis operators."))
273 (export 'open-parenthesis)
274 (defclass open-parenthesis (parenthesis prefix-operator) ())
276 (export 'close-parenthesis)
277 (defclass close-parenthesis (parenthesis) ())
279 (export '(lparen rparen))
281 (make-instance 'open-parenthesis :tag tag))
283 (make-instance 'close-parenthesis :tag tag))
285 ;;;----- That's all, folks --------------------------------------------------