From a32a36453a88fefa67b312dc91e819a38dac032f Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Tue, 6 Feb 2007 14:49:03 +0000 Subject: [PATCH] Corrections to bugs 8517 and 8223 svn: r5562 --- collects/profj/build-info.ss | 4 ++-- collects/profj/to-scheme.ss | 38 ++++++++++++++++++++---------------- 2 files changed, 23 insertions(+), 19 deletions(-) diff --git a/collects/profj/build-info.ss b/collects/profj/build-info.ss index 9fca544734..987ed29a25 100644 --- a/collects/profj/build-info.ss +++ b/collects/profj/build-info.ss @@ -380,10 +380,10 @@ ((null? (cdr path)) (make-dir-path (build-path 'same) #t)) ((not (equal? (cadr path) "lib")) (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)))) (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 (when (null? (classpath)) (classpath (get-classpath))) (let-values (((search) diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss index d4330bad1a..5aa53bc1f3 100644 --- a/collects/profj/to-scheme.ss +++ b/collects/profj/to-scheme.ss @@ -2418,24 +2418,28 @@ (expr (if obj (translate-expression obj)))) (cond ((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) - (let ((access-syntax (cond - ((unknown-ref? (dynamic-val-type type)) - `(let ((val-1 ,(translate-id static-name field-src))) - (if (string? val-1) - (make-java-string val-1) - val-1))) - (else (translate-id static-name field-src))))) + (let ((access-syntax + (cond + ((unknown-ref? (dynamic-val-type type)) + `(let ((val-1 ,(translate-id static-name field-src))) + (if (string? val-1) + (make-java-string val-1) + val-1))) + (else (translate-id static-name field-src))))) (make-syntax #f - (convert-assert-value - (make-syntax #f - `(c:contract ,(type->contract (dynamic-val-type type) #t) - ,access-syntax - (quote ,(string->symbol (class-name))) '||) - (build-src field-src)) - (dynamic-val-type type)) (build-src field-src))) - (translate-id (build-var-name static-name) field-src)))) + (obj-wrapper + (convert-assert-value + (make-syntax #f + `(c:contract ,(type->contract (dynamic-val-type type) #t) + ,access-syntax + (quote ,(string->symbol (class-name))) '||) + (build-src field-src)) + (dynamic-val-type type))) (build-src field-src))) + (obj-wrapper (translate-id (build-var-name static-name) field-src))))) ((eq? 'array (var-access-class access)) (if cant-be-null? (make-syntax #f `(send ,expr ,(translate-id field-string field-src)) (build-src src)) @@ -2620,7 +2624,7 @@ (cond ((and cant-be-null? (not static?)) (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 (create-syntax #f `(let ((,unique-name ,expression))