Changeset 14887 in project


Ignore:
Timestamp:
06/05/09 08:35:20 (10 years ago)
Author:
Ivan Raikov
Message:

bug fix in lexgen range

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

Legend:

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

    r14885 r14887  
    150150(define (range a b)
    151151  (if (char<? b a) (range b a)
    152       (set (ucs-range->char-set
    153             (char->integer a) (char->integer b)))))
     152      (set (ucs-range->char-set (char->integer a) (+ 1 (char->integer b))))))
    154153
    155154;; Matches a consecutive list of patterns
     
    159158    (let loop ((ps (cdr ps)) (p1 (car ps)))
    160159      (cond ((null? ps) p1)
    161             ((null? (cdr ps))    (seq (car ps) p1))
    162160            (else (loop (cdr ps) (seq (car ps) p1)))))))
    163161 
     
    215213      (if (not (table-ref memo arg  #f))
    216214          (let ((memo-table (make-table)))
    217             (print "miss: arg = " arg)
    218215            (table-put! memo arg memo-table)
    219216            (f (lambda (result)
    220                  (print "miss: result = " result)
    221217                 (if (null? result) (k result)
    222218                     (let* ((len     (length result))
    223219                            (old-len (table-ref memo-table result #f))
    224220                            (new-len (combine (or old-len 0) len)))
    225                        (print "len = " len)
    226                        (print "old-len = " old-len)
    227                        (print "new-len = " new-len)
    228221                       (if (not (equal? old-len new-len))
    229222                           (begin
     
    234227               arg))
    235228          (let ((memo-table (table-ref memo arg #f) ))
    236             (print "hit: arg = " arg)
    237229            (table-for-each memo-table (lambda (result len) (k result)))
    238230            )))))
  • release/4/lexgen/trunk/tests/run.scm

    r14885 r14887  
    1414(define aabac-pat (lit "aabac"))
    1515(define aa-pat (lit "aa"))
     16(define n4-pat (lst (list-tabulate 4 (lambda (i) (range #\0 #\9)))))
    1617
    1718(define aa-star-memo-pat (star (cps-table  aa-pat (try <))))
     
    2122(define aabac-stream    (list `(() ,(string->list "aabac"))))
    2223(define aaaabac-stream  (list `(() ,(string->list "aaaabac"))))
     24(define num-stream      (list `(() ,(string->list "1234"))))
    2325
    2426(define (err s)
     
    8890                     res))
    8991
     92            (test (sprintf "match n4 on  ~S" "1234")
     93                   `(((#\4 #\3 #\2 #\1) ()) )
     94                   (n4-pat identity num-stream))
     95
     96
    9097            )
    9198;; A pattern to match floating point numbers.
     
    103110
    104111(test-group "lexgen numpat test"
    105             (test (sprintf "match numpat on ~S" "-3.45e-6")
    106                    `((#\- #\3 #\. #\4 #\5 #\e #\- #\6) ()) (lex numpat err "-3.45e-6"))
     112            (test (sprintf "match numpat on ~S" "-123.45e-6")
     113                   `((#\- #\1 #\2 #\3 #\. #\4 #\5 #\e #\- #\6) ()) (lex numpat err "-123.45e-6"))
    107114            (test (sprintf "match numpat on ~S" "hi there")
    108115                  #f (lex numpat err "hi there")))
     
    112119(define (bind f p)
    113120  (lambda (cont s)
    114     (let ((cont1 (lambda (s1)
    115                 (match (longest s1)
    116                        ((eaten food)
    117                         (let ((x (f eaten)))
    118                           (cont `((,x ,food)))))
    119                        (else #f)))))
     121    (let ((cont1
     122           (lambda (s1)
     123             (match (longest s1)
     124                    ((eaten food)
     125                     (let ((x (f eaten)))
     126                       (if x (cont `((,x ,food))) (cont `((,eaten ,food))))))
     127                    (else #f)))))
    120128      (p cont1 s))))
    121129           
    122 (define ($ cs)
     130(define (collect cs)
    123131  (let loop ((cs cs) (ax (list)))
    124132    (cond ((null? cs)         `(,(list->string ax)))
     
    127135
    128136(define (make-exp x)
    129   (or (and (pair? x) (let ((x1 ($ x)))
     137  (or (and (pair? x) (let ((x1 (collect x)))
    130138                       (cons `(exp ,(car x1)) (cdr x1)))) x))
    131139
    132140(define (make-significand x)
    133   (or (and (pair? x) (let ((x1 ($ x)))
     141  (or (and (pair? x) (let ((x1 (collect x)))
    134142                       (cons `(significand ,(car x1)) (cdr x1)))) x))
    135143
    136144(define (make-sign x)
    137   (or (and (pair? x) (let ((x1 ($ x)))
     145  (or (and (pair? x) (let ((x1 (collect x)))
    138146                       (cons `(sign ,(car x1)) (cdr x1)))) x))
    139147
     
    152160
    153161(test-group "lexgen num-parser test"
    154             (test (sprintf "match num-parser on ~S" "-3.45e-6")
    155                    `((sign "-") (significand "3.45") (exp "e-6"))
    156                    (num-parser "-3.45e-6"))
     162            (test (sprintf "match num-parser on ~S" "-123.45e-6")
     163                   `((sign "-") (significand "123.45") (exp "e-6"))
     164                   (num-parser "-123.45e-6"))
    157165            )
    158166
Note: See TracChangeset for help on using the changeset viewer.