diff --git a/.dir-locals.el b/.dir-locals.el index c5c6695..8140372 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -12,4 +12,5 @@ (eval . (put 'sh:for 'scheme-indent-function 2)) (eval . (put 'sh:subshell 'scheme-indent-function 1)) (eval . (put 'sh:substitute-command 'scheme-indent-function 1)) - (eval . (put 'sh:with-redirects 'scheme-indent-function 2))))) + (eval . (put 'sh:with-redirects 'scheme-indent-function 2)) + (eval . (put 'with-environment-arguments 'scheme-indent-function 2))))) diff --git a/geesh/environment.scm b/geesh/environment.scm index e155bd5..bcb8248 100644 --- a/geesh/environment.scm +++ b/geesh/environment.scm @@ -32,7 +32,9 @@ environment-status set-environment-status! environment-function-ref - define-environment-function!)) + define-environment-function! + environment-arguments + with-environment-arguments)) ;;; Commentary: ;;; @@ -42,19 +44,21 @@ ;;; Code: (define-record-type - (%make-environment vars functions status) + (%make-environment vars functions arguments status) 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!)) -(define (make-environment vars) +(define* (make-environment vars #:optional (arguments '())) ;; In order to insure that each pair in the 'vars' alist is mutable, ;; we copy each one into a new list. (%make-environment (map (match-lambda ((key . val) (cons key val))) vars) '() + arguments 0)) (define (var-ref env name) @@ -105,3 +109,17 @@ such function, return @code{#f}." "Make @var{name} refer to @var{proc} in @var{env}." (set-environment-functions! env (acons name proc (environment-functions env)))) + +(define (with-environment-arguments env arguments thunk) + "Call @var{thunk} with the arguments in @var{env} set to +@var{arguments}." + (let ((saved-arguments #f)) + (dynamic-wind + (lambda () + (set! saved-arguments (environment-arguments env)) + (set-environment-arguments! env arguments)) + thunk + (lambda () + (let ((tmp saved-arguments)) + (set! saved-arguments (environment-arguments env)) + (set-environment-arguments! env tmp))))))