Add 'break' and 'continue'
* geesh/environment.scm (<environment>): 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.
This commit is contained in:
parent
1601a8d8b3
commit
06db42088a
|
@ -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 \
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -0,0 +1,36 @@
|
|||
;;; The Geesh Shell Interpreter
|
||||
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
(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))))))
|
|
@ -0,0 +1,36 @@
|
|||
;;; The Geesh Shell Interpreter
|
||||
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
(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))))))
|
|
@ -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 <environment>
|
||||
(%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
|
||||
|
|
|
@ -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))))))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue