[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, wip-r6rs-libraries, updated. release_1
|
From: |
Julian Graham |
|
Subject: |
[Guile-commits] GNU Guile branch, wip-r6rs-libraries, updated. release_1-9-8-85-g4123ca6 |
|
Date: |
Sun, 21 Mar 2010 23:27:23 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=4123ca6b01730f59d3cbb6153c92ea926edc34a3
The branch, wip-r6rs-libraries has been updated
via 4123ca6b01730f59d3cbb6153c92ea926edc34a3 (commit)
via 6c7209e9e5ec1531065fa93398890215d1e8a0d2 (commit)
via dd28a40f4f6ad153b75bb819368499fe74533047 (commit)
from dbf667f9777c1ac37e904e8192895f1a2b51dbfc (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 4123ca6b01730f59d3cbb6153c92ea926edc34a3
Author: Julian Graham <address@hidden>
Date: Sun Mar 21 19:26:48 2010 -0400
Implementation and test cases for R6RS (rnrs files) library.
* module/Makefile.am: Add rnrs/6/files.scm to RNRS_SOURCES.
* module/rnrs/6/conditions.scm (define-condition-type): Use specified
accessor name to create accessor binding. Add internally-visible
&i/o-* condition types.
* module/rnrs/6/files.scm: New file.
* module/rnrs/io/6/simple.scm: Export &i/o-* condition types clandestinely
imported from (rnrs conditions).
* test-suite/Makefile.am: Add tests/r6rs-files.test to SCM_TESTS.
* test-suite/test/r6rs-files.test: New file.
commit 6c7209e9e5ec1531065fa93398890215d1e8a0d2
Author: Julian Graham <address@hidden>
Date: Sun Mar 21 17:12:38 2010 -0400
Implementation for the R6RS (rnrs sorting) library.
* module/Makefile.am: Add rnrs/6/sorting.scm to RNRS_SOURCES.
* module/rnrs/6/sorting.scm: New file.
commit dd28a40f4f6ad153b75bb819368499fe74533047
Author: Julian Graham <address@hidden>
Date: Sun Mar 21 17:03:35 2010 -0400
Implementation for the R6RS (rnrs programs) library.
* module/Makefile.am: Add rnrs/6/programs.scm to RNRS_SOURCES.
* module/rnrs/6/programs.scm: New file.
-----------------------------------------------------------------------
Summary of changes:
module/Makefile.am | 3 +
module/rnrs/6/conditions.scm | 36 +++++-
module/rnrs/6/files.scm | 125 ++++++++++++++++++++
module/{srfi/srfi-8.scm => rnrs/6/programs.scm} | 21 +---
module/rnrs/6/{control.scm => sorting.scm} | 20 +--
module/rnrs/io/6/simple.scm | 99 +++++++++++++++-
test-suite/Makefile.am | 1 +
.../tests/{r6rs-control.test => r6rs-files.test} | 32 +++--
8 files changed, 290 insertions(+), 47 deletions(-)
create mode 100644 module/rnrs/6/files.scm
copy module/{srfi/srfi-8.scm => rnrs/6/programs.scm} (67%)
copy module/rnrs/6/{control.scm => sorting.scm} (65%)
copy test-suite/tests/{r6rs-control.test => r6rs-files.test} (54%)
diff --git a/module/Makefile.am b/module/Makefile.am
index 2ef342d..52ca7e8 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -260,8 +260,11 @@ RNRS_SOURCES = \
rnrs/6/conditions.scm \
rnrs/6/control.scm \
rnrs/6/exceptions.scm \
+ rnrs/6/files.scm \
rnrs/6/hashtables.scm \
rnrs/6/lists.scm \
+ rnrs/6/programs.scm \
+ rnrs/6/sorting.scm \
rnrs/6/syntax-case.scm \
rnrs/6/unicode.scm \
rnrs/arithmetic/6/bitwise.scm \
diff --git a/module/rnrs/6/conditions.scm b/module/rnrs/6/conditions.scm
index 5916f51..b6630c8 100644
--- a/module/rnrs/6/conditions.scm
+++ b/module/rnrs/6/conditions.scm
@@ -104,7 +104,7 @@
(let*
((fields (let* ((field-spec-syntax #'((field accessor) ...))
(field-specs (syntax->datum field-spec-syntax)))
- (list->vector (map (lambda (field-spec)
+ (list->vector (map (lambda (field-spec)
(cons 'immutable field-spec))
field-specs))))
(fields-syntax (datum->syntax stx fields)))
@@ -123,8 +123,8 @@
(if (>= counter (vector-length fields))
accessors
(f (cons #`(define #,(datum->syntax
- stx (cadr (vector-ref fields
- counter)))
+ stx (caddr (vector-ref fields
+ counter)))
(record-accessor condition-type #,counter))
accessors)
(+ counter 1))))))))))
@@ -212,4 +212,32 @@
(subform syntax-violation-subform))
(define-condition-type &undefined &violation
- make-undefined-violation undefined-violation?))
+ make-undefined-violation undefined-violation?)
+
+ ;; Condition types that are used by (rnrs files), (rnrs io ports), and
+ ;; (rnrs io simple). These are defined here so as to be easily shareable by
+ ;; these three libraries.
+
+ (define-condition-type &i/o &error make-i/o-error i/o-error?)
+ (define-condition-type &i/o-read &i/o make-i/o-read-error i/o-read-error?)
+ (define-condition-type &i/o-write &i/o make-i/o-write-error i/o-write-error?)
+ (define-condition-type &i/o-invalid-position
+ &i/o make-i/o-invalid-position-error i/o-invalid-position-error?
+ (position i/o-error-position))
+ (define-condition-type &i/o-filename
+ &i/o make-i/o-filename-error i/o-filename-error?
+ (filename i/o-error-filename))
+ (define-condition-type &i/o-file-protection
+ &i/o-filename make-i/o-file-protection-error i/o-file-protection-error?)
+ (define-condition-type &i/o-file-is-read-only
+ &i/o-file-protection make-i/o-file-is-read-only-error
+ i/o-file-is-read-only-error?)
+ (define-condition-type &i/o-file-already-exists
+ &i/o-filename make-i/o-file-already-exists-error
+ i/o-file-already-exists-error?)
+ (define-condition-type &i/o-file-does-not-exist
+ &i/o-filename make-i/o-file-does-not-exist-error
+ i/o-file-does-not-exist-error?)
+ (define-condition-type &i/o-port &i/o make-i/o-port-error i/o-port-error?
+ (port i/o-error-port))
+)
diff --git a/module/rnrs/6/files.scm b/module/rnrs/6/files.scm
new file mode 100644
index 0000000..da806d4
--- /dev/null
+++ b/module/rnrs/6/files.scm
@@ -0,0 +1,125 @@
+;;; files.scm --- The R6RS file system library
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(library (rnrs files (6))
+ (export file-exists?
+ delete-file
+
+ &i/o make-i/o-error i/o-error?
+ &i/o-read make-i/o-read-error i/o-read-error?
+ &i/o-write make-i/o-write-error i/o-write-error?
+
+ &i/o-invalid-position
+ make-i/o-invalid-position-error
+ i/o-invalid-position-error?
+ i/o-error-position
+
+ &i/o-filename
+ make-i/o-filename-error
+ i/o-filename-error?
+ i/o-error-filename
+
+ &i/o-file-protection
+ make-i/o-file-protection-error
+ i/o-file-protection-error?
+
+ &i/o-file-is-read-only
+ make-i/o-file-is-read-only-error
+ i/o-file-is-read-only-error?
+
+ &i/o-file-already-exists
+ make-i/o-file-already-exists-error
+ i/o-file-already-exists-error?
+
+ &i/o-file-does-not-exist
+ make-i/o-file-does-not-exist-error
+ i/o-file-does-not-exist-error?
+
+ &i/o-port
+ make-i/o-port-error
+ i/o-port-error?
+ i/o-error-port)
+
+ (import (rename (only (guile) file-exists? delete-file catch)
+ (delete-file delete-file-internal))
+ (rnrs base (6))
+ (rnrs conditions (6))
+ (rnrs exceptions (6)))
+
+ (define (delete-file filename)
+ (catch #t
+ (lambda () (delete-file-internal filename))
+ (lambda (key . args) (raise (make-i/o-filename-error filename)))))
+
+ (define &i/o (@@ (rnrs conditions) &i/o))
+ (define make-i/o-error (@@ (rnrs conditions) make-i/o-error))
+ (define i/o-error? (@@ (rnrs conditions) i/o-error?))
+
+ (define &i/o-read (@@ (rnrs conditions) &i/o-read))
+ (define make-i/o-read-error (@@ (rnrs conditions) make-i/o-read-error))
+ (define i/o-read-error? (@@ (rnrs conditions) i/o-read-error?))
+
+ (define &i/o-write (@@ (rnrs conditions) &i/o-write))
+ (define make-i/o-write-error (@@ (rnrs conditions) make-i/o-write-error))
+ (define i/o-write-error? (@@ (rnrs conditions) i/o-write-error?))
+
+ (define &i/o-invalid-position (@@ (rnrs conditions) &i/o-invalid-position))
+ (define make-i/o-invalid-position-error
+ (@@ (rnrs conditions) make-i/o-invalid-position-error))
+ (define i/o-invalid-position-error?
+ (@@ (rnrs conditions) i/o-invalid-position-error?))
+ (define i/o-error-position (@@ (rnrs conditions) i/o-error-position))
+
+ (define &i/o-filename (@@ (rnrs conditions) &i/o-filename))
+ (define make-i/o-filename-error
+ (@@ (rnrs conditions) make-i/o-filename-error))
+ (define i/o-filename-error? (@@ (rnrs conditions) i/o-filename-error?))
+ (define i/o-error-filename (@@ (rnrs conditions) i/o-error-filename))
+
+ (define &i/o-file-protection (@@ (rnrs conditions) &i/o-file-protection))
+ (define make-i/o-file-protection-error
+ (@@ (rnrs conditions) make-i/o-file-protection-error))
+ (define i/o-file-protection-error?
+ (@@ (rnrs conditions) i/o-file-protection-error?))
+
+ (define &i/o-file-is-read-only (@@ (rnrs conditions) &i/o-file-is-read-only))
+ (define make-i/o-file-is-read-only-error
+ (@@ (rnrs conditions) make-i/o-file-is-read-only-error))
+ (define i/o-file-is-read-only-error?
+ (@@ (rnrs conditions) i/o-file-is-read-only-error?))
+
+ (define &i/o-file-already-exists
+ (@@ (rnrs conditions) &i/o-file-already-exists))
+ (define make-i/o-file-already-exists-error
+ (@@ (rnrs conditions) make-i/o-file-already-exists-error))
+ (define i/o-file-already-exists-error?
+ (@@ (rnrs conditions) i/o-file-already-exists-error?))
+
+ (define &i/o-file-does-not-exist
+ (@@ (rnrs conditions) &i/o-file-does-not-exist))
+ (define make-i/o-file-does-not-exist-error
+ (@@ (rnrs conditions) make-i/o-file-does-not-exist-error))
+ (define i/o-file-does-not-exist-error?
+ (@@ (rnrs conditions) i/o-file-does-not-exist-error?))
+
+ (define &i/o-port (@@ (rnrs conditions) &i/o-port))
+ (define make-i/o-port-error (@@ (rnrs conditions) make-i/o-port-error))
+ (define i/o-port-error? (@@ (rnrs conditions) i/o-port-error?))
+ (define i/o-error-port (@@ (rnrs conditions) i/o-error-port))
+)
diff --git a/module/srfi/srfi-8.scm b/module/rnrs/6/programs.scm
similarity index 67%
copy from module/srfi/srfi-8.scm
copy to module/rnrs/6/programs.scm
index ced1238..4daa781 100644
--- a/module/srfi/srfi-8.scm
+++ b/module/rnrs/6/programs.scm
@@ -1,6 +1,6 @@
-;;; srfi-8.scm --- receive
+;;; programs.scm --- The R6RS process management library
-;; Copyright (C) 2000, 2001, 2002, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2010 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -15,17 +15,8 @@
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
-;;; Commentary:
-
-;; This module is fully documented in the Guile Reference Manual.
-
-;;; Code:
-
-(define-module (srfi srfi-8)
- :use-module (ice-9 receive)
- :re-export-syntax (receive))
-
-(cond-expand-provide (current-module) '(srfi-8))
-
-;;; srfi-8.scm ends here
+(library (rnrs programs (6))
+ (export command-line exit)
+ (import (only (guile) command-line exit)))
diff --git a/module/rnrs/6/control.scm b/module/rnrs/6/sorting.scm
similarity index 65%
copy from module/rnrs/6/control.scm
copy to module/rnrs/6/sorting.scm
index 69351c6..08f44b8 100644
--- a/module/rnrs/6/control.scm
+++ b/module/rnrs/6/sorting.scm
@@ -1,4 +1,4 @@
-;;; control.scm --- The R6RS control structures library
+;;; sorting.scm --- The R6RS sorting library
;; Copyright (C) 2010 Free Software Foundation, Inc.
;;
@@ -17,17 +17,11 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-(library (rnrs control (6))
- (export when unless do case-lambda)
+(library (rnrs sorting (6))
+ (export list-sort vector-sort vector-sort!)
(import (rnrs base (6))
- (only (guile) do case-lambda))
+ (only (guile) *unspecified* stable-sort sort!))
- (define-syntax when
- (syntax-rules ()
- ((when test result1 result2 ...)
- (if test (begin result1 result2 ...)))))
-
- (define-syntax unless
- (syntax-rules ()
- ((unless test result1 result2 ...)
- (if (not test) (begin result1 result2 ...))))))
+ (define (list-sort proc list) (stable-sort list proc))
+ (define (vector-sort proc vector) (stable-sort vector proc))
+ (define (vector-sort! proc vector) (sort! vector proc) *unspecified*))
diff --git a/module/rnrs/io/6/simple.scm b/module/rnrs/io/6/simple.scm
index cf6c130..fab7da6 100644
--- a/module/rnrs/io/6/simple.scm
+++ b/module/rnrs/io/6/simple.scm
@@ -46,7 +46,43 @@
write-char
newline
display
- write)
+ write
+
+ &i/o make-i/o-error i/o-error?
+ &i/o-read make-i/o-read-error i/o-read-error?
+ &i/o-write make-i/o-write-error i/o-write-error?
+
+ &i/o-invalid-position
+ make-i/o-invalid-position-error
+ i/o-invalid-position-error?
+ i/o-error-position
+
+ &i/o-filename
+ make-i/o-filename-error
+ i/o-filename-error?
+ i/o-error-filename
+
+ &i/o-file-protection
+ make-i/o-file-protection-error
+ i/o-file-protection-error?
+
+ &i/o-file-is-read-only
+ make-i/o-file-is-read-only-error
+ i/o-file-is-read-only-error?
+
+ &i/o-file-already-exists
+ make-i/o-file-already-exists-error
+ i/o-file-already-exists-error?
+
+ &i/o-file-does-not-exist
+ make-i/o-file-does-not-exist-error
+ i/o-file-does-not-exist-error?
+
+ &i/o-port
+ make-i/o-port-error
+ i/o-port-error?
+ i/o-error-port)
+
(import (only (rnrs io ports) eof-object
eof-object?
@@ -74,4 +110,63 @@
write-char
newline
display
- write)))
+ write)
+ (rnrs base (6))
+ (rnrs conditions (6)))
+
+ (define &i/o (@@ (rnrs conditions) &i/o))
+ (define make-i/o-error (@@ (rnrs conditions) make-i/o-error))
+ (define i/o-error? (@@ (rnrs conditions) i/o-error?))
+
+ (define &i/o-read (@@ (rnrs conditions) &i/o-read))
+ (define make-i/o-read-error (@@ (rnrs conditions) make-i/o-read-error))
+ (define i/o-read-error? (@@ (rnrs conditions) i/o-read-error?))
+
+ (define &i/o-write (@@ (rnrs conditions) &i/o-write))
+ (define make-i/o-write-error (@@ (rnrs conditions) make-i/o-write-error))
+ (define i/o-write-error? (@@ (rnrs conditions) i/o-write-error?))
+
+ (define &i/o-invalid-position (@@ (rnrs conditions) &i/o-invalid-position))
+ (define make-i/o-invalid-position-error
+ (@@ (rnrs conditions) make-i/o-invalid-position-error))
+ (define i/o-invalid-position-error?
+ (@@ (rnrs conditions) i/o-invalid-position-error?))
+ (define i/o-error-position (@@ (rnrs conditions) i/o-error-position))
+
+ (define &i/o-filename (@@ (rnrs conditions) &i/o-filename))
+ (define make-i/o-filename-error
+ (@@ (rnrs conditions) make-i/o-filename-error))
+ (define i/o-filename-error? (@@ (rnrs conditions) i/o-filename-error?))
+ (define i/o-error-filename (@@ (rnrs conditions) i/o-error-filename))
+
+ (define &i/o-file-protection (@@ (rnrs conditions) &i/o-file-protection))
+ (define make-i/o-file-protection-error
+ (@@ (rnrs conditions) make-i/o-file-protection-error))
+ (define i/o-file-protection-error?
+ (@@ (rnrs conditions) i/o-file-protection-error?))
+
+ (define &i/o-file-is-read-only (@@ (rnrs conditions) &i/o-file-is-read-only))
+ (define make-i/o-file-is-read-only-error
+ (@@ (rnrs conditions) make-i/o-file-is-read-only-error))
+ (define i/o-file-is-read-only-error?
+ (@@ (rnrs conditions) i/o-file-is-read-only-error?))
+
+ (define &i/o-file-already-exists
+ (@@ (rnrs conditions) &i/o-file-already-exists))
+ (define make-i/o-file-already-exists-error
+ (@@ (rnrs conditions) make-i/o-file-already-exists-error))
+ (define i/o-file-already-exists-error?
+ (@@ (rnrs conditions) i/o-file-already-exists-error?))
+
+ (define &i/o-file-does-not-exist
+ (@@ (rnrs conditions) &i/o-file-does-not-exist))
+ (define make-i/o-file-does-not-exist-error
+ (@@ (rnrs conditions) make-i/o-file-does-not-exist-error))
+ (define i/o-file-does-not-exist-error?
+ (@@ (rnrs conditions) i/o-file-does-not-exist-error?))
+
+ (define &i/o-port (@@ (rnrs conditions) &i/o-port))
+ (define make-i/o-port-error (@@ (rnrs conditions) make-i/o-port-error))
+ (define i/o-port-error? (@@ (rnrs conditions) i/o-port-error?))
+ (define i/o-error-port (@@ (rnrs conditions) i/o-error-port))
+)
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 0ea70b3..3e10dc9 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -72,6 +72,7 @@ SCM_TESTS = tests/alist.test \
tests/r5rs_pitfall.test \
tests/r6rs-arithmetic-bitwise.test \
tests/r6rs-control.test \
+ tests/r6rs-files.test \
tests/r6rs-hashtables.test \
tests/r6rs-ports.test \
tests/r6rs-records-inspection.test \
diff --git a/test-suite/tests/r6rs-control.test
b/test-suite/tests/r6rs-files.test
similarity index 54%
copy from test-suite/tests/r6rs-control.test
copy to test-suite/tests/r6rs-files.test
index 0f099a0..df5dd22 100644
--- a/test-suite/tests/r6rs-control.test
+++ b/test-suite/tests/r6rs-files.test
@@ -1,4 +1,4 @@
-;;; r6rs-control.test --- Test suite for R6RS (rnrs control)
+;;; r6rs-files.test --- Test suite for R6RS (rnrs unicode)
;; Copyright (C) 2010 Free Software Foundation, Inc.
;;
@@ -17,18 +17,24 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-(define-module (test-suite test-rnrs-control)
- :use-module ((rnrs control) :version (6))
+(define-module (test-suite test-rnrs-files)
+ :use-module ((rnrs exceptions) :version (6))
+ :use-module ((rnrs files) :version (6))
:use-module (test-suite lib))
-(with-test-prefix "when"
- (pass-if "when true"
- (eq? (when (> 3 2) 'greater) 'greater))
- (pass-if "when false"
- (unspecified? (when (< 3 2) 'greater))))
+(with-test-prefix "delete-file"
+ (pass-if "delete-file deletes file"
+ (let ((filename (port-filename (mkstemp! "T-XXXXXX"))))
+ (delete-file filename)
+ (not (file-exists? filename))))
-(with-test-prefix "unless"
- (pass-if "unless true"
- (unspecified? (unless (> 3 2) 'less)))
- (pass-if "unless false"
- (eq? (unless (< 3 2) 'less) 'less)))
+ (pass-if "delete-file raises &i/o-filename on error"
+ (let ((success #f))
+ (call/cc
+ (lambda (continuation)
+ (with-exception-handler
+ (lambda (condition)
+ (set! success (i/o-filename-error? condition))
+ (continuation))
+ (lambda () (delete-file "")))))
+ success)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, wip-r6rs-libraries, updated. release_1-9-8-85-g4123ca6,
Julian Graham <=