Changeset 14871 in project


Ignore:
Timestamp:
06/03/09 13:09:08 (10 years ago)
Author:
Ivan Raikov
Message:

bug fixes in lexgen star

Location:
release/4/lexgen/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/lexgen/trunk/lexgen.scm

    r14868 r14871  
    105105(define (star p)
    106106  (lambda (a r streams)
    107     (let* ((r1 (lambda (streams1) (a (concatenate (list streams streams1)))))
    108            (a2 (lambda (streams1) (p (lambda (streams2) (a (concatenate (list streams streams1 streams2)))) r1 streams1)))
    109            (a1 (lambda (streams1) (p a2 r1 streams1))))
    110       (p a1 a streams))))
    111 
     107    (let ((a1 (lambda (streams1) (a (concatenate (list streams streams1))))))
     108      (p (lambda (streams1) (if (equal? streams streams1) (a streams1)
     109                                ((star p) a1 a1 streams1)))
     110         a streams))))
    112111
    113112;; The rest of these are built from the previous four and are provided
     
    115114
    116115;; this parser always succeeds
    117 (define (pass a r s)
    118   (a s))
     116(define (pass a r s) (a s))
    119117 
    120118;; Positive closure. Analogous to '+'
    121119
    122 (define (pos pat)
    123   (seq pat (star pat)))
     120(define (pos pat) (seq pat (star pat)))
    124121
    125122;; Optional pattern. Analogous to '?'
    126123
    127 (define (opt pat)
    128   (bar pat pass))
     124(define (opt pat) (bar pat pass))
    129125
    130126;; Converts a binary predicate procedure to a binary procedure that
  • release/4/lexgen/trunk/lexgen.setup

    r14868 r14871  
    1717
    1818  ;; Assoc list with properties for your extension:
    19   '((version 2.1)
     19  '((version 2.2)
    2020    (documentation "lexgen.html")
    2121    ))
  • release/4/lexgen/trunk/tests/run.scm

    r14868 r14871  
    4646
    4747            (test (sprintf "match a* on ~S" "aabac")
    48                   `((() (#\a #\a #\b #\a #\c)) ((#\a #\a) (#\b #\a #\c)))
     48                  `((() (#\a #\a #\b #\a #\c)) ((#\a ) (#\a #\b #\a #\c)) ((#\a #\a) (#\b #\a #\c)))
    4949                  (a-star-pat identity err aabac-stream))
    5050
    5151            (test (sprintf "match (a*|b) on ~S" "aabac")
    52                    `((() (#\a #\a #\b #\a #\c)) ((#\a #\a) (#\b #\a #\c)))
     52                   `((() (#\a #\a #\b #\a #\c)) ((#\a ) (#\a #\b #\a #\c)) ((#\a #\a) (#\b #\a #\c)))
    5353                   (a-star-or-b-pat identity err aabac-stream))
    5454
    5555            (test (sprintf "match (a|b)* on ~S" "abc")
    56                    `((() (#\a #\b #\c))  ((#\b #\a) (#\c)))
     56                   `((() (#\a #\b #\c))  ((#\a) (#\b #\c)) ((#\b #\a) (#\c)))
    5757                   (a-or-b-star-pat identity err abc-stream))
    5858
    5959            (test (sprintf "match (a|b)* on ~S" "aabac")
    60                    `((() (#\a #\a #\b #\a #\c)) ((#\a #\a) (#\b #\a #\c)) ((#\b #\a #\a) (#\a #\c)))
     60                   `((() (#\a #\a #\b #\a #\c)) ((#\a ) (#\a #\b #\a #\c)) ((#\a #\a) (#\b #\a #\c))
     61                     ((#\b #\a #\a) (#\a #\c)) ((#\a #\b #\a #\a) (#\c)))
    6162                   (a-or-b-star-pat identity err aabac-stream))
    6263
Note: See TracChangeset for help on using the changeset viewer.