source: project/release/4/lexgen/trunk/tests/run.scm @ 14699

Last change on this file since 14699 was 14699, checked in by Ivan Raikov, 10 years ago

added num-parser test

File size: 3.0 KB
Line 
1
2(require-extension chicken lexgen srfi-1 srfi-14 matchable test)
3
4
5(define a-pat (tok #\a (try char=?)))
6(define b-pat (tok #\b (try char=?)))
7(define a-then-b-pat (seq (list a-pat b-pat)))
8(define a-or-b-pat (seq (list a-pat b-pat)))
9(define a-star-pat (star a-pat))
10 
11(define abc-stream (list `(() ,(string->list "abc"))))
12
13(print (a-pat abc-stream))
14
15(test-group "lexgen test"
16            (test (sprintf "match [a] on ~S" "abc") 
17                   `(((#\a) (#\b #\c))) (a-pat abc-stream))
18            (test (sprintf "match [b] on ~S" "abc") 
19                   `() (b-pat abc-stream))
20            (test (sprintf "match ab on ~S" "abc") 
21                   `(((#\b #\a ) ( #\c))) (a-then-b-pat abc-stream))
22            (test (sprintf "match a|b on ~S" "abc") 
23                   `(((#\b #\a ) ( #\c))) (a-or-b-pat abc-stream))
24            (test (sprintf "match a* on ~S" "abc") 
25                   `((() (#\a #\b #\c)) ((#\a) (#\b #\c))) (a-star-pat abc-stream))
26            )
27
28
29;; A pattern to match floating point numbers.
30;; "-"?(([0-9]+(\\.[0-9]+)?)|(\\.[0-9]+))([eE][+-]?[0-9]+)?
31
32(define numpat
33  (let* ((digit        (range #\0 #\9))
34         (digits       (pos digit))
35         (fraction     (seq `(,(char #\.) ,digits)))
36         (significand  (bar `(,(seq `(,digits ,(opt fraction))) ,fraction)))
37         (exp          (seq `(,(set "eE") ,(opt (set "+-")) ,digits)))
38         (sign         (opt (char #\-)) ))     
39    (seq `(,sign ,(seq `(,significand ,(opt exp)))))))
40
41(test-group "lexgen numpat test"
42            (test (sprintf "match numpat on ~S" "-3.45e-6")
43                   `((#\- #\3 #\. #\4 #\5 #\e #\- #\6) ()) (lex numpat "-3.45e-6"))
44            (test (sprintf "match numpat on ~S" "hi there")
45                  #f (lex numpat "hi there")))
46
47
48(define (->char-list 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 (make-exp x)
67  (or (and (pair? x) (let ((x1 ($ x)))
68                       (cons `(exp ,(car x1)) (cdr x1)))) x))
69
70(define (make-significand x)
71  (or (and (pair? x) (let ((x1 ($ x)))
72                       (cons `(significand ,(car x1)) (cdr x1)))) x))
73
74(define (make-sign x)
75  (or (and (pair? x) (let ((x1 ($ x)))
76                       (cons `(sign ,(car x1)) (cdr x1)))) x))
77
78
79(define (num-parser 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 make-sign sign) ,(bind make-significand significand) ,(bind make-exp (opt exp))))))
87    (reverse (car (longest (pat `((() ,(->char-list s)))))))))
88
89
90(test-group "lexgen num-parser test"
91            (test (sprintf "match num-parser on ~S" "-3.45e-6")
92                   `((sign "-") (significand "3.45") (exp "e-6"))
93                   (num-parser "-3.45e-6"))
94            )
Note: See TracBrowser for help on using the repository browser.