scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
This commit is contained in:
shivers 1999-07-11 20:41:27 +00:00
parent 96d9b0e068
commit 2413f9c763
9 changed files with 101 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
scsh/rx/packages.scm
View File

@ -144,13 +144,13 @@
(define-interface re-folders-interface
(export
(regexp-foldl (proc (:value (proc (:exact-integer :value :value) :value)
(regexp-fold (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)
(regexp-fold (proc (:value (proc (:value :exact-integer :value) :value)
:value
:string
&opt (proc (:exact-integer :value) :value)
@ -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)

10
scsh/rx/parse.scm
View File

@ -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 ,<exp> 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,7 +615,7 @@
(receive (loose ranges) (char-set->in-pair cset)
(values (apply string loose)
(apply string
(foldr (lambda (r lis)
(fold-right (lambda (r lis)
`(,(car r) ,(cdr r) . ,lis))
'() ranges)))))))
(receive (cs+ rp+) (->sexp-pair cset)

4
scsh/rx/posixstr.scm
View File

@ -324,13 +324,13 @@
(if (zero? len)
(values "()" 0 1 '#()) ; Special case ""
(let* ((len2 (string-foldl (lambda (c len) ; Length of answer str
(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)
(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 #\\)

22
scsh/rx/re-fold.scm
View File

@ -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)))))))

8
scsh/rx/re-subst.scm
View File

@ -34,13 +34,13 @@
;; 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)
(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)
(fold (lambda (item index)
(cond ((string? item)
(string-copy! ans index item)
(+ index (string-length item)))
@ -62,7 +62,7 @@
(else (error "Illegal substitution item."
item
regexp-substitute/global)))))
(num-posts (foldl (lambda (item count)
(num-posts (fold (lambda (item count)
(+ count (if (eq? item 'post) 1 0)))
0 items)))
@ -108,7 +108,7 @@
(s (vector-ref sv 0))
(e (vector-ref ev 0))
(empty? (= s e)))
(foldl (lambda (item pieces)
(fold (lambda (item pieces)
(cond ((string? item)
(cons item pieces))

2
scsh/rx/re-syntax.scm
View File

@ -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 ...)

8
scsh/rx/re.scm
View File

@ -89,7 +89,7 @@
(define (make-re-seq res)
(%make-re-seq res
(foldl (lambda (re sm-count) (+ (re-tsm re) sm-count))
(fold (lambda (re sm-count) (+ (re-tsm re) sm-count))
0 res)))
;;; Slightly smart sequence constructor:
@ -135,7 +135,7 @@
(define (make-re-choice res)
(%make-re-choice res
(foldl (lambda (re sm-count) (+ (re-tsm re) sm-count))
(fold (lambda (re sm-count) (+ (re-tsm re) sm-count))
0 res)))
;;; Slightly smart choice constructor:
@ -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,7 +540,7 @@
(define (uncase-string s)
;; SEQ is a list of chars and doubleton char-sets.
(let* ((seq (string-foldr (lambda (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))

2
scsh/rx/rx-lib.scm
View File

@ -26,7 +26,7 @@
(define (spec->char-set in? loose ranges)
(let ((doit (lambda (loose ranges)
(foldl (lambda (r cset)
(fold (lambda (r cset)
(let ((from (char->ascii (car r)))
(to (char->ascii (cdr r))))
(do ((i from (+ i 1))

4
scsh/rx/simp.scm
View File

@ -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)))