mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

run the vm repl instead of the scm-style-repl

Browse source 
* ice-9/boot-9.scm (@, @@): Note that these don't work with the compiler.
  Damn.
  (top-repl): Run the VM repl. Whooo!

* module/system/repl/repl.scm (start-repl): Catch 'quit, as the
  scm-style-repl does. Newline after input EOF's, so that we don't leave
  the user's shell messed up.
This commit is contained in:
Andy Wingo 2008-09-09 08:23:10 +02:00
parent 02ed0d3df2
commit 6a01fabfd0
2 changed files with 25 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

5
ice-9/boot-9.scm
View file

@ -2975,6 +2975,7 @@ module '(ice-9 q) '(make-q q-length))}."
;; Indeed, all references to global variables are memoized into such ;; Indeed, all references to global variables are memoized into such
;; variable objects. ;; variable objects.
;; FIXME: these don't work with the compiler
(define-macro (@ mod-name var-name) (define-macro (@ mod-name var-name)
(let ((var (module-variable (resolve-interface mod-name) var-name))) (let ((var (module-variable (resolve-interface mod-name) var-name)))
(if (not var) (if (not var)
@ -3337,6 +3338,8 @@ module '(ice-9 q) '(make-q q-length))}."
;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have ;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have
;; no effect. ;; no effect.
(let ((old-handlers #f) (let ((old-handlers #f)
(start-repl (module-ref (resolve-interface '(system repl repl))
'start-repl))
(signals (if (provided? 'posix) (signals (if (provided? 'posix)
`((,SIGINT . "User interrupt") `((,SIGINT . "User interrupt")
(,SIGFPE . "Arithmetic error") (,SIGFPE . "Arithmetic error")
@ -3371,7 +3374,7 @@ module '(ice-9 q) '(make-q q-length))}."
;; the protected thunk. ;; the protected thunk.
(lambda () (lambda ()
(let ((status (scm-style-repl))) (let ((status (start-repl 'scheme)))
(run-hook exit-hook) (run-hook exit-hook)
status)) status))

34
module/system/repl/repl.scm
View file

@ -102,7 +102,8 @@
expr))) expr)))
(define (start-repl lang) (define (start-repl lang)
(let ((repl (make-repl lang))) (let ((repl (make-repl lang))
(status #f))
(repl-welcome repl) (repl-welcome repl)
(let prompt-loop () (let prompt-loop ()
(let ((exp (call-with-backtrace (let ((exp (call-with-backtrace
@ -114,21 +115,28 @@
(lambda () (lambda ()
(meta-command repl (read-line))))) (meta-command repl (read-line)))))
((eof-object? exp) ((eof-object? exp)
(throw 'quit)) (newline)
(set! status '()))
(else (else
(call-with-backtrace (call-with-backtrace
(lambda () (lambda ()
(call-with-values (lambda () (catch 'quit
(run-hook before-eval-hook exp) (lambda ()
(start-stack repl-eval (call-with-values (lambda ()
(repl-eval repl exp))) (run-hook before-eval-hook exp)
(lambda l (start-stack repl-eval
(for-each (lambda (v) (repl-eval repl exp)))
(run-hook before-print-hook v) (lambda l
(repl-print repl v)) (for-each (lambda (v)
l))))))) (run-hook before-print-hook v)
(next-char #f) ;; consume trailing whitespace (repl-print repl v))
(prompt-loop))))) l))))
(lambda (k . args)
(set! status args)))))))
(or status
(begin
(next-char #f) ;; consume trailing whitespace
(prompt-loop)))))))
(define (next-char wait) (define (next-char wait)
(if (or wait (char-ready?)) (if (or wait (char-ready?))