From 2413f9c7633c9b4c8668c6e507ca0cf5e8230f7e Mon Sep 17 00:00:00 2001 From: shivers Date: Sun, 11 Jul 1999 20:41:27 +0000 Subject: [PATCH] More fitting the SRE system into the scsh upgrade; should have been committed with previous commit of the rest of the sources in the rx directory. -Olin --- scsh/rx/packages.scm | 30 +++++++++---------- scsh/rx/parse.scm | 14 ++++----- scsh/rx/posixstr.scm | 24 +++++++-------- scsh/rx/re-fold.scm | 22 +++++++------- scsh/rx/re-subst.scm | 70 +++++++++++++++++++++---------------------- scsh/rx/re-syntax.scm | 2 +- scsh/rx/re.scm | 20 ++++++------- scsh/rx/rx-lib.scm | 16 +++++----- scsh/rx/simp.scm | 4 +-- 9 files changed, 101 insertions(+), 101 deletions(-) diff --git a/scsh/rx/packages.scm b/scsh/rx/packages.scm index 9f11971..2d06a7e 100644 --- a/scsh/rx/packages.scm +++ b/scsh/rx/packages.scm @@ -144,18 +144,18 @@ (define-interface re-folders-interface (export - (regexp-foldl (proc (:value (proc (:exact-integer :value :value) :value) - :value - :string - &opt (proc (:exact-integer :value) :value) - :exact-integer) - :value)) - (regexp-foldr (proc (:value (proc (:value :exact-integer :value) :value) - :value - :string - &opt (proc (:exact-integer :value) :value) - :exact-integer) - :value)) + (regexp-fold (proc (:value (proc (:exact-integer :value :value) :value) + :value + :string + &opt (proc (:exact-integer :value) :value) + :exact-integer) + :value)) + (regexp-fold (proc (:value (proc (:value :exact-integer :value) :value) + :value + :string + &opt (proc (:exact-integer :value) :value) + :exact-integer) + :value)) (regexp-for-each (proc (:value (proc (:value) :unspecific) :string &opt :exact-integer) :unspecific)))) @@ -199,7 +199,7 @@ char-set-package error-package ascii - string-lib ; string-foldl + string-lib ; string-fold scheme) (files re-low re simp re-high parse posixstr spencer re-syntax) @@ -225,7 +225,7 @@ conditionals re-level-0 char-set-package - scsh-utilities ; foldl + scsh-utilities ; fold error-package ascii scheme) @@ -264,7 +264,7 @@ (define-structure re-subst re-subst-interface (open re-level-0 re-match-internals - scsh-utilities ; foldl & some string utilities that need to be moved. + scsh-utilities ; fold & some string utilities that need to be moved. scsh-level-0 ; write-string string-lib ; string-copy! scheme) diff --git a/scsh/rx/parse.scm b/scsh/rx/parse.scm index 12ba951..a4cea78 100644 --- a/scsh/rx/parse.scm +++ b/scsh/rx/parse.scm @@ -25,7 +25,7 @@ ;;; Imports: ;;; ? for COND, and SWITCHQ conditional form. -;;; every? +;;; every ;;; This code is much hairier than it would otherwise be because of the ;;; the presence of , forms, which put a static/dynamic duality over @@ -53,8 +53,8 @@ ;;; in the form of embedded code in some of the regexp's fields? (define (static-regexp? re) - (? ((re-seq? re) (every? static-regexp? (re-seq:elts re))) - ((re-choice? re) (every? static-regexp? (re-choice:elts re))) + (? ((re-seq? re) (every static-regexp? (re-seq:elts re))) + ((re-choice? re) (every static-regexp? (re-choice:elts re))) ((re-char-set? re) (char-set? (re-char-set:cset re))) ; Might be code. @@ -267,7 +267,7 @@ (posix-string->regexp (cadr sre)) (error "Illegal (posix-string ...) SRE body." sre))) - (else (if (every? string? sre) ; A set spec -- ("wxyz"). + (else (if (every string? sre) ; A set spec -- ("wxyz"). (let* ((cs (apply char-set-union (map string->char-set sre))) (cs (if case-sensitive? cs (uncase-char-set cs)))) @@ -615,9 +615,9 @@ (receive (loose ranges) (char-set->in-pair cset) (values (apply string loose) (apply string - (foldr (lambda (r lis) - `(,(car r) ,(cdr r) . ,lis)) - '() ranges))))))) + (fold-right (lambda (r lis) + `(,(car r) ,(cdr r) . ,lis)) + '() ranges))))))) (receive (cs+ rp+) (->sexp-pair cset) (receive (cs- rp-) (->sexp-pair (char-set-invert cset)) (if (< (+ (string-length cs-) (string-length rp-)) diff --git a/scsh/rx/posixstr.scm b/scsh/rx/posixstr.scm index 861ab32..45f4dd5 100644 --- a/scsh/rx/posixstr.scm +++ b/scsh/rx/posixstr.scm @@ -324,21 +324,21 @@ (if (zero? len) (values "()" 0 1 '#()) ; Special case "" - (let* ((len2 (string-foldl (lambda (c len) ; Length of answer str - (+ len (if (char-set-contains? specials c) 2 1))) - 0 s)) + (let* ((len2 (string-fold (lambda (c len) ; Length of answer str + (+ len (if (char-set-contains? specials c) 2 1))) + 0 s)) (s2 (make-string len2))) ; Answer string ;; Copy the chars over to S2. - (string-foldl (lambda (c i) - ;; Write char C at index I, return the next index. - (let ((i (cond ((char-set-contains? specials c) - (string-set! s2 i #\\) - (+ i 1)) - (else i)))) - (string-set! s2 i c) - (+ i 1))) - 0 s) + (string-fold (lambda (c i) + ;; Write char C at index I, return the next index. + (let ((i (cond ((char-set-contains? specials c) + (string-set! s2 i #\\) + (+ i 1)) + (else i)))) + (string-set! s2 i c) + (+ i 1))) + 0 s) (values s2 (if (= len 1) 1 2) 0 '#()))))))) diff --git a/scsh/rx/re-fold.scm b/scsh/rx/re-fold.scm index 2f22ea0..2a85879 100644 --- a/scsh/rx/re-fold.scm +++ b/scsh/rx/re-fold.scm @@ -1,13 +1,13 @@ ;;; Regexp "fold" combinators -*- scheme -*- ;;; Copyright (c) 1998 by Olin Shivers. -;;; REGEXP-FOLDL re kons knil s [finish start] -> value -;;; REGEXP-FOLDR re kons knil s [finish start] -> value +;;; REGEXP-FOLD re kons knil s [finish start] -> value +;;; REGEXP-FOLD-RIGHT re kons knil s [finish start] -> value ;;; REGEXP-FOR-EACH re proc s [start] -> unspecific ;;; Non-R4RS imports: let-optionals :optional error ? -;;; regexp-foldl re kons knil s [finish start] -> value +;;; regexp-fold re kons knil s [finish start] -> value ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The following definition is a bit unwieldy, but the intuition is ;;; simple: this procedure uses the regexp RE to divide up string S into @@ -17,7 +17,7 @@ ;;; Search from START (defaulting to 0) for a match to RE; call ;;; this match M. Let I be the index of the end of the match ;;; (that is, (match:end M 0)). Loop as follows: -;;; (regexp-foldl re kons (kons START M knil) s finish I) +;;; (regexp-fold re kons (kons START M knil) s finish I) ;;; If there is no match, return instead ;;; (finish START knil) ;;; FINISH defaults to (lambda (i knil) knil) @@ -38,23 +38,23 @@ ;;; where Ji is the index of the start of NMi, MTCHi is a match value ;;; describing Mi, and Q is the index of the beginning of NMlast. -(define (regexp-foldl re kons knil s . maybe-finish+start) +(define (regexp-fold re kons knil s . maybe-finish+start) (let-optionals maybe-finish+start ((finish (lambda (i x) x)) (start 0)) (if (> start (string-length s)) (error "Illegal START parameter" - regexp-foldl re kons knil s finish start)) + regexp-fold re kons knil s finish start)) (let lp ((i start) (val knil)) (? ((regexp-search re s i) => (lambda (m) (let ((next-i (match:end m 0))) (if (= next-i (match:start m 0)) - (error "An empty-string regexp match has put regexp-foldl into an infinite loop." + (error "An empty-string regexp match has put regexp-fold into an infinite loop." re s start next-i) (lp next-i (kons i m val)))))) (else (finish i val)))))) -;;; regexp-foldr re kons knil s [finish start] -> value +;;; regexp-fold-right re kons knil s [finish start] -> value ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; This procedure repeatedly matches regexp RE across string S. ;;; This divides S up into a sequence of matching/non-matching chunks: @@ -72,11 +72,11 @@ ;;; operation by handling the initial chunk of non-matching text (NM0, above). ;;; FINISH defaults to (lambda (i knil) knil) -(define (regexp-foldr re kons knil s . maybe-finish+start) +(define (regexp-fold-right re kons knil s . maybe-finish+start) (let-optionals maybe-finish+start ((finish (lambda (i x) x)) (start 0)) (if (> start (string-length s)) - (error "Illegal START parameter" regexp-foldr re kons knil s + (error "Illegal START parameter" regexp-fold-right re kons knil s finish start)) (? ((regexp-search re s start) => @@ -87,7 +87,7 @@ (lambda (m) (let ((i (match:start m 0))) (if (= i (match:end m 0)) - (error "An empty-string regexp match has put regexp-foldr into an infinite loop." + (error "An empty-string regexp match has put regexp-fold-right into an infinite loop." re s start i) (kons last-m i (recur m)))))) (else (kons last-m (string-length s) knil))))))) diff --git a/scsh/rx/re-subst.scm b/scsh/rx/re-subst.scm index 6c6c1c0..a55b82b 100644 --- a/scsh/rx/re-subst.scm +++ b/scsh/rx/re-subst.scm @@ -34,20 +34,20 @@ ;; Here's the string case. Make two passes -- one to ;; compute the length of the target string, one to fill it in. - (let* ((len (foldl (lambda (item i) - (+ i (if (string? item) (string-length item) - (receive (si ei) (range item) (- ei si))))) - 0 items)) + (let* ((len (fold (lambda (item i) + (+ i (if (string? item) (string-length item) + (receive (si ei) (range item) (- ei si))))) + 0 items)) (ans (make-string len))) - (foldl (lambda (item index) - (cond ((string? item) - (string-copy! ans index item) - (+ index (string-length item))) - (else (receive (si ei) (range item) - (string-copy! ans index str si ei) - (+ index (- ei si)))))) - 0 items) + (fold (lambda (item index) + (cond ((string? item) + (string-copy! ans index item) + (+ index (string-length item))) + (else (receive (si ei) (range item) + (string-copy! ans index str si ei) + (+ index (- ei si)))))) + 0 items) ans)))) @@ -62,9 +62,9 @@ (else (error "Illegal substitution item." item regexp-substitute/global))))) - (num-posts (foldl (lambda (item count) - (+ count (if (eq? item 'post) 1 0))) - 0 items))) + (num-posts (fold (lambda (item count) + (+ count (if (eq? item 'post) 1 0))) + 0 items))) (if (and port (< num-posts 2)) @@ -108,30 +108,30 @@ (s (vector-ref sv 0)) (e (vector-ref ev 0)) (empty? (= s e))) - (foldl (lambda (item pieces) - (cond ((string? item) - (cons item pieces)) + (fold (lambda (item pieces) + (cond ((string? item) + (cons item pieces)) - ((procedure? item) - (cons (item match) pieces)) + ((procedure? item) + (cons (item match) pieces)) - ((eq? 'post0 item) - (if (and empty? (< s str-len)) - (cons (string (string-ref str s)) - pieces) - pieces)) + ((eq? 'post0 item) + (if (and empty? (< s str-len)) + (cons (string (string-ref str s)) + pieces) + pieces)) - ((eq? 'post item) - (if (not cached-post) - (set! cached-post - (recur (if empty? (+ e 1) e)))) - (append cached-post pieces)) + ((eq? 'post item) + (if (not cached-post) + (set! cached-post + (recur (if empty? (+ e 1) e)))) + (append cached-post pieces)) - (else (receive (si ei) - (range start sv ev item) - (cons (substring str si ei) - pieces))))) - '() items)) + (else (receive (si ei) + (range start sv ev item) + (cons (substring str si ei) + pieces))))) + '() items)) ;; No match. Return str[start,end]. (list (if (zero? start) str diff --git a/scsh/rx/re-syntax.scm b/scsh/rx/re-syntax.scm index 154bd44..41f2763 100644 --- a/scsh/rx/re-syntax.scm +++ b/scsh/rx/re-syntax.scm @@ -11,7 +11,7 @@ (or (string? exp) ; "foo" (and (pair? exp) (let ((head (car exp))) - (or (every? string? exp) ; ("aeiou") + (or (every string? exp) ; ("aeiou") (kw? head '*) ; (* re ...) (kw? head '+) ; (+ re ...) (kw? head '?) ; (? re ...) diff --git a/scsh/rx/re.scm b/scsh/rx/re.scm index 902fd43..d62efb6 100644 --- a/scsh/rx/re.scm +++ b/scsh/rx/re.scm @@ -89,8 +89,8 @@ (define (make-re-seq res) (%make-re-seq res - (foldl (lambda (re sm-count) (+ (re-tsm re) sm-count)) - 0 res))) + (fold (lambda (re sm-count) (+ (re-tsm re) sm-count)) + 0 res))) ;;; Slightly smart sequence constructor: ;;; - Flattens nested sequences @@ -135,8 +135,8 @@ (define (make-re-choice res) (%make-re-choice res - (foldl (lambda (re sm-count) (+ (re-tsm re) sm-count)) - 0 res))) + (fold (lambda (re sm-count) (+ (re-tsm re) sm-count)) + 0 res))) ;;; Slightly smart choice constructor: ;;; - Flattens nested choices @@ -160,7 +160,7 @@ (else (cons re tail)))) '())))) ;; If all elts are char-class re's, fold them together. - (if (every? static-char-class? res) + (if (every static-char-class? res) (let ((cset (apply char-set-union (map (lambda (elt) (if (re-char-set? elt) @@ -540,11 +540,11 @@ (define (uncase-string s) ;; SEQ is a list of chars and doubleton char-sets. - (let* ((seq (string-foldr (lambda (c lis) - (cons (? ((char-lower-case? c) (char-set c (char-upcase c))) - ((char-upper-case? c) (char-set c (char-downcase c))) - (else c)) - lis)) + (let* ((seq (string-fold-right (lambda (c lis) + (cons (? ((char-lower-case? c) (char-set c (char-upcase c))) + ((char-upper-case? c) (char-set c (char-downcase c))) + (else c)) + lis)) '() s)) ;; Coalesce adjacent chars together into a string. diff --git a/scsh/rx/rx-lib.scm b/scsh/rx/rx-lib.scm index 2cd93ea..9bb245b 100644 --- a/scsh/rx/rx-lib.scm +++ b/scsh/rx/rx-lib.scm @@ -26,14 +26,14 @@ (define (spec->char-set in? loose ranges) (let ((doit (lambda (loose ranges) - (foldl (lambda (r cset) - (let ((from (char->ascii (car r))) - (to (char->ascii (cdr r)))) - (do ((i from (+ i 1)) - (cs cset (char-set-adjoin! cs (ascii->char i)))) - ((> i to) cs)))) - (string->char-set loose) - ranges)))) + (fold (lambda (r cset) + (let ((from (char->ascii (car r))) + (to (char->ascii (cdr r)))) + (do ((i from (+ i 1)) + (cs cset (char-set-adjoin! cs (ascii->char i)))) + ((> i to) cs)))) + (string->char-set loose) + ranges)))) (if in? (doit loose ranges) (char-set-invert! (doit loose ranges))))) diff --git a/scsh/rx/simp.scm b/scsh/rx/simp.scm index 4fda498..07dde93 100644 --- a/scsh/rx/simp.scm +++ b/scsh/rx/simp.scm @@ -388,8 +388,8 @@ (define (has-live-submatches? re) (or (re-submatch? re) - (? ((re-seq? re) (every? has-live-submatches? (re-seq:elts re))) - ((re-choice? re) (every? has-live-submatches? (re-choice:elts re))) + (? ((re-seq? re) (every has-live-submatches? (re-seq:elts re))) + ((re-choice? re) (every has-live-submatches? (re-choice:elts re))) ((re-repeat? re) (has-live-submatches? (re-repeat:body re))) ((re-dsm? re) (has-live-submatches? (re-dsm:body re)))