~ chicken-core (chicken-5) 489b853f50af9ed1eff6a3f89a3c2e1d274dbdcb
commit 489b853f50af9ed1eff6a3f89a3c2e1d274dbdcb
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jul 20 01:48:13 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jul 20 01:48:13 2010 +0200
preparations for eggification of regex; removed regex unit; applied newest patch by sjaaman; replaced internal uses of regex into uses of irregex; worked like a slave
diff --git a/chicken-install.scm b/chicken-install.scm
index 1ed773e2..c12451d8 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -25,13 +25,13 @@
(require-library setup-download setup-api)
-(require-library srfi-1 posix data-structures utils regex ports extras srfi-13 files)
+(require-library srfi-1 posix data-structures utils irregex ports extras srfi-13 files)
(require-library chicken-syntax) ; in case an import library reexports chicken syntax
(require-library chicken-ffi-syntax) ; same reason, also for filling modules.db
(module main ()
- (import scheme chicken srfi-1 posix data-structures utils regex ports extras
+ (import scheme chicken srfi-1 posix data-structures utils irregex ports extras
srfi-13 files)
(import setup-download setup-api)
@@ -51,7 +51,6 @@
"srfi-13.import.so"
"srfi-69.import.so"
"extras.import.so"
- "regex.import.so"
"srfi-14.import.so"
"tcp.import.so"
"foreign.import.so"
@@ -479,17 +478,17 @@
(let* ((files (glob (make-pathname (repository-path) "*.import.*")))
(tmpdir (create-temporary-directory))
(dbfile (make-pathname tmpdir +module-db+))
- (rx (regexp ".*/([^/]+)\\.import\\.(scm|so)")))
+ (rx (irregex ".*/([^/]+)\\.import\\.(scm|so)")))
(print "loading import libraries ...")
(fluid-let ((##sys#warnings-enabled #f))
(for-each
(lambda (f)
- (let ((m (string-match rx f)))
+ (let ((m (irregex-match rx f)))
(handle-exceptions ex
(print-error-message
ex (current-error-port)
(sprintf "Failed to import from `~a'" f))
- (eval `(import ,(string->symbol (cadr m)))))))
+ (eval `(import ,(string->symbol (irregex-match-substring m 1)))))))
files))
(print "generating database")
(let ((db
@@ -575,10 +574,10 @@ EOF
(define (setup-proxy uri)
(if (string? uri)
- (cond ((string-match "(.+)\\:([0-9]+)" uri) =>
+ (cond ((irregex-match "(.+)\\:([0-9]+)" uri) =>
(lambda (m)
- (set! *proxy-host* (cadr m))
- (set! *proxy-port* (string->number (caddr m))))
+ (set! *proxy-host* (irregex-match-substring m 1))
+ (set! *proxy-port* (string->number (irregex-match-substring m 2))))
(else
(set! *proxy-host* uri)
(set! *proxy-port* 80))))))
@@ -587,7 +586,7 @@ EOF
(define (main args)
(let ((update #f)
- (rx (regexp "([^:]+):(.+)")))
+ (rx (irregex "([^:]+):(.+)")))
(setup-proxy (get-environment-variable "http_proxy"))
(let loop ((args args) (eggs '()))
(cond ((null? args)
@@ -729,9 +728,14 @@ EOF
"")
*eggs+dirs+vers*))
(loop (cdr args) (cons egg eggs))))
- ((string-match rx arg) =>
+ ((irregex-match rx arg) =>
(lambda (m)
- (loop (cdr args) (alist-cons (cadr m) (caddr m) eggs))))
+ (loop
+ (cdr args)
+ (alist-cons
+ (irregex-match-substring m 1)
+ (irregex-match-substring m 2)
+ eggs))))
(else (loop (cdr args) (cons arg eggs))))))))))
(register-feature! 'chicken-install)
diff --git a/chicken-status.scm b/chicken-status.scm
index 35ac16d8..736b0d86 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -24,13 +24,13 @@
; POSSIBILITY OF SUCH DAMAGE.
-(require-library setup-api srfi-1 posix data-structures utils ports regex files)
+(require-library setup-api srfi-1 posix data-structures utils ports irregex files)
(module main ()
(import scheme chicken foreign)
- (import srfi-1 posix data-structures utils ports regex
+ (import srfi-1 posix data-structures utils ports irregex
files setup-api)
(define-foreign-variable C_TARGET_LIB_HOME c-string)
@@ -45,6 +45,9 @@
(make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION))
(repository-path)))
+ (define (grep rx lst)
+ (filter (cut irregex-search rx <>) lst))
+
(define (gather-eggs patterns)
(let ((eggs (map pathname-file
(glob (make-pathname (repo-path) "*" "setup-info")))))
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index fb232b13..844acf86 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -26,14 +26,14 @@
(require-library
setup-api
- srfi-1 posix data-structures utils ports regex srfi-13 files)
+ srfi-1 posix data-structures utils ports irregex srfi-13 files)
(module main ()
(import scheme chicken foreign)
(import setup-api)
- (import srfi-1 posix data-structures utils ports regex srfi-13 files)
+ (import srfi-1 posix data-structures utils ports irregex srfi-13 files)
(define-foreign-variable C_TARGET_LIB_HOME c-string)
(define-foreign-variable C_BINARY_VERSION int)
@@ -49,6 +49,9 @@
(define *force* #f)
+ (define (grep rx lst)
+ (filter (cut irregex-search rx <>) lst))
+
(define (gather-eggs patterns)
(let ((eggs (map pathname-file
(glob (make-pathname (repo-path) "*" "setup-info")))))
@@ -137,7 +140,7 @@ EOF
(loop (append (map (cut string #\- <>) sos) (cdr args)) pats)
(usage 1)))
(usage 1)))
- (else (loop (cdr args) (cons (glob->regexp arg) pats))))))))
+ (else (loop (cdr args) (cons (##sys#glob->regexp arg) pats))))))))
(main (command-line-arguments))
diff --git a/defaults.make b/defaults.make
index 3b7217fc..4564b952 100644
--- a/defaults.make
+++ b/defaults.make
@@ -321,12 +321,9 @@ CHICKEN_INSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-install$(PROGRAM_SUFFIX)
CHICKEN_UNINSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-uninstall$(PROGRAM_SUFFIX)
CHICKEN_STATUS_PROGRAM = $(PROGRAM_PREFIX)chicken-status$(PROGRAM_SUFFIX)
CHICKEN_BUG_PROGRAM = $(PROGRAM_PREFIX)chicken-bug$(PROGRAM_SUFFIX)
-IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix srfi-13 srfi-69 extras \
- regex srfi-14 tcp foreign scheme srfi-18 utils csi irregex
+IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix srfi-13 srfi-69 extras srfi-14 tcp foreign scheme srfi-18 utils csi irregex
IMPORT_LIBRARIES += setup-api setup-download
-SCRUTINIZED_LIBRARIES = library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
- srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex irregex scheduler \
- profiler stub expand chicken-syntax chicken-ffi-syntax
+SCRUTINIZED_LIBRARIES = library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 srfi-14 srfi-18 srfi-69 $(POSIXFILE) irregex scheduler profiler stub expand chicken-syntax chicken-ffi-syntax
ifdef STATICBUILD
CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)$(EXE)
diff --git a/distribution/manifest b/distribution/manifest
index d5771035..19fb1737 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -28,7 +28,6 @@ optimizer.c
compiler-syntax.c
scrutinizer.c
unboxing.c
-regex.c
irregex.c
posixunix.c
posixwin.c
@@ -78,7 +77,6 @@ optimizer.scm
compiler-syntax.scm
scrutinizer.scm
unboxing.scm
-regex.scm
irregex.scm
irregex-core.scm
posixunix.scm
@@ -211,7 +209,6 @@ posix.import.scm
srfi-13.import.scm
srfi-69.import.scm
extras.import.scm
-regex.import.scm
irregex.import.scm
srfi-14.import.scm
tcp.import.scm
@@ -225,7 +222,6 @@ posix.import.c
srfi-13.import.c
srfi-69.import.c
extras.import.c
-regex.import.c
irregex.import.c
srfi-14.import.c
tcp.import.c
@@ -290,7 +286,6 @@ manual/Unit library
manual/Unit lolevel
manual/Unit ports
manual/Unit posix
-manual/Unit regex
manual/Unit irregex
manual/Unit srfi-1
manual/Unit srfi-13
diff --git a/eval.scm b/eval.scm
index 44a9ed88..7bfc00ec 100644
--- a/eval.scm
+++ b/eval.scm
@@ -55,7 +55,7 @@
(define-foreign-variable binary-version int "C_BINARY_VERSION")
(define ##sys#core-library-modules
- '(extras lolevel utils files tcp regex irregex posix srfi-1 srfi-4 srfi-13
+ '(extras lolevel utils files tcp irregex posix srfi-1 srfi-4 srfi-13
srfi-14 srfi-18 srfi-69 data-structures ports chicken-syntax
chicken-ffi-syntax))
diff --git a/files.scm b/files.scm
index 5e77dcea..902d5900 100644
--- a/files.scm
+++ b/files.scm
@@ -36,7 +36,7 @@
(declare
(unit files)
- (uses regex data-structures)
+ (uses irregex data-structures)
(fixnum)
(hide chop-pds absolute-pathname-root root-origin root-directory split-directory)
(disable-interrupts)
@@ -172,20 +172,19 @@ EOF
(define root-origin)
(define root-directory)
-(let ((string-match string-match))
- (if ##sys#windows-platform
- (let ((rx (regexp "([A-Za-z]:)?([\\/\\\\]).*")))
- (set! absolute-pathname-root (lambda (pn) (string-match rx pn)))
- (set! root-origin (lambda (rt) (and rt (cadr rt))))
- (set! root-directory (lambda (rt) (and rt (caddr rt)))) )
- (let ((rx (regexp "([\\/\\\\]).*")))
- (set! absolute-pathname-root (lambda (pn) (string-match rx pn)))
- (set! root-origin (lambda (rt) #f))
- (set! root-directory (lambda (rt) (and rt (cadr rt)))) ) ) )
+(if ##sys#windows-platform
+ (let ((rx (irregex "([A-Za-z]:)?([\\/\\\\]).*")))
+ (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn)))
+ (set! root-origin (lambda (rt) (and rt (irregex-match-substring rt 1))))
+ (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 2)))) )
+ (let ((rx (irregex "([\\/\\\\]).*")))
+ (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn)))
+ (set! root-origin (lambda (rt) #f))
+ (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 1)))) ) )
(define (absolute-pathname? pn)
(##sys#check-string pn 'absolute-pathname?)
- (pair? (absolute-pathname-root pn)) )
+ (irregex-match-data? (absolute-pathname-root pn)) )
(define-inline (*char-pds? ch) (memq ch '(#\\ #\/)))
@@ -262,28 +261,33 @@ EOF
file ext pds) ) ) )
(define decompose-pathname
- (let ((string-match string-match))
- (let* ([patt1 "^(.*[\\/\\\\])?([^\\/\\\\]+)(\\.([^\\/\\\\.]+))$"]
- [patt2 "^(.*[\\/\\\\])?((\\.)?[^\\/\\\\]+)$"]
- [rx1 (regexp patt1)]
- [rx2 (regexp patt2)]
- [strip-pds
- (lambda (dir)
- (and dir
- (if (member dir '("/" "\\"))
- dir
- (chop-pds dir #f) ) ) )] )
- (lambda (pn)
- (##sys#check-string pn 'decompose-pathname)
- (if (fx= 0 (##sys#size pn))
- (values #f #f #f)
- (let ([ms (string-search rx1 pn)])
- (if ms
- (values (strip-pds (cadr ms)) (caddr ms) (car (cddddr ms)))
- (let ([ms (string-search rx2 pn)])
- (if ms
- (values (strip-pds (cadr ms)) (caddr ms) #f)
- (values (strip-pds pn) #f #f) ) ) ) ) ) ) ) ) )
+ (let* ([patt1 "^(.*[\\/\\\\])?([^\\/\\\\]+)(\\.([^\\/\\\\.]+))$"]
+ [patt2 "^(.*[\\/\\\\])?((\\.)?[^\\/\\\\]+)$"]
+ [rx1 (irregex patt1)]
+ [rx2 (irregex patt2)]
+ [strip-pds
+ (lambda (dir)
+ (and dir
+ (if (member dir '("/" "\\"))
+ dir
+ (chop-pds dir #f) ) ) )] )
+ (lambda (pn)
+ (##sys#check-string pn 'decompose-pathname)
+ (if (fx= 0 (##sys#size pn))
+ (values #f #f #f)
+ (let ([ms (irregex-search rx1 pn)])
+ (if ms
+ (values
+ (strip-pds (irregex-match-substring ms 1))
+ (irregex-match-substring ms 2)
+ (irregex-match-substring ms 4))
+ (let ([ms (irregex-search rx2 pn)])
+ (if ms
+ (values
+ (strip-pds (irregex-match-substring ms 1))
+ (irregex-match-substring ms 2)
+ #f)
+ (values (strip-pds pn) #f #f) ) ) ) ) ) ) ) )
(define pathname-directory)
(define pathname-file)
diff --git a/irregex-core.scm b/irregex-core.scm
index 040136bd..4f5f410c 100644
--- a/irregex-core.scm
+++ b/irregex-core.scm
@@ -162,7 +162,12 @@
(define (%irregex-match-end-index m n)
(internal "##sys#slot" (internal "##sys#slot" m 1) (+ 3 (* n 4))))
(define (%irregex-match-fail m) (internal "##sys#slot" m 4))
- (define (%irregex-match-fail-set! m x) (internal "##sys#setslot" m 4 x))))
+ (define (%irregex-match-fail-set! m x) (internal "##sys#setslot" m 4 x))
+ (define-record-printer (regexp-match m out)
+ (let ((n (irregex-match-num-submatches m)))
+ (display "#<regexp-match (" out)
+ (display n out)
+ (display " submatches)>" out)))))
(else
(begin
(define (irregex-new-matches irx)
@@ -243,9 +248,14 @@
(define (irregex-match-index m opt)
(if (pair? opt)
- (cond ((number? (car opt)) (car opt))
- ((assq (car opt) (irregex-match-names m)) => cdr)
- (else (error "unknown match name" (car opt))))
+ (if (number? (car opt))
+ (car opt)
+ (let lp ((ls (irregex-match-names m)))
+ (cond ((null? ls) (error "unknown match name" (car opt)))
+ ((and (eq? (car opt) (caar ls))
+ (%irregex-match-start-chunk m (cdar ls)))
+ (cdar ls))
+ (else (lp (cdr ls))))))
0))
(cond-expand
diff --git a/irregex.scm b/irregex.scm
index 875826dc..afa0c0ce 100644
--- a/irregex.scm
+++ b/irregex.scm
@@ -28,10 +28,10 @@
(declare (unit irregex))
(declare
- (disable-interrupts)
(no-procedure-checks)
(fixnum)
(export
+ ##sys#glob->regexp
irregex
irregex-apply-match
irregex-dfa
@@ -123,3 +123,45 @@
,(fold (add1 i))))))))
(include "irregex-core.scm")
+
+(define ##sys#glob->regexp
+ (let ((list->string list->string)
+ (string->list string->list))
+ (lambda (s #!optional sre?)
+ (##sys#check-string s 'glob->regexp)
+ (let ((sre
+ (cons
+ ':
+ (let loop ((cs (string->list s)) (dir #t))
+ (if (null? cs)
+ '()
+ (let ((c (car cs))
+ (rest (cdr cs)) )
+ (cond ((char=? c #\*)
+ (if dir
+ `((or (: (~ ("./\\"))
+ (* (~ ("/\\"))))
+ (* (~ ("./\\"))))
+ ,@(loop rest #f))
+ `((* (~ ("/\\"))) ,@(loop rest #f))))
+ ((char=? c #\?) (cons 'any (loop rest #f)))
+ ((char=? c #\[)
+ (let loop2 ((rest rest) (s '()))
+ (cond ((not (pair? rest))
+ (error 'glob->regexp
+ "unexpected end of character class" s))
+ ((char=? #\] (car rest))
+ `((or ,@s) ,@(loop (cdr rest) #f)))
+ ((and (pair? (cdr rest))
+ (pair? (cddr rest))
+ (char=? #\- (cadr rest)) )
+ (loop2 (cdddr rest)
+ (cons `(/ ,(car rest) ,(caddr rest)) s)))
+ ((and (pair? (cdr rest))
+ (char=? #\- (car rest)))
+ (loop2 (cddr rest)
+ (cons `(~ ,(cadr rest)) s)))
+ (else
+ (loop2 (cdr rest) (cons (car rest) s))))))
+ (else (cons c (loop rest (memq c '(#\\ #\/))))))))))))
+ (if sre? sre (regexp sre))))))
diff --git a/manual/Supported language b/manual/Supported language
index 07794a9e..d7be9c82 100644
--- a/manual/Supported language
+++ b/manual/Supported language
@@ -20,7 +20,6 @@
* [[Unit files]] File and pathname operations
* [[Unit extras]] Useful utility definitions
* [[Unit irregex]] Regular expressions
-* [[Unit regex]] Regular expression utilities
* [[Unit srfi-1]] List Library
* [[Unit srfi-4]] Homogeneous numeric vectors
* [[Unit srfi-13]] String library
diff --git a/manual/Unit irregex b/manual/Unit irregex
index f8c37036..51073caf 100644
--- a/manual/Unit irregex
+++ b/manual/Unit irregex
@@ -816,4 +816,4 @@ possible.
---
Previous: [[Unit extras]]
-Next: [[Unit regex]]
+Next: [[Unit srfi-1]]
diff --git a/manual/Unit srfi-1 b/manual/Unit srfi-1
index 72ac271f..7a8eb917 100644
--- a/manual/Unit srfi-1
+++ b/manual/Unit srfi-1
@@ -1515,6 +1515,6 @@ arguments.
----
-Previous: [[Unit regex]]
+Previous: [[Unit irregex]]
Next: [[Unit srfi-4]]
diff --git a/manual/Unit utils b/manual/Unit utils
index e1af0895..8c174b1d 100644
--- a/manual/Unit utils
+++ b/manual/Unit utils
@@ -88,11 +88,12 @@ The initial default options are {{-scrutinize -O2 -d2}}.
<procedure>(scan-input-lines REGEXP [PORT])</procedure>
Reads lines from {{PORT}} (defaults to the result of {{(current-input-port)}})
-using {{read-line}} and returns the result of {{(string-search REGEXP LINE)}},
+using {{read-line}} and returns the result of {{(irregex-search REGEXP LINE)}},
if the match succeeds. If no match could be found, {{#f}} is returned.
{{REGEXP}} may also be a procedure of one argument which is called for each
-input line and should return a non-false value on success.
+input line and should return a non-false value on success, which will then
+be the result of the call to {{scan-input-lines}}.
=== Asking the user for confirmation
diff --git a/posix-common.scm b/posix-common.scm
index 724d3283..e77b05fb 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -233,64 +233,54 @@ EOF
;;; Filename globbing:
(define glob
- (let ((regexp regexp)
- (string-match string-match)
- (glob->regexp glob->regexp)
- (directory directory)
- (make-pathname make-pathname)
- (decompose-pathname decompose-pathname) )
- (lambda paths
- (let conc-loop ((paths paths))
- (if (null? paths)
- '()
- (let ((path (car paths)))
- (let-values (((dir fil ext) (decompose-pathname path)))
- (let ((rx (glob->regexp (make-pathname #f (or fil "*") ext))))
- (let loop ((fns (directory (or dir ".") #t)))
- (cond ((null? fns) (conc-loop (cdr paths)))
- ((string-match rx (car fns))
- => (lambda (m)
- (cons (make-pathname dir (car m)) (loop (cdr fns)))) )
- (else (loop (cdr fns))) ) ) ) ) ) ) ) ) ) )
+ (lambda paths
+ (let conc-loop ((paths paths))
+ (if (null? paths)
+ '()
+ (let ((path (car paths)))
+ (let-values (((dir fil ext) (decompose-pathname path)))
+ (let ((rx (##sys#glob->regexp (make-pathname #f (or fil "*") ext))))
+ (let loop ((fns (directory (or dir ".") #t)))
+ (cond ((null? fns) (conc-loop (cdr paths)))
+ ((irregex-match rx (car fns))
+ => (lambda (m)
+ (cons
+ (make-pathname dir (irregex-match-substring m))
+ (loop (cdr fns)))) )
+ (else (loop (cdr fns))) ) ) ) ) ) ) ) ) )
;;; Find matching files:
(define ##sys#find-files
- (let ((glob glob)
- (string-match string-match)
- (make-pathname make-pathname)
- (pathname-file pathname-file)
- (symbolic-link? symbolic-link?)
- (directory? directory?) )
- (lambda (dir pred action id limit follow dot loc)
- (##sys#check-string dir loc)
- (let* ((depth 0)
- (lproc
- (cond ((not limit) (lambda _ #t))
- ((fixnum? limit) (lambda _ (fx< depth limit)))
- (else limit) ) )
- (pproc
- (if (or (string? pred) (regexp? pred))
- (let ((pred (regexp pred))) ; force compilation
- (lambda (x) (string-match pred x)))
- pred) ) )
- (let loop ((fs (glob (make-pathname dir (if dot "?*" "*"))))
- (r id) )
- (if (null? fs)
- r
- (let ((f (##sys#slot fs 0))
- (rest (##sys#slot fs 1)) )
- (cond ((directory? f)
- (cond ((member (pathname-file f) '("." "..")) (loop rest r))
- ((lproc f)
- (loop rest
- (fluid-let ((depth (fx+ depth 1)))
- (loop (glob (make-pathname f "*"))
- (if (pproc f) (action f r) r)) ) ) )
- (else (loop rest (if (pproc f) (action f r) r))) ) )
- ((pproc f) (loop rest (action f r)))
- (else (loop rest r)) ) ) ) ) ) ) ) )
+ (lambda (dir pred action id limit follow dot loc)
+ (##sys#check-string dir loc)
+ (let* ((depth 0)
+ (lproc
+ (cond ((not limit) (lambda _ #t))
+ ((fixnum? limit) (lambda _ (fx< depth limit)))
+ (else limit) ) )
+ (pproc
+ (if (or (string? pred) (irregex? pred))
+ (let ((pred (irregex pred))) ; force compilation
+ (lambda (x) (irregex-match pred x)))
+ pred) ) )
+ (let loop ((fs (glob (make-pathname dir (if dot "?*" "*"))))
+ (r id) )
+ (if (null? fs)
+ r
+ (let ((f (##sys#slot fs 0))
+ (rest (##sys#slot fs 1)) )
+ (cond ((directory? f)
+ (cond ((member (pathname-file f) '("." "..")) (loop rest r))
+ ((lproc f)
+ (loop rest
+ (fluid-let ((depth (fx+ depth 1)))
+ (loop (glob (make-pathname f "*"))
+ (if (pproc f) (action f r) r)) ) ) )
+ (else (loop rest (if (pproc f) (action f r) r))) ) )
+ ((pproc f) (loop rest (action f r)))
+ (else (loop rest r)) ) ) ) ) ) ) )
(define (find-files dir . args)
(cond ((or (null? args) (not (keyword? (car args))))
diff --git a/posixunix.scm b/posixunix.scm
index 49213e6c..1ff8652b 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -27,7 +27,7 @@
(declare
(unit posix)
- (uses scheduler regex extras utils files ports)
+ (uses scheduler irregex extras utils files ports)
(disable-interrupts)
(hide group-member _get-groups _ensure-groups posix-error ##sys#terminal-check)
(not inline ##sys#interrupt-hook ##sys#user-interrupt-hook))
diff --git a/posixwin.scm b/posixwin.scm
index 9f313952..64c44fd8 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -63,7 +63,7 @@
(declare
(unit posix)
- (uses scheduler regex extras utils files ports)
+ (uses scheduler irregex extras utils files ports)
(disable-interrupts)
(hide $quote-args-list $exec-setup $exec-teardown)
(not inline ##sys#interrupt-hook ##sys#user-interrupt-hook)
diff --git a/regex.import.scm b/regex.import.scm
deleted file mode 100644
index 70310a22..00000000
--- a/regex.import.scm
+++ /dev/null
@@ -1,41 +0,0 @@
-;;;; regex.import.scm - import library for "regex" module
-;
-; Copyright (c) 2008-2010, The Chicken Team
-; All rights reserved.
-;
-; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
-; conditions are met:
-;
-; Redistributions of source code must retain the above copyright notice, this list of conditions and the following
-; disclaimer.
-; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
-; disclaimer in the documentation and/or other materials provided with the distribution.
-; Neither the name of the author nor the names of its contributors may be used to endorse or promote
-; products derived from this software without specific prior written permission.
-;
-; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
-; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
-; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
-; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-; POSSIBILITY OF SUCH DAMAGE.
-
-
-(##sys#register-primitive-module
- 'regex
- '(glob->regexp
- glob?
- grep
- regexp
- regexp-escape
- regexp?
- string-match
- string-match-positions
- string-search
- string-search-positions
- string-split-fields
- string-substitute
- string-substitute*))
diff --git a/regex.scm b/regex.scm
deleted file mode 100644
index 8d0df304..00000000
--- a/regex.scm
+++ /dev/null
@@ -1,296 +0,0 @@
-;;;; regex.scm
-;
-; Copyright (c) 2008-2010, The Chicken Team
-; Copyright (c) 2000-2007, Felix L. Winkelmann
-; All rights reserved.
-;
-; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
-; conditions are met:
-;
-; Redistributions of source code must retain the above copyright notice, this list of conditions and the following
-; disclaimer.
-; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
-; disclaimer in the documentation and/or other materials provided with the distribution.
-; Neither the name of the author nor the names of its contributors may be used to endorse or promote
-; products derived from this software without specific prior written permission.
-;
-; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
-; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
-; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
-; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-; POSSIBILITY OF SUCH DAMAGE.
-
-
-(declare (unit regex))
-
-(declare
- (uses irregex)
- (disable-interrupts)
- (fixnum)
- (export
- regexp? regexp
- string-match string-match-positions string-search string-search-positions
- string-split-fields string-substitute string-substitute*
- glob->regexp
- grep
- regexp-escape
- ))
-
-(include "common-declarations.scm")
-
-(register-feature! 'regex)
-
-
-;;; Record `regexp'
-
-(define (regexp pat #!optional caseless extended utf8)
- (apply
- irregex
- pat
- (let ((opts '()))
- (when caseless (set! opts (cons 'i opts)))
- (when extended (set! opts (cons 'x opts)))
- (when utf8 (set! opts (cons 'utf8 opts)))
- opts)))
-
-(define regexp? irregex?)
-
-
-;;; Basic `regexp' operations
-
-(define (string-match rx str)
- (and-let* ((m (irregex-match rx str)))
- (let loop ((i (irregex-match-num-submatches m))
- (res '()))
- (if (fx<= i 0)
- (cons str res)
- (loop (fx- i 1) (cons (irregex-match-substring m i) res))))))
-
-(define (string-match-positions rx str)
- (and-let* ((m (irregex-match rx str)))
- (let loop ((i (irregex-match-num-submatches m))
- (res '()))
- (if (fx<= i 0)
- (cons (list 0 (string-length str)) res)
- (loop (fx- i 1) (cons (list (irregex-match-start-index m i)
- (irregex-match-end-index m i))
- res))))))
-
-(define (string-search rx str #!optional (start 0) (range (string-length str)))
- (let ((n (string-length str)))
- (and-let* ((m (irregex-search rx str start (min n (fx+ start range)))))
- (let loop ((i (irregex-match-num-submatches m))
- (res '()))
- (if (fx< i 0)
- res
- (loop (fx- i 1) (cons (irregex-match-substring m i) res)))))))
-
-(define (string-search-positions rx str #!optional (start 0) (range (string-length str)))
- (let ((n (string-length str)))
- (and-let* ((m (irregex-search rx str start (min n (fx+ start range)))))
- (let loop ((i (irregex-match-num-submatches m))
- (res '()))
- (if (fx< i 0)
- res
- (loop (fx- i 1) (cons (list (irregex-match-start-index m i)
- (irregex-match-end-index m i))
- res)))))))
-
-
-;;; Split string into fields:
-
-(define string-split-fields
- (let ([reverse reverse]
- [substring substring]
- [string-search-positions string-search-positions] )
- (lambda (rx str . mode-and-start)
- (##sys#check-string str 'string-split-fields)
- (let* ([argc (length mode-and-start)]
- [len (##sys#size str)]
- [mode (if (fx> argc 0) (car mode-and-start) #t)]
- [start (if (fx> argc 1) (cadr mode-and-start) 0)]
- [fini (case mode
- [(#:suffix)
- (lambda (ms start)
- (if (fx< start len)
- (##sys#error 'string-split-fields
- "record does not end with suffix" str rx)
- (reverse ms) ) ) ]
- [(#:infix)
- (lambda (ms start)
- (if (fx>= start len)
- (reverse (cons "" ms))
- (reverse (cons (substring str start len) ms)) ) ) ]
- [else (lambda (ms start) (reverse ms)) ] ) ]
- [fetch (case mode
- [(#:infix #:suffix) (lambda (start from to) (substring str start from))]
- [else (lambda (start from to) (substring str from to))] ) ] )
- (let loop ([ms '()] [start start])
- (let ([m (string-search-positions rx str start)])
- (if m
- (let* ([mp (car m)]
- [from (car mp)]
- [to (cadr mp)] )
- (if (fx= from to)
- (if (fx= to len)
- (fini ms start)
- (loop (cons (fetch start (fx+ from 1) (fx+ to 2)) ms) (fx+ to 1)) )
- (loop (cons (fetch start from to) ms) to) ) )
- (fini ms start) ) ) ) ) ) ) )
-
-
-;;; Substitute matching strings:
-
-(define string-substitute
- (let ([substring substring]
- [reverse reverse]
- [make-string make-string]
- [string-search-positions string-search-positions] )
- (lambda (rx subst string . flag)
- (##sys#check-string subst 'string-substitute)
- (##sys#check-string string 'string-substitute)
- (let* ([which (if (pair? flag) (car flag) 1)]
- [substlen (##sys#size subst)]
- (strlen (##sys#size string))
- [substlen-1 (fx- substlen 1)]
- [result '()]
- [total 0] )
- (define (push x)
- (set! result (cons x result))
- (set! total (fx+ total (##sys#size x))) )
- (define (substitute matches)
- (let loop ([start 0] [index 0])
- (if (fx>= index substlen-1)
- (push (if (fx= start 0) subst (substring subst start substlen)))
- (let ([c (##core#inline "C_subchar" subst index)]
- [index+1 (fx+ index 1)] )
- (if (char=? c #\\)
- (let ([c2 (##core#inline "C_subchar" subst index+1)])
- (if (and (not (char=? #\\ c2)) (char-numeric? c2))
- (let ([mi (list-ref matches (fx- (char->integer c2) 48))])
- (push (substring subst start index))
- (push (substring string (car mi) (cadr mi)))
- (loop (fx+ index 2) index+1) )
- (loop start (fx+ index+1 1)) ) )
- (loop start index+1) ) ) ) ) )
- (let loop ([index 0] [count 1])
- (let ((matches (and (fx< index strlen)
- (string-search-positions rx string index))))
- (cond [matches
- (let* ([range (car matches)]
- [upto (cadr range)] )
- (cond ((fx= 0 (fx- (cadr range) (car range)))
- (##sys#error
- 'string-substitute "empty substitution match"
- rx) )
- ((or (not (fixnum? which)) (fx= count which))
- (push (substring string index (car range)))
- (substitute matches)
- (loop upto #f) )
- (else
- (push (substring string index upto))
- (loop upto (fx+ count 1)) ) ) ) ]
- [else
- (push (substring string index (##sys#size string)))
- (##sys#fragments->string total (reverse result)) ] ) ) ) ) ) ) )
-
-(define string-substitute*
- (let ([string-substitute string-substitute])
- (lambda (str smap . mode)
- (##sys#check-string str 'string-substitute*)
- (##sys#check-list smap 'string-substitute*)
- (let ((mode (and (pair? mode) (car mode))))
- (let loop ((str str) (smap smap))
- (if (null? smap)
- str
- (let ((sm (car smap)))
- (loop (string-substitute (car sm) (cdr sm) str mode)
- (cdr smap) ) ) ) ) ) ) ) )
-
-
-;;; Glob support:
-
-(define glob->regexp
- (let ((list->string list->string)
- (string->list string->list)
- (regexp regexp))
- (lambda (s #!optional sre?)
- (##sys#check-string s 'glob->regexp)
- (let ((sre
- (cons
- ':
- (let loop ((cs (string->list s)) (dir #t))
- (if (null? cs)
- '()
- (let ((c (car cs))
- (rest (cdr cs)) )
- (cond ((char=? c #\*)
- (if dir
- `((or (: (~ ("./\\"))
- (* (~ ("/\\"))))
- (* (~ ("./\\"))))
- ,@(loop rest #f))
- `((* (~ ("/\\"))) ,@(loop rest #f))))
- ((char=? c #\?) (cons 'any (loop rest #f)))
- ((char=? c #\[)
- (let loop2 ((rest rest) (s '()))
- (cond ((not (pair? rest))
- (error 'glob->regexp "unexpected end of character class" s))
- ((char=? #\] (car rest))
- `((or ,@s) ,@(loop (cdr rest) #f)))
- ((and (pair? (cdr rest))
- (pair? (cddr rest))
- (char=? #\- (cadr rest)) )
- (loop2 (cdddr rest) (cons `(/ ,(car rest) ,(caddr rest)) s)))
- ((and (pair? (cdr rest))
- (char=? #\- (car rest)))
- (loop2 (cddr rest)
- (cons `(~ ,(cadr rest)) s)))
- (else
- (loop2 (cdr rest) (cons (car rest) s))))))
- (else (cons c (loop rest (memq c '(#\\ #\/))))))))))))
- (if sre? sre (regexp sre))))))
-
-
-;;; Grep-like function on list:
-
-(define grep
- (let ((string-search string-search)
- (regexp regexp))
- (lambda (rx lst #!optional (acc (lambda (x) x)))
- (##sys#check-list lst 'grep)
- (##sys#check-closure acc 'grep)
- (let ((rx (regexp rx)))
- (let loop ((lst lst))
- (if (null? lst)
- '()
- (let ((x (##sys#slot lst 0))
- (r (##sys#slot lst 1)) )
- (if (string-search rx (acc x))
- (cons x (loop r))
- (loop r) ) ) ) ) ) ) ) )
-
-
-;;; Escape regular expression (suggested by Peter Bex):
-
-(define regexp-escape
- (let ([open-output-string open-output-string]
- [get-output-string get-output-string] )
- (lambda (str)
- (##sys#check-string str 'regexp-escape)
- (let ([out (open-output-string)]
- [len (##sys#size str)] )
- (let loop ([i 0])
- (cond [(fx>= i len) (get-output-string out)]
- [(memq (##core#inline "C_subchar" str i)
- '(#\. #\\ #\? #\* #\+ #\^ #\$ #\( #\) #\[ #\] #\| #\{ #\}))
- (##sys#write-char-0 #\\ out)
- (##sys#write-char-0 (##core#inline "C_subchar" str i) out)
- (loop (fx+ i 1)) ]
- [else
- (##sys#write-char-0 (##core#inline "C_subchar" str i) out)
- (loop (fx+ i 1)) ] ) ) ) ) ) )
diff --git a/rules.make b/rules.make
index 9c9efd5b..9b1ed9ba 100644
--- a/rules.make
+++ b/rules.make
@@ -28,16 +28,11 @@ VPATH=$(SRCDIR)
# object files
-LIBCHICKEN_OBJECTS_1 = \
- library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
- srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex irregex scheduler \
- profiler stub expand chicken-syntax chicken-ffi-syntax runtime
+LIBCHICKEN_OBJECTS_1 = library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 srfi-14 srfi-18 srfi-69 $(POSIXFILE) irregex scheduler profiler stub expand chicken-syntax chicken-ffi-syntax runtime
LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
LIBCHICKEN_STATIC_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=-static$(O))
-COMPILER_OBJECTS_1 = \
- chicken batch-driver compiler optimizer compiler-syntax scrutinizer unboxing support \
- c-platform c-backend
+COMPILER_OBJECTS_1 = chicken batch-driver compiler optimizer compiler-syntax scrutinizer unboxing support c-platform c-backend
COMPILER_OBJECTS = $(COMPILER_OBJECTS_1:=$(O))
COMPILER_STATIC_OBJECTS = $(COMPILER_OBJECTS_1:=-static$(O))
@@ -100,10 +95,6 @@ profiler$(O): profiler.c chicken.h $(CHICKEN_CONFIG_H)
$(C_COMPILER) $(C_COMPILER_OPTIONS) $(INCLUDES) \
$(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
$(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
-regex$(O): regex.c chicken.h $(CHICKEN_CONFIG_H)
- $(C_COMPILER) $(C_COMPILER_OPTIONS) \
- $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
- $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
irregex$(O): irregex.c chicken.h $(CHICKEN_CONFIG_H)
$(C_COMPILER) $(C_COMPILER_OPTIONS) \
$(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
@@ -219,11 +210,6 @@ profiler-static$(O): profiler.c chicken.h $(CHICKEN_CONFIG_H)
$(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
$(C_COMPILER_STATIC_OPTIONS) \
$(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
-regex-static$(O): regex.c chicken.h $(CHICKEN_CONFIG_H)
- $(C_COMPILER) $(C_COMPILER_OPTIONS) $(INCLUDES) \
- $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
- $(C_COMPILER_STATIC_OPTIONS) \
- $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
irregex-static$(O): irregex.c chicken.h $(CHICKEN_CONFIG_H)
$(C_COMPILER) $(C_COMPILER_OPTIONS) $(INCLUDES) \
$(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
@@ -335,10 +321,6 @@ extras.import$(O): extras.import.c chicken.h $(CHICKEN_CONFIG_H)
$(HOST_C_COMPILER) $(HOST_C_COMPILER_OPTIONS) $(HOST_C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) -DC_SHARED \
$(HOST_C_COMPILER_COMPILE_OPTION) $(HOST_C_COMPILER_OPTIMIZATION_OPTIONS) $(HOST_C_COMPILER_SHARED_OPTIONS) \
$(HOST_C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(HOST_C_COMPILER_OUTPUT)
-regex.import$(O): regex.import.c chicken.h $(CHICKEN_CONFIG_H)
- $(HOST_C_COMPILER) $(HOST_C_COMPILER_OPTIONS) $(HOST_C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) -DC_SHARED \
- $(HOST_C_COMPILER_COMPILE_OPTION) $(HOST_C_COMPILER_OPTIMIZATION_OPTIONS) $(HOST_C_COMPILER_SHARED_OPTIONS) \
- $(HOST_C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(HOST_C_COMPILER_OUTPUT)
irregex.import$(O): irregex.import.c chicken.h $(CHICKEN_CONFIG_H)
$(HOST_C_COMPILER) $(HOST_C_COMPILER_OPTIONS) $(HOST_C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) -DC_SHARED \
$(HOST_C_COMPILER_COMPILE_OPTION) $(HOST_C_COMPILER_OPTIMIZATION_OPTIONS) $(HOST_C_COMPILER_SHARED_OPTIONS) \
@@ -688,7 +670,6 @@ ifdef STATICBUILD
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) srfi-13.import.scm "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) srfi-69.import.scm "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) extras.import.scm "$(DESTDIR)$(IEGGDIR)"
- $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) regex.import.scm "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) srfi-14.import.scm "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) tcp.import.scm "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_FILE_OPTIONS) foreign.import.scm "$(DESTDIR)$(IEGGDIR)"
@@ -711,7 +692,6 @@ else
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) srfi-13.import.so "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) srfi-69.import.so "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) extras.import.so "$(DESTDIR)$(IEGGDIR)"
- $(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) regex.import.so "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) srfi-14.import.so "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) tcp.import.so "$(DESTDIR)$(IEGGDIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_EXECUTABLE_OPTIONS) foreign.import.so "$(DESTDIR)$(IEGGDIR)"
@@ -749,7 +729,6 @@ ifneq ($(POSTINSTALL_PROGRAM),true)
$(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) "$(DESTDIR)$(IEGGDIR)$(SEP)srfi-13.import.so"
$(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) "$(DESTDIR)$(IEGGDIR)$(SEP)srfi-69.import.so"
$(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) "$(DESTDIR)$(IEGGDIR)$(SEP)extras.import.so"
- $(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) "$(DESTDIR)$(IEGGDIR)$(SEP)regex.import.so"
$(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) "$(DESTDIR)$(IEGGDIR)$(SEP)irregex.import.so"
$(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) "$(DESTDIR)$(IEGGDIR)$(SEP)srfi-14.import.so"
$(POSTINSTALL_PROGRAM) $(POSTINSTALL_PROGRAM_FLAGS) "$(DESTDIR)$(IEGGDIR)$(SEP)tcp.import.so"
@@ -873,8 +852,6 @@ posixunix.c: $(SRCDIR)posixunix.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-de
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
posixwin.c: $(SRCDIR)posixwin.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
-regex.c: $(SRCDIR)regex.scm $(SRCDIR)common-declarations.scm
- $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
irregex.c: $(SRCDIR)irregex.scm $(SRCDIR)irregex-core.scm $(SRCDIR)common-declarations.scm
$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
scheduler.c: $(SRCDIR)scheduler.scm $(SRCDIR)common-declarations.scm
@@ -906,8 +883,6 @@ srfi-69.import.c: $(SRCDIR)srfi-69.import.scm
$(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
extras.import.c: $(SRCDIR)extras.import.scm
$(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
-regex.import.c: $(SRCDIR)regex.import.scm
- $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
irregex.import.c: $(SRCDIR)irregex.import.scm
$(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
srfi-14.import.c: $(SRCDIR)srfi-14.import.scm
@@ -991,7 +966,7 @@ setup-download.c: $(SRCDIR)setup-download.scm setup-api.c
distfiles: library.c eval.c expand.c chicken-syntax.c chicken-ffi-syntax.c \
data-structures.c ports.c files.c extras.c lolevel.c utils.c \
tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c \
- posixunix.c posixwin.c regex.c irregex.c scheduler.c profiler.c stub.c \
+ posixunix.c posixwin.c irregex.c scheduler.c profiler.c stub.c \
chicken-profile.c chicken-install.c chicken-uninstall.c chicken-status.c \
csc.c csi.c chicken.c batch-driver.c compiler.c optimizer.c \
compiler-syntax.c scrutinizer.c unboxing.c support.c \
@@ -1034,7 +1009,7 @@ spotless: distclean testclean
-$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) library.c eval.c data-structures.c \
ports.c files.c extras.c lolevel.c utils.c chicken-syntax.c chicken-ffi-syntax.c \
tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c expand.c \
- posixunix.c posixwin.c regex.c irregex.c scheduler.c profiler.c stub.c \
+ posixunix.c posixwin.c irregex.c scheduler.c profiler.c stub.c \
chicken-profile.c chicken-bug.c \
csc.c csi.c chicken-install.c chicken-uninstall.c chicken-status.c \
chicken.c batch-driver.c compiler.c optimizer.c compiler-syntax.c \
diff --git a/scripts/henrietta.scm b/scripts/henrietta.scm
index af227e22..3a3f829e 100644
--- a/scripts/henrietta.scm
+++ b/scripts/henrietta.scm
@@ -36,7 +36,7 @@
; list
-(require-library setup-download regex extras utils ports srfi-1 posix)
+(require-library setup-download irregex extras utils ports srfi-1 posix)
(module main ()
@@ -65,8 +65,8 @@
(remove-directory tmpdir)))
(define test-file?
- (let ((rx (regexp "(\\./)?tests(/.*)?")))
- (lambda (path) (string-match rx path))))
+ (let ((rx (irregex "(\\./)?tests(/.*)?")))
+ (lambda (path) (irregex-match rx path))))
(define (retrieve name version)
(let ((dir (handle-exceptions ex
@@ -113,8 +113,8 @@
(display dir)
(fail "unable to retrieve extension-list"))))
- (define query-string-rx (regexp "[^?]+\\?(.+)"))
- (define query-arg-rx (regexp "^&?(\\w+)=([^&]+)"))
+ (define query-string-rx (irregex "[^?]+\\?(.+)"))
+ (define query-arg-rx (irregex "^&?(\\w+)=([^&]+)"))
(define (service)
(let ((qs (getenv "QUERY_STRING"))
@@ -123,13 +123,13 @@
(or ra "<unknown>") qs)
(unless qs
(error "no QUERY_STRING set"))
- (let ((m (string-match query-string-rx qs))
+ (let ((m (irregex-match query-string-rx qs))
(egg #f)
(version #f))
- (let loop ((qs (if m (cadr m) qs)))
- (let* ((m (string-search-positions query-arg-rx qs))
- (ms (and m (apply substring qs (cadr m))))
- (rest (and m (substring qs (cadar m)))))
+ (let loop ((qs (if m (irregex-match-substring m 1) qs)))
+ (let* ((m (irregex-search query-arg-rx qs))
+ (ms (and m (irregex-match-substring m 1)))
+ (rest (and m (substring qs (irregex-match-end-index m)))))
(cond ((not m)
(headers) ; from here on use `fail'
(cond (egg
@@ -137,10 +137,10 @@
(cleanup) )
(else (fail "no extension name specified") ) ))
((string=? ms "version")
- (set! version (apply substring qs (caddr m)))
+ (set! version (irregex-match-substring m 2))
(loop rest))
((string=? ms "name")
- (set! egg (apply substring qs (caddr m)))
+ (set! egg (irregex-match-substring m 2))
(loop rest))
((string=? ms "tests")
(set! *tests* #t)
@@ -149,7 +149,7 @@
(headers)
(listing))
((string=? ms "mode")
- (set! *mode* (string->symbol (apply substring qs (caddr m))))
+ (set! *mode* (string->symbol (irregex-match-substring m 2)))
(loop rest))
(else
(warning "unrecognized query option" ms)
diff --git a/scripts/make-egg-index.scm b/scripts/make-egg-index.scm
index 055b987e..69e12c2f 100644
--- a/scripts/make-egg-index.scm
+++ b/scripts/make-egg-index.scm
@@ -2,9 +2,8 @@
(load-relative "tools.scm")
-(use setup-download matchable sxml-transforms data-structures regex)
+(use setup-download matchable sxml-transforms data-structures irregex)
-(import irregex)
(define *help* #f)
(define *major-version* (##sys#fudge 41))
@@ -224,24 +223,24 @@
(let* ((end (irregex-match-end m 0))
(acc (kons i m acc)))
(lp end acc))))))))
- (let ((irregex-match-start-index irregex-match-start)) ;; upcoming API change in irregex 0.7
- (irregex-fold irx
- (lambda (i m s)
- (cons (matched (irregex-match-substring m 1))
- (cons (did-not-match
- (substring str i (irregex-match-start-index m 0)))
- s)))
- '()
- str
- (lambda (i s)
- (reverse (cons (did-not-match (substring str i))
- s))))))
+ (irregex-fold
+ irx
+ (lambda (i m s)
+ (cons (matched (irregex-match-substring m 1))
+ (cons (did-not-match
+ (substring str i (irregex-match-start-index m 0)))
+ s)))
+ '()
+ str
+ (lambda (i s)
+ (reverse (cons (did-not-match (substring str i))
+ s)))))
(transform
+link-regexp+
str
(lambda (name) ;; wiki username
`(a (@ (href ,(string-append "http://chicken.wiki.br/users/"
- (string-substitute " " "-" name 'global))))
+ (irregex-replace/all " " name "-" name))))
,name))
(lambda (x) ;; raw HTML chunk
`(literal ,x))))
diff --git a/scripts/makedist.scm b/scripts/makedist.scm
index e44f234c..a9ca70d7 100644
--- a/scripts/makedist.scm
+++ b/scripts/makedist.scm
@@ -1,7 +1,7 @@
;;;; makedist.scm - Make distribution tarballs
-(use srfi-69)
+(use srfi-69 irregex)
(define *release* #f)
@@ -15,7 +15,7 @@
(define *platform*
(let ((sv (symbol->string (software-version))))
- (cond ((string-match ".*bsd" sv) "bsd")
+ (cond ((irregex-match ".*bsd" sv) "bsd")
(else
(case (build-platform)
((mingw32)
diff --git a/scripts/setversion b/scripts/setversion
index a46d7290..d751ee66 100644
--- a/scripts/setversion
+++ b/scripts/setversion
@@ -10,10 +10,6 @@ exec csi -s "$0" "$@"
(define files '("README" "manual/The User's Manual"))
-(define-syntax rx
- (syntax-rules ()
- ((_ r) (force (delay (regexp r))))))
-
(define (patch which rx subst)
(cond ((and (list? which) (= 2 (length which)))
(let ((from (car which))
@@ -26,17 +22,17 @@ exec csi -s "$0" "$@"
(let loop ()
(let ((ln (read-line)))
(unless (eof-object? ln)
- (write-line (string-substitute rx subst ln #t))
+ (write-line (irregex-replace/all rx ln subst))
(loop) ) ) ) )
- binary:) )
- binary:)))
+ #:binary) )
+ #:binary)))
(else
(let ((tmp (create-temporary-file)))
(patch (list which tmp) rx subst)
(system* "mv ~S ~S" tmp which) ) ) ) )
(define (parse-version v)
- (string-match (rx "(\\d+)\\.(\\d+)\\.(\\d+)(.*)") v) )
+ (string-match (irregex "(\\d+)\\.(\\d+)\\.(\\d+)(.*)") v) )
(define (main args)
(let ((major (##sys#fudge 41))
@@ -65,14 +61,14 @@ exec csi -s "$0" "$@"
binary:)
(system* "cat version.scm")
(let ([vstr (sprintf "version ~A" buildversion)])
- (for-each (cut patch <> (rx "version [0-9][-.0-9a-zA-Z]+") vstr) files) )
+ (for-each (cut patch <> (irregex "version [0-9][-.0-9a-zA-Z]+") vstr) files) )
(patch
"chicken.h"
- (rx "C_MAJOR_VERSION[ \\t]+[0-9]+")
+ (irregex "C_MAJOR_VERSION[ \\t]+[0-9]+")
(sprintf "C_MAJOR_VERSION ~a" major))
(patch
"chicken.h"
- (rx "C_MINOR_VERSION[ \\t]+[0-9]+")
+ (irregex "C_MINOR_VERSION[ \\t]+[0-9]+")
(sprintf "C_MINOR_VERSION ~a" minor))
0))
diff --git a/scripts/tools.scm b/scripts/tools.scm
index c809067f..23dac5e5 100644
--- a/scripts/tools.scm
+++ b/scripts/tools.scm
@@ -341,15 +341,19 @@
(set! debug #t) )
(else (usage 1)) )
(loop (cdr args)) )
- ((string-match "([-_A-Za-z0-9]+)=(.*)" x) =>
+ ((irregex-match "([-_A-Za-z0-9]+)=(.*)" x) =>
(lambda (m)
- (let* ((sym (string->symbol (cadr m))))
+ (let* ((sym (string->symbol (irregex-match-substring m 1))))
(if (##sys#symbol-has-toplevel-binding? sym)
(let ((val (##sys#slot sym 0)))
- (if (or (boolean? val) (string? val) (symbol? val) (eq? (void) val))
- (##sys#setslot sym 0 (caddr m))
- (quit "variable `~a' already has a suspicious value" sym) ) )
- (##sys#setslot sym 0 (caddr m)) )
+ (if (or (boolean? val)
+ (string? val)
+ (symbol? val)
+ (eq? (void) val))
+ (##sys#setslot sym 0 (irregex-match-substring m 2))
+ (quit "variable `~a' already has a suspicious value"
+ sym) ) )
+ (##sys#setslot sym 0 (irregex-match-substring m 2)) )
(loop (cdr args)) ) ) )
(else
(set! targets (cons x targets))
@@ -424,22 +428,24 @@
val)))
(let loop ((args args) (vals '()))
(cond ((null? args) (reverse vals))
- ((string-match "(-{1,2})([-_A-Za-z0-9]+)(=)?\\s*(.+)?" (car args))
+ ((irregex-match "(-{1,2})([-_A-Za-z0-9]+)(=)?\\s*(.+)?" (car args))
=>
(lambda (m)
(let*-values (((next) (cdr args))
((var val)
- (cond ((equal? "=" (fourth m))
- (let ((opt (third m))
- (val (fifth m)))
+ (cond ((equal? "=" (irregex-match-substring m 3))
+ (let ((opt (irregex-match-substring m 2))
+ (val (irregex-match-substring m 4)))
(cond (val (values opt val))
(else
(when (null? next)
- (error "missing argument for option" (car args)) )
+ (error "missing argument for option"
+ (car args)) )
(let ((x (car next)))
(set! next (cdr next))
(values opt x))))) )
- ((string? (second m)) (values (third m) #t))
+ ((string? (irregex-match-substring m 1))
+ (values (irregex-match-substring m 2) #t))
(else (values #f #f)) ) ) )
(cond (var
(assign var val)
diff --git a/setup-api.scm b/setup-api.scm
index 0185dd6f..af36c910 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -24,7 +24,7 @@
; POSSIBILITY OF SUCH DAMAGE.
-(require-library srfi-1 regex utils posix srfi-13 extras ports data-structures files)
+(require-library srfi-1 irregex utils posix srfi-13 extras ports data-structures files)
; This code is partially quite messy and the API is not overly consistent,
; mainly because it has grown "organically" while the old chicken-setup program
@@ -66,7 +66,7 @@
shellpath)
(import scheme chicken foreign
- regex utils posix ports extras data-structures
+ irregex utils posix ports extras data-structures
srfi-1 srfi-13 files)
;;; Constants, variables and parameters
@@ -191,7 +191,7 @@
(let loop ()
(let ((ln (read-line)))
(unless (eof-object? ln)
- (write-line (string-substitute rx subst ln #t))
+ (write-line (irregex-replace/all rx ln subst))
(loop) ) ) ) ) ) ) )
(let ((tmp (create-temporary-file)))
(patch (list tmp tmp) rx subst)
@@ -718,7 +718,7 @@
(define (version>=? v1 v2)
(define (version->list v)
(map (lambda (x) (or (string->number x) x))
- (string-split-fields "[-\\._]" (->string v) #:infix)))
+ (irregex-split "[-\\._]" (->string v))))
(let loop ((p1 (version->list v1))
(p2 (version->list v2)))
(cond ((null? p1) (null? p2))
diff --git a/setup-download.scm b/setup-download.scm
index 02a687ad..f080b5a7 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -24,7 +24,7 @@
; POSSIBILITY OF SUCH DAMAGE.
-(require-library extras regex posix utils setup-api srfi-1 data-structures tcp srfi-13
+(require-library extras irregex posix utils setup-api srfi-1 data-structures tcp srfi-13
files)
@@ -37,7 +37,7 @@
temporary-directory)
(import scheme chicken)
- (import extras regex posix utils srfi-1 data-structures tcp srfi-13 files setup-api)
+ (import extras irregex posix utils srfi-1 data-structures tcp srfi-13 files setup-api)
(define-constant +default-tcp-connect-timeout+ 10000) ; 10 seconds
(define-constant +default-tcp-read/write-timeout+ 20000) ; 20 seconds
@@ -138,7 +138,9 @@
[tagver (existing-version
egg version
(filter-map
- (lambda (f) (and-let* ((m (string-search "^tags/([^/]+)/" f))) (cadr m)))
+ (lambda (f)
+ (and-let* ((m (irregex-search "^tags/([^/]+)/" f)))
+ (irregex-match-substring m 1)))
files))])
(let-values ([(filedir ver)
(if tagver
@@ -170,14 +172,15 @@
(conc dir #\/ egg ".meta"))
(define (deconstruct-url url)
- (let ([m (string-match "(http://)?([^/:]+)(:([^:/]+))?(/.+)" url)])
+ (let ([m (irregex-match "(http://)?([^/:]+)(:([^:/]+))?(/.+)" url)])
(values
- (if m (caddr m) url)
- (if (and m (cadddr m))
- (or (string->number (list-ref m 4))
- (error "not a valid port" (list-ref m 4)))
+ (if m (irregex-match-substring m 2) url)
+ (if (and m (irregex-match-substring m 3))
+ (let ((port (irregex-match-substring m 4)))
+ (or (string->number port)
+ (error "not a valid port" port)))
80)
- (if m (list-ref m 5) "/")) ) )
+ (if m (irregex-match-substring m 5) "/")) ) )
(define (locate-egg/http egg url #!optional version destination tests
proxy-host proxy-port)
@@ -226,13 +229,13 @@
(define (match-http-response rsp)
(and (string? rsp)
- (string-match "HTTP/[0-9.]+\\s+([0-9]+)\\s+.*" rsp)) )
+ (irregex-match "HTTP/[0-9.]+\\s+([0-9]+)\\s+.*" rsp)) )
(define (response-match-code? mrsp code)
- (and mrsp (string=? (number->string code) (cadr mrsp))) )
+ (and mrsp (string=? (number->string code) (irregex-match-substring mrsp 1))) )
(define (match-chunked-transfer-encoding ln)
- (string-match "[Tt]ransfer-[Ee]ncoding:\\s*chunked.*" ln) )
+ (irregex-match "[Tt]ransfer-[Ee]ncoding:\\s*chunked.*" ln) )
(define (http-fetch host port locn dest proxy-host proxy-port)
(d "connecting to host ~s, port ~a ~a...~%" host port
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 963a5c5b..8c33dc87 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -20,7 +20,7 @@ for x in setup-api.so setup-api.import.so setup-download.so \
srfi-1.import.so srfi-4.import.so data-structures.import.so \
ports.import.so files.import.so posix.import.so \
srfi-13.import.so srfi-69.import.so extras.import.so \
- regex.import.so srfi-14.import.so tcp.import.so \
+ irregex.import.so srfi-14.import.so tcp.import.so \
foreign.import.so scheme.import.so srfi-18.import.so \
utils.import.so csi.import.so irregex.import.so types.db; do
cp ../$x test-repository
diff --git a/tests/test-glob.scm b/tests/test-glob.scm
index a5732384..91fc3d64 100644
--- a/tests/test-glob.scm
+++ b/tests/test-glob.scm
@@ -1,20 +1,20 @@
;;;; test-glob.scm - test glob-pattern -> regex translation
-(use regex)
+(use irregex)
-(assert (string-match (glob->regexp "foo.bar") "foo.bar"))
-(assert (string-match (glob->regexp "foo*") "foo.bar"))
-(assert (string-match (glob->regexp "foo/*") "foo/bar"))
-(assert (not (string-match (glob->regexp "foo/*") "foo/bar/baz")))
-(assert (string-match (glob->regexp "foo/*/*") "foo/bar/baz"))
-(assert (not (string-match (glob->regexp "foo/*") "foo/.bar")))
-(assert (string-match (glob->regexp "*foo") "xyzfoo"))
-(assert (not (string-match (glob->regexp "*foo") ".foo")))
-(assert (not (string-match (glob->regexp "*foo*") "a.fooxxx/yyy")))
-(assert (string-match (glob->regexp "*foo*") "fooxxx"))
-(assert (string-match (glob->regexp "main.[ch]") "main.c"))
-(assert (string-match (glob->regexp "main.[ch]") "main.h"))
-(assert (not (string-match (glob->regexp "main.[ch]") "main.cpp")))
-(assert (string-match (glob->regexp "main.[-c]") "main.h"))
-(assert (not (string-match (glob->regexp "main.[-h]") "main.h")))
+(assert (irregex-match (##sys#glob->regexp "foo.bar") "foo.bar"))
+(assert (irregex-match (##sys#glob->regexp "foo*") "foo.bar"))
+(assert (irregex-match (##sys#glob->regexp "foo/*") "foo/bar"))
+(assert (not (irregex-match (##sys#glob->regexp "foo/*") "foo/bar/baz")))
+(assert (irregex-match (##sys#glob->regexp "foo/*/*") "foo/bar/baz"))
+(assert (not (irregex-match (##sys#glob->regexp "foo/*") "foo/.bar")))
+(assert (irregex-match (##sys#glob->regexp "*foo") "xyzfoo"))
+(assert (not (irregex-match (##sys#glob->regexp "*foo") ".foo")))
+(assert (not (irregex-match (##sys#glob->regexp "*foo*") "a.fooxxx/yyy")))
+(assert (irregex-match (##sys#glob->regexp "*foo*") "fooxxx"))
+(assert (irregex-match (##sys#glob->regexp "main.[ch]") "main.c"))
+(assert (irregex-match (##sys#glob->regexp "main.[ch]") "main.h"))
+(assert (not (irregex-match (##sys#glob->regexp "main.[ch]") "main.cpp")))
+(assert (irregex-match (##sys#glob->regexp "main.[-c]") "main.h"))
+(assert (not (irregex-match (##sys#glob->regexp "main.[-h]") "main.h")))
diff --git a/tests/test-irregex.scm b/tests/test-irregex.scm
index 55e39c68..fbeb6288 100644
--- a/tests/test-irregex.scm
+++ b/tests/test-irregex.scm
@@ -1,12 +1,10 @@
;;;: test-irregex.scm
-(use extras regex)
+(use extras irregex)
(include "test.scm")
-(import irregex)
-
(define (subst-matches matches subst)
(define (submatch n)
(if (irregex-match-data? matches)
@@ -292,6 +290,25 @@
(lambda (src i s) (reverse s))))
)
+
+(define (extract name irx str)
+ (irregex-match-substring (irregex-match irx str) name))
+
+(test-group "named submatches"
+ (test-equal "matching alternative is used"
+ "first" (extract 'sub `(or (submatch-named sub "first")
+ (submatch-named sub "second"))
+ "first"))
+ (test-equal "matching alternative is used (second match)"
+ "second" (extract 'sub `(or (submatch-named sub "first")
+ (submatch-named sub "second"))
+ "second"))
+ (test-equal "last match is used with multiple matches for a name"
+ "second" (extract 'sub `(seq (submatch-named sub "first")
+ space
+ (submatch-named sub "second"))
+ "first second")))
+
(test-end)
diff --git a/types.db b/types.db
index e11c436e..c39d00fc 100644
--- a/types.db
+++ b/types.db
@@ -920,22 +920,6 @@
(with-input-from-pipe (procedure with-input-from-pipe (string (procedure () . *) #!optional symbol) . *))
(with-output-to-pipe (procedure with-output-to-pipe (string (procedure () . *) #!optional symbol) . *))
-;; regex
-
-(glob->regexp (procedure glob->regexp (string #!optional *) *))
-(glob? deprecated)
-(grep (procedure grep (* list #!optional (procedure (*) *)) list))
-(regexp (procedure regexp (* #!optional * * *) (struct regexp)))
-(regexp-escape (procedure regexp-escape (string) string))
-(regexp? (procedure regexp? (*) boolean))
-(string-match (procedure string-match (* string) *))
-(string-match-positions (procedure string-match-positions (* string) *))
-(string-search (procedure string-search (* string #!optional fixnum fixnum) *))
-(string-search-positions (procedure string-search-positions (* string #!optional fixnum fixnum) *))
-(string-split-fields (procedure string-split-fields (* string #!optional * fixnum) list))
-(string-substitute (procedure string-substitute (* string string #!optional *) string))
-(string-substitute* (procedure string-substitute* (string list #!optional *) string))
-
;; srfi-1
(alist-cons (procedure alist-cons (* * *) list))
diff --git a/utils.scm b/utils.scm
index 03bd4ed6..b934a550 100644
--- a/utils.scm
+++ b/utils.scm
@@ -27,7 +27,7 @@
(declare
(unit utils)
- (uses extras srfi-13 posix files regex)
+ (uses extras srfi-13 posix files irregex)
(fixnum)
(hide chop-pds)
(disable-interrupts) )
@@ -115,18 +115,15 @@
;;; Scan lines until regex or predicate matches
(define scan-input-lines
- (let ((regexp regexp)
- (read-line read-line)
- (string-search string-search))
- (lambda (rx #!optional (port ##sys#standard-input))
- (let ((rx (if (procedure? rx)
- rx
- (cut string-search (regexp rx) <>))))
- (let loop ()
- (let ((ln (read-line port)))
- (and (not (eof-object? ln))
- (or (rx ln)
- (loop)))))))))
+ (lambda (rx #!optional (port ##sys#standard-input))
+ (let ((rx (if (procedure? rx)
+ rx
+ (cute irregex-search (irregex rx) <>))))
+ (let loop ()
+ (let ((ln (read-line port)))
+ (and (not (eof-object? ln))
+ (or (rx ln)
+ (loop))))))))
;; Ask for confirmation
Trap