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.

32
src/ikarus.syntax.ss
View File

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