Changeset 14699 in project


Ignore:
Timestamp:
05/19/09 04:00:32 (10 years ago)
Author:
Ivan Raikov
Message:

added num-parser test

File:
1 edited

Legend:

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

    r14685 r14699  
    11
    2 (require-extension lexgen srfi-1 srfi-14 test)
     2(require-extension chicken lexgen srfi-1 srfi-14 matchable test)
    33
    44
     
    3939    (seq `(,sign ,(seq `(,significand ,(opt exp)))))))
    4040
    41 (test-group "lexgen lex test"
    42             (test (sprintf "match numpat on ~S" "3.45e-6")
    43                    `((#\3 #\. #\4 #\5 #\e #\- #\6) ()) (lex numpat "3.45e-6"))
     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"))
    4444            (test (sprintf "match numpat on ~S" "hi there")
    4545                  #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 TracChangeset for help on using the changeset viewer.