From 4bb7e170b58ec68d7bec67bebfe0e9b514c3e183 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Wed, 18 Jun 2008 22:47:56 -0700
Subject: [PATCH] Some procedures (like console-output-port) did not get names
 when printed (instead, they were just #<procedure>).  Names for procedures
 that are defined like   (define foo     (let ([something ---])       (lamdba
 () ---))) now works.

---
 scheme/ikarus.compiler.ss | 28 +++++++++++++++-------------
 scheme/last-revision      |  2 +-
 2 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/scheme/ikarus.compiler.ss b/scheme/ikarus.compiler.ss
index 9c3d1a0..3d8e875 100644
--- a/scheme/ikarus.compiler.ss
+++ b/scheme/ikarus.compiler.ss
@@ -293,19 +293,21 @@
          [(case-lambda)
           (let ([cls*
                  (map
-                   (lambda (cls)
-                     (let ([fml* (car cls)] [body (cadr cls)])
-                       (let ([nfml* (gen-fml* fml*)])
-                         (let ([body (E body #f)])
-                           (ungen-fml* fml*)
-                           (make-clambda-case 
-                             (make-case-info
-                               (gensym)
-                               (properize nfml*) 
-                               (list? fml*)) 
-                             body)))))
+                   (let ([ctxt (if (pair? ctxt) (car ctxt) #f)])
+                     (lambda (cls)
+                       (let ([fml* (car cls)] [body (cadr cls)])
+                         (let ([nfml* (gen-fml* fml*)])
+                           (let ([body (E body ctxt)])
+                             (ungen-fml* fml*)
+                             (make-clambda-case 
+                               (make-case-info
+                                 (gensym)
+                                 (properize nfml*) 
+                                 (list? fml*)) 
+                               body))))))
                    (cdr x))])
-            (make-clambda (gensym) cls* #f #f ctxt))]
+            (make-clambda (gensym) cls* #f #f
+              (and (symbol? ctxt) ctxt)))]
          [(lambda) 
           (E `(case-lambda ,(cdr x)) ctxt)]
          [(foreign-call)
@@ -317,7 +319,7 @@
          [else
           (let ([names (get-fmls (car x) (cdr x))])
             (make-funcall 
-              (E (car x) #f) 
+              (E (car x) (list ctxt))
               (let f ([arg* (cdr x)] [names names])
                 (cond
                   [(pair? names)
diff --git a/scheme/last-revision b/scheme/last-revision
index 522e1e9..1491db5 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1517
+1518