Add return and exit semantics
* geesh/environment.scm (*return-tag*): New variable. (call-with-return): New public function. (sh:return): New public function. (*atexit*): New variable. (*exiting?*) New variable. (set-atexit!): New public function. (sh:exit): New public function. * geesh/repl.scm (run-repl): Call sh:exit at the end of a script. * geesh/shell.scm (sh:exec-let): Use call-with-return for functions. * geesh/built-ins/dot.scm (main): Use call-with-return.
This commit is contained in:
parent
2fdbfe2ca4
commit
66e89c1a05
|
@ -36,11 +36,13 @@
|
||||||
(call-with-input-file file
|
(call-with-input-file file
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(set-status! 0)
|
(set-status! 0)
|
||||||
|
(call-with-return
|
||||||
|
(lambda ()
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(match (read-sh port)
|
(match (read-sh port)
|
||||||
((? eof-object?) (get-status))
|
((? eof-object?) (get-status))
|
||||||
(exp ((get-evaluator) exp)
|
(exp ((get-evaluator) exp)
|
||||||
(loop)))))))
|
(loop)))))))))
|
||||||
(lambda args
|
(lambda args
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
"~a: .: ~a: ~a.~%"
|
"~a: .: ~a: ~a.~%"
|
||||||
|
|
|
@ -45,6 +45,10 @@
|
||||||
sh:continue
|
sh:continue
|
||||||
call-with-break
|
call-with-break
|
||||||
sh:break
|
sh:break
|
||||||
|
call-with-return
|
||||||
|
sh:return
|
||||||
|
set-atexit!
|
||||||
|
sh:exit
|
||||||
*fd-count*
|
*fd-count*
|
||||||
fd->current-port))
|
fd->current-port))
|
||||||
|
|
||||||
|
@ -319,6 +323,36 @@ exit the dynamic extent of @var{thunk}."
|
||||||
@var{n} is set, exit to the @math{n + 1}th closest invocation."
|
@var{n} is set, exit to the @math{n + 1}th closest invocation."
|
||||||
(abort-to-prompt *break-tag* n))
|
(abort-to-prompt *break-tag* n))
|
||||||
|
|
||||||
|
(define *return-tag* (make-prompt-tag))
|
||||||
|
|
||||||
|
(define (call-with-return thunk)
|
||||||
|
"Call @var{thunk} in such a way that a call to @code{return} will
|
||||||
|
exit the dynamic extent of @var{thunk}."
|
||||||
|
(call-with-prompt *return-tag*
|
||||||
|
thunk
|
||||||
|
(lambda (cont status)
|
||||||
|
(set-status! status))))
|
||||||
|
|
||||||
|
(define* (sh:return #:optional (status (get-status)))
|
||||||
|
"Exit to the closest invocation of @code{call-with-return} setting
|
||||||
|
status to @var{status}. If @var{status} is not set, keep the current
|
||||||
|
status."
|
||||||
|
(abort-to-prompt *return-tag* status))
|
||||||
|
|
||||||
|
(define *atexit* #f)
|
||||||
|
(define *exiting?* #f)
|
||||||
|
|
||||||
|
(define (set-atexit! handler)
|
||||||
|
(set! *atexit* handler))
|
||||||
|
|
||||||
|
(define* (sh:exit #:optional status)
|
||||||
|
(if (and (not *exiting?*) (thunk? *atexit*))
|
||||||
|
(begin
|
||||||
|
(set! *exiting?* #t)
|
||||||
|
(*atexit*)
|
||||||
|
(exit (or status (get-status))))
|
||||||
|
(exit (or status (get-status)))))
|
||||||
|
|
||||||
|
|
||||||
;;; Files.
|
;;; Files.
|
||||||
|
|
||||||
|
|
|
@ -20,6 +20,7 @@
|
||||||
#:use-module (geesh environment)
|
#:use-module (geesh environment)
|
||||||
#:use-module (geesh eval)
|
#:use-module (geesh eval)
|
||||||
#:use-module (geesh parser)
|
#:use-module (geesh parser)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:export (run-repl))
|
#:export (run-repl))
|
||||||
|
|
||||||
|
@ -31,8 +32,7 @@
|
||||||
|
|
||||||
(define* (run-repl #:optional (port (current-input-port)))
|
(define* (run-repl #:optional (port (current-input-port)))
|
||||||
(let loop ((exp (read-sh port)))
|
(let loop ((exp (read-sh port)))
|
||||||
(if (eof-object? exp)
|
(match exp
|
||||||
(get-status)
|
((? eof-object?) (sh:exit))
|
||||||
(begin
|
(_ (eval-sh exp)
|
||||||
(eval-sh exp)
|
|
||||||
(loop (read-sh port))))))
|
(loop (read-sh port))))))
|
||||||
|
|
|
@ -112,7 +112,9 @@ environment variable bindings @var{bindings}."
|
||||||
(lambda (proc)
|
(lambda (proc)
|
||||||
(with-arguments (cons (car (program-arguments)) args)
|
(with-arguments (cons (car (program-arguments)) args)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(apply proc args)))))
|
(call-with-return
|
||||||
|
(lambda ()
|
||||||
|
(apply proc args)))))))
|
||||||
(and=> (search-built-ins name)
|
(and=> (search-built-ins name)
|
||||||
(lambda (proc)
|
(lambda (proc)
|
||||||
;; TODO: Use 'bindings' here.
|
;; TODO: Use 'bindings' here.
|
||||||
|
|
Loading…
Reference in New Issue