X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/bf090e021a5c20da452a4841cdfb8eb78e29544e..aa14a4cddcb96b681d5c19a2ec8bad382f43b264:/src/parser/proto-parser-expr.lisp diff --git a/src/parser/proto-parser-expr.lisp b/src/parser/proto-parser-expr.lisp deleted file mode 100644 index 7fc2609..0000000 --- a/src/parser/proto-parser-expr.lisp +++ /dev/null @@ -1,285 +0,0 @@ -;;; -*-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-value) -(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. - - Within the parsers for operands and operators, the variable NESTEDP is - bound to a generalized boolean which is true if an unmatched open- - parenthesis has been seen. - - The OPERAND parser should produce a value; the various operator parsers - (BINOP, PREOP, and POSTOP) should produce objects obeying the `operator' - protocol. The final output of the `expr' parse is the result of - evaluating the parsed expression. (Of course, the definition of - `evaluation' here is determined entirely by the methods on - `apply-operator', so the final value may be a parse tree, for example.)" - - (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) - "Define a prefix operator. - - The operator will be called NAME in error messages, and have right - precedence PREC. To apply the operator, BODY is evaluated with X bound to - the operand." - - `(make-instance 'simple-prefix-operator - :name ,name - :precedence ,prec - :function (lambda (,x) ,@body))) - -(export 'postop) -(defmacro postop (name (x prec &key rprec) &body body) - "Define a postfix operator. - - The operator will be called NAME in error messages, and have left - precedence PREC and right precendence RPREC (defaulting to PREC). To - apply the operator, BODY is evaluated with X bound to the operand." - - (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) - "Define a binary operator. - - The operator will be called NAME in error messages, and have left - precedence PREC and right precedence RPREC (defaulting to PREC, implying - left associativity under the default `operator-push-action' - implementation. To apply the operator, BODY is evaluated with X and Y - bound to the operands in the order they were parsed" - - (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 --------------------------------------------------