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

Fixes 1/2 of bug 176207: identifier-syntax second case broken

This commit is contained in:
Abdulaziz Ghuloum 2007-12-14 01:58:55 -05:00
parent 75f2d78678
commit fa27b7e9cd
4 changed files with 14 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
scheme/ikarus.io.ss
View File

@ -125,11 +125,13 @@
port-id port-id
)) ))
(module UNSAFE (fx< fx<= fx> fx>= fx= fx+ fx- (module UNSAFE
fxior fxand fxsra fxsll (fx< fx<= fx> fx>= fx= fx+ fx-
integer->char char->integer fxior fxand fxsra fxsll
string-ref string-set! string-length integer->char char->integer
bytevector-u8-ref bytevector-u8-set!) string-ref string-set! string-length
bytevector-u8-ref bytevector-u8-set!)
(import (import
(rename (ikarus system $strings) (rename (ikarus system $strings)
($string-length string-length) ($string-length string-length)

2
scheme/last-revision
View File

@ -1 +1 @@
1239 1240

7
scheme/pass-specify-rep-primops.ss
View File

@ -1804,7 +1804,12 @@
[(V x) [(V x)
(make-conditional (make-conditional
(tag-test (T x) vector-mask vector-tag) (tag-test (T x) vector-mask vector-tag)
(cogen-value-$port-attrs x) (with-tmp ([tag
(prm 'mref (T x) (K (- disp-port-attrs vector-tag)))])
(make-conditional
(tag-test tag port-mask port-tag)
(prm 'sra tag (K port-attrs-shift))
(K 0)))
(K 0))]) (K 0))])
(define-primop $set-port-index! unsafe (define-primop $set-port-index! unsafe

11
scheme/psyntax.expander.ss
View File

@ -2830,14 +2830,6 @@
(stx-error ctxt "cannot modify imported binding")))))) (stx-error ctxt "cannot modify imported binding"))))))
(else (stx-error ctxt "cannot modify binding in"))))))) (else (stx-error ctxt "cannot modify binding in")))))))
(define chi-top-set!
(lambda (e)
(syntax-match e ()
((_ id rhs) (id? id)
(let ((loc (gen-global-var-binding id e)))
(let ((rhs (chi-expr rhs '() '())))
(values loc rhs)))))))
(define chi-top* (define chi-top*
(lambda (e* init*) (lambda (e* init*)
(cond (cond
@ -2851,9 +2843,6 @@
(let ((loc (gen-global-var-binding id e))) (let ((loc (gen-global-var-binding id e)))
(let ((rhs (chi-rhs rhs '() '()))) (let ((rhs (chi-rhs rhs '() '())))
(chi-top* (cdr e*) (cons (cons loc rhs) init*)))))) (chi-top* (cdr e*) (cons (cons loc rhs) init*))))))
((set!)
(let-values (((loc rhs) (chi-top-set! e)))
(chi-top* (cdr e*) (cons (cons loc rhs) init*))))
((define-syntax) ((define-syntax)
(let-values (((id rhs) (parse-define-syntax e))) (let-values (((id rhs) (parse-define-syntax e)))
(let ((loc (gen-global-macro-binding id e))) (let ((loc (gen-global-macro-binding id e)))