This file is indexed.

/usr/share/common-lisp/source/esrap/example-left-recursion.lisp is in cl-esrap 20151218-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")))))