Changeset 14699 in project
 Timestamp:
 05/19/09 04:00:32 (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/lexgen/trunk/tests/run.scm
r14685 r14699 1 1 2 (requireextension lexgen srfi1 srfi14test)2 (requireextension chicken lexgen srfi1 srfi14 matchable test) 3 3 4 4 … … 39 39 (seq `(,sign ,(seq `(,significand ,(opt exp))))))) 40 40 41 (testgroup "lexgen lextest"42 (test (sprintf "match numpat on ~S" " 3.45e6")43 `((#\ 3 #\. #\4 #\5 #\e #\ #\6) ()) (lex numpat "3.45e6"))41 (testgroup "lexgen numpat test" 42 (test (sprintf "match numpat on ~S" "3.45e6") 43 `((#\ #\3 #\. #\4 #\5 #\e #\ #\6) ()) (lex numpat "3.45e6")) 44 44 (test (sprintf "match numpat on ~S" "hi there") 45 45 #f (lex numpat "hi there"))) 46 47 48 (define (>charlist s) 49 (if (string? s) (string>list s) s)) 50 51 (define (bind f p) 52 (lambda (s) 53 (let ((s1 (p s))) 54 (match (longest (p s)) 55 ((eaten food) 56 (let ((x (f eaten))) 57 (and x `((,x ,food))))) 58 (else #f))))) 59 60 (define ($ cs) 61 (let loop ((cs cs) (ax (list))) 62 (cond ((null? cs) `(,(list>string ax))) 63 ((atom? (car cs)) (loop (cdr cs) (cons (car cs) ax))) 64 (else (cons (list>string ax) cs))))) 65 66 (define (makeexp x) 67 (or (and (pair? x) (let ((x1 ($ x))) 68 (cons `(exp ,(car x1)) (cdr x1)))) x)) 69 70 (define (makesignificand x) 71 (or (and (pair? x) (let ((x1 ($ x))) 72 (cons `(significand ,(car x1)) (cdr x1)))) x)) 73 74 (define (makesign x) 75 (or (and (pair? x) (let ((x1 ($ x))) 76 (cons `(sign ,(car x1)) (cdr x1)))) x)) 77 78 79 (define (numparser s) 80 (let* ((digit (range #\0 #\9)) 81 (digits (star digit)) 82 (fraction (seq `(,(char #\.) ,digits))) 83 (significand (bar `(,(seq `(,digits ,(opt fraction))) ,fraction))) 84 (exp (seq `(,(set "eE") ,(opt (set "+")) ,digits))) 85 (sign (opt (char #\)) ) 86 (pat (seq `(,(bind makesign sign) ,(bind makesignificand significand) ,(bind makeexp (opt exp)))))) 87 (reverse (car (longest (pat `((() ,(>charlist s))))))))) 88 89 90 (testgroup "lexgen numparser test" 91 (test (sprintf "match numparser on ~S" "3.45e6") 92 `((sign "") (significand "3.45") (exp "e6")) 93 (numparser "3.45e6")) 94 )
Note: See TracChangeset
for help on using the changeset viewer.