mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +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
;; variable objects.
;; FIXME: these don't work with the compiler
(define-macro (@ mod-name var-name)
(let ((var (module-variable (resolve-interface mod-name) var-name)))
(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
;; no effect.
(let ((old-handlers #f)
(start-repl (module-ref (resolve-interface '(system repl repl))
'start-repl))
(signals (if (provided? 'posix)
`((,SIGINT . "User interrupt")
(,SIGFPE . "Arithmetic error")
@ -3371,7 +3374,7 @@ module '(ice-9 q) '(make-q q-length))}."
;; the protected thunk.
(lambda ()
(let ((status (scm-style-repl)))
(let ((status (start-repl 'scheme)))
(run-hook exit-hook)
status))

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

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