[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-scsh ChangeLog INCOMPAT README USAG...
From: |
Gary Houston |
Subject: |
guile/guile-scsh ChangeLog INCOMPAT README USAG... |
Date: |
Sat, 04 Aug 2001 08:22:09 -0700 |
CVSROOT: /cvs
Module name: guile
Changes by: Gary Houston <address@hidden> 01/08/04 08:22:08
Modified files:
guile-scsh : ChangeLog INCOMPAT README USAGE filesys.scm
fluid.scm fr.scm network.scm rdelim.scm
scsh.scm syscalls.scm
guile-scsh/rx : let-match.scm parse.scm posixstr.scm re.scm
rx-lib.scm simp.scm spencer.scm
Log message:
* rx/spencer.scm, rx/simp.scm, rx/rx-lib.scm, rx/re.scm,
rx/posixstr.scm, rx/parse.scm, rx/let-match.scm, rdelim.scm,
network.scm: upgraded with scsh 0.5.2 -> 0.5.3 changes.
* rdelim.scm (read-delimited): don't use obsolete char-set-members.
don't use module (scsh cset-obsolete). define guile-read-delimted!
before read-delimited! is redefined by export.
* rx/spencer.scm, rx/simp.scm, rx/rx-lib.scm, rx/re.scm, rx/parse.scm,
posixstr.scm, fr.scm: don't use module (scsh cset-obsolete).
* scsh.scm: use module (ice-9 format). adjust home-directory and
exec-path-list.
* filesys.scm (rename-file), fluid.scm (make-fluid),
rdelim.scm (read-delimited, read-delimited!),
syscalls.scm (pipe, sleep): use module-ref to get bindings from
guile-core.
* README, USAGE, INCOMPAT: updated: now guile-scsh is based on
scsh 0.5.3.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/ChangeLog.diff?cvsroot=OldCVS&tr1=1.72&tr2=1.73&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/INCOMPAT.diff?cvsroot=OldCVS&tr1=1.24&tr2=1.25&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/README.diff?cvsroot=OldCVS&tr1=1.15&tr2=1.16&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/USAGE.diff?cvsroot=OldCVS&tr1=1.20&tr2=1.21&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/filesys.scm.diff?cvsroot=OldCVS&tr1=1.6&tr2=1.7&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/fluid.scm.diff?cvsroot=OldCVS&tr1=1.3&tr2=1.4&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/fr.scm.diff?cvsroot=OldCVS&tr1=1.5&tr2=1.6&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/network.scm.diff?cvsroot=OldCVS&tr1=1.11&tr2=1.12&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rdelim.scm.diff?cvsroot=OldCVS&tr1=1.10&tr2=1.11&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/scsh.scm.diff?cvsroot=OldCVS&tr1=1.13&tr2=1.14&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/syscalls.scm.diff?cvsroot=OldCVS&tr1=1.16&tr2=1.17&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rx/let-match.scm.diff?cvsroot=OldCVS&tr1=1.2&tr2=1.3&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rx/parse.scm.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rx/posixstr.scm.diff?cvsroot=OldCVS&tr1=1.5&tr2=1.6&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rx/re.scm.diff?cvsroot=OldCVS&tr1=1.5&tr2=1.6&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rx/rx-lib.scm.diff?cvsroot=OldCVS&tr1=1.3&tr2=1.4&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rx/simp.scm.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-scsh/rx/spencer.scm.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text
Patches:
Index: guile/guile-scsh/ChangeLog
diff -u guile/guile-scsh/ChangeLog:1.72 guile/guile-scsh/ChangeLog:1.73
--- guile/guile-scsh/ChangeLog:1.72 Sat Aug 4 03:26:37 2001
+++ guile/guile-scsh/ChangeLog Sat Aug 4 08:22:08 2001
@@ -1,3 +1,27 @@
+2001-08-04 Gary Houston <address@hidden>
+
+ * rx/spencer.scm, rx/simp.scm, rx/rx-lib.scm, rx/re.scm,
+ rx/posixstr.scm, rx/parse.scm, rx/let-match.scm, rdelim.scm,
+ network.scm: upgraded with scsh 0.5.2 -> 0.5.3 changes.
+
+ * rdelim.scm (read-delimited): don't use obsolete char-set-members.
+ don't use module (scsh cset-obsolete). define guile-read-delimted!
+ before read-delimited! is redefined by export.
+
+ * rx/spencer.scm, rx/simp.scm, rx/rx-lib.scm, rx/re.scm, rx/parse.scm,
+ posixstr.scm, fr.scm: don't use module (scsh cset-obsolete).
+
+ * scsh.scm: use module (ice-9 format). adjust home-directory and
+ exec-path-list.
+
+ * filesys.scm (rename-file), fluid.scm (make-fluid),
+ rdelim.scm (read-delimited, read-delimited!),
+ syscalls.scm (pipe, sleep): use module-ref to get bindings from
+ guile-core.
+
+ * README, USAGE, INCOMPAT: updated: now guile-scsh is based on
+ scsh 0.5.3.
+
2001-08-03 Gary Houston <address@hidden>
* glob.scm, fr.scm, fileinfo.scm, let-opt.scm:
Index: guile/guile-scsh/INCOMPAT
diff -u guile/guile-scsh/INCOMPAT:1.24 guile/guile-scsh/INCOMPAT:1.25
--- guile/guile-scsh/INCOMPAT:1.24 Sat Aug 4 03:26:37 2001
+++ guile/guile-scsh/INCOMPAT Sat Aug 4 08:22:08 2001
@@ -9,6 +9,7 @@
=============================
The ODBC interface.
+The char->char partial maps library (CCP).
enabled-interrupts, interrupt-set, itimer, %set-unix-signal-handler,
set-enabled-interrupts, %unix-signal-handler,
Index: guile/guile-scsh/README
diff -u guile/guile-scsh/README:1.15 guile/guile-scsh/README:1.16
--- guile/guile-scsh/README:1.15 Wed Jun 27 13:31:25 2001
+++ guile/guile-scsh/README Sat Aug 4 08:22:08 2001
@@ -1,10 +1,11 @@
-This is an incomplete port of the Scheme Shell, scsh 0.5.2, to Guile.
+This is an incomplete port of the Scheme Shell, scsh 0.5.3, to Guile.
This is not a release of guile-scsh, but was presumably obtained at
some random time from the CVS archive.
For the original scsh package and documentation, see:
http://www.swiss.ai.mit.edu/ftpdir/scsh/
+http://sourceforge.net/projects/scsh/
This version of guile-scsh requires:
Index: guile/guile-scsh/USAGE
diff -u guile/guile-scsh/USAGE:1.20 guile/guile-scsh/USAGE:1.21
--- guile/guile-scsh/USAGE:1.20 Sat Aug 4 03:26:37 2001
+++ guile/guile-scsh/USAGE Sat Aug 4 08:22:08 2001
@@ -175,8 +175,7 @@
(scsh rx re-syntax)
;; rx macro generates code that requires at least:
-;; (scsh rx re) (srfi srfi-14) (scsh cset-obsolete)
-;; (scsh cset-obsolete only needed until rx upgraded to 0.5.3.
+;; (scsh rx re) (srfi srfi-14)
(sre-form? expand-rx if-sre-form rx)
(scsh rx parse)
Index: guile/guile-scsh/filesys.scm
diff -u guile/guile-scsh/filesys.scm:1.6 guile/guile-scsh/filesys.scm:1.7
--- guile/guile-scsh/filesys.scm:1.6 Sat Jul 7 08:35:28 2001
+++ guile/guile-scsh/filesys.scm Sat Aug 4 08:22:08 2001
@@ -121,8 +121,8 @@
;;; do the rename, we could end up overriding it, when the user asked
;;; us not to. That's life in the food chain.
-(if (not (defined? 'guile-rename-file))
- (define guile-rename-file rename-file))
+(define guile-rename-file
+ (module-ref (resolve-module '(guile)) 'rename-file))
(define (rename-file old-fname new-fname . maybe-override?)
(let ((override? (:optional maybe-override? #f)))
Index: guile/guile-scsh/fluid.scm
diff -u guile/guile-scsh/fluid.scm:1.3 guile/guile-scsh/fluid.scm:1.4
--- guile/guile-scsh/fluid.scm:1.3 Sat Jul 7 08:35:28 2001
+++ guile/guile-scsh/fluid.scm Sat Aug 4 08:22:08 2001
@@ -2,9 +2,6 @@
(define-module (scsh fluid))
-(if (not (defined? 'guile-make-fluid))
- (define guile-make-fluid make-fluid))
-
(begin-deprecated
;; Prevent `export' from re-exporting core bindings. This behaviour
;; of `export' is deprecated and will disappear in one of the next
@@ -12,6 +9,9 @@
(define make-fluid #f))
(export make-fluid set-fluid! fluid let-fluid)
+
+(define guile-make-fluid
+ (module-ref (resolve-module '(guile)) 'make-fluid))
(define (make-fluid value)
(let ((result (guile-make-fluid)))
Index: guile/guile-scsh/fr.scm
diff -u guile/guile-scsh/fr.scm:1.5 guile/guile-scsh/fr.scm:1.6
--- guile/guile-scsh/fr.scm:1.5 Sat Aug 4 03:26:37 2001
+++ guile/guile-scsh/fr.scm Sat Aug 4 08:22:08 2001
@@ -11,10 +11,6 @@
:use-module (ice-9 receive)
:use-module (scsh let-opt)
:use-module (srfi srfi-14)
-
- ;; can be removed when rx upgraded to 0.5.3
- :use-module (scsh cset-obsolete)
-
:use-module (scsh rdelim)
:use-module (scsh rx re)
:use-module (scsh rx re-low)
Index: guile/guile-scsh/network.scm
diff -u guile/guile-scsh/network.scm:1.11 guile/guile-scsh/network.scm:1.12
--- guile/guile-scsh/network.scm:1.11 Tue Jun 12 14:36:51 2001
+++ guile/guile-scsh/network.scm Sat Aug 4 08:22:08 2001
@@ -96,31 +96,26 @@
#f))))
(define (bind-listen-accept-loop protocol-family proc arg)
- (let* ((sock (create-socket protocol-family socket-type/stream))
- (addr (cond ((= protocol-family
- protocol-family/internet)
- (let ((port (cond ((integer? arg) arg)
- ((string? arg)
- (service-info:port
- (service-info arg "tcp")))
- (else
- (error "socket-connect: bad arg ~s"
- arg)))))
- (internet-address->socket-address internet-address/any
- arg)))
- ((= protocol-family
- protocol-family/unix)
- (unix-address->socket-address arg))
- (else
- (error "bind-listen-accept-loop: unsupported protocol-family ~s"
- protocol-family)))))
+ (let ((sock (create-socket protocol-family socket-type/stream))
+ (addr (cond ((= protocol-family protocol-family/internet)
+ (internet-address->socket-address internet-address/any
+ (cond ((integer? arg) arg)
+ ((string? arg)
+ (service-info:port (service-info arg "tcp")))
+ (else (error "socket-connect: bad arg ~s" arg)))))
+
+ ((= protocol-family protocol-family/unix)
+ (unix-address->socket-address arg))
+
+ (else
+ (error "bind-listen-accept-loop: unsupported
protocol-family ~s"
+ protocol-family)))))
+
(set-socket-option sock level/socket socket/reuse-address #t)
(bind-socket sock addr)
(listen-socket sock 5)
(let loop ()
- (call-with-values
- (lambda () (accept-connection sock))
- proc)
+ (call-with-values (lambda () (accept-connection sock)) proc)
(loop))))
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Index: guile/guile-scsh/rdelim.scm
diff -u guile/guile-scsh/rdelim.scm:1.10 guile/guile-scsh/rdelim.scm:1.11
--- guile/guile-scsh/rdelim.scm:1.10 Wed Aug 1 14:49:58 2001
+++ guile/guile-scsh/rdelim.scm Sat Aug 4 08:22:08 2001
@@ -7,7 +7,6 @@
(define-module (scsh rdelim)
:use-module (ice-9 rdelim)
:use-module (srfi srfi-14)
- :use-module (scsh cset-obsolete)
:use-module (scsh rx re-high)
:use-module (scsh rx re)
:use-module (scsh rx re-syntax)
@@ -15,9 +14,6 @@
:use-module (scsh let-opt)
)
-(if (not (defined? 'guile-read-delimited))
- (define guile-read-delimited read-delimited))
-
(begin-deprecated
;; Prevent `export' from re-exporting (ice-9 rdelim) bindings. This behaviour
;; of `export' is deprecated and will disappear in one of the next
@@ -31,21 +27,21 @@
;; unchanged from (ice-9 rdelim)
(re-export %read-delimited!)
+(define guile-read-delimited
+ (module-ref (resolve-module '(ice-9 rdelim)) 'read-delimited))
+(define guile-read-delimited!
+ (module-ref (resolve-module '(ice-9 rdelim)) 'read-delimited!))
+
(define (read-delimited delims . args)
(let ((rv
- (apply guile-read-delimited (list->string
- (char-set-members delims)) args)))
+ (apply guile-read-delimited (char-set->string delims) args)))
(if (pair? rv)
(values (car rv) (cdr rv))
rv)))
-(if (not (defined? 'guile-read-delimited!))
- (define guile-read-delimited! read-delimited!))
-
(define (read-delimited! delims . args)
(let ((rv
- (apply guile-read-delimited! (list->string
- (char-set-members delims)) args)))
+ (apply guile-read-delimited! (char-set->string delims) args)))
(if (pair? rv)
(values (car rv) (cdr rv))
rv)))
@@ -244,7 +240,6 @@
; (values c (- i start)))
; ((>= i end) ; Filled the buffer.
-; (if gobble? (read-char port))
; (values #f (- i start)))
; (else (string-set! buf i (read-char port))
Index: guile/guile-scsh/rx/let-match.scm
diff -u guile/guile-scsh/rx/let-match.scm:1.2
guile/guile-scsh/rx/let-match.scm:1.3
--- guile/guile-scsh/rx/let-match.scm:1.2 Sun Oct 29 11:53:23 2000
+++ guile/guile-scsh/rx/let-match.scm Sat Aug 4 08:22:08 2001
@@ -1,22 +1,11 @@
;;; These are some macros to support using regexp matching.
+;; this file has been renamed to re-match-syntax.scm in scsh.
(define-module (scsh rx let-match)
:use-module (scsh module-system)
:use-module (scsh alt-syntax))
(export-syntax let-match if-match match-cond)
-(define-structure let-match-package
- (export (let-match :syntax)
- (if-match :syntax)
- (match-cond :syntax))
- (for-syntax (open scheme
- signals)) ; For ERROR
-
- (open scsh scheme)
- (access signals) ; for ERROR
-
- (begin
-
;;; (let-match m mvars body ...)
;;; Bind the vars in MVARS to the match & submatch strings of match data M,
;;; and eval the body forms. #F is allowed in the MVARS list, as a don't-care
@@ -123,4 +112,3 @@
(let-match m mvars
body ...))))
clause2 ...))))
-))
Index: guile/guile-scsh/rx/parse.scm
diff -u guile/guile-scsh/rx/parse.scm:1.4 guile/guile-scsh/rx/parse.scm:1.5
--- guile/guile-scsh/rx/parse.scm:1.4 Wed Aug 1 13:42:57 2001
+++ guile/guile-scsh/rx/parse.scm Sat Aug 4 08:22:08 2001
@@ -47,7 +47,6 @@
(define-module (scsh rx parse)
:use-module (scsh utilities)
:use-module (srfi srfi-14)
- :use-module (scsh cset-obsolete)
:use-module (ice-9 receive)
:use-module (scsh ascii)
:use-module (scsh rx re-low)
@@ -87,8 +86,8 @@
;;; Two useful standard char sets
-(define nonl-chars (char-set-invert (char-set #\newline)))
-(define word-chars (char-set-union (char-set #\_) char-set:alphanumeric))
+(define nonl-chars (char-set-complement (char-set #\newline)))
+(define word-chars (char-set-union (char-set #\_) char-set:letter+digit))
;;; Little utility that should be moved to scsh's utilities.scm
(define (partition pred lis)
@@ -245,8 +244,8 @@
(map parse-char-class (cdr sre))
r))
(cs (if (char-set? cs)
- (char-set-invert cs)
- `(,(r 'char-set-invert) ,cs))))
+ (char-set-complement cs)
+ `(,(r 'char-set-complement) ,cs))))
(if cset? cs (make-re-char-set cs))))
((&) (let ((cs (assoc-cset-op char-set-intersection
'char-set-intersection
@@ -294,15 +293,15 @@
((nonl) nonl-chars)
((lower-case lower) char-set:lower-case)
((upper-case upper) char-set:upper-case)
- ((alphabetic alpha) char-set:alphabetic)
- ((numeric digit num) char-set:numeric)
- ((alphanumeric alnum alphanum) char-set:alphanumeric)
+ ((alphabetic alpha) char-set:letter)
+ ((numeric digit num) char-set:digit)
+ ((alphanumeric alnum alphanum) char-set:letter+digit)
((punctuation punct) char-set:punctuation)
((graphic graph) char-set:graphic)
((blank) char-set:blank)
((whitespace space white) char-set:whitespace)
((printing print) char-set:printing)
- ((control cntrl) char-set:control)
+ ((control cntrl) char-set:iso-control)
((hex-digit xdigit hex) char-set:hex-digit)
((ascii) char-set:ascii)
(else (error "Illegal regular expression" sre)))))
@@ -359,10 +358,9 @@
(if (< i 0)
(if cs? cset (uncase-char-set cset)) ; Case fold if necessary.
(lp (- i 2)
- (char-set-union!
- cset
- (ascii-range->char-set (char->ascii (string-ref specs (-
i 1)))
- (+ 1 (char->ascii (string-ref
specs i)))))))))))
+ (ucs-range->char-set! (char->ascii (string-ref specs (- i 1)))
+ (+ 1 (char->ascii (string-ref specs i)))
+ #f cset)))))))
;;; (regexp->scheme re r)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -464,17 +462,17 @@
(else #f)))
(if one
(switch char-set= cs
- ((char-set:alphanumeric) alphanum)
+ ((char-set:letter+digit) alphanum)
((char-set:graphic) graph)
((char-set:hex-digit) hex)
(else #f))
- (and (char-set= cs char-set:alphabetic) alpha)))
+ (and (char-set= cs char-set:letter) alpha)))
(and (char-set= cs char-set:lower-case) lower)) ; a, not A
(if biga
(and (not space) (char-set= cs char-set:upper-case) upper)
(if one
- (and (not space) (char-set= cs char-set:numeric) num)
+ (and (not space) (char-set= cs char-set:digit) num)
(if space
(switch char-set= cs
((char-set:whitespace) white)
@@ -482,7 +480,7 @@
(else #f))
(switch char-set= cs
((char-set:punctuation) punct)
- ((char-set:control) ctl)
+ ((char-set:iso-control) ctl)
(else #f))))))))
@@ -491,21 +489,21 @@
(try-classify-char-set cs
'char-set:full 'nonl-chars
'char-set:lower-case
'char-set:upper-case
- 'char-set:alphabetic 'char-set:numeric
- 'char-set:alphanumeric
'char-set:punctuation
+ 'char-set:letter 'char-set:digit
+ 'char-set:letter+digit
'char-set:punctuation
'char-set:graphic
'char-set:whitespace
- 'char-set:printing 'char-set:control
+ 'char-set:printing
'char-set:iso-control
'char-set:hex-digit 'char-set:blank
'char-set:ascii))))
(? ((not (char-set? cs)) cs) ; Dynamic -- *already* Scheme code.
((char-set-empty? cs) (r 'char-set:empty))
((try cs) => r)
- ((try (char-set-invert cs)) =>
- (lambda (name) `(,(r 'char-set-invert) ,name)))
+ ((try (char-set-complement cs)) =>
+ (lambda (name) `(,(r 'char-set-complement) ,name)))
(else
(receive (loose+ ranges+) (char-set->in-pair cs)
- (receive (loose- ranges-) (char-set->in-pair (char-set-invert cs))
+ (receive (loose- ranges-) (char-set->in-pair (char-set-complement cs))
(let ((makeit (r 'spec->char-set)))
(if (< (+ (length loose-) (* 12 (length ranges-)))
(+ (length loose+) (* 12 (length ranges+))))
@@ -530,9 +528,9 @@
'ascii)))
(nchars (char-set-size cs)))
(? ((zero? nchars) `(,(r '|)))
- ((= 1 nchars) (apply string (char-set-members cs)))
+ ((= 1 nchars) (apply string (char-set->list cs)))
((try cs) => r)
- ((try (char-set-invert cs)) =>
+ ((try (char-set-complement cs)) =>
(lambda (name) `(,(r '~) ,name)))
(else (receive (cs rp comp?) (char-set->in-sexp-spec cs)
(let ((args (append (? ((string=? cs "") '())
@@ -632,7 +630,7 @@
`(,(car r) ,(cdr r) .
,lis))
'() ranges)))))))
(receive (cs+ rp+) (->sexp-pair cset)
- (receive (cs- rp-) (->sexp-pair (char-set-invert cset))
+ (receive (cs- rp-) (->sexp-pair (char-set-complement cset))
(if (< (+ (string-length cs-) (string-length rp-))
(+ (string-length cs+) (string-length rp+)))
(values cs- rp- #t)
Index: guile/guile-scsh/rx/posixstr.scm
diff -u guile/guile-scsh/rx/posixstr.scm:1.5
guile/guile-scsh/rx/posixstr.scm:1.6
--- guile/guile-scsh/rx/posixstr.scm:1.5 Wed Aug 1 13:42:57 2001
+++ guile/guile-scsh/rx/posixstr.scm Sat Aug 4 08:22:08 2001
@@ -57,7 +57,6 @@
:use-module (ice-9 receive)
:use-module (srfi srfi-13)
:use-module (srfi srfi-14)
- :use-module (scsh cset-obsolete)
:use-module (scsh utilities)
:use-module (scsh ascii)
:use-module (scsh rx re)
@@ -388,11 +387,11 @@
(? ((= 0 nchars) (values "[^\000-\177]" 1 0 '#())) ; Empty set
((= 1 nchars) ; Singleton set
- (translate-string (string (car (char-set-members cset)))))
+ (translate-string (string (car (char-set->list cset)))))
;; General case. Try both [...] and [^...].
(else (let ((s- (->bracket-string cset #t))
- (s+ (->bracket-string (char-set-invert cset) #f)))
+ (s+ (->bracket-string (char-set-complement cset) #f)))
(values (if (< (string-length s-) (string-length s+))
s- s+)
1 0 '#())))))))
Index: guile/guile-scsh/rx/re.scm
diff -u guile/guile-scsh/rx/re.scm:1.5 guile/guile-scsh/rx/re.scm:1.6
--- guile/guile-scsh/rx/re.scm:1.5 Wed Aug 1 13:42:57 2001
+++ guile/guile-scsh/rx/re.scm Sat Aug 4 08:22:08 2001
@@ -18,7 +18,6 @@
:use-module (ice-9 receive)
:use-module (srfi srfi-13)
:use-module (srfi srfi-14)
- :use-module (scsh cset-obsolete)
:use-module (scsh defrec)
:use-module (scsh jar-defrecord)
:use-module (scsh rx re-low)
@@ -86,7 +85,7 @@
(re-tsm (re-dsm:body re))))) ; minus body's submatches.
;;; Slightly smart DSM constructor:
-;;; - Absorb this DSM into an inner dsm, or submatch.
+;;; - Absorb this DSM into an inner dsm.
;;; - Punt unnecessary DSM's.
(define (re-dsm body pre-dsm post-dsm)
@@ -94,15 +93,9 @@
(receive (body1 pre-dsm1) (open-dsm body)
(let ((pre-dsm (+ pre-dsm pre-dsm1)))
- (? ((= tsm (re-tsm body1)) body1) ; Trivial DSM
+ (if (= tsm (re-tsm body1)) body1 ; Trivial DSM
+ (%make-re-dsm body1 pre-dsm tsm)))))) ; Non-trivial DSM
- ((re-submatch? body1) ; Absorb into submatch.
- (%make-re-submatch (re-submatch:body body1)
- (+ pre-dsm (re-submatch:pre-dsm body1))
- tsm))
-
- (else (%make-re-dsm body1 pre-dsm tsm))))))) ; Non-trivial DSM
-
;;; Take a regexp RE and return an equivalent (re', pre-dsm) pair of values.
;;; Recurses into DSM records. It is the case that
;;; (<= (+ pre-dsm (re-tsm re')) (re-tsm re))
@@ -213,7 +206,7 @@
(string->char-set (re-string:chars elt))))
res))))
(if (= 1 (char-set-size cset))
- (make-re-string (apply string (char-set-members cset)))
+ (make-re-string (apply string (char-set->list cset)))
(make-re-char-set cset)))
(if (pair? res)
@@ -438,7 +431,7 @@
(char-set-full? cs)))))
(define re-nonl
- (make-re-char-set/posix (char-set-invert (char-set #\newline))
+ (make-re-char-set/posix (char-set-complement (char-set #\newline))
"[^\n]"
'#()))
@@ -465,7 +458,7 @@
(define re-word
- (let ((wcs (char-set-union char-set:alphanumeric ; Word chars
+ (let ((wcs (char-set-union char-set:letter+digit ; Word chars
(char-set #\_))))
(make-re-seq (list re-bow
(make-re-repeat 1 #f (make-re-char-set wcs))
Index: guile/guile-scsh/rx/rx-lib.scm
diff -u guile/guile-scsh/rx/rx-lib.scm:1.3 guile/guile-scsh/rx/rx-lib.scm:1.4
--- guile/guile-scsh/rx/rx-lib.scm:1.3 Wed Aug 1 13:42:57 2001
+++ guile/guile-scsh/rx/rx-lib.scm Sat Aug 4 08:22:08 2001
@@ -6,7 +6,6 @@
(define-module (scsh rx rx-lib)
:use-module (scsh utilities)
:use-module (srfi srfi-14)
- :use-module (scsh cset-obsolete)
:use-module (scsh ascii)
:use-module (scsh rx re)
:use-module (scsh rx cond-package)
@@ -46,5 +45,5 @@
ranges))))
(if in?
(doit loose ranges)
- (char-set-invert! (doit loose ranges)))))
+ (char-set-complement! (doit loose ranges)))))
Index: guile/guile-scsh/rx/simp.scm
diff -u guile/guile-scsh/rx/simp.scm:1.4 guile/guile-scsh/rx/simp.scm:1.5
--- guile/guile-scsh/rx/simp.scm:1.4 Wed Aug 1 13:42:57 2001
+++ guile/guile-scsh/rx/simp.scm Sat Aug 4 08:22:08 2001
@@ -36,7 +36,6 @@
:use-module (scsh rx re)
:use-module (scsh rx cond-package)
:use-module (srfi srfi-14)
- :use-module (scsh cset-obsolete)
)
(export simplify-regexp)
@@ -56,7 +55,7 @@
(values (let ((cs (re-char-set:cset re)))
(if (and (char-set? cs)
(= 1 (char-set-size cs)))
- (make-re-string (string (car (char-set-members cs))))
+ (make-re-string (string (car (char-set->list cs))))
re))
0))
@@ -252,7 +251,7 @@
(tail (if (and bos? (not prev-bos?)) (cons re-bos tail) tail))
(tail (? ((zero? numchars) tail) ; Drop empty char set.
((= 1 numchars) ; {c} => "c"
- (cons (make-re-string (string (car (char-set-members cset))))
+ (cons (make-re-string (string (car (char-set->list cset))))
tail))
(else (cons (make-re-char-set cset) tail)))))
tail))
Index: guile/guile-scsh/rx/spencer.scm
diff -u guile/guile-scsh/rx/spencer.scm:1.4 guile/guile-scsh/rx/spencer.scm:1.5
--- guile/guile-scsh/rx/spencer.scm:1.4 Wed Aug 1 13:42:57 2001
+++ guile/guile-scsh/rx/spencer.scm Sat Aug 4 08:22:08 2001
@@ -8,7 +8,6 @@
(define-module (scsh rx spencer)
:use-module (ice-9 receive)
:use-module (srfi srfi-14)
- :use-module (scsh cset-obsolete)
:use-module (scsh ascii)
:use-module (scsh rx re))
(export posix-string->regexp)
@@ -136,7 +135,7 @@
((#\]) (if (= i i0)
(lp i1 (char-set-adjoin! cset #\]))
(let ((cset (if negate?
- (char-set-invert! cset)
+ (char-set-complement! cset)
cset)))
(values (make-re-char-set cset) i1))))
Index: guile/guile-scsh/scsh.scm
diff -u guile/guile-scsh/scsh.scm:1.13 guile/guile-scsh/scsh.scm:1.14
--- guile/guile-scsh/scsh.scm:1.13 Sat Jul 7 08:35:28 2001
+++ guile/guile-scsh/scsh.scm Sat Aug 4 08:22:08 2001
@@ -5,6 +5,7 @@
(define-module (scsh scsh)
:use-module (ice-9 receive)
+ :use-module (ice-9 format)
:use-module (scsh utilities)
:use-module (scsh syscalls)
:use-module (scsh syntax)
@@ -336,8 +337,10 @@
(close-fdes (open-fdes fname oflags #o600))
fname)
(if (null? maybe-prefix) '()
- (list (string-append (car maybe-prefix) ".~a"))))))
+ (list (string-append (constant-format-string (car maybe-prefix))
+ ".~a"))))))
+
(define *temp-file-template*
(make-fluid (string-append "/usr/tmp/" (number->string (pid)) ".~a")))
@@ -355,6 +358,23 @@
(loop (+ i 1)))))))))
+;; Double tildes in S.
+;; Using the return value as a format string will output exactly S.
+(define (constant-format-string s) ; Ugly code. Would be much clearer
+ (let* ((len (string-length s)) ; if written with string SRFI.
+ (tilde? (lambda (s i) (char=? #\~ (string-ref s i))))
+ (newlen (do ((i (- len 1) (- i 1))
+ (ans 0 (+ ans (if (tilde? s i) 2 1))))
+ ((< i 0) ans)))
+ (fs (make-string newlen)))
+ (let lp ((i 0) (j 0))
+ (cond ((< i len)
+ (let ((j (cond ((tilde? s i) (string-set! fs j #\~) (+ j 1))
+ (else j))))
+ (string-set! fs j (string-ref s i))
+ (lp (+ i 1) (+ j 1))))))
+ fs))
+
;;; Roughly equivalent to (pipe).
;;; Returns two file ports [iport oport] open on a temp file.
@@ -706,7 +726,7 @@
(%exec prog (cons prog arglist) env))
;(define (exec-path/env prog env . arglist)
-; (cond ((exec-path-search (stringify prog) exec-path-list) =>
+; (cond ((exec-path-search (stringify prog) (fluid exec-path-list)) =>
; (lambda (binary)
; (apply exec/env binary env arglist)))
; (else (error "No executable found." prog arglist))))
@@ -728,7 +748,7 @@
(for-each (lambda (dir)
(let ((binary (string-append dir "/" prog)))
(false-if-exception (%exec binary arglist env))))
- exec-path-list))))
+ (fluid exec-path-list)))))
(error "No executable found." prog arglist))
@@ -787,10 +807,8 @@
;;; Some globals:
-(if (not (defined? 'home-directory))
- (define home-directory ""))
-(if (not (defined? 'exec-path-list))
- (define exec-path-list '()))
+(define home-directory "")
+(define exec-path-list (make-fluid '()))
(define (init-scsh-vars quietly?)
(set! home-directory
@@ -798,11 +816,11 @@
(else (if (not quietly?)
(warn "Starting up with no home directory ($HOME)."))
"/")))
- (set! exec-path-list
- (cond ((getenv "PATH") => split-colon-list)
- (else (if (not quietly?)
- (warn "Starting up with no path ($PATH)."))
- '()))))
+ (set-fluid! exec-path-list
+ (cond ((getenv "PATH") => split-colon-list)
+ (else (if (not quietly?)
+ (warn "Starting up with no path ($PATH)."))
+ '()))))
(init-scsh-vars #f)
Index: guile/guile-scsh/syscalls.scm
diff -u guile/guile-scsh/syscalls.scm:1.16 guile/guile-scsh/syscalls.scm:1.17
--- guile/guile-scsh/syscalls.scm:1.16 Sat Jul 7 08:35:28 2001
+++ guile/guile-scsh/syscalls.scm Sat Aug 4 08:22:08 2001
@@ -634,8 +634,9 @@
(define-errno-syscall (pipe-fdes) pipe-fdes/errno
r w)
-(if (not (defined? 'guile-pipe))
- (define guile-pipe pipe))
+(define guile-pipe
+ (module-ref (resolve-module '(guile)) 'pipe))
+
(define pipe (lambda ()
(let ((rv (guile-pipe)))
(values (car rv) (cdr rv)))))
@@ -889,6 +890,8 @@
cons))
env-list))
+;; guile version uses lists instead of vectors.
+; (define (alist->env-vec alist)
(define (alist->env-list alist)
(map (lambda (var.val)
(string-append (car var.val) "=" (cdr var.val)))
@@ -1128,11 +1131,11 @@
; De-released -- not POSIX and not on SGI systems.
; (define-foreign usleep (usleep (integer usecs)) integer)
-;; Guile's sleep can be interrupted.
-(if (not (defined? 'guile-sleep))
- (define guile-sleep sleep))
+;; Guile's sleep can be interrupted so define using sleep-until.
+(define (sleep secs) (sleep-until (+ secs (current-time))))
-(define (sleep secs) (sleep-until (+ secs (time))))
+(define guile-sleep
+ (module-ref (resolve-module '(guile)) 'sleep))
(define (sleep-until when)
(let ((now (current-time))
- guile/guile-scsh ChangeLog INCOMPAT README USAG...,
Gary Houston <=