mdw@git.distorted.org.uk Git - sod/blob - src/parser/parser-expr-proto.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Parsers for expressions with binary operators
   4 ;;;
   5 ;;; (c) 2009 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of the Sensible Object Design, an object system for C.
  11 ;;;
  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.
  16 ;;;
  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.
  21 ;;;
  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.
  25
  26 (cl:in-package #:sod-parser)
  27
  28 ;;;--------------------------------------------------------------------------
  29 ;;; Basic protocol.
  30
  31 (export 'operator-push-action)
  32 (defgeneric operator-push-action (left right)
  33   (:documentation
  34    "Determine relative precedence between LEFT and RIGHT operators.
  35
  36    Returns one of three possible values:
  37
  38      * `:push' means to push the RIGHT operator onto the stack, above the
  39        LEFT operator -- i.e., RIGHT has higher precedence than LEFT.
  40
  41      * `:apply' means to apply the LEFT operator to arguments immediately
  42        and try again, comparing RIGHT to the new topmost operator -- i.e.,
  43        LEFT has higher precedence than RIGHT.
  44
  45      * `:error' means that the situation is erroneous: a continuable error is
  46        signalled and the situation resolved by applying the LEFT operator and
  47        then pushing the RIGHT one -- i.e., treating them as having similar
  48        precedence and left associativity).
  49
  50    There is a default method which decides between `:push' and `:apply' by
  51    comparing numerical precedence values."))
  52
  53 (export 'expr)
  54 (defparse expr ((&key (nestedp (gensym "NESTEDP-")))
  55                 operand binop preop postop)
  56   "Parse an expression involving unary and binary operators.
  57
  58    Within the parsers for operands and operators, the variable NESTEDP is
  59    bound to a generalized boolean which is true if an unmatched open-
  60    parenthesis has been seen.
  61
  62    The OPERAND parser should produce a value; the various operator parsers
  63    (BINOP, PREOP, and POSTOP) should produce objects obeying the `operator'
  64    protocol.  The final output of the `expr' parse is the result of
  65    evaluating the parsed expression.  (Of course, the definition of
  66    `evaluation' here is determined entirely by the methods on
  67    `apply-operator', so the final value may be a parse tree, for example.)
  68
  69    Alternatively, the BINOP, PREOP, and POSTOP parsers may be /lists/ of
  70    parsers (distinguished because the head of a parser form is expected to be
  71    an atom).  These are implicitly `or'red together.  Within such a list, a
  72    parser form beginning `:op' is given special interpretation.  The syntax
  73    is expected to be
  74
  75         (:op MAKE-OP RECOG &rest ARGS)
  76
  77    which has the following effects:
  78
  79      * around the expression parser, the expression
  80
  81         (MAKE-OP . ARGS)
  82
  83       is evaluated once and the result stashed away; and
  84
  85     * a parser of the form
  86
  87         (seq (RECOG) OP)
  88
  89       is added as one of the alternatives of the disjunction, where OP is the
  90       cached operator built in the first step."
  91
  92   (flet ((wrap (parser)
  93            `(parser (,nestedp)
  94               (declare (ignorable ,nestedp))
  95               ,parser))
  96          (hack-oplist (oplist)
  97            (if (or (atom oplist) (atom (car oplist))) (values nil oplist)
  98                (let ((binds nil) (ops nil))
  99                  (dolist (op oplist)
 100                    (if (and (consp op) (eq (car op) :op))
 101                        (destructuring-bind
 102                            (recog make-op &rest args) (cdr op)
 103                          (with-gensyms (var)
 104                            (push `(,var (,make-op ,@args)) binds)
 105                            (push `(seq ((nil ,recog)) ,var) ops)))
 106                        (push op ops)))
 107                  (values (nreverse binds) `(or ,@(nreverse ops)))))))
 108     (multiple-value-bind (binvars binops) (hack-oplist binop)
 109       (multiple-value-bind (prevars preops) (hack-oplist preop)
 110         (multiple-value-bind (postvars postops) (hack-oplist postop)
 111           `(let (,@binvars ,@prevars ,@postvars)
 112              (parse-expression ,(wrap operand)
 113                                ,(wrap binops)
 114                                ,(wrap preops)
 115                                ,(wrap postops))))))))
 116
 117 ;;;--------------------------------------------------------------------------
 118 ;;; Numerical precedence.
 119
 120 (export '(operator-left-precedence operator-right-precedence
 121           operator-associativity))
 122 (defgeneric operator-left-precedence (operator)
 123   (:documentation
 124    "Return the OPERATOR's left-precedence.
 125
 126    Higher precedence numbers indicate tighter leftward binding.  Under the
 127    default method for `operator-push-action', the OPERATOR's left precedence
 128    is compared to the existing operators' right precedences to determine the
 129    parser's behaviour: if it is higher, then the OPERATOR is pushed;
 130    otherwise the existing operator is applied.  Thus, equal precedences cause
 131    left-associative parsing."))
 132 (defgeneric operator-right-precedence (operator)
 133   (:documentation
 134    "Return the OPERATOR's right-precedence.
 135
 136    Higher precedence numbers indicate tighter rightward binding.  Under the
 137    default method for `operator-push-action', a new operator's left
 138    precedence may be compared to the existing OPERATOR's right precedences to
 139    determine the parser's behaviour: if it is higher, then the new operator
 140    is pushed; otherwise the existing OPERATOR is applied.  Thus, equal
 141    precedences cause left-associative parsing."))
 142
 143 (defgeneric operator-associativity (operator)
 144   (:documentation
 145    "Returns an OPERATOR's associativity, as a symbol.
 146
 147    The return value is one of `:left', `:right' or `nil'.  If two adjacent
 148    operators have the same precedence, their associativities are compared.
 149    If both associativities are `:left' then the left-hand operator is
 150    considered to have higher precedence; if both are `:right' then the
 151    right-hand operator is considered to have higher precedence.  If they're
 152    inconsistent or `nil', then an error is reported and the behaviour is as
 153    if both were `:left'.")
 154   (:method (operator) :left))
 155
 156 ;;;--------------------------------------------------------------------------
 157 ;;; Basic operator protocol.
 158
 159 (export 'prefix-operator)
 160 (defclass prefix-operator ()
 161   ()
 162   (:documentation
 163    "Prefix operator base class.
 164
 165    Prefix operators are special because they are pushed at a time when the
 166    existing topmost operator on the stack may not have its operand
 167    available.  It is therefore incorrect to attempt to apply any existing
 168    operators without careful checking."))
 169
 170 (export 'simple-operator)
 171 (defclass simple-operator ()
 172   ((%function :initarg :function :reader operator-function)
 173    (name :initarg :name :initform "<unnamed operator>"
 174          :reader operator-name))
 175   (:documentation
 176    "A simple operator applies a FUNCTION to arguments when it is applied.
 177
 178    The precise details of the function are left to subclasses to sort out."))
 179
 180 (export 'simple-unary-operator)
 181 (defclass simple-unary-operator (simple-operator)
 182   ()
 183   (:documentation
 184    "A unary operator works on the topmost value on the value stack.
 185
 186    The topmost item is popped, the FUNCTION is applied to it, and the result
 187    is pushed back on."))
 188
 189 (export 'simple-binary-operator)
 190 (defclass simple-binary-operator (simple-operator)
 191   ((lprec :initarg :left-precedence :initarg :precedence
 192           :reader operator-left-precedence)
 193    (rprec :initarg :right-precedence :reader operator-right-precedence)
 194    (associativity :initarg :associative :initform :left
 195                   :reader operator-associativity))
 196   (:documentation
 197    "A binary operator works on the two topmost values on the value stack.
 198
 199    The function's arguments are the two topmost items in /reverse/ order --
 200    so the topmost item is second.  This is usually what you want.
 201
 202    The left and right precedences are settable independently.  Usually (and
 203    this is the default) you will set them equal, and use the `:associativity'
 204    initarg to determine associativity; however, right-associativity can also
 205    be obtained by setting the right-precedence lower than the left.  Special
 206    effects can be obtained by setting them in other ways.  Use your
 207    imagination."))
 208
 209 (export 'simple-postfix-operator)
 210 (defclass simple-postfix-operator (simple-unary-operator)
 211   ((lprec :initarg :left-precedence :initarg :precedence
 212           :reader operator-left-precedence)
 213    (rprec :initarg :right-precedence :reader operator-right-precedence))
 214   (:documentation
 215    "A postfix operator is applied to a single operand.
 216
 217    The left and right precedences are settable independently.  Usually you
 218    will want to set them equal (this is the default) and quite high.  Special
 219    effects can be obtained by doing other things instead; but note that you
 220    will get an incorrect parse if the right precedence is lower than the left
 221    precedence of a binary operator because the postfix operator will be
 222    applied to the result of the binary operator."))
 223
 224 (export 'simple-prefix-operator)
 225 (defclass simple-prefix-operator (prefix-operator simple-unary-operator)
 226   ((rprec :initarg :precedence :reader operator-right-precedence))
 227   (:documentation
 228    "A prefix operator is applied to a single operand.
 229
 230    There is only one precedence value for a prefix operator: the
 231    `prefix-operator' superclass arranges that the left precedence is
 232    effectively minus infinity."))
 233
 234 (export 'preop)
 235 (defmacro preop (name (x prec) &body body)
 236   "Define a prefix operator.
 237
 238    The operator will be called NAME in error messages, and have right
 239    precedence PREC.  To apply the operator, BODY is evaluated with X bound to
 240    the operand."
 241
 242   `(make-instance 'simple-prefix-operator
 243                   :name ,name
 244                   :precedence ,prec
 245                   :function (lambda (,x) ,@body)))
 246
 247 (export 'postop)
 248 (defmacro postop (name (x prec &key rprec) &body body)
 249   "Define a postfix operator.
 250
 251    The operator will be called NAME in error messages, and have left
 252    precedence PREC and right precendence RPREC (defaulting to PREC).  To
 253    apply the operator, BODY is evaluated with X bound to the operand."
 254
 255   (once-only (name prec rprec)
 256     `(make-instance 'simple-postfix-operator
 257                     :name ,name
 258                     :left-precedence ,prec
 259                     :right-precedence ,(or rprec prec)
 260                     :function (lambda (,x) ,@body))))
 261
 262 (export 'binop)
 263 (defmacro binop (name (x y prec &key rprec (assoc :left)) &body body)
 264   "Define a binary operator.
 265
 266    The operator will be called NAME in error messages, and have left
 267    precedence PREC and right precedence RPREC (defaulting to PREC, implying
 268    left associativity under the default `operator-push-action'
 269    implementation.  To apply the operator, BODY is evaluated with X and Y
 270    bound to the operands in the order they were parsed"
 271
 272   (once-only (name prec rprec assoc)
 273     `(make-instance 'simple-binary-operator
 274                     :name ,name
 275                     :left-precedence ,prec
 276                     :right-precedence ,(or rprec prec)
 277                     :associative ,assoc
 278                     :function (lambda (,x ,y) ,@body))))
 279
 280 ;;;--------------------------------------------------------------------------
 281 ;;; Parentheses.
 282
 283 (defclass parenthesis ()
 284   ((tag :initarg :tag :initform nil))
 285   (:documentation
 286    "Base class for parenthesis operators."))
 287
 288 (export 'open-parenthesis)
 289 (defclass open-parenthesis (parenthesis prefix-operator) ())
 290
 291 (export 'close-parenthesis)
 292 (defclass close-parenthesis (parenthesis) ())
 293
 294 (export '(lparen rparen))
 295 (defun lparen (tag)
 296   (make-instance 'open-parenthesis :tag tag))
 297 (defun rparen (tag)
 298   (make-instance 'close-parenthesis :tag tag))
 299
 300 ;;;----- That's all, folks --------------------------------------------------