From 06db42088a81e8c13ffb3bf457a531a1dd239342 Mon Sep 17 00:00:00 2001 From: Timothy Sample Date: Wed, 21 Nov 2018 10:59:19 -0500 Subject: [PATCH] Add 'break' and 'continue' * geesh/environment.scm (): Add 'break-prompt' and 'continue-prompt' fields. (make-environment): Initialize them. * geesh/shell.scm (sh:for): Setup break and continue prompts. * geesh/built-ins/break.scm: New file. * geesh/built-ins/continue.scm: New file. * Makefile.am: Add them. * geesh/built-ins.scm (*special-built-ins*): Add break and continue. --- Makefile.am | 2 ++ geesh/built-ins.scm | 4 ++-- geesh/built-ins/break.scm | 36 ++++++++++++++++++++++++++++++++++++ geesh/built-ins/continue.scm | 36 ++++++++++++++++++++++++++++++++++++ geesh/environment.scm | 15 +++++++++++---- geesh/shell.scm | 24 +++++++++++++++++++----- 6 files changed, 106 insertions(+), 11 deletions(-) create mode 100644 geesh/built-ins/break.scm create mode 100644 geesh/built-ins/continue.scm diff --git a/Makefile.am b/Makefile.am index 3108122..dc02dff 100644 --- a/Makefile.am +++ b/Makefile.am @@ -41,6 +41,8 @@ check-spec: $(MAKE) $(AM_MAKEFLAGS) -L -C tests/spec check MODULES = \ + geesh/built-ins/break.scm \ + geesh/built-ins/continue.scm \ geesh/built-ins/echo.scm \ geesh/built-ins/false.scm \ geesh/built-ins/read.scm \ diff --git a/geesh/built-ins.scm b/geesh/built-ins.scm index ec61c7c..c491437 100644 --- a/geesh/built-ins.scm +++ b/geesh/built-ins.scm @@ -34,8 +34,8 @@ (define *special-built-ins* `(("." . ,undefined) (":" . ,undefined) - ("break" . ,undefined) - ("continue" . ,undefined) + ("break" . ,(@@ (geesh built-ins break) main)) + ("continue" . ,(@@ (geesh built-ins continue) main)) ("eval" . ,undefined) ("exec" . ,undefined) ("exit" . ,undefined) diff --git a/geesh/built-ins/break.scm b/geesh/built-ins/break.scm new file mode 100644 index 0000000..1990dac --- /dev/null +++ b/geesh/built-ins/break.scm @@ -0,0 +1,36 @@ +;;; The Geesh Shell Interpreter +;;; Copyright 2018 Timothy Sample +;;; +;;; This file is part of Geesh. +;;; +;;; Geesh is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Geesh is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Geesh. If not, see . + +(define-module (geesh built-ins break) + #:use-module (geesh environment)) + +;;; Commentary: +;;; +;;; The 'break' utility. +;;; +;;; Code: + +(define (main env . args) + (let* ((arg (and (pair? args) (car args))) + (n (string->number (or arg "1")))) + (if (and arg (or (not n) (not (exact-integer? n)) (< n 1))) + 1 + (let ((break-prompt (environment-break-prompt env))) + ;; Since we do not return, we have to set the status here. + (set-environment-status! env 0) + (abort-to-prompt break-prompt (1- n)))))) diff --git a/geesh/built-ins/continue.scm b/geesh/built-ins/continue.scm new file mode 100644 index 0000000..ce7c3eb --- /dev/null +++ b/geesh/built-ins/continue.scm @@ -0,0 +1,36 @@ +;;; The Geesh Shell Interpreter +;;; Copyright 2018 Timothy Sample +;;; +;;; This file is part of Geesh. +;;; +;;; Geesh is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Geesh is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Geesh. If not, see . + +(define-module (geesh built-ins continue) + #:use-module (geesh environment)) + +;;; Commentary: +;;; +;;; The 'continue' utility. +;;; +;;; Code: + +(define (main env . args) + (let* ((arg (and (pair? args) (car args))) + (n (string->number (or arg "1")))) + (if (and arg (or (not n) (not (exact-integer? n)) (< n 1))) + 1 + (let ((continue-prompt (environment-continue-prompt env))) + ;; Since we do not return, we have to set the status here. + (set-environment-status! env 0) + (abort-to-prompt continue-prompt (1- n)))))) diff --git a/geesh/environment.scm b/geesh/environment.scm index 4b07044..f6fd071 100644 --- a/geesh/environment.scm +++ b/geesh/environment.scm @@ -36,7 +36,9 @@ define-environment-function! delete-environment-functions! environment-arguments - with-environment-arguments)) + with-environment-arguments + environment-break-prompt + environment-continue-prompt)) ;;; Commentary: ;;; @@ -46,12 +48,15 @@ ;;; Code: (define-record-type - (%make-environment vars functions arguments status) + (%make-environment vars functions arguments status + break-prompt continue-prompt) environment? (vars environment-vars set-environment-vars!) (functions environment-functions set-environment-functions!) (arguments environment-arguments set-environment-arguments!) - (status environment-status set-environment-status!)) + (status environment-status set-environment-status!) + (break-prompt environment-break-prompt) + (continue-prompt environment-continue-prompt)) (define* (make-environment vars #:optional (arguments '())) ;; In order to insure that each pair in the 'vars' alist is mutable, @@ -61,7 +66,9 @@ vars) '() arguments - 0)) + 0 + (make-prompt-tag) + (make-prompt-tag))) (define (var-ref env name) "Get the value of the variable @var{name} in @var{env}. If diff --git a/geesh/shell.scm b/geesh/shell.scm index 2b2ad34..7a89a69 100644 --- a/geesh/shell.scm +++ b/geesh/shell.scm @@ -333,8 +333,22 @@ run @var{thunk2}." "Run @var{thunk} for each binding in @var{bindings}. The value of @var{bindings} have the form @code{(@var{name} (@var{value} ...))}." (set-environment-status! env 0) - (match-let (((name (values ...)) bindings)) - (for-each (lambda (value) - (set-var! env name value) - (thunk)) - values))) + (match-let ((break-prompt (environment-break-prompt env)) + (continue-prompt (environment-continue-prompt env)) + ((name (values ...)) bindings)) + (call-with-prompt break-prompt + (lambda () + (for-each (lambda (value) + (set-var! env name value) + (call-with-prompt continue-prompt + thunk + (lambda (cont n) + (when (> n 0) + (false-if-exception + (abort-to-prompt continue-prompt (1- n))))))) + values)) + (lambda (cont n) + (when (> n 0) + (false-if-exception + (abort-to-prompt break-prompt (1- n)))))))) +