Change from (module ...) -> #lang and also move any mzscheme -> scheme/base.

svn: r16563

collects/scheme/class.ss

@@ -1,11 +1,11 @@
-(module class mzscheme
+#lang scheme/base
 
-  (require "contract/private/object.ss")
-  (provide (all-from "contract/private/object.ss"))
+(require "contract/private/object.ss")
+(provide (all-from-out "contract/private/object.ss"))
   
-  ;; All of the implementation is actually in private/class-internal.ss,
-  ;;  which provides extra (private) functionality to contract.ss.
-  (require "private/class-internal.ss")
+;; All of the implementation is actually in private/class-internal.ss,
+;;  which provides extra (private) functionality to contract.ss.
+(require "private/class-internal.ss")
   
-  (provide-public-names)
-  (provide generic?))
+(provide-public-names)
+(provide generic?)

collects/scheme/private/class-events.ss

@@ -1,10 +1,10 @@
+#lang scheme/base
 
-(module class-events mzscheme
+(require (for-syntax scheme/base
+                     scheme/stxparam))
+(require scheme/stxparam)
 
-  (require-for-syntax mzlib/stxparam)
-  (require mzlib/stxparam)
-
-  (provide current-class-event-handler
+(provide current-class-event-handler
          define-traced
          trace-begin
          trace
@@ -16,16 +16,16 @@
          get-event
          )
 
-  (define current-class-event-handler
+(define current-class-event-handler
   (make-parameter void))
 
-  ;; ----------------------------------------------------------------------
-  ;; Definitions for traced vs untraced functions
-  ;; ----------------------------------------------------------------------
+;; ----------------------------------------------------------------------
+;; Definitions for traced vs untraced functions
+;; ----------------------------------------------------------------------
 
-  (define-syntax-parameter trace? #f)
+(define-syntax-parameter trace? #f)
 
-  (define-syntax trace
+(define-syntax trace
   (make-set!-transformer
    (lambda (stx)
      (raise-syntax-error
@@ -33,7 +33,7 @@
       "trace used outside a trace-begin"
       stx))))
 
-  (define-syntax (trace-begin stx)
+(define-syntax (trace-begin stx)
   (syntax-case stx (trace)
     [(form (trace expr) ...)
      (raise-syntax-error
@@ -51,13 +51,13 @@
     [(form expr rest ...)
      (syntax/loc stx (begin expr (form rest ...)))]))
 
-  (define-syntax (define-traced stx)
+(define-syntax (define-traced stx)
   (syntax-case stx ()
     [(form (name . args) . body)
      (syntax/loc stx (form name (lambda args . body)))]
     [(form name body ...)
      (with-syntax ([name-traced
-                      (datum->syntax-object
+                    (datum->syntax
                      (syntax name)
                      (string->symbol
                       (string-append
@@ -73,39 +73,38 @@
              (syntax-parameterize ([trace? #t])
                                   body ...)))))]))
 
-  (define current-class-event-stack
+(define current-class-event-stack
   (make-parameter null))
 
-  (define (initialize-event event . args)
+(define (initialize-event event . args)
   (current-class-event-stack
    (cons
     (apply (current-class-event-handler) event args)
     (current-class-event-stack))))
 
-  (define (finalize-event event . args)
+(define (finalize-event event . args)
   (let* ([stack (current-class-event-stack)]
          [head (car stack)]
          [tail (cdr stack)])
     (when (procedure? head) (apply head args))
     (current-class-event-stack tail)))
 
-  (define (new-event class obj fields)
+(define (new-event class obj fields)
   ((current-class-event-handler) 'new class obj fields))
 
-  (define (initialize-call-event obj method args)
+(define (initialize-call-event obj method args)
   (initialize-event 'call obj method args))
 
-  (define (finalize-call-event . returned)
+(define (finalize-call-event . returned)
   (apply finalize-event 'call returned)
   (apply values returned))
 
-  (define (inspect-event obj)
+(define (inspect-event obj)
   ((current-class-event-handler) 'inspect obj))
 
-  (define (set-event obj field value)
+(define (set-event obj field value)
   ((current-class-event-handler) 'set obj field value))
 
-  (define (get-event obj field)
+(define (get-event obj field)
   ((current-class-event-handler) 'get obj field))
 
-  )

collects/scheme/private/classidmap.ss

@@ -1,16 +1,16 @@
+#lang scheme/base
 
-(module classidmap scheme/base
-  (require syntax/stx
+(require syntax/stx
          (for-syntax scheme/base)
          (for-template scheme/base "class-events.ss"))
 
-  (define-values (struct:s!t make-s!t s!t? s!t-ref s!t-set!)
+(define-values (struct:s!t make-s!t s!t? s!t-ref s!t-set!)
   (make-struct-type 'set!-transformer #f 2 0 #f null (current-inspector) 0))
 
-  (define (mk-set!-trans old-id proc)
+(define (mk-set!-trans old-id proc)
   (make-set!-transformer (make-s!t proc old-id)))
 
-  (define (make-method-apply id this orig-args)
+(define (make-method-apply id this orig-args)
   (let loop ([args orig-args][accum null])
     (cond
       [(stx-null? args)
@@ -20,16 +20,16 @@
       [else
        (list* 'apply id this (reverse (cons args accum)))])))
 
-  (define (find the-finder name src)
+(define (find the-finder name src)
   (let ([this-id (syntax-local-value (syntax-local-get-shadower the-finder))])
     (datum->syntax this-id name src)))
 
-  ;; Check Syntax binding info:
-  (define (binding from to stx)
+;; Check Syntax binding info:
+(define (binding from to stx)
   stx)
 
 
-  (define (make-this-map orig-id the-finder the-obj)
+(define (make-this-map orig-id the-finder the-obj)
   (let ([set!-stx (datum->syntax the-finder 'set!)])
     (mk-set!-trans
      orig-id
@@ -45,7 +45,7 @@
            stx)]
          [id (find the-finder the-obj stx)])))))
 
-  (define (make-field-map trace-flag the-finder the-obj the-binder the-binder-localized
+(define (make-field-map trace-flag the-finder the-obj the-binder the-binder-localized
                         field-accessor field-mutator field-pos/null)
   (let ([set!-stx (datum->syntax the-finder 'set!)])
     (mk-set!-trans
@@ -82,7 +82,7 @@
                   (syntax/loc stx (let* bindings trace get))
                   (syntax/loc stx (let* bindings get))))]))))))
 
-  (define (make-method-map the-finder the-obj the-binder the-binder-localized method-accessor)
+(define (make-method-map the-finder the-obj the-binder the-binder-localized method-accessor)
   (let ([set!-stx (datum->syntax the-finder 'set!)])
     (mk-set!-trans
      the-binder-localized
@@ -107,9 +107,9 @@
            "misuse of method (not in application)" 
            stx)])))))
 
-  ;; For methods that are dirrectly available via their names
-  ;;  (e.g., private methods)
-  (define (make-direct-method-map the-finder the-obj the-binder the-binder-localized new-name)
+;; For methods that are dirrectly available via their names
+;;  (e.g., private methods)
+(define (make-direct-method-map the-finder the-obj the-binder the-binder-localized new-name)
   (let ([set!-stx (datum->syntax the-finder 'set!)])
     (mk-set!-trans
      the-binder-localized
@@ -131,7 +131,7 @@
            "misuse of method (not in application)" 
            stx)])))))
 
-  (define (make-rename-super-map the-finder the-obj the-binder the-binder-localized rename-temp)
+(define (make-rename-super-map the-finder the-obj the-binder the-binder-localized rename-temp)
   (let ([set!-stx (datum->syntax the-finder 'set!)])
     (mk-set!-trans
      the-binder-localized
@@ -153,7 +153,7 @@
            "misuse of super method (not in application)" 
            stx)])))))
 
-  (define (make-rename-inner-map the-finder the-obj the-binder the-binder-localized rename-temp)
+(define (make-rename-inner-map the-finder the-obj the-binder the-binder-localized rename-temp)
   (let ([set!-stx (datum->syntax the-finder 'set!)]
         [lambda-stx (datum->syntax the-finder 'lambda)])
     (mk-set!-trans
@@ -196,7 +196,7 @@
            "misuse of inner method (not in application)" 
            stx)])))))
 
-  (define (generate-super-call stx the-finder the-obj rename-temp args)
+(define (generate-super-call stx the-finder the-obj rename-temp args)
   (datum->syntax 
    the-finder
    (make-method-apply (find the-finder rename-temp stx) 
@@ -204,7 +204,7 @@
                       args)
    stx))
 
-  (define (generate-inner-call stx the-finder the-obj default-expr rename-temp args)
+(define (generate-inner-call stx the-finder the-obj default-expr rename-temp args)
   (datum->syntax 
    the-finder
    (let ([target (find the-finder the-obj stx)])
@@ -217,7 +217,7 @@
       stx))
    stx))
 
-  (define (make-init-error-map localized-id)
+(define (make-init-error-map localized-id)
   (mk-set!-trans
    localized-id
    (lambda (stx)
@@ -226,7 +226,7 @@
       "cannot use non-field init variable in a method"
       stx))))
 
-  (define (make-init-redirect set!-stx #%app-stx local-id localized-id)
+(define (make-init-redirect set!-stx #%app-stx local-id localized-id)
   (mk-set!-trans
    localized-id
    (lambda (stx)
@@ -245,14 +245,14 @@
                stx
                stx)]))))
 
-  (define super-error-map
+(define super-error-map
   (lambda (stx)
     (raise-syntax-error 
      'class
      "cannot use superclass initialization form in a method"
      stx)))
 
-  (define (make-with-method-map trace-flag set!-stx id-stx
+(define (make-with-method-map trace-flag set!-stx id-stx
                               method-stx method-obj-stx unwrap-stx)
   (make-set!-transformer
    (lambda (stx)
@@ -282,7 +282,7 @@
          "misuse of method (not in application)" 
          stx)]))))
 
-  (define (flatten-args orig-args)
+(define (flatten-args orig-args)
   (let loop ([args orig-args][accum null])
     (cond
       [(stx-null? args) orig-args]
@@ -291,7 +291,7 @@
       [else
        (reverse (cons args accum))])))
 
-  (define-struct private-name (orig-id gen-id)
+(define-struct private-name (orig-id gen-id)
   #:property prop:procedure (lambda (self stx)
                               (if (not (eq? (syntax-local-context) 'expression))
                                   #`(#%expression #,stx)
@@ -300,7 +300,7 @@
                                    "unbound local member name"
                                    stx))))
 
-  (define (do-localize orig-id validate-local-member-stx)
+(define (do-localize orig-id validate-local-member-stx)
   (let loop ([id orig-id])
     (let ([v (syntax-local-value id (lambda () #f))])
       (cond
@@ -316,20 +316,20 @@
          (s!t-ref (set!-transformer-procedure v) 1)]
         [else orig-id]))))
 
-  (define-struct class-context ())
+(define-struct class-context ())
 
-  (define (generate-class-expand-context)
+(define (generate-class-expand-context)
   (let ([c (syntax-local-context)]
         [v (make-class-context)])
     (if (pair? c)
         (cons v c)
         (list v))))
 
-  (define (class-top-level-context? ctx)
+(define (class-top-level-context? ctx)
   (and (pair? ctx)
        (class-context? (car ctx))))
 
-  (define (make-method-call traced? source-stx object-stx unwrap-stx
+(define (make-method-call traced? source-stx object-stx unwrap-stx
                           method-proc-stx method-name-stx args-stx rest-arg?)
   
   (define-syntax (qstx stx)
@@ -356,7 +356,7 @@
                                     finalize-call-event))))
         (qstx (app method object . args)))))
 
-  (provide (protect-out make-this-map make-field-map make-method-map 
+(provide (protect-out make-this-map make-field-map make-method-map 
                       make-direct-method-map 
                       make-rename-super-map make-rename-inner-map
                       make-init-error-map make-init-redirect super-error-map 
@@ -364,4 +364,4 @@
                       flatten-args make-method-call
                       do-localize make-private-name
                       generate-super-call generate-inner-call
-                        generate-class-expand-context class-top-level-context?)))
+                      generate-class-expand-context class-top-level-context?))