;;;; calling.scm --- Calling Conventions
;;;;
-;;;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+;;;; Copyright (C) 1995, 1996, 1997, 2000, 2001 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
+;;;;
+;;;; As a special exception, the Free Software Foundation gives permission
+;;;; for additional uses of the text contained in its release of GUILE.
+;;;;
+;;;; The exception is that, if you link the GUILE library with other files
+;;;; to produce an executable, this does not by itself cause the
+;;;; resulting executable to be covered by the GNU General Public License.
+;;;; Your use of that executable is in no way restricted on account of
+;;;; linking the GUILE library code into it.
+;;;;
+;;;; This exception does not however invalidate any other reasons why
+;;;; the executable file might be covered by the GNU General Public License.
+;;;;
+;;;; This exception applies only to the code released by the
+;;;; Free Software Foundation under the name GUILE. If you copy
+;;;; code from other Free Software Foundation releases into a copy of
+;;;; GUILE, as the General Public License permits, the exception does
+;;;; not apply to the code that you add in this way. To avoid misleading
+;;;; anyone as to the status of such modified files, you must delete
+;;;; this exception notice from them.
+;;;;
+;;;; If you write modifications of your own for GUILE, it is your choice
+;;;; whether to permit this exception to apply to your modifications.
+;;;; If you do not wish that, delete this exception notice.
;;;;
\f
-(define-module (ice-9 calling))
+(define-module (ice-9 calling)
+ :export-syntax (with-excursion-function
+ with-getter-and-setter
+ with-getter
+ with-delegating-getter-and-setter
+ with-excursion-getter-and-setter
+ with-configuration-getter-and-setter
+ with-delegating-configuration-getter-and-setter
+ let-with-configuration-getter-and-setter))
;;;;
;;;
;;; entering and leaving the call to proc non-locally, such as using
;;; call-with-current-continuation, error, or throw.
;;;
-(defmacro-public with-excursion-function (vars proc)
+(defmacro with-excursion-function (vars proc)
`(,proc ,(excursion-function-syntax vars)))
;;; ;; takes its arguments in a different order.
;;;
;;;
-(defmacro-public with-getter-and-setter (vars proc)
+(defmacro with-getter-and-setter (vars proc)
`(,proc ,@ (getter-and-setter-syntax vars)))
;;; with-getter vars proc
;;; The procedure is called:
;;; (proc getter)
;;;
-(defmacro-public with-getter (vars proc)
+(defmacro with-getter (vars proc)
`(,proc ,(car (getter-and-setter-syntax vars))))
;;; proc is a procedure that is called
;;; (proc getter setter)
;;;
-(defmacro-public with-delegating-getter-and-setter (vars get-delegate set-delegate proc)
+(defmacro with-delegating-getter-and-setter (vars get-delegate set-delegate proc)
`(,proc ,@ (delegating-getter-and-setter-syntax vars get-delegate set-delegate)))
;;; with-getter-and-setter
;;; with-excursion-function
;;;
-(defmacro-public with-excursion-getter-and-setter (vars proc)
+(defmacro with-excursion-getter-and-setter (vars proc)
`(,proc ,(excursion-function-syntax vars)
,@ (getter-and-setter-syntax vars)))
(define (excursion-function-syntax vars)
(let ((saved-value-names (map gensym vars))
- (tmp-var-name (gensym 'temp))
- (swap-fn-name (gensym 'swap))
- (thunk-name (gensym 'thunk)))
+ (tmp-var-name (gensym "temp"))
+ (swap-fn-name (gensym "swap"))
+ (thunk-name (gensym "thunk")))
`(lambda (,thunk-name)
(letrec ((,tmp-var-name #f)
(,swap-fn-name
(define (getter-and-setter-syntax vars)
- (let ((args-name (gensym 'args))
- (an-arg-name (gensym 'an-arg))
- (new-val-name (gensym 'new-value))
- (loop-name (gensym 'loop))
+ (let ((args-name (gensym "args"))
+ (an-arg-name (gensym "an-arg"))
+ (new-val-name (gensym "new-value"))
+ (loop-name (gensym "loop"))
(kws (map symbol->keyword vars)))
(list `(lambda ,args-name
(let ,loop-name ((,args-name ,args-name))
(,loop-name (cddr ,args-name)))))))))
(define (delegating-getter-and-setter-syntax vars get-delegate set-delegate)
- (let ((args-name (gensym 'args))
- (an-arg-name (gensym 'an-arg))
- (new-val-name (gensym 'new-value))
- (loop-name (gensym 'loop))
+ (let ((args-name (gensym "args"))
+ (an-arg-name (gensym "an-arg"))
+ (new-val-name (gensym "new-value"))
+ (loop-name (gensym "loop"))
(kws (map symbol->keyword vars)))
(list `(lambda ,args-name
(let ,loop-name ((,args-name ,args-name))
;;; for the corresponding variable. If omitted, the binding of <var>
;;; is simply set using set!.
;;;
-(defmacro-public with-configuration-getter-and-setter (vars-etc proc)
+(defmacro with-configuration-getter-and-setter (vars-etc proc)
`((lambda (simpler-get simpler-set body-proc)
(with-delegating-getter-and-setter ()
simpler-get simpler-set body-proc))
,proc))
-(defmacro-public with-delegating-configuration-getter-and-setter (vars-etc delegate-get delegate-set proc)
+(defmacro with-delegating-configuration-getter-and-setter (vars-etc delegate-get delegate-set proc)
`((lambda (simpler-get simpler-set body-proc)
(with-delegating-getter-and-setter ()
simpler-get simpler-set body-proc))
;;; ...)
;;; (with-configuration-getter-and-setter ((<var1> v1-get v1-set) ...) proc))
;;;
-(defmacro-public let-with-configuration-getter-and-setter (vars-etc proc)
+(defmacro let-with-configuration-getter-and-setter (vars-etc proc)
`(let ,(map (lambda (v) `(,(car v) ,(cadr v))) vars-etc)
(with-configuration-getter-and-setter ,(map (lambda (v) `(,(car v) ,(caddr v) ,(cadddr v))) vars-etc)
,proc)))
-
-
-
HCoop / bpt / guile.git / blobdiff