mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

deprecate scm-style-repl

Browse source 
* module/ice-9/deprecated.scm (scm-style-repl): Deprecate.
This commit is contained in:
Andy Wingo 2010-06-10 13:52:14 +02:00
parent 222a2b19a1
commit 03af6e0953
2 changed files with 110 additions and 108 deletions
Download patch file Download diff file Expand all files Collapse all files

107
module/ice-9/boot-9.scm
View file

@ -3086,113 +3086,6 @@ module '(ice-9 q) '(make-q q-length))}."
(run-hook before-read-hook)
((or reader read) (current-input-port))))
(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))))

111
module/ice-9/deprecated.scm
View file

@ -38,7 +38,8 @@
$tanh
closure?
%nil
@bind)
@bind
scm-style-repl)
#:replace (module-ref-submodule module-define-submodule!))
@ -350,3 +351,111 @@ deprecated. Use set-module-public-interface! instead.")
(lambda (mod iface)
(setter mod iface)
(module-define! mod '%module-public-interface iface))))
(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))))