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.
This commit is contained in:
Abdulaziz Ghuloum 2008-06-18 22:47:56 -07:00
parent 1bd699349a
commit 4bb7e170b5
2 changed files with 16 additions and 14 deletions

View File

@ -293,19 +293,21 @@
[(case-lambda) [(case-lambda)
(let ([cls* (let ([cls*
(map (map
(lambda (cls) (let ([ctxt (if (pair? ctxt) (car ctxt) #f)])
(let ([fml* (car cls)] [body (cadr cls)]) (lambda (cls)
(let ([nfml* (gen-fml* fml*)]) (let ([fml* (car cls)] [body (cadr cls)])
(let ([body (E body #f)]) (let ([nfml* (gen-fml* fml*)])
(ungen-fml* fml*) (let ([body (E body ctxt)])
(make-clambda-case (ungen-fml* fml*)
(make-case-info (make-clambda-case
(gensym) (make-case-info
(properize nfml*) (gensym)
(list? fml*)) (properize nfml*)
body))))) (list? fml*))
body))))))
(cdr x))]) (cdr x))])
(make-clambda (gensym) cls* #f #f ctxt))] (make-clambda (gensym) cls* #f #f
(and (symbol? ctxt) ctxt)))]
[(lambda) [(lambda)
(E `(case-lambda ,(cdr x)) ctxt)] (E `(case-lambda ,(cdr x)) ctxt)]
[(foreign-call) [(foreign-call)
@ -317,7 +319,7 @@
[else [else
(let ([names (get-fmls (car x) (cdr x))]) (let ([names (get-fmls (car x) (cdr x))])
(make-funcall (make-funcall
(E (car x) #f) (E (car x) (list ctxt))
(let f ([arg* (cdr x)] [names names]) (let f ([arg* (cdr x)] [names names])
(cond (cond
[(pair? names) [(pair? names)

View File

@ -1 +1 @@
1517 1518