From 6b08d75b56b1464b36abd9d50ccde69d6e4e56f0 Mon Sep 17 00:00:00 2001
From: Keisuke Nishida <kxn30@po.cwru.edu>
Date: Sun, 15 Apr 2001 22:47:25 +0000
Subject: [PATCH] 	* boot-9.scm (call-with-deprecation): New procedure. 
 (identity): New procedure. 	(id): Deprecated.

---
 ice-9/ChangeLog  |  6 ++++++
 ice-9/boot-9.scm | 21 ++++++++++++++++++++-
 2 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 2a49030ee..20e054d25 100644
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,9 @@
+2001-04-15  Keisuke Nishida  <kxn30@po.cwru.edu>
+
+	* boot-9.scm (call-with-deprecation): New procedure.
+	(identity): New procedure.
+	(id): Deprecated.	
+
 2001-04-15  Keisuke Nishida  <kxn30@po.cwru.edu>
 
 	* boot-9.scm (defmacro, define-macro, define-syntax-macro):
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index 17bdf5c38..afca0435a 100644
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -87,7 +87,7 @@
 ;;; {Trivial Functions}
 ;;;
 
-(define (id x) x)
+(define (identity x) x)
 (define (1+ n) (+ n 1))
 (define (-1+ n) (+ n -1))
 (define 1- -1+)
@@ -109,6 +109,25 @@
 
 (define (apply-to-args args fn) (apply fn args))
 
+
+;;; {Deprecation}
+;;;
+
+(define call-with-deprecation
+  (let ((issued-warnings (make-hash-table 13)))
+    (lambda (msg thunk)
+      (cond ((not (hashv-ref issued-warnings msg #f))
+	     (display ";;; " (current-error-port))
+	     (display msg (current-error-port))
+	     (newline (current-error-port))
+	     (hashv-set! issued-warnings msg #t)))
+      (thunk))))
+
+(define (id x)
+  (call-with-deprecation "`id' is deprecated.  Use `identity' instead."
+    (lambda ()
+      (identity x))))
+
 
 ;;; {Integer Math}
 ;;;