~ chicken-core (chicken-5) e39865ff77837f1b82a96e70aae92ffc1bbaf554

commit e39865ff77837f1b82a96e70aae92ffc1bbaf554
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jun 14 11:03:35 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Jun 18 17:11:16 2011 +0200

    applied patch by sjamaan to fix #584; store both raw and aliased name in callback-names list

diff --git a/compiler.scm b/compiler.scm
index 760fb2ef..654dfcfe 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1122,14 +1122,16 @@
 			((##core#foreign-callback-wrapper)
 			 (let-values ([(args lam) (split-at (cdr x) 4)])
 			   (let* ([lam (car lam)]
-				  [name (cadr (first args))]
+				  [raw-c-name (cadr (first args))]
+                                  [name (##sys#alias-global-hook raw-c-name #t dest)]
 				  [rtype (cadr (third args))]
 				  [atypes (cadr (fourth args))]
 				  [vars (second lam)] )
-			     (if (valid-c-identifier? name)
-				 (set! callback-names (cons name callback-names))
+			     (if (valid-c-identifier? raw-c-name)
+				 (set! callback-names
+				   (cons (cons raw-c-name name) callback-names))
 				 (quit "name `~S' of external definition is not a valid C identifier"
-				       name) )
+				       raw-c-name) )
 			     (when (or (not (proper-list? vars)) 
 				       (not (proper-list? atypes))
 				       (not (= (length vars) (length atypes))) )
@@ -1204,7 +1206,7 @@
 					    e se #f #f h) ) ]
 				     [(assq sym external-to-pointer) 
 				      => (lambda (a) (walk (cdr a) e se #f #f h)) ]
-				     [(memq sym callback-names)
+				     [(assq sym callback-names)
 				      `(##core#inline_ref (,(symbol->string sym) c-pointer)) ]
 				     [else 
 				      (walk 
@@ -2024,7 +2026,7 @@
 				  #t]
 				 [else #f] ) )
 			 vars) )
-		      (cond [(and has (not (memq sym callback-names)))
+		      (cond [(and has (not (rassoc sym callback-names eq?)))
 			     (put! db (first lparams) 'has-unused-parameters #t) ]
 			    [rest
 			     (set! explicitly-consed (cons rest explicitly-consed))
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index f4feb011..6b7432fc 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -138,6 +138,25 @@
    "print_foo(\"bar\");"))
 
 
+;; Unused arguments in foreign callback wrappers are not optimized away (#584)
+(module bla (foo)
+
+(import chicken scheme foreign)
+
+(define-external
+  (blabla (int a) (c-string b) (int c) (int d) (c-string e) (int f))
+  int
+  f)
+
+(define (foo) ((foreign-safe-lambda* int () "C_return(blabla(1, \"2\", 3, 4, \"5\", 6));")))
+
+(assert (location blabla))
+)
+
+(import bla)
+(assert (= (foo) 6))
+
+
 ;;; compiler-syntax for map/for-each must be careful when the
 ;   operator may have side-effects (currently only lambda exprs and symbols
 ;   are allowed)