[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-44-ge9
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-44-ge979130 |
|
Date: |
Thu, 10 Jun 2010 21:49: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=e979130b660eed63a21f73fea2580e936b468e48
The branch, master has been updated
via e979130b660eed63a21f73fea2580e936b468e48 (commit)
via b2e27da35b6a30f6aa0c450b31106811b98f2bb4 (commit)
from 7e3147666b0bb2366cfaf0ce34a11147f7f55e8f (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 e979130b660eed63a21f73fea2580e936b468e48
Author: Andy Wingo <address@hidden>
Date: Thu Jun 10 23:39:19 2010 +0200
remove annotation?
* module/ice-9/boot-9.scm (annotation?): Remove unused new definition.
commit b2e27da35b6a30f6aa0c450b31106811b98f2bb4
Author: Andy Wingo <address@hidden>
Date: Thu Jun 10 23:28:23 2010 +0200
scm-style-repl -> (ice-9 scm-style-repl)
* module/Makefile.am:
* module/ice-9/scm-style-repl.scm: New file, to hold the old
scm-style-repl.
* module/ice-9/deprecated.scm: Provide scm-style-repl and
error-catching-loop and error-catching-repl in the default env, but
with deprecation warnings.
-----------------------------------------------------------------------
Summary of changes:
module/Makefile.am | 1 +
module/ice-9/boot-9.scm | 5 -
module/ice-9/deprecated.scm | 202 ++----------------------------------
module/ice-9/scm-style-repl.scm | 216 +++++++++++++++++++++++++++++++++++++++
4 files changed, 229 insertions(+), 195 deletions(-)
create mode 100644 module/ice-9/scm-style-repl.scm
diff --git a/module/Makefile.am b/module/Makefile.am
index 16de9ed..0d0463c 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -207,6 +207,7 @@ ICE_9_SOURCES = \
ice-9/rw.scm \
ice-9/safe-r5rs.scm \
ice-9/safe.scm \
+ ice-9/scm-style-repl.scm \
ice-9/session.scm \
ice-9/slib.scm \
ice-9/stack-catch.scm \
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 85b44b1..0a02a98 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -337,11 +337,6 @@ If there is no handler at all, Guile prints an error and
then exits."
(define (resolve-module . args)
#f)
-;; Input hook to syncase -- so that we might be able to pass annotated
-;; expressions in. Currently disabled. Maybe we should just use
-;; source-properties directly.
-(define (annotation? x) #f)
-
;; API provided by psyntax
(define syntax-violation #f)
(define datum->syntax #f)
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index ba5434f..70fddd1 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -39,6 +39,8 @@
closure?
%nil
@bind
+ error-catching-loop
+ error-catching-repl
scm-style-repl)
#:replace (module-ref-submodule module-define-submodule!))
@@ -354,199 +356,19 @@ deprecated. Use set-module-public-interface! instead.")
(define (error-catching-loop thunk)
(issue-deprecation-warning
- "`error-catching-loop' is deprecated. Use the repl from `(system repl
repl)' instead.")
- (let ((status #f)
- (interactive #t))
- (define (loop first)
- (let ((next
- (catch #t
-
- (lambda ()
- (call-with-unblocked-asyncs
- (lambda ()
- (with-traps
- (lambda ()
- (first)
-
- ;; This line is needed because mark
- ;; doesn't do closures quite right.
- ;; Unreferenced locals should be
- ;; collected.
- (set! first #f)
- (let loop ((v (thunk)))
- (loop (thunk)))
- #f)))))
-
- (lambda (key . args)
- (case key
- ((quit)
- (set! status args)
- #f)
-
- ((switch-repl)
- (apply throw 'switch-repl args))
-
- ((abort)
- ;; This is one of the closures that require
- ;; (set! first #f) above
- ;;
- (lambda ()
- (run-hook abort-hook)
- (force-output (current-output-port))
- (display "ABORT: " (current-error-port))
- (write args (current-error-port))
- (newline (current-error-port))
- (if interactive
- (begin
- (if (and
- (not has-shown-debugger-hint?)
- (not (memq 'backtrace
- (debug-options-interface)))
- (stack? (fluid-ref the-last-stack)))
- (begin
- (newline (current-error-port))
- (display
- "Type \"(backtrace)\" to get more
information or \"(debug)\" to enter the debugger.\n"
- (current-error-port))
- (set! has-shown-debugger-hint? #t)))
- (force-output (current-error-port)))
- (begin
- (primitive-exit 1)))
- (set! stack-saved? #f)))
-
- (else
- ;; This is the other cons-leak closure...
- (lambda ()
- (cond ((= (length args) 4)
- (apply handle-system-error key args))
- (else
- (apply bad-throw key args)))))))
-
- default-pre-unwind-handler)))
-
- (if next (loop next) status)))
- (set! set-batch-mode?! (lambda (arg)
- (cond (arg
- (set! interactive #f)
- (restore-signals))
- (#t
- (error "sorry, not implemented")))))
- (set! batch-mode? (lambda () (not interactive)))
- (call-with-blocked-asyncs
- (lambda () (loop (lambda () #t))))))
+ "`error-catching-loop' in the default environment is deprecated.
+Find it in the `(ice-9 scm-style-repl)' module instead.")
+ ((@ (ice-9 scm-style-repl) error-catching-loop) thunk))
(define (error-catching-repl r e p)
(issue-deprecation-warning
- "`error-catching-repl' is deprecated. Use the repl from `(system repl
repl)' instead.")
- (error-catching-loop
- (lambda ()
- (call-with-values (lambda () (e (r)))
- (lambda the-values (for-each p the-values))))))
+ "`error-catching-repl' in the default environment is deprecated.
+Find it in the `(ice-9 scm-style-repl)' module instead.")
+ ((@ (ice-9 scm-style-repl) error-catching-repl) r e p))
(define (scm-style-repl)
(issue-deprecation-warning
- "`scm-style-repl' is deprecated. Use the repl from `(system repl repl)'
instead.")
- (letrec (
- (start-gc-rt #f)
- (start-rt #f)
- (repl-report-start-timing (lambda ()
- (set! start-gc-rt (gc-run-time))
- (set! start-rt
(get-internal-run-time))))
- (repl-report (lambda ()
- (display ";;; ")
- (display (inexact->exact
- (* 1000 (/ (- (get-internal-run-time)
start-rt)
-
internal-time-units-per-second))))
- (display " msec (")
- (display (inexact->exact
- (* 1000 (/ (- (gc-run-time) start-gc-rt)
-
internal-time-units-per-second))))
- (display " msec in gc)\n")))
-
- (consume-trailing-whitespace
- (lambda ()
- (let ((ch (peek-char)))
- (cond
- ((eof-object? ch))
- ((or (char=? ch #\space) (char=? ch #\tab))
- (read-char)
- (consume-trailing-whitespace))
- ((char=? ch #\newline)
- (read-char))))))
- (-read (lambda ()
- (let ((val
- (let ((prompt (cond ((string? scm-repl-prompt)
- scm-repl-prompt)
- ((thunk? scm-repl-prompt)
- (scm-repl-prompt))
- (scm-repl-prompt "> ")
- (else ""))))
- (repl-reader prompt))))
-
- ;; As described in R4RS, the READ procedure updates the
- ;; port to point to the first character past the end of
- ;; the external representation of the object. This
- ;; means that it doesn't consume the newline typically
- ;; found after an expression. This means that, when
- ;; debugging Guile with GDB, GDB gets the newline, which
- ;; it often interprets as a "continue" command, making
- ;; breakpoints kind of useless. So, consume any
- ;; trailing newline here, as well as any whitespace
- ;; before it.
- ;; But not if EOF, for control-D.
- (if (not (eof-object? val))
- (consume-trailing-whitespace))
- (run-hook after-read-hook)
- (if (eof-object? val)
- (begin
- (repl-report-start-timing)
- (if scm-repl-verbose
- (begin
- (newline)
- (display ";;; EOF -- quitting")
- (newline)))
- (quit 0)))
- val)))
-
- (-eval (lambda (sourc)
- (repl-report-start-timing)
- (run-hook before-eval-hook sourc)
- (let ((val (start-stack 'repl-stack
- ;; If you change this procedure
- ;; (primitive-eval), please also
- ;; modify the repl-stack case in
- ;; save-stack so that stack cutting
- ;; continues to work.
- (primitive-eval sourc))))
- (run-hook after-eval-hook sourc)
- val)))
-
-
- (-print (let ((maybe-print (lambda (result)
- (if (or scm-repl-print-unspecified
- (not (unspecified? result)))
- (begin
- (write result)
- (newline))))))
- (lambda (result)
- (if (not scm-repl-silent)
- (begin
- (run-hook before-print-hook result)
- (maybe-print result)
- (run-hook after-print-hook result)
- (if scm-repl-verbose
- (repl-report))
- (force-output))))))
-
- (-quit (lambda (args)
- (if scm-repl-verbose
- (begin
- (display ";;; QUIT executed, repl exitting")
- (newline)
- (repl-report)))
- args)))
-
- (let ((status (error-catching-repl -read
- -eval
- -print)))
- (-quit status))))
+ "`scm-style-repl' in the default environment is deprecated.
+Find it in the `(ice-9 scm-style-repl)' module instead, or
+better yet, use the repl from `(system repl repl)'.")
+ ((@ (ice-9 scm-style-repl) scm-style-repl)))
diff --git a/module/ice-9/scm-style-repl.scm b/module/ice-9/scm-style-repl.scm
new file mode 100644
index 0000000..e544872
--- /dev/null
+++ b/module/ice-9/scm-style-repl.scm
@@ -0,0 +1,216 @@
+;;;; Copyright (C)
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,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
+;;;;
+
+(define-module (ice-9 scm-style-repl)
+ ;; #:replace, as with deprecated code enabled these will be in the root env
+ #:replace (error-catching-loop
+ error-catching-repl
+ scm-style-repl))
+
+(define (error-catching-loop thunk)
+ (let ((status #f)
+ (interactive #t))
+ (define (loop first)
+ (let ((next
+ (catch #t
+
+ (lambda ()
+ (call-with-unblocked-asyncs
+ (lambda ()
+ (with-traps
+ (lambda ()
+ (first)
+
+ ;; This line is needed because mark
+ ;; doesn't do closures quite right.
+ ;; Unreferenced locals should be
+ ;; collected.
+ (set! first #f)
+ (let loop ((v (thunk)))
+ (loop (thunk)))
+ #f)))))
+
+ (lambda (key . args)
+ (case key
+ ((quit)
+ (set! status args)
+ #f)
+
+ ((switch-repl)
+ (apply throw 'switch-repl args))
+
+ ((abort)
+ ;; This is one of the closures that require
+ ;; (set! first #f) above
+ ;;
+ (lambda ()
+ (run-hook abort-hook)
+ (force-output (current-output-port))
+ (display "ABORT: " (current-error-port))
+ (write args (current-error-port))
+ (newline (current-error-port))
+ (if interactive
+ (begin
+ (if (and
+ (not has-shown-debugger-hint?)
+ (not (memq 'backtrace
+ (debug-options-interface)))
+ (stack? (fluid-ref the-last-stack)))
+ (begin
+ (newline (current-error-port))
+ (display
+ "Type \"(backtrace)\" to get more
information or \"(debug)\" to enter the debugger.\n"
+ (current-error-port))
+ (set! has-shown-debugger-hint? #t)))
+ (force-output (current-error-port)))
+ (begin
+ (primitive-exit 1)))
+ (set! stack-saved? #f)))
+
+ (else
+ ;; This is the other cons-leak closure...
+ (lambda ()
+ (cond ((= (length args) 4)
+ (apply handle-system-error key args))
+ (else
+ (apply bad-throw key args)))))))
+
+ default-pre-unwind-handler)))
+
+ (if next (loop next) status)))
+ (set! set-batch-mode?! (lambda (arg)
+ (cond (arg
+ (set! interactive #f)
+ (restore-signals))
+ (#t
+ (error "sorry, not implemented")))))
+ (set! batch-mode? (lambda () (not interactive)))
+ (call-with-blocked-asyncs
+ (lambda () (loop (lambda () #t))))))
+
+(define (error-catching-repl r e p)
+ (error-catching-loop
+ (lambda ()
+ (call-with-values (lambda () (e (r)))
+ (lambda the-values (for-each p the-values))))))
+
+(define (scm-style-repl)
+ (letrec (
+ (start-gc-rt #f)
+ (start-rt #f)
+ (repl-report-start-timing (lambda ()
+ (set! start-gc-rt (gc-run-time))
+ (set! start-rt
(get-internal-run-time))))
+ (repl-report (lambda ()
+ (display ";;; ")
+ (display (inexact->exact
+ (* 1000 (/ (- (get-internal-run-time)
start-rt)
+
internal-time-units-per-second))))
+ (display " msec (")
+ (display (inexact->exact
+ (* 1000 (/ (- (gc-run-time) start-gc-rt)
+
internal-time-units-per-second))))
+ (display " msec in gc)\n")))
+
+ (consume-trailing-whitespace
+ (lambda ()
+ (let ((ch (peek-char)))
+ (cond
+ ((eof-object? ch))
+ ((or (char=? ch #\space) (char=? ch #\tab))
+ (read-char)
+ (consume-trailing-whitespace))
+ ((char=? ch #\newline)
+ (read-char))))))
+ (-read (lambda ()
+ (let ((val
+ (let ((prompt (cond ((string? scm-repl-prompt)
+ scm-repl-prompt)
+ ((thunk? scm-repl-prompt)
+ (scm-repl-prompt))
+ (scm-repl-prompt "> ")
+ (else ""))))
+ (repl-reader prompt))))
+
+ ;; As described in R4RS, the READ procedure updates the
+ ;; port to point to the first character past the end of
+ ;; the external representation of the object. This
+ ;; means that it doesn't consume the newline typically
+ ;; found after an expression. This means that, when
+ ;; debugging Guile with GDB, GDB gets the newline, which
+ ;; it often interprets as a "continue" command, making
+ ;; breakpoints kind of useless. So, consume any
+ ;; trailing newline here, as well as any whitespace
+ ;; before it.
+ ;; But not if EOF, for control-D.
+ (if (not (eof-object? val))
+ (consume-trailing-whitespace))
+ (run-hook after-read-hook)
+ (if (eof-object? val)
+ (begin
+ (repl-report-start-timing)
+ (if scm-repl-verbose
+ (begin
+ (newline)
+ (display ";;; EOF -- quitting")
+ (newline)))
+ (quit 0)))
+ val)))
+
+ (-eval (lambda (sourc)
+ (repl-report-start-timing)
+ (run-hook before-eval-hook sourc)
+ (let ((val (start-stack 'repl-stack
+ ;; If you change this procedure
+ ;; (primitive-eval), please also
+ ;; modify the repl-stack case in
+ ;; save-stack so that stack cutting
+ ;; continues to work.
+ (primitive-eval sourc))))
+ (run-hook after-eval-hook sourc)
+ val)))
+
+
+ (-print (let ((maybe-print (lambda (result)
+ (if (or scm-repl-print-unspecified
+ (not (unspecified? result)))
+ (begin
+ (write result)
+ (newline))))))
+ (lambda (result)
+ (if (not scm-repl-silent)
+ (begin
+ (run-hook before-print-hook result)
+ (maybe-print result)
+ (run-hook after-print-hook result)
+ (if scm-repl-verbose
+ (repl-report))
+ (force-output))))))
+
+ (-quit (lambda (args)
+ (if scm-repl-verbose
+ (begin
+ (display ";;; QUIT executed, repl exitting")
+ (newline)
+ (repl-report)))
+ args)))
+
+ (let ((status (error-catching-repl -read
+ -eval
+ -print)))
+ (-quit status))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-11-44-ge979130,
Andy Wingo <=