diff --git a/collects/compiler/compiler-unit.ss b/collects/compiler/compiler-unit.ss index 774f819cb5..421b2ad8d4 100644 --- a/collects/compiler/compiler-unit.ss +++ b/collects/compiler/compiler-unit.ss @@ -22,6 +22,7 @@ syntax/toplevel syntax/moddep + scheme/namespace syntax/namespace-reflect mzlib/list @@ -168,7 +169,12 @@ (printf " [output to \"~a\"]~n" dest)) (define (compile-zos prefix) - (let ([n (if prefix (make-namespace) (current-namespace))]) + (let ([n (if prefix + (let ([ns (make-base-namespace)]) + (parameterize ([current-namespace ns]) + (namespace-require 'scheme/base) + ns)) + (current-namespace))]) (when prefix (eval prefix n)) (lambda (source-files destination-directory) diff --git a/collects/compiler/main.ss b/collects/compiler/main.ss index b641a626a6..9e3de9eb70 100644 --- a/collects/compiler/main.ss +++ b/collects/compiler/main.ss @@ -32,7 +32,8 @@ (lib "link.ss" "dynext") (lib "pack.ss" "setup") (lib "getinfo.ss" "setup") - (lib "dirs.ss" "setup")) + (lib "dirs.ss" "setup") + scheme/namespace) (define dest-dir (make-parameter #f)) (define auto-dest-dir (make-parameter #f)) @@ -424,9 +425,11 @@ (error 'mzc "prefix files not allowed with -m or --module")) #f) `(begin - ,(if (compiler:option:assume-primitives) '(require mzscheme) '(void)) + (require scheme) + ,(if (compiler:option:assume-primitives) + '(void) + '(namespace-require/copy 'scheme)) (require (lib "cffi.ss" "compiler")) - (require-for-syntax mzscheme) ,@(map (lambda (s) `(load ,s)) prefixes) (void))))))) (list "file/directory/collection" "file/directory/sub-collection"))) @@ -483,7 +486,7 @@ 'auto (dest-dir)))] [(make-zo) - (let ([n (make-namespace)] + (let ([n (make-base-namespace)] [mc (dynamic-require '(lib "mzlib/cm.ss") 'managed-compile-zo)] [cnh (dynamic-require '(lib "mzlib/cm.ss") @@ -493,23 +496,23 @@ [cnh (lambda (p) (set! did-one? #t) (printf " making ~s~n" (path->string p)))]) - (map (lambda (file) - (unless (file-exists? file) - (error 'mzc "file does not exist: ~a" file)) - (set! did-one? #f) - (let ([name (extract-base-filename/ss file 'mzc)]) - (printf "\"~a\":~n" file) - (mc file) - (let ([dest (append-zo-suffix - (let-values ([(base name dir?) (split-path name)]) - (build-path (if (symbol? base) 'same base) - "compiled" name)))]) - (printf " [~a \"~a\"]~n" - (if did-one? - "output to" - "already up-to-date at") - dest)))) - source-files)))] + (for-each (lambda (file) + (unless (file-exists? file) + (error 'mzc "file does not exist: ~a" file)) + (set! did-one? #f) + (let ([name (extract-base-filename/ss file 'mzc)]) + (printf "\"~a\":~n" file) + (mc file) + (let ([dest (append-zo-suffix + (let-values ([(base name dir?) (split-path name)]) + (build-path (if (symbol? base) 'same base) + "compiled" name)))]) + (printf " [~a \"~a\"]~n" + (if did-one? + "output to" + "already up-to-date at") + dest)))) + source-files)))] [(collection-extension) (compiler-warning) (apply compile-collection-extension source-files)] diff --git a/collects/mzlib/private/class-internal.ss b/collects/mzlib/private/class-internal.ss index 439f8788d9..c668ed3632 100644 --- a/collects/mzlib/private/class-internal.ss +++ b/collects/mzlib/private/class-internal.ss @@ -130,6 +130,7 @@ (append (kernel-form-identifier-list) (list + (quote-syntax #%app) ; scheme/base app, as opposed to #%plain-app (quote-syntax -init) (quote-syntax init-rest) (quote-syntax -field) @@ -1314,7 +1315,7 @@ (letrec-syntaxes+values ([(plain-init-name) (make-init-redirect (quote-syntax set!) - (quote-syntax #%app) + (quote-syntax #%plain-app) (quote-syntax local-plain-init-name) (quote-syntax plain-init-name-localized))] ...) ([(local-plain-init-name) undefined] ...) diff --git a/collects/mzlib/private/classidmap.ss b/collects/mzlib/private/classidmap.ss index 833a70c2b0..553fb97fea 100644 --- a/collects/mzlib/private/classidmap.ss +++ b/collects/mzlib/private/classidmap.ss @@ -328,7 +328,7 @@ (with-syntax ([object object-stx] [method method-proc-stx] - [app (if rest-arg? (qstx apply) (qstx #%app))] + [app (if rest-arg? (qstx apply) (qstx #%plain-app))] [args args-stx]) (if traced? (with-syntax ([(mth obj) (generate-temporaries diff --git a/collects/tests/mred/draw.ss b/collects/tests/mred/draw.ss index fd2e934244..d4b8fbf34d 100644 --- a/collects/tests/mred/draw.ss +++ b/collects/tests/mred/draw.ss @@ -1,5 +1,4 @@ - -(require (lib "class100.ss")) +#lang scheme/gui (define manual-chinese? #f) @@ -65,8 +64,6 @@ (send c set-editor e) (send f show #t))) -(define pi (atan 0 -1)) - (define star (list (make-object point% 30 0) (make-object point% 48 60) @@ -215,6 +212,7 @@ [clock-start #f] [clock-end #f] [clock-clip? #f] + [do-clock #f] [use-bitmap? #f] [use-bad? #f] [depth-one? #f] @@ -286,15 +284,15 @@ [otfg (send dc get-text-foreground)] [otbg (send dc get-text-background)] [obm (send dc get-text-mode)]) - (if (positive? flevel) - (send dc set-font - (make-object font% - 10 'decorative - 'normal - (if (> flevel 1) - 'bold - 'normal) - #t))) + (when (positive? flevel) + (send dc set-font + (make-object font% + 10 'decorative + 'normal + (if (> flevel 1) + 'bold + 'normal) + #t))) (send dc set-pen pens) (send dc set-brush brusht) @@ -1146,7 +1144,7 @@ (set! smoothing (list-ref '(unsmoothed smoothed aligned) (send self get-selection))) (send canvas refresh))) - (make-object button% "Clock" hp2.5 (lambda (b e) (clock #f))) + (make-object button% "Clock" hp2.5 (lambda (b e) (do-clock #f))) (make-object choice% #f '("MrEd XOR" "PLT Middle" "PLT ^ MrEd" "MrEd ^ PLT" "MrEd ^ MrEd" "MrEd~" "MrEd ^ MrEd~" "M^M~ Opaque" "M^M~ Red" @@ -1212,6 +1210,7 @@ (set! clock-start #f) (set! clock-end #f) (send canvas refresh))))]) + (set! do-clock clock) (make-object button% "Clip Clock" hp3 (lambda (b e) (clock #t))) (make-object slider% "Alpha" 0 10 hp4 (lambda (s e)