suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Corrections to bugs 8517 and 8223

Browse Source 
svn: r5562
This commit is contained in:
Kathy Gray 2007-02-06 14:49:03 +00:00
parent bb1f188642
commit a32a36453a
2 changed files with 23 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/profj/build-info.ss
View File

@ -380,10 +380,10 @@
((null? (cdr path)) (make-dir-path (build-path 'same) #t)) ((null? (cdr path)) (make-dir-path (build-path 'same) #t))
((not (equal? (cadr path) "lib")) ((not (equal? (cadr path) "lib"))
(let ((dir (find-directory (cdr path) fail))) (let ((dir (find-directory (cdr path) fail)))
(make-dir-path dir #t))) (make-dir-path (dir-path-path dir) #t)))
((and (equal? (cadr path) "lib") (not (null? (cddr path)))) ((and (equal? (cadr path) "lib") (not (null? (cddr path))))
(make-dir-path (apply collection-path (cddr path)) #t)) (make-dir-path (apply collection-path (cddr path)) #t))
(else (make-dir-path (list "mzlib") #t)))) (else (make-dir-path (build-path "mzlib") #t))))
(else (else
(when (null? (classpath)) (classpath (get-classpath))) (when (null? (classpath)) (classpath (get-classpath)))
(let-values (((search) (let-values (((search)

14
collects/profj/to-scheme.ss
View File

@ -2418,9 +2418,12 @@
(expr (if obj (translate-expression obj)))) (expr (if obj (translate-expression obj))))
(cond (cond
((var-access-static? access) ((var-access-static? access)
(let ((static-name (build-static-name field-string (var-access-class access)))) (let ((static-name (build-static-name field-string (var-access-class access)))
(obj-wrapper
(lambda (s) (if obj (make-syntax #f `(begin ,expr ,s) (build-src field-src)) s))))
(if (dynamic-val? type) (if (dynamic-val? type)
(let ((access-syntax (cond (let ((access-syntax
(cond
((unknown-ref? (dynamic-val-type type)) ((unknown-ref? (dynamic-val-type type))
`(let ((val-1 ,(translate-id static-name field-src))) `(let ((val-1 ,(translate-id static-name field-src)))
(if (string? val-1) (if (string? val-1)
@ -2428,14 +2431,15 @@
val-1))) val-1)))
(else (translate-id static-name field-src))))) (else (translate-id static-name field-src)))))
(make-syntax #f (make-syntax #f
(obj-wrapper
(convert-assert-value (convert-assert-value
(make-syntax #f (make-syntax #f
`(c:contract ,(type->contract (dynamic-val-type type) #t) `(c:contract ,(type->contract (dynamic-val-type type) #t)
,access-syntax ,access-syntax
(quote ,(string->symbol (class-name))) '||) (quote ,(string->symbol (class-name))) '||)
(build-src field-src)) (build-src field-src))
(dynamic-val-type type)) (build-src field-src))) (dynamic-val-type type))) (build-src field-src)))
(translate-id (build-var-name static-name) field-src)))) (obj-wrapper (translate-id (build-var-name static-name) field-src)))))
((eq? 'array (var-access-class access)) ((eq? 'array (var-access-class access))
(if cant-be-null? (if cant-be-null?
(make-syntax #f `(send ,expr ,(translate-id field-string field-src)) (build-src src)) (make-syntax #f `(send ,expr ,(translate-id field-string field-src)) (build-src src))
@ -2620,7 +2624,7 @@
(cond (cond
((and cant-be-null? (not static?)) ((and cant-be-null? (not static?))
(create-syntax #f `(send ,expression ,name ,@translated-args) (build-src src))) (create-syntax #f `(send ,expression ,name ,@translated-args) (build-src src)))
(static? (create-syntax #f `(,name ,@translated-args) (build-src src))) (static? (create-syntax #f `(begin ,expression (,name ,@translated-args)) (build-src src)))
(else (else
(create-syntax #f (create-syntax #f
`(let ((,unique-name ,expression)) `(let ((,unique-name ,expression))