Big Commit that introduces the freeze in demos relying on animation

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
+           (for-syntax racket/base (only-in racket/function identity))
-                   posn-x posn-y make-posn make-rgb)
+           (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)
+  (require (for-syntax (only-in racket/base build-list)
-                      (only racket/function identity))
+                      (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)))

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"

collects/frtime/frlibs/list.rkt

@@ -1,11 +1,16 @@
 (module list frtime/frtime-lang-only
   
   (require 
-   (lifted racket/base sort)
+   (lifted (only-in racket/base sort) sort)
-   (lifted racket/list
+   
-                   fifth sixth seventh eighth
+   (lifted (only-in racket/list fifth) 
-                   last-pair)
+           fifth)
-           (rename racket/list empty empty))
+   (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))

collects/frtime/frp-snip.rkt

@@ -1,11 +1,8 @@
-#lang scheme/base
+#lang racket/base
-(require scheme/class
+(require racket/class
-         (only-in mzlib/string expr->string)
+         racket/list
-         scheme/list
+         racket/port
-         scheme/port
-         
          framework
-         
          ;; FRP requires
          
          frtime/core/frp
@@ -50,7 +47,7 @@
            [(event-set? tmp) (format "#<event (last: ~a@~a)>"
                                      (event-set-events tmp) (event-set-time tmp))]
            [(undefined? tmp) "<undefined>"]
-           [else (expr->string tmp)])))]
+           [else (number->string tmp)])))]
     [(bhvr super-render-fun)
      (get-rendering (value-now bhvr) super-render-fun)]))
 

collects/frtime/frtime-big.rkt

@@ -5,8 +5,8 @@
            frtime/frlibs/math
            frtime/frlibs/date)
   
-  (provide (all-from frtime/frtime)
+  (provide (all-from-out frtime/frtime)
-           (all-from frtime/frlibs/list)
+           (all-from-out frtime/frlibs/list)
-           (all-from frtime/frlibs/etc)
+           (all-from-out frtime/frlibs/etc)
-           (all-from frtime/frlibs/math)
+           (all-from-out frtime/frlibs/math)
-           (all-from frtime/frlibs/date)))
+           (all-from-out frtime/frlibs/date)))

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 (only-in frtime/lang-ext undefined? signal? value-now lift))
-  (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)
@@ -13,5 +13,5 @@
           (pred v))))
 
   (provide value-nowable? behaviorof
-	   (all-from "lang-utils.rkt")
+	   (all-from-out "lang-utils.rkt")
-       (all-from-except frtime/lang-ext lift)))
+       (all-from-out frtime/lang-ext)))

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-out "lang-ext.rkt")
-	   (all-from "lang-utils.rkt")
+           (all-from-out "lang-utils.rkt")
-           (all-from "frp-snip.rkt")))
+           (all-from-out "frp-snip.rkt")))

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)))

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)))

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) 

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
 
 

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)
+  (provide (all-defined-out)
-           (all-from racket/class)
+           (all-from-out racket/class)
-           (all-from "mixin-macros.rkt")
+           (all-from-out "mixin-macros.rkt")
-           (all-from "aux-mixin-macros.rkt")))
+           (all-from-out "aux-mixin-macros.rkt")))

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)

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)
+  (provide (all-defined-out)
-           (all-from "fred.rkt")
+           (all-from-out "fred.rkt")
-           (all-from racket/class)))
+           (all-from-out racket/class)))

collects/frtime/lang-core.rkt

