mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
deprecate scm-style-repl
* module/ice-9/deprecated.scm (scm-style-repl): Deprecate.
This commit is contained in:
parent
222a2b19a1
commit
03af6e0953
2 changed files with 110 additions and 108 deletions
|
@ -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))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue