Changeset 35657 in project


Ignore:
Timestamp:
06/21/18 11:49:51 (5 months ago)
Author:
kooda
Message:

Port the regex egg to CHICKEN 5

Location:
release/5
Files:
2 added
5 deleted
3 edited
2 copied

Legend:

Unmodified
Added
Removed
  • release/5/egg-locations

    r35637 r35657  
    2020(r7rs "http://code.call-cc.org/release-info?egg={egg-name};release={chicken-release}")
    2121(record-variants "http://code.call-cc.org/release-info?egg={egg-name};release={chicken-release}")
     22(regex "http://code.call-cc.org/release-info?egg={egg-name};release={chicken-release}")
    2223(silex "http://code.call-cc.org/release-info?egg={egg-name};release={chicken-release}")
    2324(sql-null "http://code.call-cc.org/release-info?egg={egg-name};release={chicken-release}")
  • release/5/regex/tags/2.0/regex.scm

    r19572 r35657  
    4141               string-substitute*)
    4242
    43 (import scheme chicken)
    44 (use irregex)
     43(import scheme (chicken base) (chicken irregex) (chicken fixnum))
    4544
    4645
     
    212211;;; Glob support:
    213212
    214 (define glob->regexp ##sys#glob->regexp)
    215 
     213(define glob->regexp
     214  (let ((list->string list->string)
     215        (string->list string->list))
     216    (lambda (s #!optional sre?)
     217      (##sys#check-string s 'glob->regexp)
     218      (let ((sre
     219             (cons
     220              ':
     221              (let loop ((cs (string->list s)) (dir #t))
     222                (if (null? cs)
     223                    '()
     224                    (let ((c (car cs))
     225                          (rest (cdr cs)) )
     226                      (cond ((char=? c #\*)
     227                             (if dir
     228                                 `((or (: (~ ("./\\"))
     229                                          (* (~ ("/\\"))))
     230                                       (* (~ ("./\\"))))
     231                                   ,@(loop rest #f))
     232                                 `((* (~ ("/\\"))) ,@(loop rest #f))))
     233                            ((char=? c #\?)  (cons 'any (loop rest #f)))
     234                            ((char=? c #\[)
     235                             (let loop2 ((rest rest) (s '()))
     236                               (cond ((not (pair? rest))
     237                                      (error 'glob->regexp
     238                                             "unexpected end of character class" s))
     239                                     ((char=? #\] (car rest))
     240                                      `(,(if (> (length s) 1)
     241                                             `(or ,@s)
     242                                             (car s))
     243                                        ,@(loop (cdr rest) #f)))
     244                                     ((and (pair? (cdr rest))
     245                                           (pair? (cddr rest))
     246                                           (char=? #\- (cadr rest)) )
     247                                      (loop2 (cdddr rest)
     248                                             (cons `(/ ,(car rest) ,(caddr rest)) s)))
     249                                     ((and (pair? (cdr rest))
     250                                           (char=? #\- (car rest)))
     251                                      (loop2 (cddr rest)
     252                                             (cons `(~ ,(cadr rest)) s)))
     253                                     (else
     254                                      (loop2 (cdr rest) (cons (car rest) s))))))
     255                            (else (cons c (loop rest (memq c '(#\\ #\/))))))))))))
     256        (if sre? sre (irregex sre))))))
    216257
    217258;;; Grep-like function on list:
  • release/5/regex/trunk/regex.scm

    r19572 r35657  
    4141               string-substitute*)
    4242
    43 (import scheme chicken)
    44 (use irregex)
     43(import scheme (chicken base) (chicken irregex) (chicken fixnum))
    4544
    4645
     
    212211;;; Glob support:
    213212
    214 (define glob->regexp ##sys#glob->regexp)
    215 
     213(define glob->regexp
     214  (let ((list->string list->string)
     215        (string->list string->list))
     216    (lambda (s #!optional sre?)
     217      (##sys#check-string s 'glob->regexp)
     218      (let ((sre
     219             (cons
     220              ':
     221              (let loop ((cs (string->list s)) (dir #t))
     222                (if (null? cs)
     223                    '()
     224                    (let ((c (car cs))
     225                          (rest (cdr cs)) )
     226                      (cond ((char=? c #\*)
     227                             (if dir
     228                                 `((or (: (~ ("./\\"))
     229                                          (* (~ ("/\\"))))
     230                                       (* (~ ("./\\"))))
     231                                   ,@(loop rest #f))
     232                                 `((* (~ ("/\\"))) ,@(loop rest #f))))
     233                            ((char=? c #\?)  (cons 'any (loop rest #f)))
     234                            ((char=? c #\[)
     235                             (let loop2 ((rest rest) (s '()))
     236                               (cond ((not (pair? rest))
     237                                      (error 'glob->regexp
     238                                             "unexpected end of character class" s))
     239                                     ((char=? #\] (car rest))
     240                                      `(,(if (> (length s) 1)
     241                                             `(or ,@s)
     242                                             (car s))
     243                                        ,@(loop (cdr rest) #f)))
     244                                     ((and (pair? (cdr rest))
     245                                           (pair? (cddr rest))
     246                                           (char=? #\- (cadr rest)) )
     247                                      (loop2 (cdddr rest)
     248                                             (cons `(/ ,(car rest) ,(caddr rest)) s)))
     249                                     ((and (pair? (cdr rest))
     250                                           (char=? #\- (car rest)))
     251                                      (loop2 (cddr rest)
     252                                             (cons `(~ ,(cadr rest)) s)))
     253                                     (else
     254                                      (loop2 (cdr rest) (cons (car rest) s))))))
     255                            (else (cons c (loop rest (memq c '(#\\ #\/))))))))))))
     256        (if sre? sre (irregex sre))))))
    216257
    217258;;; Grep-like function on list:
Note: See TracChangeset for help on using the changeset viewer.