guile-cvs
[Top][All Lists]
Advanced

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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]