guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-151-g990d


From: No Itisnt
Subject: [Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-151-g990d8ff
Date: Mon, 21 Jun 2010 02:59:49 +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=990d8ff7b50532eb2c0d036dd3b41f6bbce4dcf3

The branch, lua has been updated
       via  990d8ff7b50532eb2c0d036dd3b41f6bbce4dcf3 (commit)
       via  8d10ccae79ff46f0ebea92ba36acfaebafba8d86 (commit)
       via  1052739b74380978a080ee5604cb1a8d0648a4d6 (commit)
       via  73b03e98a74b213ecb8907a649e0d00234cf237d (commit)
       via  eba5ea7a4f780115cd49c90bcec7624d5481802b (commit)
       via  35d70eccaca513c49cac29ca8b46262be725644a (commit)
       via  a5f93842116d71026911382e48158a2385d1ccd6 (commit)
       via  23b4c817b1090dfbf6165fde71d0c34e2d973ada (commit)
       via  0f8e69a44ecf322231a5e1e8f94c234db2f72b41 (commit)
       via  0feb833d22d4998773fe045f04cfbe1afebf82b9 (commit)
       via  c4a8200fa0f28ac9bab80ee6c2ab93fbd818c33f (commit)
       via  b1e5445f778abb61832c70b884b1afe52bab75b6 (commit)
       via  e5b218826a42554510643c6752d914417bbc382a (commit)
      from  89d236124e6f32aac3e1043346564f3edd5153b3 (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 990d8ff7b50532eb2c0d036dd3b41f6bbce4dcf3
Merge: 89d236124e6f32aac3e1043346564f3edd5153b3 
8d10ccae79ff46f0ebea92ba36acfaebafba8d86
Author: No Itisnt <address@hidden>
Date:   Sun Jun 20 21:59:45 2010 -0500

    Merge branch 'master' into lua

-----------------------------------------------------------------------

Summary of changes:
 libguile/load.c                              |    3 ++
 module/ice-9/boot-9.scm                      |   16 +++++++---
 module/ice-9/r6rs-libraries.scm              |   42 ++++++++++++++++---------
 module/ice-9/receive.scm                     |   10 ++++--
 module/rnrs.scm                              |   42 +++++++++++++++++++++++++-
 module/rnrs/exceptions.scm                   |    2 +-
 module/rnrs/io/ports.scm                     |    6 ++-
 module/rnrs/mutable-strings.scm              |    3 +-
 module/srfi/srfi-9.scm                       |    4 ++
 module/system/repl/command.scm               |   13 ++------
 module/system/repl/common.scm                |   20 +++++++-----
 test-suite/tests/r6rs-records-syntactic.test |    1 +
 test-suite/tests/srfi-9.test                 |    2 +
 13 files changed, 116 insertions(+), 48 deletions(-)

diff --git a/libguile/load.c b/libguile/load.c
index 0e4894e..f0e5d73 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -761,6 +761,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 
0, 0, 1,
     exception_on_not_found = SCM_BOOL_T;
 
   full_filename = scm_sys_search_load_path (filename);
+  if (scm_is_string (full_filename))
+    full_filename = scm_canonicalize_path (full_filename);
+
   compiled_filename =
     scm_search_path (*scm_loc_load_compiled_path,
                     filename,
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 3928d1e..3803ba2 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2677,15 +2677,13 @@ module '(ice-9 q) '(make-q q-length))}."
 ;; `batch-mode?' returns #f during their extent.
 ;;
 ;; Programs can re-enter batch mode, for example after a fork, by calling
-;; `ensure-batch-mode!'. This will also restore signal handlers. It's not a
-;; great interface, though; it would be better to abort to the outermost 
prompt,
-;; and call a thunk there.
+;; `ensure-batch-mode!'. It's not a great interface, though; it would be better
+;; to abort to the outermost prompt, and call a thunk there.
 (define *repl-level* (make-fluid))
 (define (batch-mode?)
   (negative? (or (fluid-ref *repl-level*) -1)))
 (define (ensure-batch-mode!)
-  (fluid-set! *repl-level* #f)
-  (restore-signals))
+  (fluid-set! *repl-level* #f))
 
 (define (quit . args)
   (apply throw 'quit args))
@@ -3038,6 +3036,14 @@ module '(ice-9 q) '(make-q q-length))}."
         (lambda ()
           (module-re-export! (current-module) '(name ...))))))))
 
+(define-syntax export!
+  (syntax-rules ()
+    ((_ name ...)
+     (eval-when (eval load compile expand)
+       (call-with-deferred-observers
+        (lambda ()
+          (module-replace! (current-module) '(name ...))))))))
+
 (define-syntax export-syntax
   (syntax-rules ()
     ((_ name ...)
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index 482f826..bf1127e 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -29,7 +29,7 @@
   (define (sym? x) (symbol? (syntax->datum x)))
 
   (syntax-case import-spec (library only except prefix rename srfi)
-    ;; (srfi :n ...) -> (srfi srfi-n ...)
+    ;; (srfi :n ...) -> (srfi srfi-n)
     ((library (srfi colon-n rest ... (version ...)))
      (and (and-map sym? #'(srfi rest ...))
           (symbol? (syntax->datum #'colon-n))
@@ -40,7 +40,7 @@
                      (substring (symbol->string (syntax->datum #'colon-n))
                                 1)))))
        (resolve-r6rs-interface
-        #`(library (srfi #,srfi-n rest ... (version ...))))))
+        #`(library (srfi #,srfi-n (version ...))))))
     
     ((library (name name* ... (version ...)))
      (and-map sym? #'(name name* ...))
@@ -121,26 +121,36 @@
     (define (compute-exports ifaces specs)
       (define (re-export? sym)
         (or-map (lambda (iface) (module-local-variable iface sym)) ifaces))
+      (define (replace? sym)
+        (module-local-variable the-scm-module sym))
       
-      (let lp ((specs specs) (e '()) (r '()))
+      (let lp ((specs specs) (e '()) (r '()) (x '()))
         (syntax-case specs (rename)
-          (() (values e r))
+          (() (values e r x))
           (((rename (from to) ...) . rest)
            (and (and-map identifier? #'(from ...))
                 (and-map identifier? #'(to ...)))
-           (let lp2 ((in #'((from . to) ...)) (e e) (r r))
+           (let lp2 ((in #'((from . to) ...)) (e e) (r r) (x x))
              (syntax-case in ()
-               (() (lp #'rest e r))
+               (() (lp #'rest e r x))
                (((from . to) . in)
-                (if (re-export? (syntax->datum #'from))
-                    (lp2 #'in e (cons #'(from . to) r))
-                    (lp2 #'in (cons #'(from . to) e) r))))))
+                (cond
+                 ((re-export? (syntax->datum #'from))
+                  (lp2 #'in e (cons #'(from . to) r) x))
+                 ((replace? (syntax->datum #'from))
+                  (lp2 #'in e r (cons #'(from . to) x)))
+                 (else
+                  (lp2 #'in (cons #'(from . to) e) r x)))))))
           ((id . rest)
            (identifier? #'id)
            (let ((sym (syntax->datum #'id)))
-             (if (re-export? sym)
-                 (lp #'rest e (cons #'id r))
-                 (lp #'rest (cons #'id e) r)))))))
+             (cond
+              ((re-export? sym)
+               (lp #'rest e (cons #'id r) x))
+              ((replace? sym)
+               (lp #'rest e r (cons #'id x)))
+              (else
+               (lp #'rest (cons #'id e) r x))))))))
 
     (syntax-case stx (export import)
       ((_ (name name* ...)
@@ -169,9 +179,10 @@
                        (import-set (resolve-r6rs-interface #'import-set))))
                    #'(ispec ...))
               #'(espec ...)))
-         (lambda (exports re-exports)
+         (lambda (exports re-exports replacements)
            (with-syntax (((e ...) exports)
-                         ((r ...) re-exports))
+                         ((r ...) re-exports)
+                         ((x ...) replacements))
              ;; It would be nice to push the module that was current before the
              ;; definition, and pop it after the library definition, but I
              ;; actually can't see a way to do that. Helper procedures perhaps,
@@ -183,8 +194,9 @@
                    #:version (version ...))
                  (import ispec)
                  ...
-                 (re-export r ...)
                  (export e ...)
+                 (re-export r ...)
+                 (export! x ...)
                  (@@ (name name* ...) body)
                  ...))))))))
     
diff --git a/module/ice-9/receive.scm b/module/ice-9/receive.scm
index d550c6f..f4f4d81 100644
--- a/module/ice-9/receive.scm
+++ b/module/ice-9/receive.scm
@@ -1,6 +1,6 @@
 ;;;; SRFI-8
 
-;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
+;;; Copyright (C) 2000, 2001, 2004, 2006, 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
@@ -21,8 +21,10 @@
   :no-backtrace
   )
 
-(define-macro (receive vars vals . body)
-  `(call-with-values (lambda () ,vals)
-     (lambda ,vars ,@body)))
+(define-syntax receive
+  (syntax-rules ()
+    ((receive vars vals . body)
+     (call-with-values (lambda () vals)
+       (lambda vars . body)))))
 
 (cond-expand-provide (current-module) '(srfi-8))
diff --git a/module/rnrs.scm b/module/rnrs.scm
index 4ba9e2a..eb2ea85 100644
--- a/module/rnrs.scm
+++ b/module/rnrs.scm
@@ -236,7 +236,47 @@
          (rnrs control (6))
          (rnrs enums (6))
          (rnrs exceptions (6))
-         (rnrs files (6))
+
+          ;; These i/o conditions are exported by (io simple), (files), and
+          ;; should be exported by (ports) but are not yet. Avoid duplicate
+          ;; bindings warnings, then, by excluding these bindings from all but
+          ;; (io simple).
+         (except (rnrs files (6))
+                  &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)
+
          (rnrs hashtables (6))
 
          (rnrs io ports (6))
diff --git a/module/rnrs/exceptions.scm b/module/rnrs/exceptions.scm
index d810f2b..cd5bacf 100644
--- a/module/rnrs/exceptions.scm
+++ b/module/rnrs/exceptions.scm
@@ -22,7 +22,7 @@
   (import (rnrs base (6))
           (rnrs conditions (6))
          (rnrs records procedural (6))
-         (only (guile) with-throw-handler @@))
+         (only (guile) with-throw-handler *unspecified* @@))
 
   (define raise (@@ (rnrs records procedural) r6rs-raise))
   (define raise-continuable 
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 4916bba..04dabe6 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -110,12 +110,14 @@ read from/written to in @var{port}."
 
 (define (open-string-input-port str)
   "Open an input port that will read from @var{str}."
-  (open-input-string str))
+  (with-fluids ((%default-port-encoding "UTF-8"))
+    (open-input-string str)))
 
 (define (open-string-output-port)
   "Return two values: an output port that will collect characters written to it
 as a string, and a thunk to retrieve the characters associated with that port."
-  (let ((port (open-output-string)))
+  (let ((port (with-fluids ((%default-port-encoding "UTF-8"))
+                (open-output-string))))
     (values port
             (lambda () (get-output-string port)))))
 
diff --git a/module/rnrs/mutable-strings.scm b/module/rnrs/mutable-strings.scm
index 1eeb8f3..b2b3102 100644
--- a/module/rnrs/mutable-strings.scm
+++ b/module/rnrs/mutable-strings.scm
@@ -15,7 +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
-^L
+
+
 
 (library (rnrs mutable-strings (6))
   (export string-set! string-fill!)
diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index 39f4e34..80c3b60 100644
--- a/module/srfi/srfi-9.scm
+++ b/module/srfi/srfi-9.scm
@@ -95,6 +95,8 @@
   (lambda (x)
     (define (field-identifiers field-specs)
       (syntax-case field-specs ()
+        (()
+         '())
         ((field-spec)
          (syntax-case #'field-spec ()
            ((name accessor) #'(name))
@@ -138,6 +140,8 @@
 
     (define (accessors type-name field-specs indices)
       (syntax-case field-specs ()
+        (()
+         #'())
         ((field-spec)
          (syntax-case #'field-spec ()
            ((name accessor)
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index f3b0d1b..9e79eb7 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -333,17 +333,10 @@ Change languages."
 ;;; Compile commands
 ;;;
 
-(define-meta-command (compile repl (form) . opts)
+(define-meta-command (compile repl (form))
   "compile FORM
-Generate compiled code.
-
-  -e    Stop after expanding syntax/macro
-  -t    Stop after translating into GHIL
-  -c    Stop after generating GLIL
-
-  -O    Enable optimization
-  -D    Add debug information"
-  (let ((x (apply repl-compile repl (repl-parse repl form) opts)))
+Generate compiled code."
+  (let ((x (repl-compile repl (repl-parse repl form))))
     (cond ((objcode? x) (guile:disassemble x))
           (else (repl-print repl x)))))
 
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 1b4e2ac..bc3fcaf 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -102,7 +102,8 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
 (define-record/keywords <repl> language options tm-stats gc-stats)
 
 (define repl-default-options
-  '((trace . #f)
+  '((compile-options . (#:warnings (unbound-variable arity-mismatch)))
+    (trace . #f)
     (interp . #f)))
 
 (define %make-repl make-repl)
@@ -132,13 +133,14 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
   ((language-reader (repl-language repl)) (current-input-port)
                                           (current-module)))
 
-(define (repl-compile repl form . opts)
-  (let ((to (lookup-language (cond ((memq #:e opts) 'scheme)
-                                   ((memq #:t opts) 'ghil)
-                                   ((memq #:c opts) 'glil)
-                                   (else 'objcode))))
-        (from (repl-language repl)))
-    (compile form #:from from #:to to #:opts opts #:env (current-module))))
+(define (repl-compile-options repl)
+  (repl-option-ref repl 'compile-options))
+
+(define (repl-compile repl form)
+  (let ((from (repl-language repl))
+        (opts (repl-compile-options repl)))
+    (compile form #:from from #:to 'objcode #:opts opts
+             #:env (current-module))))
 
 (define (repl-parse repl form)
   (let ((parser (language-parser (repl-language repl))))
@@ -150,7 +152,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
                          (or (null? (language-compilers (repl-language repl)))
                              (assq-ref (repl-options repl) 'interp)))
                     (lambda () (eval form (current-module)))
-                    (make-program (repl-compile repl form '())))))
+                    (make-program (repl-compile repl form)))))
     (% (thunk))))
 
 (define (repl-print repl val)
diff --git a/test-suite/tests/r6rs-records-syntactic.test 
b/test-suite/tests/r6rs-records-syntactic.test
index 64b2fbb..152e31c 100644
--- a/test-suite/tests/r6rs-records-syntactic.test
+++ b/test-suite/tests/r6rs-records-syntactic.test
@@ -1,3 +1,4 @@
+;;; -*- scheme -*-
 ;;; r6rs-records-syntactic.test --- Test suite for R6RS (rnrs records 
syntactic)
 
 ;;      Copyright (C) 2010 Free Software Foundation, Inc.
diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test
index a645ddc..cf933a8 100644
--- a/test-suite/tests/srfi-9.test
+++ b/test-suite/tests/srfi-9.test
@@ -23,6 +23,8 @@
   #:use-module (srfi srfi-9))
 
 
+(define-record-type :qux (make-qux) qux?)
+
 (define-record-type :foo (make-foo x) foo? 
   (x get-x) (y get-y set-y!))
 


hooks/post-receive
-- 
GNU Guile



reply via email to

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