add tests for "zero-or-more" patterns; lots of very small tweaks

Author: fstamour

src/analysis.lisp

@@ -92,6 +92,12 @@
 (defmethod match (pattern (state state) &key skipp)
   (match-parser-state pattern state :skipp skipp))
 
+(defmethod match ((pattern null) (state state) &key skipp)
+  "Nil should not match a parse-tree (use an empty vector as pattern to
+match an empty parse tree."
+  (declare (ignore skipp))
+  nil)
+
 (defmethod match ((pattern symbol) (state state) &key skipp)
   (declare (ignore skipp))
   ;; These should return nil because we're trying to match 1 symbol
@@ -151,24 +157,25 @@
   (unless (donep node-iterator)
     (breeze.pattern::make-binding pattern (copy-iterator node-iterator))))
 
-(defmethod match ((pattern repetition) (node-iterator node-iterator) &key skipp)
-  (when skipp (breeze.pattern::skip node-iterator skipp))
-  (unless (donep node-iterator)
+(defmethod match ((pattern repetition) (iterator node-iterator) &key skipp)
+  (when skipp (breeze.pattern::skip iterator skipp))
+  (unless (donep iterator)
     (loop
-      :with bindings := t ;; (make-binding-set)
+      ;; :with bindings := t ;; (make-binding-set)
       :with $pattern := (make-pattern-iterator
                          (repetition-pattern pattern))
       ;; TODO update node-iterator on match
-      :with $input := (copy-iterator node-iterator)
+      :with $input := (copy-iterator iterator)
       :for $prev-input := (copy-iterator $input)
-        :then  (copy-iterator $input $prev-input)
+        :then (copy-iterator $input $prev-input)
       :for i :from 0 :below 100 ;; TODO removve infinite loop guard
 
       :for new-bindings = (progn
                             (reset $pattern)
                             (match $pattern $input :skipp skipp))
+      :when new-bindings
+        :collect new-bindings :into bindings
       :do
-         ;;(break)
          ;; No more input or, no match
          (when (or
                 ;; no more input
@@ -183,17 +190,22 @@
                ;; (break "i: ~s new-bindings: ~s" i new-bindings)
                (if (and (zerop i) (not new-bindings))
                    t
-                   (let (($start (copy-iterator node-iterator))
+                   (let (($start (copy-iterator iterator))
                          ($end
                            ;; if it was a match, include the current position,
                            ;; otherwise stop at the previous one.
                            (if new-bindings $input $prev-input)))
-                     ;; update node-iterator
-                     (copy-iterator $end node-iterator)
-                     #++ (return bindings)
+                     ;; update iterator
+                     (copy-iterator $end iterator)
                      ;; TODO return an object (iterator-range? +
                      ;; binding-sets???)
-                     (cons $start $end))))))
+                     (make-binding
+                      pattern
+                      (list
+                       :bindings bindings
+                       :$start $start
+                       :$end $end
+                       :times i)))))))
       #++
        (when new-bindings
          ;; collect all the bindings

src/command.lisp

@@ -685,7 +685,7 @@ resulting string to the editor."
   (let ((doc (documentation function 'function)))
     (unless doc
       (error
-       "Function ~s does not have a documentation string.~
+       "Function ~s does not have a documentation string. ~
                   Is it defined?"
        function))
     doc))

src/completion.lisp

@@ -16,8 +16,10 @@
 ;; "quickfix", and it shouldn't generate an interactive command when
 (define-command completions-at-point (&optional string)
   "completion-at-point"
+  (declare (ignorable string))
   (let* (($node (node-iterator (current-buffer)))
          (node (breeze.iterator:value $node)))
+    (declare (ignorable node))
     ;; (break "~s" (breeze.lossless-reader:node-string $node))
     (return-value-from-command
      (list "prin1" "print")

src/iterator.lisp

@@ -60,7 +60,8 @@ generalization of that first iteration (ha!).
    #:root-value)
   ;; Functions for recursive-iterator
   (:export
-   #:go-down)
+   #:go-down
+   #:go-up)
   ;; Other utility functions
   (:export
    #:firstp
@@ -305,9 +306,9 @@ If APPLY-FILTER-TO-ITERATOR-P is non-nil, the predicate FILTER-IN will be applie
 
 (defmethod print-object ((iterator nested-vector-iterator) stream)
   (print-unreadable-object
-      (iterator stream :type nil :identity t)
+      (iterator stream :type t :identity t)
     (with-slots (depth positions) iterator
-        (format stream "nested-vector-iterator depth: ~s pos: ~s" depth positions))))
+        (format stream "depth: ~s pos: ~s" depth positions))))
 
 (defun make-nested-vector-iterator (vector)
   "Create a new depth-first iterator on VECTOR."
@@ -496,6 +497,11 @@ If APPLY-FILTER-TO-ITERATOR-P is non-nil, the predicate FILTER-IN will be applie
                                       value-to-dig-in))
                      t))))
 
+(defmethod go-up ((iterator recursive-iterator))
+  (when (lastp iterator)
+    (unless (zerop (slot-value iterator 'depth))
+      (pop-vector iterator))))
+
 
 
 (defclass pre-order-iterator (recursive-iterator) ())

src/pattern.lisp

@@ -18,7 +18,8 @@
            #:repetition-max
            #:make-pattern-iterator)
   ;; Working with match results
-  (:export #:merge-sets-of-bindings
+  (:export #:make-binding
+           #:merge-sets-of-bindings
            #:find-binding
            #:binding
            #:from
@@ -120,6 +121,13 @@
              (mb (repetition-max a)))
          (or (eq ma mb) (and (numberp ma) (numberp mb)) (= ma mb)))))
 
+(defmethod print-object ((repetition repetition) stream)
+  (print-unreadable-object
+      (repetition stream :type t :identity t)
+    (format stream "[~s-~s]"
+            (repetition-min repetition)
+            (repetition-max repetition))))
+
 (defun maybe (pattern)
   (repetition pattern 0 1))
 
@@ -141,6 +149,12 @@
        (pattern= (alternation-pattern a)
                  (alternation-pattern b))))
 
+(defmethod print-object ((alternation alternation) stream)
+  (print-unreadable-object
+      (alternation stream :type t :identity t)
+    ;; (format stream "~s" (alternation-something alternation))
+    ))
+
 
 ;;; Pattern comparison
 
@@ -421,8 +435,8 @@ bindings and keeping only those that have not conflicting bindings."
     (make-binding pattern input)))
 
 ;; Recurse into a referenced pattern
-(defmethod match ((pattern ref) input &key)
-  (match (ref-pattern pattern) input))
+(defmethod match ((pattern ref) input &key skipp)
+  (match (ref-pattern pattern) input :skipp skipp))
 
 ;; Match a string literal
 (defmethod match ((pattern string) (input string) &key)
@@ -465,6 +479,8 @@ bindings and keeping only those that have not conflicting bindings."
                 (funcall skipp $input))
         :do (next $input :dont-recurse-p t)))
 
+;; TODO rename $input to iterator; :with $input = copy iterator, copy
+;; back if match is successful
 (defmethod match (($pattern pattern-iterator) ($input iterator) &key skipp)
   (loop
     :with bindings = t ;; (make-binding-set)
@@ -548,7 +564,6 @@ bindings and keeping only those that have not conflicting bindings."
                           (reset $pattern)
                           (match $pattern $input :skipp skipp))
     :do
-       ;;(break)
        ;; No more input or, no match
        (when (or
               ;; no more input