Changeset 14956 in project
- Timestamp:
- 06/10/09 04:40:07 (11 years ago)
- Location:
- release/4/lexgen/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/lexgen/trunk/lexgen.scm
r14944 r14956 46 46 cps-table longest lex ) 47 47 48 49 (import scheme chicken data-structures srfi-14 srfi-69) 48 50 (require-library srfi-1) 49 50 (import scheme chicken data-structures 51 (only srfi-1 first second filter-map fold concatenate) 52 srfi-14 srfi-69) 51 (import (only srfi-1 first second filter-map fold concatenate lset<= )) 53 52 (require-extension matchable) 54 53 … … 81 80 ((c (h . r)) 82 81 (let ((ans (p t h))) 83 (and ans (list (cons ans c) r)))) 84 ((c ()) s) 82 (and ans (list (cons ans c) r)))) 85 83 (else #f))))) 86 84 (lambda (cont streams) … … 102 100 (lambda (cont streams) 103 101 (let ((cont1 (lambda (streams1) 104 (if ( null? streams1) (p2 cont streams) (cont streams1)))))102 (if (lset<= equal? streams1 streams) (p2 cont streams) (cont streams1))))) 105 103 (p1 cont1 streams)))) 106 107 104 108 105 ;; Kleene closure. Analogous to '*' … … 113 110 (let ((cont1 (lambda (streams1) (cont (concatenate (list streams streams1)))))) 114 111 (p (lambda (streams1) 115 (cond (( equal? streams streams1) (cont streams))112 (cond ((lset<= equal? streams1 streams) (cont streams)) 116 113 (else ((star p) cont1 streams1)))) 117 114 streams))))) -
release/4/lexgen/trunk/tests/run.scm
r14887 r14956 68 68 (a-or-b-star-pat identity aabac-stream)) 69 69 70 (test (sprintf "match ab? on ~S" "abc") 71 `(((#\b #\a) (#\c)) ) 72 (a-b-opt-pat identity abc-stream)) 73 70 74 (test (sprintf "match ab? on ~S" "aabac") 71 75 `(((#\a) (#\a #\b #\a #\c)) ) 72 76 (a-b-opt-pat identity aabac-stream)) 73 77 74 (test (sprintf "match ab? on ~S" "abc")75 `(((#\b #\a) (#\c)) )76 (a-b-opt-pat identity abc-stream))77 78 78 (test (sprintf "match a*b? on ~S" "aabac") 79 `(((#\b #\a #\a) (#\a #\c)) 79 `(((#\b #\a #\a) (#\a #\c))) 80 80 (a-star-b-opt-pat identity aabac-stream)) 81 81 … … 107 107 (sign (opt (char #\-)))) 108 108 (seq sign (seq significand (opt exp))))) 109 110 109 111 110 (test-group "lexgen numpat test"
Note: See TracChangeset
for help on using the changeset viewer.