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.

geesh/built-ins/dot.scm

@@ -36,11 +36,13 @@
          (call-with-input-file file
            (lambda (port)
              (set-status! 0)
-             (let loop ()
-               (match (read-sh port)
-                 ((? eof-object?) (get-status))
-                 (exp ((get-evaluator) exp)
-                      (loop)))))))
+             (call-with-return
+              (lambda ()
+                (let loop ()
+                  (match (read-sh port)
+                    ((? eof-object?) (get-status))
+                    (exp ((get-evaluator) exp)
+                         (loop)))))))))
        (lambda args
          (format (current-error-port)
                  "~a: .: ~a: ~a.~%"

geesh/environment.scm

@@ -45,6 +45,10 @@
             sh:continue
             call-with-break
             sh:break
+            call-with-return
+            sh:return
+            set-atexit!
+            sh:exit
             *fd-count*
             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."
   (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.
 

geesh/repl.scm

@@ -20,6 +20,7 @@
   #:use-module (geesh environment)
   #:use-module (geesh eval)
   #:use-module (geesh parser)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:export (run-repl))
 
@@ -31,8 +32,7 @@
 
 (define* (run-repl #:optional (port (current-input-port)))
   (let loop ((exp (read-sh port)))
-    (if (eof-object? exp)
-        (get-status)
-        (begin
-          (eval-sh exp)
-          (loop (read-sh port))))))
+    (match exp
+      ((? eof-object?) (sh:exit))
+      (_ (eval-sh exp)
+         (loop (read-sh port))))))

geesh/shell.scm

@@ -112,7 +112,9 @@ environment variable bindings @var{bindings}."
                  (lambda (proc)
                    (with-arguments (cons (car (program-arguments)) args)
                      (lambda ()
-                       (apply proc args)))))
+                       (call-with-return
+                        (lambda ()
+                          (apply proc args)))))))
           (and=> (search-built-ins name)
                  (lambda (proc)
                    ;; TODO: Use 'bindings' here.