diff --git a/collects/frtime/animation.rkt b/collects/frtime/animation.rkt index 909448f79f..d598b45970 100644 --- a/collects/frtime/animation.rkt +++ b/collects/frtime/animation.rkt @@ -1,19 +1,26 @@ (module animation frtime - (require (all-except frtime/animation/graphics + (require (except-in frtime/animation/graphics make-posn posn-x posn-y make-rgb) - (lifted frtime/animation/graphics - posn-x posn-y make-posn make-rgb) + (for-syntax racket/base (only-in racket/function identity)) + (lifted (only-in frtime/animation/graphics posn-x) + posn-x) + (lifted (only-in frtime/animation/graphics posn-y) + posn-y) + (lifted (only-in frtime/animation/graphics make-posn) + make-posn) + (lifted (only-in frtime/animation/graphics make-rgb) make-rgb) + racket/match (as-is:unchecked frtime/lang-ext lift) racket/class frtime/frlibs/list frtime/frlibs/etc frtime/frlibs/math - #;(rename mzscheme mz:define-struct define-struct)) + #;(rename-in racket [define-struct mz:define-struct])) - (require-for-syntax (only racket/base build-list) - (only racket/function identity)) + (require (for-syntax (only-in racket/base build-list) + (only-in racket/function identity))) (open-graphics) @@ -76,7 +83,7 @@ (syntax-case stx () [(_ name (field ...)) (with-syntax - ([ctor-name (datum->syntax-object stx (string->symbol (format "make-~a" (syntax-e #'name))))] + ([ctor-name (datum->syntax stx (string->symbol (format "make-~a" (syntax-e #'name))))] [(accessor-name ...) (map (lambda (fd) (string->symbol (format "~a-~a" (syntax-e #'name) (syntax-e fd)))) @@ -376,6 +383,6 @@ (make-posn (integral (posn-x p)) (integral (posn-y p)))) (provide - (all-defined-except pixmap window draw-list l d + (except-out (all-defined-out) pixmap window draw-list l d make-wave-state wave-state-hz wave-state-offset) - (all-from frtime/animation/graphics))) + (all-from-out frtime/animation/graphics))) diff --git a/collects/frtime/frlibs/etc.rkt b/collects/frtime/frlibs/etc.rkt index a54758063d..2b4cbc3379 100644 --- a/collects/frtime/frlibs/etc.rkt +++ b/collects/frtime/frlibs/etc.rkt @@ -1,12 +1,14 @@ (module etc frtime/frtime-lang-only (require setup/main-collects) - (require-for-syntax syntax/kerncase + (require (for-syntax + racket/base + syntax/kerncase syntax/stx syntax/name syntax/context setup/main-collects - mzlib/private/stxset) + mzlib/private/stxset)) (provide true false boolean=? symbol=? @@ -314,7 +316,7 @@ (let loop ([tests tests]) (unless (null? (cdr tests)) (when (and (identifier? (car tests)) - (module-identifier=? (quote-syntax else) (car tests))) + (free-identifier=? (quote-syntax else) (car tests))) (raise-syntax-error #f "else is not in last clause" diff --git a/collects/frtime/frlibs/list.rkt b/collects/frtime/frlibs/list.rkt index aec63a881c..18e7e6a72a 100644 --- a/collects/frtime/frlibs/list.rkt +++ b/collects/frtime/frlibs/list.rkt @@ -1,11 +1,16 @@ (module list frtime/frtime-lang-only (require - (lifted racket/base sort) - (lifted racket/list - fifth sixth seventh eighth - last-pair) - (rename racket/list empty empty)) + (lifted (only-in racket/base sort) sort) + + (lifted (only-in racket/list fifth) + fifth) + (lifted (only-in racket/list sixth) sixth) + (lifted (only-in racket/list seventh) seventh) + (lifted (only-in racket/list eighth) eighth) + (lifted (only-in racket/list last-pair) last-pair) + + (rename-in (except-in racket/list first rest second third fourth empty? cons? fifth sixth seventh eighth last-pair) [empty empty])) (define first car) (define rest cdr) @@ -21,7 +26,7 @@ [(item list equal?) (let loop ([list list]) (cond - [(null? list) ()] + [(null? list) '()] [(equal? item (car list)) (cdr list)] [else (cons (car list) (loop (cdr list)))]))])]) @@ -164,4 +169,4 @@ (define (cons? x) (pair? x)) - (provide (all-defined) empty)) + (provide (all-defined-out) empty)) diff --git a/collects/frtime/frp-snip.rkt b/collects/frtime/frp-snip.rkt index 0df5cda112..e4e1fcd52f 100644 --- a/collects/frtime/frp-snip.rkt +++ b/collects/frtime/frp-snip.rkt @@ -1,11 +1,8 @@ -#lang scheme/base -(require scheme/class - (only-in mzlib/string expr->string) - scheme/list - scheme/port - +#lang racket/base +(require racket/class + racket/list + racket/port framework - ;; FRP requires frtime/core/frp @@ -50,7 +47,7 @@ [(event-set? tmp) (format "#" (event-set-events tmp) (event-set-time tmp))] [(undefined? tmp) ""] - [else (expr->string tmp)])))] + [else (number->string tmp)])))] [(bhvr super-render-fun) (get-rendering (value-now bhvr) super-render-fun)])) diff --git a/collects/frtime/frtime-big.rkt b/collects/frtime/frtime-big.rkt index 8987df24a0..ae9731774d 100644 --- a/collects/frtime/frtime-big.rkt +++ b/collects/frtime/frtime-big.rkt @@ -5,8 +5,8 @@ frtime/frlibs/math frtime/frlibs/date) - (provide (all-from frtime/frtime) - (all-from frtime/frlibs/list) - (all-from frtime/frlibs/etc) - (all-from frtime/frlibs/math) - (all-from frtime/frlibs/date))) + (provide (all-from-out frtime/frtime) + (all-from-out frtime/frlibs/list) + (all-from-out frtime/frlibs/etc) + (all-from-out frtime/frlibs/math) + (all-from-out frtime/frlibs/date))) diff --git a/collects/frtime/frtime-lang-only.rkt b/collects/frtime/frtime-lang-only.rkt index 7b39a7e99e..47a1f9f99d 100644 --- a/collects/frtime/frtime-lang-only.rkt +++ b/collects/frtime/frtime-lang-only.rkt @@ -1,6 +1,6 @@ (module frtime-lang-only "lang-utils.rkt" - (require (only frtime/lang-ext undefined? signal? value-now lift)) - (require (as-is:unchecked frtime/core/frp + (require (only-in frtime/lang-ext undefined? signal? value-now lift)) + (require (as-is:unchecked (except-in frtime/core/frp undefined? undefined) event-set? signal-value)) (define (value-nowable? x) @@ -13,5 +13,5 @@ (pred v)))) (provide value-nowable? behaviorof - (all-from "lang-utils.rkt") - (all-from-except frtime/lang-ext lift))) + (all-from-out "lang-utils.rkt") + (all-from-out frtime/lang-ext))) diff --git a/collects/frtime/frtime.rkt b/collects/frtime/frtime.rkt index 802e5b8fef..b48c041981 100644 --- a/collects/frtime/frtime.rkt +++ b/collects/frtime/frtime.rkt @@ -1,7 +1,7 @@ (module frtime "lang-utils.rkt" - (require (all-except "lang-ext.rkt" lift deep-value-now)) + (require (except-in "lang-ext.rkt" lift deep-value-now)) (require "frp-snip.rkt") - (require (as-is:unchecked frtime/core/frp + (require (as-is:unchecked (except-in frtime/core/frp undefined undefined?) event-set? signal-value)) (define (value-nowable? x) @@ -14,6 +14,6 @@ (pred v)))) (provide value-nowable? behaviorof - (all-from "lang-ext.rkt") - (all-from "lang-utils.rkt") - (all-from "frp-snip.rkt"))) + (all-from-out "lang-ext.rkt") + (all-from-out "lang-utils.rkt") + (all-from-out "frp-snip.rkt"))) diff --git a/collects/frtime/gui.rkt b/collects/frtime/gui.rkt index c0a142248c..017e2b5616 100644 --- a/collects/frtime/gui.rkt +++ b/collects/frtime/gui.rkt @@ -1,6 +1,6 @@ (module gui frtime (require - (all-except mzlib/etc rec) + (except-in mzlib/etc rec) frtime/gui/fred) (define frame (new ft-frame% [label "GUI"] [min-height 150] [min-width 200] [shown #t])) @@ -44,4 +44,4 @@ (set! frame (new ft-frame% [label "GUI"] [min-height 150] [min-width 200] [shown #t]))))))) - (provide (all-defined))) + (provide (all-defined-out))) diff --git a/collects/frtime/gui/aux-mixin-macros.rkt b/collects/frtime/gui/aux-mixin-macros.rkt index dd7515a15f..7da6b725af 100644 --- a/collects/frtime/gui/aux-mixin-macros.rkt +++ b/collects/frtime/gui/aux-mixin-macros.rkt @@ -1,6 +1,7 @@ (module aux-mixin-macros frtime (require "mixin-macros.rkt") (require racket/class) + (require (for-syntax racket/base)) ;; consider taking out setter @@ -70,4 +71,4 @@ [(_ src) src])) - (provide (all-defined))) + (provide (all-defined-out))) diff --git a/collects/frtime/gui/demo/bindec.rkt b/collects/frtime/gui/demo/bindec.rkt index 26476453bc..1418087159 100644 --- a/collects/frtime/gui/demo/bindec.rkt +++ b/collects/frtime/gui/demo/bindec.rkt @@ -1,6 +1,6 @@ #lang frtime (require frtime/gui/simple) -(require (rename mred horizontal-panel% horizontal-panel%)) +(require (rename-in mred [horizontal-panel% horizontal-panel%])) ; just change this to change the range of the binary/decimal converter (define SIZE 10) diff --git a/collects/frtime/gui/demo/instr.rkt b/collects/frtime/gui/demo/instr.rkt index c015cd3c2c..aceafd7d9f 100644 --- a/collects/frtime/gui/demo/instr.rkt +++ b/collects/frtime/gui/demo/instr.rkt @@ -1,6 +1,6 @@ #lang frtime (require frtime/gui/mixin-macros frtime/gui/aux-mixin-macros) -(require mzlib/class) ; require class utilities +(require racket/class) ; require class utilities (require mred) ; require base mred library diff --git a/collects/frtime/gui/fred.rkt b/collects/frtime/gui/fred.rkt index 23e3fef7d3..0524de6694 100644 --- a/collects/frtime/gui/fred.rkt +++ b/collects/frtime/gui/fred.rkt @@ -4,7 +4,7 @@ racket/class racket/string texpict/mrpict - (all-except mred send-event) + mred framework) @@ -322,7 +322,7 @@ menu-item%))) - (provide (all-defined) - (all-from racket/class) - (all-from "mixin-macros.rkt") - (all-from "aux-mixin-macros.rkt"))) + (provide (all-defined-out) + (all-from-out racket/class) + (all-from-out "mixin-macros.rkt") + (all-from-out "aux-mixin-macros.rkt"))) diff --git a/collects/frtime/gui/mixin-macros.rkt b/collects/frtime/gui/mixin-macros.rkt index f4a2bfd715..f5789e20e2 100644 --- a/collects/frtime/gui/mixin-macros.rkt +++ b/collects/frtime/gui/mixin-macros.rkt @@ -1,5 +1,7 @@ (module mixin-macros frtime - (require racket/class) + (require racket/class + (for-syntax racket/base)) + (define-syntax events->callbacks (lambda (stx) diff --git a/collects/frtime/gui/simple.rkt b/collects/frtime/gui/simple.rkt index 50521a8c15..d7116d712e 100644 --- a/collects/frtime/gui/simple.rkt +++ b/collects/frtime/gui/simple.rkt @@ -2,7 +2,8 @@ (require "fred.rkt" racket/class - (rename mred frame% frame%)) + (rename-in mred [frame% frame%]) + (for-syntax racket/base)) (define widget (lambda (x) x)) (define value-b (lambda (x) (send x get-value-b))) @@ -48,6 +49,6 @@ - (provide (all-defined) - (all-from "fred.rkt") - (all-from racket/class))) + (provide (all-defined-out) + (all-from-out "fred.rkt") + (all-from-out racket/class))) diff --git a/collects/frtime/lang-core.rkt b/collects/frtime/lang-core.rkt index a3d9de6726..0822311101 100644 --- a/collects/frtime/lang-core.rkt +++ b/collects/frtime/lang-core.rkt @@ -1,14 +1,14 @@ -(module lang-core mzscheme - (require-for-syntax (only syntax/struct build-struct-names build-struct-generation build-struct-expand-info) - (only racket/base foldl) - (only racket/list empty)) - (require (only racket/list cons? first second rest empty empty?) - (only racket/base vector-ref build-vector build-list) - (only racket/function identity) - (only mzlib/etc opt-lambda) - (only frtime/core/frp super-lift undefined undefined? behavior? do-in-manager-after do-in-manager proc->signal set-signal-thunk! register unregister iq-enqueue value-now/no-copy +(module lang-core racket + (require (for-syntax (only-in syntax/struct build-struct-names build-struct-generation build-struct-expand-info) + (only-in racket/base foldl) + (only-in racket/list empty))) + (require (only-in racket/list cons? first second rest empty empty?) + (only-in racket/base vector-ref build-vector build-list) + (only-in racket/function identity) + (only-in mzlib/etc opt-lambda) + (only-in frtime/core/frp super-lift undefined undefined? behavior? do-in-manager-after do-in-manager proc->signal set-signal-thunk! register unregister iq-enqueue value-now/no-copy signal? signal-depth signal:switching? signal-value value-now signal:compound? signal:compound-content signal:switching-current signal:switching-trigger set-cell!) - (only frtime/lang-ext lift new-cell switch ==> changes deep-value-now)) + (only-in frtime/lang-ext lift new-cell switch ==> changes deep-value-now)) #| (VECTOR-ANY ) -> value ;;; Apply PRED? to each element in VECTOR ...; if PRED? @@ -63,7 +63,7 @@ (define (frp:copy-list lst) (frp:if (null? lst) - () + '() (frp:cons (frp:car lst) (frp:copy-list (frp:cdr lst))))) (define-syntax frp:let-values @@ -134,9 +134,9 @@ (cond [(assq obj table) => second] [(behavior? obj) - (case (hash-table-get deps obj 'absent) - [(absent) (hash-table-put! deps obj 'new)] - [(old) (hash-table-put! deps obj 'alive)] + (case (hash-ref deps obj 'absent) + [(absent) (hash-set! deps obj 'new)] + [(old) (hash-set! deps obj 'alive)] [(new) (void)]) (deep-value-now/update-deps (signal-value obj) deps (cons (list obj (signal-value obj)) table))] @@ -191,9 +191,9 @@ (define (deep-cdr-value-now/update-deps obj deps table) (cond [(behavior? obj) - (case (hash-table-get deps obj 'absent) - [(absent) (hash-table-put! deps obj 'new)] - [(old) (hash-table-put! deps obj 'alive)] + (case (hash-ref deps obj 'absent) + [(absent) (hash-set! deps obj 'new)] + [(old) (hash-set! deps obj 'alive)] [(new) (void)]) (deep-cdr-value-now/update-deps (signal-value obj) deps table)] [(cons? obj) @@ -206,20 +206,20 @@ (let ([rtn (proc->signal void)]) (set-signal-thunk! rtn - (let ([deps (make-hash-table)]) + (let ([deps (make-hash)]) (lambda () (begin0 (deep-cdr-value-now/update-deps obj deps empty) - (hash-table-for-each + (hash-for-each deps (lambda (k v) (case v - [(new) (hash-table-put! deps k 'old) + [(new) (hash-set! deps k 'old) (register rtn k) (do-in-manager (iq-enqueue rtn))] - [(alive) (hash-table-put! deps k 'old)] - [(old) (hash-table-remove! deps k) + [(alive) (hash-set! deps k 'old)] + [(old) (hash-remove! deps k) (unregister rtn k)]))))))) (do-in-manager (iq-enqueue rtn)) @@ -230,18 +230,18 @@ (let ([rtn (proc->signal void)]) (set-signal-thunk! rtn - (let ([deps (make-hash-table)]) + (let ([deps (make-hash)]) (lambda () (begin0 (deep-value-now/update-deps obj deps empty) - (hash-table-for-each + (hash-for-each deps (lambda (k v) (case v - [(new) (hash-table-put! deps k 'old) + [(new) (hash-set! deps k 'old) (register rtn k)] - [(alive) (hash-table-put! deps k 'old)] - [(old) (hash-table-remove! deps k) + [(alive) (hash-set! deps k 'old)] + [(old) (hash-remove! deps k) (unregister rtn k)]))))))) (do-in-manager (iq-enqueue rtn)) @@ -251,7 +251,7 @@ (let ([rtn (proc->signal void)]) (set-signal-thunk! rtn - (let ([deps (make-hash-table)]) + (let ([deps (make-hash)]) (lambda () (begin0 (let/ec esc @@ -259,23 +259,23 @@ (proc (lambda (obj) (if (behavior? obj) (begin - (case (hash-table-get deps obj 'absent) - [(absent) (hash-table-put! deps obj 'new) + (case (hash-ref deps obj 'absent) + [(absent) (hash-set! deps obj 'new) (let ([o-depth (signal-depth rtn)]) (register rtn obj) (when (> (signal-depth rtn) o-depth) (iq-enqueue rtn) (esc #f)))] - [(old) (hash-table-put! deps obj 'alive)] + [(old) (hash-set! deps obj 'alive)] [(new) (void)]) (value-now obj)) obj)));) - (hash-table-for-each + (hash-for-each deps (lambda (k v) (case v - [(new alive) (hash-table-put! deps k 'old)] - [(old) (hash-table-remove! deps k) + [(new alive) (hash-set! deps k 'old)] + [(old) (hash-remove! deps k) (unregister rtn k)]))))))))) (iq-enqueue rtn) rtn)) @@ -333,7 +333,7 @@ (define frp:append (case-lambda - [() ()] + [() '()] [(lst) lst] [(lst1 lst2 . lsts) (list-match lst1 @@ -435,7 +435,7 @@ (define (ensure-no-signal-args val name) - (if (procedure? val) + (when (procedure? val) (lambda args (cond [(find signal? args) @@ -463,7 +463,7 @@ (with-syntax ([(fun-name ...) (syntax ids)] [(tmp-name ...) (map (lambda (id) - (datum->syntax-object stx (syntax-object->datum id))) + (datum->syntax stx (syntax->datum id))) (generate-temporaries (syntax ids)))]) (syntax (begin @@ -471,12 +471,12 @@ (define (tmp-name . args) (apply lift #t fun-name args)) ... - (provide (rename tmp-name fun-name) ...))))] + (provide (rename-out [tmp-name fun-name]) ...))))] [(lifted:nonstrict . ids) (with-syntax ([(fun-name ...) (syntax ids)] [(tmp-name ...) (map (lambda (id) - (datum->syntax-object stx (syntax-object->datum id))) + (datum->syntax stx (syntax->datum id))) (generate-temporaries (syntax ids)))]) (syntax (begin @@ -484,7 +484,7 @@ (define (tmp-name . args) (apply lift #f fun-name args)) ... - (provide (rename tmp-name fun-name) ...))))] + (provide (rename-out [tmp-name fun-name]) ...))))] [provide-spec (syntax (begin clause ... (provide provide-spec)))])])) (syntax (begin)) @@ -493,7 +493,7 @@ (define-syntax (frp:require stx) (define (generate-temporaries/loc st ids) (map (lambda (id) - (datum->syntax-object stx (syntax-object->datum id))) + (datum->syntax stx (syntax->datum id))) (generate-temporaries ids))) (syntax-case stx () [(_ . clauses) @@ -507,7 +507,7 @@ [(tmp-name ...) (generate-temporaries/loc stx #'ids)]) #'(begin clause ... - (require (rename module tmp-name fun-name) ...) + (require (rename-in module [fun-name tmp-name]) ...) (define (fun-name . args) (apply lift #f tmp-name args)) ...))] @@ -516,18 +516,18 @@ [(tmp-name ...) (generate-temporaries/loc stx #'ids)]) #'(begin clause ... - (require (rename module tmp-name fun-name) ...) + (require (rename-in module [fun-name tmp-name]) ...) (define (fun-name . args) (apply lift #t tmp-name args)) ...))] [(as-is:unchecked module id ...) - (syntax (begin clause ... (require (rename module id id) ...)))] + (syntax (begin clause ... (require (rename-in module [id id]) ...)))] [(as-is module . ids) (with-syntax ([(fun-name ...) (syntax ids)] [(tmp-name ...) (generate-temporaries/loc stx #'ids)]) #'(begin clause ... - (require (rename module tmp-name fun-name) ...) + (require (rename-in module [fun-name tmp-name]) ...) (define fun-name (ensure-no-signal-args tmp-name 'fun-name)) ...))] [require-spec @@ -545,7 +545,12 @@ #%plain-module-begin #%module-begin #%top-interaction - + only-in + except-in + rename-in + all-from-out + all-defined-out + except-out raise-reactivity raise-list-for-apply @@ -555,25 +560,25 @@ frp:copy-list frp:->boolean - (rename public-dvn deep-value-now) - (rename frp:if if) - (rename frp:lambda lambda) - (rename frp:case-lambda case-lambda) - (rename frp:letrec letrec) - (rename frp:cons cons) - (rename frp:car car) - (rename frp:cdr cdr) - (rename frp:list list) - (rename frp:list? list?) - (rename frp:list* list*) - (rename frp:null? null?) - (rename frp:pair? pair?) - (rename frp:append append) - (rename frp:vector vector) - (rename frp:vector-ref vector-ref) - (rename frp:make-struct-type make-struct-type) - (rename frp:make-struct-field-accessor make-struct-field-accessor) - (rename frp:make-struct-field-mutator make-struct-field-mutator) - (rename frp:define-struct define-struct) - (rename frp:provide provide) - (rename frp:require require))) + (rename-out [public-dvn deep-value-now]) + (rename-out [frp:if if]) + (rename-out [frp:lambda lambda]) + (rename-out [frp:case-lambda case-lambda]) + (rename-out [frp:letrec letrec]) + (rename-out [frp:cons cons]) + (rename-out [frp:car car]) + (rename-out [frp:cdr cdr]) + (rename-out [frp:list list]) + (rename-out [frp:list? list?]) + (rename-out [frp:list* list*]) + (rename-out [frp:null? null?]) + (rename-out [frp:pair? pair?]) + (rename-out [frp:append append]) + (rename-out [frp:vector vector]) + (rename-out [frp:vector-ref vector-ref]) + (rename-out [frp:make-struct-type make-struct-type]) + (rename-out [frp:make-struct-field-accessor make-struct-field-accessor]) + (rename-out [frp:make-struct-field-mutator make-struct-field-mutator]) + (rename-out [frp:define-struct define-struct]) + (rename-out [frp:provide provide]) + (rename-out [frp:require require]))) diff --git a/collects/frtime/lang-utils.rkt b/collects/frtime/lang-utils.rkt index 8702289a90..ccd72e4122 100644 --- a/collects/frtime/lang-utils.rkt +++ b/collects/frtime/lang-utils.rkt @@ -1,7 +1,6 @@ (module lang-utils "lang-core.rkt" - - (require (only mzscheme let define-syntax define apply procedure-arity syntax-object->datum with-input-from-file require-for-syntax make-namespace expand-path collection-path begin syntax-rules) - (all-except racket + (require (only-in racket let define-syntax define apply procedure-arity syntax->datum with-input-from-file for-syntax make-empty-namespace cleanse-path collection-path begin syntax-rules) + (except-in racket else module begin @@ -28,8 +27,7 @@ collection-path collection-file-path list-ref - require - collection-path + require raise-arity-error procedure-rename impersonate-procedure @@ -57,13 +55,14 @@ or cond when unless map ormap andmap assoc member open-input-file open-output-file open-input-output-file call-with-output-file call-with-input-file with-output-to-file with-input-from-file) - (rename mzscheme mzscheme:if if) - (rename "lang-ext.rkt" lift lift) - (only frtime/core/frp super-lift behavior? value-now) - (rename "lang-ext.rkt" undefined undefined) - (rename "lang-ext.rkt" undefined? undefined?) - racket/class) - (require (only racket/list empty)) + (rename-in (only-in mzscheme if) [if mzscheme:if]) + (rename-in (only-in "lang-ext.rkt" lift) [lift lift]) + (only-in frtime/core/frp super-lift behavior? value-now) + (rename-in "lang-ext.rkt" [undefined undefined]) + (rename-in "lang-ext.rkt" [undefined? undefined?]) + racket/class + (for-syntax racket/base)) + (require (only-in racket/list empty)) (define-syntax (lifted-send stx) (syntax-case stx () @@ -277,7 +276,7 @@ (lift #t list->string (raise-reactivity lst))) (define (reverse lst) - (let loop ([lst lst] [acc ()]) + (let loop ([lst lst] [acc '()]) (if (pair? lst) (loop (cdr lst) (cons (car lst) acc)) acc))) @@ -313,10 +312,11 @@ dont-optimize list-ref - (rename frp:case case) - (rename frp:apply apply) - (rename frp:length length) - (rename frp:list->string list->string) + (rename-out [frp:case case]) + (rename-out [frp:apply apply]) + (rename-out [frp:length length]) + (rename-out [frp:list->string list->string]) + (rename-out [eq? mzscheme:eq?]) reverse (lifted + - * / = @@ -342,13 +342,13 @@ make-polar denominator truncate bitwise-not bitwise-xor bitwise-and bitwise-ior inexact? char-whitespace? assq assv memq memv list-tail seconds->date - expand syntax-object->datum exn-message continuation-mark-set->list exn-continuation-marks + expand syntax->datum exn-message continuation-mark-set->list exn-continuation-marks exn:fail? regexp-match vector->list list->vector make-vector) - (rename eq? mzscheme:eq?) + make-exn:fail current-inspector make-inspector - make-namespace namespace? namespace-symbol->identifier namespace-variable-value + make-empty-namespace namespace? namespace-symbol->identifier namespace-variable-value namespace-set-variable-value! namespace-undefine-variable! namespace-mapped-symbols parameterize current-seconds current-milliseconds current-inexact-milliseconds call-with-values make-parameter @@ -357,7 +357,7 @@ error set! printf fprintf current-error-port for-each void procedure-arity-includes? raise-type-error raise thread current-continuation-marks - raise-mismatch-error require-for-syntax define-syntax define-syntaxes syntax-rules syntax-case + raise-mismatch-error for-syntax define-syntax define-syntaxes syntax-rules syntax-case (lifted:nonstrict format) print-struct define @@ -385,7 +385,7 @@ path->complete-path string->path path->string bytes->path path->bytes - split-path simplify-path normal-case-path expand-path resolve-path + split-path simplify-path normal-case-path cleanse-path resolve-path path-replace-suffix current-directory exit @@ -402,6 +402,6 @@ read) ; from core - (provide (all-from "lang-core.rkt")) + (provide (all-from-out "lang-core.rkt")) ) diff --git a/collects/frtime/lang.rkt b/collects/frtime/lang.rkt index 0a8cda79e9..90c3f5e432 100644 --- a/collects/frtime/lang.rkt +++ b/collects/frtime/lang.rkt @@ -1,7 +1,6 @@ (module lang frtime/lang-utils (require frtime/lang-ext) - (require (as-is:unchecked frtime/core/frp - event-set? signal-value)) + (require (as-is:unchecked (except-in frtime/core/frp undefined undefined?) event-set? signal-value)) (define (value-nowable? x) (or (not (signal? x)) @@ -13,5 +12,5 @@ (pred v)))) (provide value-nowable? behaviorof - (all-from frtime/lang-utils) - (all-from-except frtime/lang-ext lift))) + (all-from-out frtime/lang-utils) + (except-out (all-from-out frtime/lang-ext) lift))) diff --git a/collects/frtime/main.rkt b/collects/frtime/main.rkt index 4bbc7c022d..185e582503 100644 --- a/collects/frtime/main.rkt +++ b/collects/frtime/main.rkt @@ -1,2 +1,2 @@ (module main "frtime-big.rkt" - (provide (all-from "frtime-big.rkt"))) + (provide (all-from-out "frtime-big.rkt"))) diff --git a/collects/frtime/opt/frtime-opt-lang.rkt b/collects/frtime/opt/frtime-opt-lang.rkt index 2ea9af9b66..803b498f82 100644 --- a/collects/frtime/opt/frtime-opt-lang.rkt +++ b/collects/frtime/opt/frtime-opt-lang.rkt @@ -1,9 +1,11 @@ ;; This module defines all the functions necessary to write FrTime programs, ;; as well as their lowered equivalents. It doesn't know how to perform ;; optimization, though -- that is left to the frtime-opt module. -(module frtime-opt-lang mzscheme - (require (prefix frtime: frtime/frtime)) - (require-for-syntax frtime/opt/lowered-equivs) +(module frtime-opt-lang racket + (require (prefix-in frtime: frtime/frtime)) + (require (for-syntax racket/base frtime/opt/lowered-equivs)) + (require (only-in frtime/frtime-big event-receiver send-event + nothing null collect-garbage)) ;; Export a function that is just a lifted version of a standard ;; function (with the same name). @@ -12,9 +14,9 @@ (syntax-case stx () [(_ MOD FUNC) (let ([lowered-equiv-id (make-lowered-equiv-id #'FUNC)]) - #`(begin (require (rename frtime/frtime-big lifted-func FUNC)) - (provide (rename lifted-func FUNC)) - (require (rename MOD #,lowered-equiv-id FUNC)) + #`(begin (require (rename-in frtime/frtime-big [FUNC lifted-func])) + (provide (rename-out [lifted-func FUNC])) + (require (rename-in MOD [FUNC #,lowered-equiv-id])) (provide #,lowered-equiv-id)))] [(_ MOD FUNC FUNCS ...) #`(begin (provide/lifted MOD FUNC) @@ -24,7 +26,7 @@ (syntax-case stx () [(_ FUNC) (let ([lowered-equiv-id (make-lowered-equiv-id #'FUNC)]) - #`(begin (require (only frtime/frtime-big FUNC)) + #`(begin (require (only-in frtime/frtime-big FUNC)) ;; note: the definition is necessary here because otherwise the lowered ;; equiv doesn't become part of the module's namespace, and there's ;; no way to find the list of identifiers exported by a module other @@ -40,13 +42,13 @@ (define-syntax provide/no-equiv (syntax-rules () [(_ FUNC) - (begin (require (rename frtime/frtime-big func FUNC)) - (provide (rename func FUNC)))] + (begin (require (rename-in frtime/frtime-big [FUNC func])) + (provide (rename-out [func FUNC])))] [(_ FUNC FUNCS ...) (begin (provide/no-equiv FUNC) (provide/no-equiv FUNCS ...))])) - (provide/lifted mzscheme + (provide/lifted racket ;; equality eq? equal? eqv? @@ -106,13 +108,13 @@ with-handlers ;; syntax - expand #;expand-syntax syntax syntax-object->datum syntax-case syntax-rules + expand #;expand-syntax syntax syntax->datum syntax-case syntax-rules ;; paths path? path-string? string->path path->string bytes->path path->bytes build-path absolute-path? relative-path? complete-path? path->complete-path resolve-path path-replace-suffix - expand-path simplify-path normal-case-path split-path + cleanse-path simplify-path normal-case-path split-path ;; I/O printf fprintf file-exists? #;link-exists? #;make-file-or-directory-link @@ -169,7 +171,7 @@ lambda quote unquote unquote-splicing make-parameter parameterize procedure-arity-includes? dynamic-require) - (provide #%app #%top #%datum require require-for-syntax provide define) + (provide #%app #%top #%datum require for-syntax provide define) (provide display) ;; for debugging #;(require frtime/frlibs/list @@ -186,7 +188,7 @@ ;; accessor functions (define-syntax (my-define-struct stx) (define (make-lowered-accessor struct-id field-id) - (let* ([upper-id (datum->syntax-object + (let* ([upper-id (datum->syntax field-id (string->symbol (format "~s-~s" @@ -210,5 +212,5 @@ #`(begin (frtime:define-struct STRUCT (FIELD ...) . REST) #,(lowered-equiv-defns #'STRUCT (syntax->list #'(FIELD ...))))])) - (provide (rename my-define-struct define-struct)) + (provide (rename-out [my-define-struct define-struct])) ) diff --git a/collects/frtime/opt/frtime-opt.rkt b/collects/frtime/opt/frtime-opt.rkt index a3d66aaadc..3967740214 100644 --- a/collects/frtime/opt/frtime-opt.rkt +++ b/collects/frtime/opt/frtime-opt.rkt @@ -4,17 +4,17 @@ ;; perform optimization of FrTime functions. The rest of the language ;; (i.e. all the functions needed to actually write FrTime programs) is ;; provided by the frtime-opt-lang module, which is automatically imported. -(module frtime-opt mzscheme - (provide (rename my-module-begin #%module-begin) +(module frtime-opt racket + (provide (rename-out [my-module-begin #%module-begin]) #%app #%top #%datum optimize-expr optimize-module dont-optimize) - (require-for-syntax frtime/opt/lowered-equivs) - (require-for-syntax (only srfi/1 lset-union lset-difference every)) - (require-for-syntax mzlib/list) - (require (only frtime/core/frp super-lift undefined undefined?)) - (require (rename frtime/lang-ext frtime:lift lift) - (rename frtime/lang-core frtime:if if) - (only frtime/lang-core frp:copy-list)) + (require (for-syntax frtime/opt/lowered-equivs) + (for-syntax (only-in srfi/1 lset-union lset-difference every)) + (for-syntax racket/list)) + (require (only-in frtime/core/frp super-lift undefined undefined?)) + (require (rename-in (except-in frtime/lang-ext undefined undefined? deep-value-now) [lift frtime:lift]) + (rename-in frtime/lang-core [if frtime:if]) + (only-in frtime/lang-core frp:copy-list)) ; (require mzlib/unit mzlib/unitsig) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,18 +30,18 @@ (define-for-syntax (safe-module-identifier=? id1 id2) (and (identifier? id1) (identifier? id2) - (module-identifier=? id1 id2))) + (free-identifier=? id1 id2))) ;; Convert a syntax-object to a datum and back again. This replaces all ;; the context information. It's necessary to get generated require ;; statements to work, for some reason. ;; See http://list.cs.brown.edu/pipermail/plt-scheme/2006-July/014163.html (define-for-syntax (so->d->so ref-stx stx) - (datum->syntax-object ref-stx (syntax-object->datum stx))) + (datum->syntax ref-stx (syntax->datum stx))) ;; Convert a syntactic module reference to a module-path-index (define-for-syntax (module-stx-to-path-index mod-stx) - (let ([mod (syntax-object->datum mod-stx)]) + (let ([mod (syntax->datum mod-stx)]) (if (symbol? mod) mod (module-path-index-join mod #f)))) @@ -49,7 +49,7 @@ ;; Convert a syntactic module reference to a module-path (this is ;; subtly different from a module-path-index) (define-for-syntax (module-stx-to-path mod-stx) - (syntax-object->datum mod-stx)) + (syntax->datum mod-stx)) ;; Does the given module export the given id? (define-for-syntax (module-exports-id? mod-stx id-stx) @@ -73,7 +73,7 @@ (lambda (id) (not (module-provide-protected? mod-path-index id))) all-symbols)] [exported-ids (map - (lambda (symbol) (datum->syntax-object ref-stx symbol)) + (lambda (symbol) (datum->syntax ref-stx symbol)) exported-symbols)]) exported-ids)))) @@ -81,7 +81,7 @@ ;; The variables are projected before evaluating the expression, ;; and the result is then injected into the dataflow graph as a ;; single node. - (require (only frtime/core/frp proc->signal value-now)) + (require (only-in frtime/core/frp proc->signal value-now)) (define-syntax (dip stx) (syntax-case stx (begin) ;; special case: don't dip lone identifiers @@ -259,7 +259,7 @@ (or (free-identifier=? #'LIFTED #'lifted) (free-identifier=? #'LIFTED #'lifted:nonstrict))) (let* ([lowered-equiv-id (make-lowered-equiv-id #'ID)] - [strict? (datum->syntax-object #'MOD (free-identifier=? #'LIFTED #'lifted))]) + [strict? (datum->syntax #'MOD (free-identifier=? #'LIFTED #'lifted))]) #`(begin (require #,(so->d->so #'MOD #`(rename MOD #,lowered-equiv-id ID))) (define (ID . args) (apply frtime:lift #,strict? #,lowered-equiv-id args)) @@ -325,7 +325,7 @@ (define-for-syntax (union-id-lists . id-lists) (foldl (lambda (l1 l2) (lset-union bound-identifier=? l1 l2)) - () + '() id-lists)) (define-for-syntax (diff-id-lists id-list1 id-list2) (lset-difference bound-identifier=? id-list1 id-list2)) @@ -343,7 +343,7 @@ (append (extract-args #'ID) (extract-args #'REST))] [() - ()] + '()] [ELSE (raise-syntax-error #f "doesn't look like an arg list" stx)])) @@ -368,15 +368,15 @@ (syntax-case stx () [ID (and (identifier? #'ID) - (module-identifier=? old-id #'ID)) + (free-identifier=? old-id #'ID)) new-id] [(X . Y) - (datum->syntax-object + (datum->syntax stx (cons (replace-id #'X old-id new-id) (replace-id #'Y old-id new-id)))] [() - ()] + '()] [ELSE stx])) @@ -385,7 +385,7 @@ (syntax-case stx () [ID (and (identifier? #'ID) - (module-identifier=? id #'ID)) + (free-identifier=? id #'ID)) #t] [(X . Y) (or (refers-to-id? #'X id) @@ -414,8 +414,8 @@ [(BEGIN EXPR ...) (and (identifier? #'BEGIN) - (or (module-identifier=? #'BEGIN #'begin) - (module-identifier=? #'BEGIN #'begin0))) + (or (free-identifier=? #'BEGIN #'begin) + (free-identifier=? #'BEGIN #'begin0))) (let* ([optimized-exprs (map (lambda (expr) (recursively-optimize-expr expr equiv-map #f)) (syntax->list #'(EXPR ...)))] @@ -483,7 +483,7 @@ LOOP_) ARG ...) (and (identifier? #'LOOP) (identifier? #'LOOP_) - (module-identifier=? #'LOOP #'LOOP_)) + (free-identifier=? #'LOOP #'LOOP_)) (let* ([optimized-args (map (lambda (e) (recursively-optimize-expr e equiv-map #f)) (syntax->list #'(ARG ...)))] @@ -524,8 +524,8 @@ [(LET-VALUES ((VARS VALS) ...) EXPR ...) (and (identifier? #'LET-VALUES) - (or (module-identifier=? #'LET-VALUES #'let-values) - (module-identifier=? #'LET-VALUES #'letrec-values))) + (or (free-identifier=? #'LET-VALUES #'let-values) + (free-identifier=? #'LET-VALUES #'letrec-values))) (let* ([bindings (syntax->list #'(VARS ...))] [flattened-bindings (apply append (map syntax->list bindings))] [body #`(begin EXPR ...)] @@ -643,7 +643,7 @@ [ELSE (raise-syntax-error #f - (format "recursively-lower-expr: unrecognized syntax: ~a" (syntax-object->datum stx)) + (format "recursively-lower-expr: unrecognized syntax: ~a" (syntax->datum stx)) stx)])) ;; Optimize a single expression. Raises exn:fail:syntax if the optimized version diff --git a/collects/frtime/opt/lowered-equivs.rkt b/collects/frtime/opt/lowered-equivs.rkt index 23da556d6d..1702f2a97f 100644 --- a/collects/frtime/opt/lowered-equivs.rkt +++ b/collects/frtime/opt/lowered-equivs.rkt @@ -1,7 +1,7 @@ ;; This module defines all the logic necessary for working with lowered ;; equivalents at the syntactic level. That is, it treats functions simply ;; as syntactic identifiers. -#lang scheme +#lang racket (provide (except-out (all-defined-out) module-identifier=?)) (require (only-in srfi/1 any))