~ chicken-core (chicken-5) 4287d477b8fa1746ee536a85862407f6b930bd3c

commit 4287d477b8fa1746ee536a85862407f6b930bd3c
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Aug 19 05:48:56 2010 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Aug 19 05:48:56 2010 -0400

    two fixes taken over from total-irregex work

diff --git a/compiler.scm b/compiler.scm
index 435909b0..5d064d2f 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1251,10 +1251,12 @@
     (##sys#strip-syntax x se))
   (define stripu ##sys#strip-syntax)
   (define (globalize sym)
-    (let loop ((se se))			; ignores syntax bindings
-      (cond ((null? se) (##sys#alias-global-hook sym #f))
-	    ((and (eq? sym (caar se)) (symbol? (cdar se))) (cdar se))
-	    (else (loop (cdr se))))))
+    (if (symbol? sym)
+	(let loop ((se se))			; ignores syntax bindings
+	  (cond ((null? se) (##sys#alias-global-hook sym #f))
+		((and (eq? sym (caar se)) (symbol? (cdar se))) (cdar se))
+		(else (loop (cdr se)))))
+	sym))
   (define (globalize-all syms) (map globalize syms))
   (call-with-current-continuation
    (lambda (return)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 097a1e55..85f9fa39 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -89,8 +89,14 @@
 		   ((eq? a 'deprecated)
 		    (report
 		     loc
-		     (sprintf "use of deprecated toplevel identifier `~a'" id) )
+		     (sprintf "use of deprecated library procedure `~a'" id) )
 		    '*)
+		   ((and (pair? a) (eq? (car a) 'deprecated))
+		    (report 
+		     loc
+		     (sprintf "use of deprecated library procedure `~a' - consider using `~a' instead"
+		       id (cadr a)))
+		     '*)
 		   (else (list a)))))
 	  (else '*)))
   (define (variable-result id e loc)
@@ -469,7 +475,8 @@
 		      (every procedure-type? (cdr t)))))))
   (define (procedure-argument-types t n)
     (cond ((or (memq t '(* procedure)) 
-	       (not-pair? t) )
+	       (not-pair? t)
+	       (eq? 'deprecated (car t)))
 	   (values (make-list n '*) #f))
 	  ((eq? 'procedure (car t))
 	   (let* ((vf #f)
diff --git a/types.db b/types.db
index f28c72a3..52fcbcb6 100644
--- a/types.db
+++ b/types.db
@@ -350,7 +350,7 @@
 (get-keyword (procedure get-keyword (symbol list #!optional *) *))
 (get-output-string (procedure get-output-string (port) string))
 (get-properties (procedure get-properties (symbol list) symbol * list))
-(getenv deprecated)
+(getenv (deprecated get-environment-variable))
 (getter-with-setter (procedure getter-with-setter (procedure procedure #!optional string) procedure))
 (implicit-exit-handler (procedure implicit-exit-handler (#!optional procedure) procedure))
 (keyword->string (procedure keyword->string (symbol) string))
@@ -455,7 +455,7 @@
 (merge! (procedure merge! (list list (procedure (* *) *)) list))
 (never? (procedure never? (#!rest) boolean))
 (none? (procedure none? (*) boolean))
-(noop deprecated)
+(noop (deprecated void))
 (o (procedure o (#!rest (procedure (*) *)) (procedure (*) *)))
 (project (procedure project (fixnum) procedure))
 (queue->list (procedure queue->list ((struct queue)) list))