remove some left recursions, add more rules
authorD Herring <dherring@at.tentpost.dot.com>
Thu, 22 Mar 2012 06:06:31 +0000 (02:06 -0400)
committerD Herring <dherring@at.tentpost.dot.com>
Thu, 22 Mar 2012 06:06:31 +0000 (02:06 -0400)
examples/extensible-parser-example.lisp
extensible-parser.lisp

index ae6f8c3..4a04ec1 100644 (file)
       (and "\U" (hex-quad) (hex-quad))))
 
 
-;; 2.10
+;; 2.10, lex.ppnumber
+
 ;; left recursion...
 (defrule pp-number
+  ;; original, left recursion
+  #|
   (or> (digit)
        (and #\. (digit))
        (and (pp-number) (digit))
        (and (pp-number) (identifier-nondigit))
        (and (pp-number) #\e (sign))
        (and (pp-number) #\E (sign))
-       (and (pp-number) #\.)))
+       (and (pp-number) #\.))
+  |#
+  ;; equivalent
+  (and
+   (or (and (repeat 0 nil (digit)) #\. (repeat 1 nil (digit)))
+       (and (repeat 1 nil (digit)) #\. (repeat 0 nil (digit)))
+       (repeat 1 nil (digit)))
+   (optional
+    (and (or #\e #\E)
+         (sign)
+         (repeat 0 nil (digit))))))
+
 
 ;; explore solution to left recursion
 ;; simulate (or (and (pp-number) (digit)) (digit))
       (and (octal-literal) (optional (integer-suffix)))
       (and (hexadecimal-literal) (optional (integer-suffix)))))
 
+;; 2.14.3, lex.ccon
+
+(defrule simple-escape-sequence
+  (and #\\ (or #\' #\" #\? #\\
+               #\a #\b #\f #\n #\r #\t #\v)))
+
+(defrule octal-escape-sequence
+  (and #\\ (repeat 1 3 (octal-digit))))
+
+(defrule hexadecimal-escape-sequence
+  (and #\\ #\x (repeat 1 nil (hexadecimal-digit))))
+
+(defrule escape-sequence
+  (or (simple-escape-sequence)
+      (octal-escape-sequence)
+      (hexadecimal-escape-sequence)))
+
+(defun any-char (string start end)
+  (when (< start end)
+    (values (1+ start) (char string start))))
+
+(defrule c-char
+  (or (exception (any-char) (or #\' #\\ slash-n))
+      (escape-sequence)
+      (universal-character-name)))
+
+(defrule c-char-sequence
+  (repeat 1 nil (c-char)))
+
+(defrule character-literal
+  (or (and #\' (c-char-sequence) #\')
+      (and "u'" (c-char-sequence) #\')
+      (and "U'" (c-char-sequence) #\')
+      (and "L'" (c-char-sequence) #\')))
+
+;; 2.14.4, lex.fcon
+(defrule sign
+  (or #\+ #\-))
+
+(defrule digit-sequence
+  (repeat 1 nil (digit)))
+
+(defrule floating-suffix
+  (or #\f #\l #\F #\L))
+
+(defrule exponent-part
+  (and (or #\e #\E) (optional (sign)) (digit-sequence)))
+
+(defrule fractional-constant
+  (or (and (optional (digit-sequence)) #\. (digit-sequence))
+      (and (digit-sequence) #\.)))
+
+(defrule floating-literal
+  (or (and (fractional-constant) (optional (exponent-part)) (optional (floating-suffix)))
+      (and (digit-sequence) (exponent-part) (optional (floating-suffix)))))
+
+
+;; --------
+
 ;; Integer            = (("0" [xX] HexDigit+) | ("0" OctalDigit*) | ([1-9] Digit*));
 (defrule r-integer
   (or
index 3e81ee4..4f92b01 100644 (file)
@@ -510,6 +510,18 @@ or to allow changes to the rule,
        (repeat 1 nil #\b)))    
 
 
+(defmethod cpf-list ((car (eql 'exception)) form context env)
+  (assert (= (length form) 3))
+  (with-slots (string start end) context
+    (destructuring-bind (pass fail) (cdr form)
+      (let* ((e (gensym (symbol-name :end-)))
+             (v (gensym (symbol-name :val-))))
+        `(multiple-value-bind (,e ,v) ,(cpf pass context env)
+           (when ,e
+             (unless ,(cpf fail context env)
+               (values ,e ,v))))))))
+
+
 #|
 (defmacro defrule (name &body body)
   `(progn