Changeset 15981 in project


Ignore:
Timestamp:
09/20/09 06:28:41 (10 years ago)
Author:
Ivan Raikov
Message:

the beginning of a stream-polymorphic lexgen

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

Legend:

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

    r15973 r15981  
    7676;; elements.
    7777
    78 (define (tok t p)
    79   (let ((f (lambda (s)
    80              (match s
    81                     ((c (h . r))
    82                      (let ((ans (p t h)))
     78(define (tok t p )
     79   (let ((f (lambda (s)
     80              (match s
     81                     ((c (h . r))
     82                      (let ((ans (p t h)))
    8383                        (and ans (list (cons ans c) r))))
    84                     (else #f)))))
    85     (lambda (cont streams)
    86       (let ((streams1 (filter-map f streams)))
    87         (cont streams1)))))
     84
     85                     ((c (h . r) succ)
     86                      (let ((ans (p t h)))
     87                        (and ans (cons (cons ans c) (succ r)))))
     88
     89                     (else #f)))))
     90     (lambda (cont streams)
     91       (let ((streams1 (filter-map f streams)))
     92         (cont streams1)))))
    8893   
    8994
     
    185190(define-inline (bind-apply f)
    186191  (lambda (s)
    187     (match s ((eaten food)
    188               (match-let (((eaten1 eaten0) (split-at-last eaten)))
     192    (cond ((pair? s)
     193           (let ((eaten (car s))
     194                 (food  (cdr s)))
     195             (match-let (((eaten1 eaten0) (split-at-last eaten)))
    189196                 (assert (box? eaten0))
    190197                 (let* ((x   (f eaten1))
    191                         (res (if x (list (append x (unbox eaten0)) food)
    192                                  (list (unbox eaten0) food))))
    193                    res)))
     198                        (res (if x (cons (append x (unbox eaten0)) food)
     199                                 (cons (unbox eaten0) food))))
     200                   res))))
    194201           (else s))))
     202
     203(define-inline (box-stream s)
     204  (cond ((pair? s)
     205         (let ((eaten (car s))
     206               (food  (cdr s)))
     207           (cons (list (box eaten)) food)))
     208        (else s)))
    195209
    196210;; Binds a procedure f to the consumed tokens returned by p
    197211(define (bind f p)
    198212    (lambda (cont ss)
    199       (let ((ss1 (map (lambda (s)
    200                        (match s
    201                               ((eaten food)  (list (list (box eaten)) food))
    202                               (else s)))
    203                      ss))
    204             (cont1 (lambda (ss)
    205                      (let ((ss1 (map (bind-apply f) ss)))
    206                        (cont ss1)))))
     213      (let ((ss1    (map box-stream ss))
     214            (cont1  (lambda (ss)
     215                      (let ((ss1 (map (bind-apply f) ss)))
     216                        (cont ss1)))))
    207217        (p cont1 ss1))))
    208218
     
    220230               (fold (lambda (stream max)
    221231                       (match (list stream max)
    222                               (((eaten food) (max-count max-stream))
     232                              (((eaten . _) (max-count max-stream))
    223233                               (if (< max-count (length eaten))
    224234                                   (list (length eaten) stream) max))
     
    241251
    242252(define (->char-list s)
    243   (if (string? s) (string->list s) s))
     253  (if (string? s) (list (string->list s)) s))
    244254
    245255(define (lex pat error s)
    246256  (let* ((stream (->char-list s))
    247          (res    (longest0 (pat (lambda (s1) (if (null? s1) (error s) s1)) `((() ,stream))))))
     257         (res    (longest0 (pat (lambda (s1) (if (null? s1) (error s) s1)) `((() . ,stream))))))
    248258    (and res (list (reverse (first res)) (second res)))))
    249259
  • release/4/lexgen/trunk/lexgen.setup

    r15973 r15981  
    1717
    1818  ;; Assoc list with properties for your extension:
    19   '((version 2.6)
     19  '((version 3.0)
    2020    (documentation "lexgen.html")
    2121    ))
Note: See TracChangeset for help on using the changeset viewer.