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:
Andy Wingo
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)
|
(run-hook before-read-hook)
|
||||||
((or reader read) (current-input-port))))
|
((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
|
$tanh
|
||||||
closure?
|
closure?
|
||||||
%nil
|
%nil
|
||||||
@bind)
|
@bind
|
||||||
|
scm-style-repl)
|
||||||
|
|
||||||
#:replace (module-ref-submodule module-define-submodule!))
|
#:replace (module-ref-submodule module-define-submodule!))
|
||||||
|
|
||||||
|
|
@ -350,3 +351,111 @@ deprecated. Use set-module-public-interface! instead.")
|
||||||
(lambda (mod iface)
|
(lambda (mod iface)
|
||||||
(setter mod iface)
|
(setter mod iface)
|
||||||
(module-define! mod '%module-public-interface 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