Permalink
Browse files

Fix curtail?

  • Loading branch information...
1 parent ece08c2 commit 77b405bb6291a86a259bbb96a580084b71ae041d @Ramarren committed Feb 2, 2011
Showing with 22 additions and 21 deletions.
  1. +0 −2 basic.lisp
  2. +18 −19 recurse.lisp
  3. +4 −0 test-parsers.lisp
View
@@ -101,13 +101,11 @@
(with-unique-names (ignore-gensym)
(do-notation spec 'bind ignore-gensym)))
-(defparameter *curtail-table* (make-hash-table))
(defparameter *memo-table* (make-hash-table))
(defun parse-string (parser string)
"Parse a string, return a PARSE-RESULT object. All returned values may share structure."
(let ((*memo-table* (make-hash-table))
- (*curtail-table* (make-hash-table))
(context (make-context string)))
(values (make-parse-result (funcall parser context))
(front-of context))))
View
@@ -1,21 +1,20 @@
(in-package :parser-combinators)
-(defun curtail? (parser &optional (label (gensym)))
- "Add recursion curtailing to promise."
- (unless (gethash label *curtail-table*)
- (setf (gethash label *curtail-table*) (make-hash-table)))
- (let ((curtail-table (gethash label *curtail-table*)))
- (labels ((curtailed (inp)
- (multiple-value-bind (counter counter-p) (gethash (position-of inp) curtail-table)
- (cond (counter-p
- (destructuring-bind (c . l) counter
- (cond ((>= c (1+ l))
- (funcall (zero) inp))
- (t
- (incf (car counter))
- (funcall parser inp)))))
- (t
- (setf (gethash (position-of inp) curtail-table)
- (cons 1 (- (length-of inp) (position-of inp))))
- (funcall parser inp))))))
- #'curtailed)))
+;; This is a hack, really.
+(defvar *curtail* nil)
+
+(defmacro curtail? (name &body body)
+ "Parser modifier: add recursion curtailing to PARSER, naming the curtailed parser NAME. Left
+recursive parser parser will only be nested once per remaining length of the input string. Note:
+this is only necessary for a limited class of left recursive parsers. Non-left recursive parsers
+should be implemented using just `named?`, and most left-recursive parsers using that in combination
+with `chainl1?`. Also see `expression?`."
+ (with-unique-names (inp curtail)
+ `(named? ,name
+ #'(lambda (,inp)
+ (let ((,curtail (if *curtail* *curtail* 0)))
+ (if (>= (+ ,curtail (position-of ,inp))
+ (length-of ,inp))
+ (funcall (zero) ,inp)
+ (let ((*curtail* (1+ ,curtail)))
+ (funcall ,@body ,inp))))))))
View
@@ -289,3 +289,7 @@
("AA(A(AA)A)A" '(#\A #\A (#\A (#\A #\A) #\A) #\A)
"AAAA" '(#\A #\A #\A #\A))
("BAF"))
+
+(defparsertest test-curtail? (curtail? e (choice (seq-list? e #\+ e) #\A))
+ ("A" #\A "A+A" '(#\A #\+ #\A) "A+A+A" '((#\A #\+ #\A) #\+ #\A))
+ ())

0 comments on commit 77b405b

Please sign in to comment.