Changeset 13288 in project


Ignore:
Timestamp:
02/13/09 07:46:58 (11 years ago)
Author:
Ivan Raikov
Message:

Added procedures tok and try.

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

Legend:

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

    r13284 r13288  
    4646 (inline)
    4747 (lambda-lift)
    48  (export pred seq star bar
     48 (export tok seq star bar
    4949         pos opt char set
    5050         set range lit longest
     
    5858
    5959;;
    60 ;;   This is a lexer generator comprised in its core of only four
    61 ;;   small functions. The programmer assembles these functions into
    62 ;;   regular expression pattern-matching functions.
     60;;   This is a lexer generator comprised in its core of four small
     61;;   functions. The programmer assembles these functions into regular
     62;;   expression pattern-matching functions.
    6363;;
    6464;;   The idea is that a pattern matcher function takes a list of
     
    6666;;   combination allowed by the pattern matcher function. In this
    6767;;   implementation, a stream is simply a tuple containing a list of
    68 ;;   characters consumed by the pattern matcher, and a list of
    69 ;;   characters not yet consumed.
     68;;   elements consumed by the pattern matcher, and a list of
     69;;   characters not yet consumed. 
    7070;;
    7171;;   Note that the number of streams returned by the function
     
    7474;;
    7575
    76 ;; The first function 'pred' builds a pattern matcher function that
    77 ;; applies a predicate to a given token and an input character.
     76;; 'tok' builds a pattern matcher function that applies procedure p to
     77;; a given token and an input character. If the procedure returns a
     78;; true value, that value is prepended to the list of consumed
     79;; elements, and the input character is removed from the list of input
     80;; elements.
    7881
    79 (define (pred t p)
     82(define (tok t p)
    8083  (let ((f (lambda (s)
    81              (match s ((s (h . r)) (if (p t h) (list (cons h s) r) #f))
     84             (match s ((s (h . r))
     85                       (let ((ans (p t h)))
     86                         (and ans (list (cons ans s) r))))
    8287                    (else #f)))))
    8388    (lambda (streams)
     
    124129  (bar (list pat identity)))
    125130
     131;; Converts a binary predicate procedure to a binary procedure that
     132;; returns its right argument when the predicate is true, and false
     133;; otherwise.
     134
     135(define (try p) (lambda (x y) (let ((res (p x y))) (and res y))))
     136
    126137;; Matches a single character
    127138
    128 (define (char c)
    129   (pred c char=?))
     139(define (char c) (tok c (try char=?)))
    130140 
    131141;; Matches any of a SRFI-14 set of characters.
     
    133143(define (set s)
    134144  (let ((cs (if (char-set? s) s (list->char-set (if (string? s) (string->list s) s)))))
    135     (pred cs char-set-contains?)))
     145    (tok cs (try char-set-contains?))))
    136146
    137147;; Range of characters. Analogous to character class '[]'
     
    145155
    146156(define (lit s)
    147   (seq (map (lambda (t) (pred t char=?)) (if (string? s) (string->list s) s))))
     157  (let ((f (lambda (t) (tok t (try char=?)))))
     158    (seq (map f (if (string? s) (string->list s) s)))))
    148159
    149160
  • release/3/lexgen/trunk/tests/run.scm

    r13244 r13288  
    77
    88
    9 (define a-pat (pred #\a char=?))
    10 (define b-pat (pred #\b char=?))
     9(define a-pat (tok #\a (try char=?)))
     10(define b-pat (tok #\b (try char=?)))
    1111(define a-then-b-pat (seq (list a-pat b-pat)))
    1212(define a-or-b-pat (seq (list a-pat b-pat)))
Note: See TracChangeset for help on using the changeset viewer.