andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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:
Timothy Sample 2018-11-21 10:59:19 -05:00
parent 1601a8d8b3
commit 06db42088a
6 changed files with 106 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

@ -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 \

4
geesh/built-ins.scm
View File

@ -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)

36
geesh/built-ins/break.scm Normal file
View File

@ -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))))))

36
geesh/built-ins/continue.scm Normal file
View File

@ -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))))))

15
geesh/environment.scm
View File

@ -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

24
geesh/shell.scm
View File

@ -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))))))))