X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/a07d8d005f69c0f9f5da2e09c6ee39cb1e1801aa..dea4d05507e59ab779ed4bb209e05971d87e260c:/src/parser/proto-parser-expr.lisp diff --git a/src/parser/proto-parser-expr.lisp b/src/parser/proto-parser-expr.lisp new file mode 100644 index 0000000..b2919d6 --- /dev/null +++ b/src/parser/proto-parser-expr.lisp @@ -0,0 +1,253 @@ +;;; -*-lisp-*- +;;; +;;; Parsers for expressions with binary operators +;;; +;;; (c) 2009 Straylight/Edgeware +;;; + +;;;----- Licensing notice --------------------------------------------------- +;;; +;;; This file is part of the Sensble Object Design, an object system for C. +;;; +;;; SOD 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. +;;; +;;; SOD 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 SOD; if not, write to the Free Software Foundation, +;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(cl:in-package #:sod-parser) + +;;;-------------------------------------------------------------------------- +;;; Basic protocol. + +(export 'push-operator) +(defgeneric push-operator (operator state) + (:documentation + "Push an OPERATOR onto the STATE's operator stack. + + This should apply existing stacked operators as necessary to obey the + language's precedence rules.")) + +(export 'push-vlaue) +(defgeneric push-value (value state) + (:documentation + "Push VALUE onto the STATE's value stack. + + The default message just does that without any fuss. It's unlikely that + this will need changing unless you invent some really weird values.")) + +(export 'apply-operator) +(defgeneric apply-operator (operator state) + (:documentation + "Apply the OPERATOR to argument on the STATE's value stack. + + This should pop any necessary arguments, and push the result.")) + +(export 'operator-push-action) +(defgeneric operator-push-action (left right) + (:documentation + "Determine relative precedence between LEFT and RIGHT operators. + + Returns one of three possible values: + + * `:push' means to push the RIGHT operator onto the stack, above the + LEFT operator -- i.e., RIGHT has higher precedence than LEFT. + + * `:apply' means to apply the LEFT operator to arguments immediately + and try again, comparing RIGHT to the new topmost operator -- i.e., + LEFT has higher precedence than RIGHT. + + * `:error' means that the situation is erroneous: a continuable error is + signalled and the situation resolved by applying the LEFT operator and + then pushing the RIGHT one -- i.e., treating them as having similar + precedence and left associativity). + + There is a default method which decides between `:push' and `:apply' by + comparing numerical precedence values.")) + +(export 'expr) +(defparse expr ((&key (nestedp (gensym "NESTEDP-"))) + operand binop preop postop) + "Parse an expression involving unary and binary operators." + (flet ((wrap (parser) + `(parser (,nestedp) + (declare (ignorable ,nestedp)) + ,parser))) + `(parse-expression ,(wrap operand) + ,(wrap binop) + ,(wrap preop) + ,(wrap postop)))) + +;;;-------------------------------------------------------------------------- +;;; Numerical precedence. + +(export '(operator-left-precedence operator-right-precedence)) +(defgeneric operator-left-precedence (operator) + (:documentation + "Return the OPERATOR's left-precedence. + + Higher precedence numbers indicate tighter leftward binding. Under the + default method for `operator-push-action', the OPERATOR's left precedence + is compared to the existing operators' right precedences to determine the + parser's behaviour: if it is higher, then the OPERATOR is pushed; + otherwise the existing operator is applied. Thus, equal precedences cause + left-associative parsing.")) +(defgeneric operator-right-precedence (operator) + (:documentation + "Return the OPERATOR's right-precedence. + + Higher precedence numbers indicate tighter rightward binding. Under the + default method for `operator-push-action', a new operator's left + precedence may be compared to the existing OPERATOR'S right precedences to + determine the parser's behaviour: if it is higher, then the new operator + is pushed; otherwise the existing OPERATOR is applied. Thus, equal + precedences cause left-associative parsing.")) + +(defgeneric operator-associativity (operator) + (:documentation + "Returns an OPERATOR's associativity, as a symbol. + + The return value is one of `:left', `:right' or `nil'. If two adjacent + operators have the same precedence, their associativities are compared. + If both associativities are `:left' then the left-hand operator is + considered to have higher precedence; if both are `:right' then the + right-hand operator is considered to have higher precedence. If they're + inconsistent or `nil', then an error is reported and the behaviour is as + if both were `:left'.") + (:method (operator) :left)) + +;;;-------------------------------------------------------------------------- +;;; Basic operator protocol. + +(export 'prefix-operator) +(defclass prefix-operator () + () + (:documentation + "Prefix operator base class. + + Prefix operators are special because they are pushed at a time when the + existing topmost operator on the stack may not have its operand + available. It is therefore incorrect to attempt to apply any existing + operators without careful checking. This class provides a method on + `push-operator' which immediately pushes the new operator without + inspecting the existing stack.")) + +(export 'simple-operator) +(defclass simple-operator () + ((function :initarg :function :reader operator-function) + (name :initarg :name :initform "" + :reader operator-name)) + (:documentation + "A simple operator applies a FUNCTION to arguments when it is applied. + + The precise details of the function are left to subclasses to sort out.")) + +(export 'simple-unary-operator) +(defclass simple-unary-operator (simple-operator) + () + (:documentation + "A unary operator works on the topmost value on the value stack. + + The topmost item is popped, the FUNCTION is applied to it, and the result + is pushed back on.")) + +(export 'simple-binary-operator) +(defclass simple-binary-operator (simple-operator) + ((lprec :initarg :left-precedence :initarg :precedence + :reader operator-left-precedence) + (rprec :initarg :right-precedence :reader operator-right-precedence) + (associativity :initarg :associative :initform :left + :reader operator-associativity)) + (:documentation + "A binary operator works on the two topmost values on the value stack. + + The function's arguments are the two topmost items in /reverse/ order -- + so the topmost item is second. This is usually what you want. + + The left and right precedences are settable independently. Usually (and + this is the default) you will set them equal, and use the `:associativity' + initarg to determine associativity; however, right-associativity can also + be obtained by setting the right-precedence lower than the left. Special + effects can be obtained by setting them in other ways. Use your + imagination.")) + +(export 'simple-postfix-operator) +(defclass simple-postfix-operator (simple-unary-operator) + ((lprec :initarg :left-precedence :initarg :precedence + :reader operator-left-precedence) + (rprec :initarg :right-precedence :reader operator-right-precedence)) + (:documentation + "A postfix operator is applied to a single operand. + + The left and right precedences are settable independently. Usually you + will want to set them equal (this is the default) and quite high. Special + effects can be obtained by doing other things instead; but note that you + will get an incorrect parse if the right precedence is lower than the left + precedence of a binary operator because the postfix operator will be + applied to the result of the binary operator.")) + +(export 'simple-prefix-operator) +(defclass simple-prefix-operator (prefix-operator simple-unary-operator) + ((rprec :initarg :precedence :reader operator-right-precedence)) + (:documentation + "A prefix operator is applied to a single operand. + + There is only one precedence value for a prefix operator: the + `prefix-operator' superclass arranges that the left precedence is + effectively minus infinity.")) + +(export 'preop) +(defmacro preop (name (x prec) &body body) + `(make-instance 'simple-prefix-operator + :name ,name + :precedence ,prec + :function (lambda (,x) ,@body))) + +(export 'postop) +(defmacro postop (name (x prec &key rprec) &body body) + (once-only (name prec rprec) + `(make-instance 'simple-postfix-operator + :name ,name + :left-precedence ,prec + :right-precedence ,(or rprec prec) + :function (lambda (,x) ,@body)))) + +(export 'binop) +(defmacro binop (name (x y prec &key rprec (assoc :left)) &body body) + (once-only (name prec rprec assoc) + `(make-instance 'simple-binary-operator + :name ,name + :left-precedence ,prec + :right-precedence ,(or rprec prec) + :associative ,assoc + :function (lambda (,x ,y) ,@body)))) + +;;;-------------------------------------------------------------------------- +;;; Parentheses. + +(defclass parenthesis () + ((tag :initarg :tag :initform nil)) + (:documentation + "Base class for parenthesis operators.")) + +(export 'open-parenthesis) +(defclass open-parenthesis (parenthesis prefix-operator) ()) + +(export 'close-parenthesis) +(defclass close-parenthesis (parenthesis) ()) + +(export '(lparen rparen)) +(defun lparen (tag) + (make-instance 'open-parenthesis :tag tag)) +(defun rparen (tag) + (make-instance 'close-parenthesis :tag tag)) + +;;;----- That's all, folks --------------------------------------------------