/usr/share/common-lisp/source/esrap/example-left-recursion.lisp is in cl-esrap 20140826-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | ;;;; Esrap example: some grammars with left-recursive rules.
(require :esrap)
(defpackage :left-recursive-grammars
(:use :cl :alexandria :esrap)
(:export #:la-expr #:ra-expr #:primary))
(in-package :left-recursive-grammars)
;;; Left associative expressions
(defrule la-expr
la-term)
(defrule la-literal
(digit-char-p character)
(:lambda (x) (parse-integer (text x))))
(defrule la-term
(and la-factor (? (and (or #\+ #\-) la-term)))
(:destructure (left (&optional op right))
(if op
(list (find-symbol op :cl) left right)
left)))
(defrule la-factor
(and (or la-literal la-expr) (? (and (or #\* #\/) la-factor)))
(:destructure (left (&optional op right))
(if op
(list (find-symbol op :cl) left right)
left)))
(defun test-la ()
(let ((*on-left-recursion* :error))
(assert (equal (parse 'la-expr "1*2+3*4+5")
'(+ (* 1 2) (+ (* 3 4) 5))))))
;;; Right associative expressions
(defrule ra-expr
ra-term)
(defrule ra-literal
(digit-char-p character)
(:lambda (x) (parse-integer (text x))))
(defrule ra-term
(and (? (and ra-term (or #\+ #\-))) ra-factor)
(:destructure ((&optional left op) right)
(if op
(list (find-symbol op :cl) left right)
right)))
(defrule ra-factor
(and (? (and ra-factor (or #\* #\/))) (or ra-literal ra-expr))
(:destructure ((&optional left op) right)
(if op
(list (find-symbol op :cl) left right)
right)))
(defun test-ra ()
(let ((*on-left-recursion* :error))
(parse 'ra-expr "1*2+3*4+5")) ; |- Error
(assert (equal (parse 'ra-expr "1*2+3*4+5")
'(+ (+ (* 1 2) (* 3 4)) 5))))
;;; The following example is given in
;;;
;;; Alessandro Warth, James R. Douglass, Todd Millstein, 2008,
;;; "Packrat Parsers Can Support Left Recursion".
;;; http://www.vpri.org/pdf/tr2007002_packrat.pdf
(defrule primary
primary-no-new-array)
(defrule primary-no-new-array
(or class-instance-creation-expression
method-invocation
field-access
array-access
"this"))
(defrule class-instance-creation-expression
(or (and "new" class-or-interface-type "()")
(and primary ".new" identifier "()")))
;; Note: in the paper, the first case is
;;
;; (and primary "." identifier "()")
;;
;; but that seems to be an error.
(defrule method-invocation
(or (and primary "." method-name "()")
(and (and) (and) method-name "()"))
(:destructure (structure dot name parens)
(declare (ignore dot parens))
(list :method-invocation structure name)))
(defrule field-access
(or (and primary "." identifier)
(and "super." identifier))
(:destructure (structure dot field)
(declare (ignore dot))
(list :field-access structure field)))
(defrule array-access
(or (and primary "[" expression "]")
(and expression-name "[" expression "]"))
(:destructure (structure open index close)
(declare (ignore open close))
(list :array-access structure index)))
(defrule class-or-interface-type
(or class-name interface-type-name))
(defrule class-name
(or "C" "D"))
(defrule interface-type-name
(or "I" "J"))
(defrule identifier
(or "x" "y" class-or-interface-type))
(defrule method-name
(or "m" "n"))
(defrule expression-name
identifier)
(defrule expression
(or "i" "j"))
(defun test-warth ()
(mapc
(curry #'apply
(lambda (input expected)
(assert (equal (parse 'primary input) expected))))
'(("this" "this")
("this.x" (:field-access "this" "x"))
("this.x.y" (:field-access (:field-access "this" "x") "y"))
("this.x.m()" (:method-invocation (:field-access "this" "x") "m"))
("x[i][j].y" (:field-access (:array-access (:array-access "x" "i") "j") "y")))))
|