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

attempting to reference/modify unexportable bindings was crashing 

the expander instead of raising a proper error.  fixed.
This commit is contained in:
Abdulaziz Ghuloum 2009-08-01 22:18:26 +03:00
parent b586d2e21a
commit 4df1dcb25a
2 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1833 1834

24
scheme/psyntax.expander.ss
View File

@ -701,6 +701,12 @@
(define (raise-unbound-error id) (define (raise-unbound-error id)
(syntax-violation* #f "unbound identifier" id (syntax-violation* #f "unbound identifier" id
(make-undefined-violation))) (make-undefined-violation)))
#;
(define (syntax-type e r)
(let-values ([(t0 t1 t2) (syntax-type^ e r)])
(printf "T ~s ~s => ~s ~s ~s\n" e r t0 t1 t2)
(values t0 t1 t2)))
(define syntax-type (define syntax-type
(lambda (e r) (lambda (e r)
(cond (cond
@ -2816,12 +2822,9 @@
(else "a non-expression")) (else "a non-expression"))
" was found where an expression was expected"))) " was found where an expression was expected")))
((mutable) ((mutable)
(let* ((lib (car value)) (if (and (pair? value) (let ((lib (car value))) (eq? lib '*interaction*)))
(loc (cdr value))) (let ((loc (cdr value))) (build-global-reference no-source loc))
(if (eq? lib '*interaction*) (stx-error e "attempt to reference an unexportable variable")))
(build-global-reference no-source loc)
(stx-error e
"attempt to reference an unexportable variable"))))
(else (else
;(assertion-violation 'chi-expr "invalid type " type (strip e '())) ;(assertion-violation 'chi-expr "invalid type " type (strip e '()))
(stx-error e "invalid expression")))))) (stx-error e "invalid expression"))))))
@ -2846,12 +2849,11 @@
((local-macro!) ((local-macro!)
(chi-expr (chi-local-macro value e r) r mr)) (chi-expr (chi-local-macro value e r) r mr))
((mutable) ((mutable)
(let ([lib (car value)] [loc (cdr value)]) (if (and (pair? value) (let ((lib (car value))) (eq? lib '*interaction*)))
(if (eq? lib '*interaction*) (let ([loc (cdr value)])
(build-global-assignment no-source loc (build-global-assignment no-source loc
(chi-expr v r mr)) (chi-expr v r mr)))
(stx-error e (stx-error e "attempt to modify an unexportable variable")))
"attempt to modify an unexportable variable"))))
(else (stx-error e)))))))) (else (stx-error e))))))))
(define (verify-formals fmls stx) (define (verify-formals fmls stx)