Changeset 14956 in project

Timestamp:

06/10/09 04:40:07 (11 years ago)

Author:

Ivan Raikov

Message:

using lset<= instead of equal? to compare input streams in lexgen

Location:

release/4/lexgen/trunk

Files:

• lexgen.scm (modified) (4 diffs)
• tests/run.scm (modified) (2 diffs)

release/4/lexgen/trunk/lexgen.scm

@@ -46 +46 @@
     cps-table longest lex )
 
+
+  (import scheme chicken data-structures srfi-14 srfi-69)
   (require-library srfi-1)
-
-  (import scheme chicken data-structures
-          (only srfi-1 first second filter-map fold concatenate) 
-          srfi-14 srfi-69)
+  (import (only srfi-1 first second filter-map fold concatenate lset<= ))
   (require-extension matchable)
 
@@ -81 +80 @@
                     ((c (h . r)) 
                      (let ((ans (p t h)))
-                       (and ans (list (cons ans c) r))))
-                    ((c ())  s)
+                        (and ans (list (cons ans c) r))))
                     (else #f)))))
     (lambda (cont streams)
@@ -102 +100 @@
   (lambda (cont streams)
     (let ((cont1 (lambda (streams1) 
-                   (if (null? streams1) (p2 cont streams) (cont streams1)))))
+                   (if (lset<= equal? streams1 streams) (p2 cont streams) (cont streams1)))))
       (p1 cont1 streams))))
-
 
 ;; Kleene closure. Analogous to '*' 
@@ -113 +110 @@
         (let ((cont1 (lambda (streams1) (cont (concatenate (list streams streams1))))))
           (p (lambda (streams1) 
-               (cond ((equal? streams streams1) (cont streams))
+               (cond ((lset<= equal? streams1 streams) (cont streams))
                      (else  ((star p) cont1 streams1))))
              streams)))))

release/4/lexgen/trunk/tests/run.scm

@@ -68 +68 @@
                    (a-or-b-star-pat identity  aabac-stream))
 
+            (test (sprintf "match ab? on ~S" "abc") 
+                   `(((#\b #\a) (#\c)) )
+                   (a-b-opt-pat identity  abc-stream))
+
             (test (sprintf "match ab? on ~S" "aabac") 
                    `(((#\a) (#\a #\b #\a #\c)) )
                    (a-b-opt-pat identity  aabac-stream))
 
-            (test (sprintf "match ab? on ~S" "abc") 
-                   `(((#\b #\a) (#\c)) )
-                   (a-b-opt-pat identity  abc-stream))
-
             (test (sprintf "match a*b? on ~S" "aabac") 
-                   `(((#\b #\a #\a) (#\a #\c)) )
+                   `(((#\b #\a #\a) (#\a #\c)))
                    (a-star-b-opt-pat identity aabac-stream))
 
@@ -107 +107 @@
          (sign         (opt (char #\-))))
     (seq sign (seq significand (opt exp)))))
-
 
 (test-group "lexgen numpat test"