Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add breadth first possibility search for find-after.

  • Loading branch information...
commit 99ad3eaf02428d853b95086c9c1034c07eaccb72 1 parent 3a66e1e
@Ramarren authored
Showing with 116 additions and 1 deletion.
  1. +1 −0  parser-combinators.asd
  2. +49 −1 parsers.lisp
  3. +66 −0 queue.lisp
View
1  parser-combinators.asd
@@ -6,6 +6,7 @@
:licence "BSD-style"
:depends-on (:iterate :alexandria :bpm)
:components ((:file "package")
+ (:file "queue" :depends-on ("package"))
(:file "contexts" :depends-on ("package"))
(:file "lazy" :depends-on ("package"))
(:file "basic" :depends-on ("package" "lazy"))
View
50 parsers.lisp
@@ -231,9 +231,57 @@
(chainr1? p op)
(result v)))
+(defclass result-node (parser-possibility)
+ ((emit :initarg :emit :initform t :accessor emit-of)
+ (up :initarg :up :initform nil :accessor up-of)
+ (count :initarg :count :initform 0 :accessor count-of)
+ (suffix-continuation :initarg :suffix-continuation :accessor suffix-continuation-of)))
+
+(defun gather-nodes (node)
+ (let ((nodes))
+ (iter (for current-node initially node then (up-of current-node))
+ (while current-node)
+ (when (emit-of current-node)
+ (push current-node nodes))
+ (finally (return nodes)))))
+
+(defun breadth? (parser min max &optional (result-type 'list))
+ "Parser: like between? but breadth first (shortest matches first)"
+ #'(lambda (inp)
+ (let ((queue (make-queue (list
+ (make-instance 'result-node
+ :suffix inp
+ :suffix-continuation (funcall parser inp)
+ :tree nil
+ :emit nil
+ :up nil))))
+ (node nil))
+ #'(lambda ()
+ (iter
+ (until (empty-p queue))
+ (setf node (pop-front queue))
+ (for count = (count-of node))
+ (iter (for result next (funcall (suffix-continuation-of node)))
+ (while result)
+ (for suffix = (suffix-of result))
+ (push-back queue (make-instance 'result-node
+ :suffix suffix
+ :suffix-continuation (funcall parser suffix)
+ :up node
+ :count (1+ count)
+ :tree (tree-of result))))
+ (when (and (emit-of node)
+ (or (null min)
+ (>= count min))
+ (or (null max)
+ (<= count max)))
+ (return (make-instance 'parser-possibility
+ :tree (map result-type #'tree-of (gather-nodes node))
+ :suffix (suffix-of node)))))))))
+
(defun find-after? (p q)
"Parser: Find first q after some sequence of p."
- (mdo (between? p nil nil nil)
+ (mdo (breadth? p nil nil nil)
q))
(defun find? (q)
View
66 queue.lisp
@@ -0,0 +1,66 @@
+(in-package :parser-combinators)
+
+(defclass queue ()
+ ((head :accessor head-of :initform nil)
+ (tail :accessor tail-of :initform nil)
+ (size :accessor size-of :initform 0)))
+
+(defun make-queue (&optional initial-contents)
+ (let ((queue (make-instance 'queue)))
+ (dolist (tk initial-contents queue)
+ (push-back queue tk))))
+
+(defgeneric peek (collection) (:documentation "Return top element without removing it"))
+
+(defgeneric empty-p (collection) (:documentation "True if collection is empty"))
+
+(defgeneric push-front (collection value) (:documentation "Push value to the front"))
+
+(defgeneric pop-front (collection) (:documentation "Remove and return value from the front"))
+
+(defgeneric push-back (collection value) (:documentation "Push value to the back"))
+
+(defgeneric peek-back (collection) (:documentation "Return value from the back without removing it"))
+
+(defmethod empty-p ((queue queue))
+ (zerop (size-of queue)))
+
+(defmethod peek ((queue queue))
+ (if (empty-p queue)
+ (values nil nil)
+ (values (car (head-of queue)) t)))
+
+(defmethod peek-back ((queue queue))
+ (if (empty-p queue)
+ (values nil nil)
+ (values (car (tail-of queue)) t)))
+
+(defmethod push-front ((queue queue) value)
+ (setf (head-of queue) (cons value (head-of queue)))
+ (unless (tail-of queue)
+ (setf (tail-of queue) (head-of queue)))
+ (incf (size-of queue))
+ queue)
+
+(defmethod pop-front ((queue queue))
+ (if (empty-p queue)
+ (values nil nil)
+ (let ((front (car (head-of queue))))
+ (setf (head-of queue) (cdr (head-of queue)))
+ (unless (head-of queue)
+ (setf (tail-of queue) nil))
+ (decf (size-of queue))
+ (values front nil))))
+
+(defmethod push-back ((queue queue) value)
+ (let ((new-cons (cons value nil)))
+ (when (tail-of queue)
+ (setf (cdr (tail-of queue)) new-cons))
+ (setf (tail-of queue) new-cons)
+ (unless (head-of queue)
+ (setf (head-of queue) new-cons)))
+ (incf (size-of queue))
+ queue)
+
+(defun queue-to-list (queue)
+ (head-of queue))
Please sign in to comment.
Something went wrong with that request. Please try again.