@@ -1,14 +1,14 @@
-(module lang-core mzscheme
+(module lang-core racket
-  (require-for-syntax (only syntax/struct build-struct-names build-struct-generation build-struct-expand-info)
+  (require (for-syntax (only-in syntax/struct build-struct-names build-struct-generation build-struct-expand-info)
-                      (only racket/base foldl)
+                      (only-in racket/base foldl)
-                      (only racket/list empty))
+                      (only-in racket/list empty)))
-  (require (only racket/list cons? first second rest empty empty?)
+  (require (only-in racket/list cons? first second rest empty empty?)
-           (only racket/base vector-ref build-vector build-list)
+           (only-in racket/base vector-ref build-vector build-list)
-           (only racket/function identity)
+           (only-in racket/function identity)
-           (only mzlib/etc opt-lambda)
+           (only-in 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
+           (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 <pred?> <vector>) -> 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)
+       (case (hash-ref deps obj 'absent)
-         [(absent) (hash-table-put! deps obj 'new)]
+         [(absent) (hash-set! deps obj 'new)]
-         [(old)    (hash-table-put! deps obj 'alive)]
+         [(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)
+       (case (hash-ref deps obj 'absent)
-         [(absent) (hash-table-put! deps obj 'new)]
+         [(absent) (hash-set! deps obj 'new)]
-         [(old)    (hash-table-put! deps obj 'alive)]
+         [(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)]
+                      [(alive) (hash-set! deps k 'old)]
-                      [(old)   (hash-table-remove! deps k)
+                      [(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)]
+                  [(alive) (hash-set! deps k 'old)]
-                  [(old)   (hash-table-remove! deps k)
+                  [(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)
+                               (case (hash-ref deps obj 'absent)
-                                 [(absent) (hash-table-put! deps obj 'new)
+                                 [(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)]
+                      [(new alive) (hash-set! deps k 'old)]
-                      [(old)   (hash-table-remove! deps k)
+                      [(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-out [public-dvn deep-value-now])
-           (rename frp:if if)
+           (rename-out [frp:if if])
-           (rename frp:lambda lambda)
+           (rename-out [frp:lambda lambda])
-           (rename frp:case-lambda case-lambda)
+           (rename-out [frp:case-lambda case-lambda])
-           (rename frp:letrec letrec)
+           (rename-out [frp:letrec letrec])
-           (rename frp:cons cons)
+           (rename-out [frp:cons cons])
-           (rename frp:car car)
+           (rename-out [frp:car car])
-           (rename frp:cdr cdr)
+           (rename-out [frp:cdr cdr])
-           (rename frp:list list)
+           (rename-out [frp:list list])
-           (rename frp:list? list?)
+           (rename-out [frp:list? list?])
-           (rename frp:list* list*)
+           (rename-out [frp:list* list*])
-           (rename frp:null? null?)
+           (rename-out [frp:null? null?])
-           (rename frp:pair? pair?)
+           (rename-out [frp:pair? pair?])
-           (rename frp:append append)
+           (rename-out [frp:append append])
-           (rename frp:vector vector)
+           (rename-out [frp:vector vector])
-           (rename frp:vector-ref vector-ref)
+           (rename-out [frp:vector-ref vector-ref])
-           (rename frp:make-struct-type make-struct-type)
+           (rename-out [frp:make-struct-type make-struct-type])
-           (rename frp:make-struct-field-accessor make-struct-field-accessor)
+           (rename-out [frp:make-struct-field-accessor make-struct-field-accessor])
-           (rename frp:make-struct-field-mutator make-struct-field-mutator)
+           (rename-out [frp:make-struct-field-mutator make-struct-field-mutator])
-           (rename frp:define-struct define-struct)
+           (rename-out [frp:define-struct define-struct])
-           (rename frp:provide provide)
+           (rename-out [frp:provide provide])
-           (rename frp:require require)))
+           (rename-out [frp:require require])))

collects/frtime/lang-utils.rkt

@@ -1,7 +1,6 @@
 (module lang-utils "lang-core.rkt"
-  
+  (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)
-  (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)
+           (except-in racket
-           (all-except racket
                        else
                        module
                        begin
@@ -29,7 +28,6 @@
                        collection-file-path
                        list-ref
                        require 
-                       collection-path
                        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-in (only-in mzscheme if) [if mzscheme:if])
-           (rename "lang-ext.rkt" lift lift)
+           (rename-in (only-in "lang-ext.rkt" lift) [lift lift])
-           (only frtime/core/frp super-lift behavior? value-now)
+           (only-in frtime/core/frp super-lift behavior? value-now)
-           (rename "lang-ext.rkt"  undefined undefined)
+           (rename-in "lang-ext.rkt"  [undefined undefined])
-           (rename "lang-ext.rkt" undefined? undefined?)
+           (rename-in "lang-ext.rkt" [undefined? undefined?])
-           racket/class)
+           racket/class
-  (require (only racket/list empty))
+           (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-out [frp:case case])
-           (rename frp:apply apply)
+           (rename-out [frp:apply apply])
-           (rename frp:length length)
+           (rename-out [frp:length length])
-           (rename frp:list->string list->string)
+           (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"))
   
   )

collects/frtime/lang.rkt

@@ -1,7 +1,6 @@
 (module lang frtime/lang-utils
   (require frtime/lang-ext)
-  (require (as-is:unchecked frtime/core/frp
+  (require (as-is:unchecked (except-in frtime/core/frp undefined undefined?) event-set? signal-value))
-	    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-out frtime/lang-utils)
-           (all-from-except frtime/lang-ext lift)))
+           (except-out (all-from-out frtime/lang-ext) lift)))

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")))

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
+(module frtime-opt-lang racket
-  (require (prefix frtime: frtime/frtime))
+  (require (prefix-in frtime: frtime/frtime))
-  (require-for-syntax frtime/opt/lowered-equivs)
+  (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))
+         #`(begin (require (rename-in frtime/frtime-big [FUNC lifted-func]))
-                  (provide (rename lifted-func FUNC))
+                  (provide (rename-out [lifted-func FUNC]))
-                  (require (rename MOD #,lowered-equiv-id 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))
+       (begin (require (rename-in frtime/frtime-big [FUNC func]))
-              (provide (rename 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]))
   )

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
+(module frtime-opt racket
-  (provide (rename my-module-begin #%module-begin)
+  (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 frtime/opt/lowered-equivs)
-  (require-for-syntax (only srfi/1 lset-union lset-difference every))
+           (for-syntax (only-in srfi/1 lset-union lset-difference every))
-  (require-for-syntax mzlib/list)
+           (for-syntax racket/list))
-  (require (only frtime/core/frp super-lift undefined undefined?))
+  (require (only-in frtime/core/frp super-lift undefined undefined?))
-  (require (rename frtime/lang-ext frtime:lift lift)
+  (require (rename-in (except-in frtime/lang-ext undefined undefined? deep-value-now) [lift frtime:lift])
-           (rename frtime/lang-core frtime:if if)
+           (rename-in frtime/lang-core [if frtime:if])
-           (only frtime/lang-core frp:copy-list))
+           (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)
+            (or (free-identifier=? #'BEGIN #'begin)
-                (module-identifier=? #'BEGIN #'begin0)))
+                (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)
+            (or (free-identifier=? #'LET-VALUES #'let-values)
-                (module-identifier=? #'LET-VALUES #'letrec-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

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))