conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* exported identifiers bound to procedures get their procedure 

annotation set to the name of the exported variable
This commit is contained in:
Abdulaziz Ghuloum 2007-09-04 20:33:21 -04:00
parent 2c2b3eb1f1
commit b3f80f0dc9
2 changed files with 28 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

28
src/ikarus.syntax.ss
View File

@ -2444,11 +2444,20 @@
(values invoke-code export-subst export-env))) (values invoke-code export-subst export-env)))
(define build-export (define build-export
(lambda (x) (lambda (x)
(define c (gensym))
;;; exports use the same gensym ;;; exports use the same gensym
`(begin `(begin
(#%$set-symbol-value! ',x ,x) (#%$set-symbol-value! ',x ,x)
(if (#%procedure? ,x)
(begin
(#%$set-symbol-proc! ',x ,x)
((case-lambda
[(,c)
; (if (#%$code-annotation ,c)
; (#%void)
(#%$set-code-annotation! ,c ',x)])
(#%$closure-code ,x)))
(#%$set-symbol-proc! ',x (#%$set-symbol-proc! ',x
(if (#%procedure? ,x) ,x
(case-lambda (case-lambda
[,(gensym) [,(gensym)
(#%error 'apply '"~s is not a procedure" (#%error 'apply '"~s is not a procedure"
@ -2458,6 +2467,7 @@
(define f (gensym)) (define f (gensym))
(define name (gensym)) (define name (gensym))
(define val (gensym)) (define val (gensym))
(define c (gensym))
`((case-lambda `((case-lambda
[(,f) [(,f)
(begin '#f (begin '#f
@ -2466,8 +2476,22 @@
[(,name ,val) [(,name ,val)
(begin (begin
(#%$set-symbol-value! ,name ,val) (#%$set-symbol-value! ,name ,val)
;(#%$set-symbol-proc! ,name
; (if (#%procedure? ,val) ,val
; (case-lambda
; [,(gensym)
; (#%error 'apply '"~s is not a procedure"
; (#%$symbol-value ,name))])))
(if (#%procedure? ,val)
(begin
(#%$set-symbol-proc! ,name ,val)
((case-lambda
[(,c)
(if (#%$code-annotation ,c)
(#%void)
(#%$set-code-annotation! ,c ,name))])
(#%$closure-code ,val)))
(#%$set-symbol-proc! ,name (#%$set-symbol-proc! ,name
(if (#%procedure? ,val) ,val
(case-lambda (case-lambda
[,(gensym) [,(gensym)
(#%error 'apply '"~s is not a procedure" (#%error 'apply '"~s is not a procedure"