Converting to scheme from mzscheme

svn: r15281

collects/frtime/date.ss

@@ -1,8 +1,7 @@
-
+#lang scheme
-(module date mzscheme
-
 (require "list.ss")
-  (require (rename "frtime.ss" frtime:provide provide))
+(require (rename-in (only-in "frtime.ss" provide)
+                    [provide frtime:provide]))
 
 (frtime:provide
 	(lifted date->string
@@ -16,35 +15,6 @@
 ;; Support for Julian calendar added by Shriram;
 ;; current version only works until 2099 CE Gregorian
 
-  #|
-
-  (define-primitive seconds->date (num -> structure:date))
-  (define-primitive current-seconds (-> num))
-  (define-primitive date-second (structure:date -> num))
-  (define-primitive date-minute (structure:date -> num))
-  (define-primitive date-hour (structure:date -> num))
-  (define-primitive date-day (structure:date -> num))
-  (define-primitive date-month (structure:date -> num))
-  (define-primitive date-year (structure:date -> num))
-  (define-primitive date-week-day (structure:date -> num))
-  (define-primitive date-year-day (structure:date -> num))
-  (define-primitive date-dst? (structure:date -> bool))
-  (define-primitive make-date (num num num num num num num num bool ->
-				   structure:date))
-  (define-primitive expr->string (a -> string))
-  (define-primitive foldl (case->
-			   ((a z -> z) z (listof a) -> z)
-			   ((a b z -> z) z (listof a) (listof b) -> z)
-			   ((a b c z -> z) z (listof a) (listof b) (listof c) -> z)
-			   (((arglistof x) ->* z) z (listof (arglistof x)) ->* z)))
-  (define-primitive foldr (case->
-			   ((a z -> z) z (listof a) -> z)
-			   ((a b z -> z) z (listof a) (listof b) -> z)
-			   ((a b c z -> z) z (listof a) (listof b) (listof c) -> z)
-			   (((arglistof x) ->* z) z (listof (arglistof x)) ->* z)))
-
-  |#
-
 (define legal-formats
   (list 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))
 
@@ -387,6 +357,3 @@
                                              (cadr reversed-digits)
                                              (car reversed-digits)))
                                 (loop (cdr (cdr (cdr reversed-digits))))))))))))
-
-  )
-

collects/frtime/frp-snip.ss

@@ -1,19 +1,21 @@
-(module frp-snip mzscheme
+#lang scheme/base
-  (require mzlib/class
+(require scheme/class
-           mzlib/string
+         (only-in mzlib/string expr->string)
-           mzlib/list
+         scheme/list
-           mzlib/port
+         scheme/port
          
          framework
          
          ;; FRP requires
          
          frtime/core/frp
-           (all-except frtime/lang-ext undefined?)
+         (except-in frtime/lang-ext
-           (only frtime/lang-core any-nested-reactivity? raise-reactivity)
+                    undefined?)
+         (only-in frtime/lang-core
+                  any-nested-reactivity? raise-reactivity)
          
          ;; MrEd require
-           (all-except mred send-event))
+         (except-in mred send-event))
 
 (define drs-eventspace #f)
 
@@ -163,5 +165,4 @@
      (make-object dynamic-snip% beh super-render-fun)]
     [else beh]))
 
-  (provide (all-defined))
+(provide (all-defined-out))
-  )

collects/frtime/frtime-tool.ss

@@ -1,10 +1,10 @@
-
+#lang scheme/base
-(module frtime-tool mzscheme
+(require scheme/unit
-  (require mzlib/unit
+         scheme/class
-	   mzlib/class
+         scheme/bool
          mred
-           mzlib/etc
+         (only-in mzlib/etc identity)
-           mzlib/list
+         scheme/list
          drscheme/tool
          string-constants)
 
@@ -91,4 +91,4 @@
     (define (phase1) (void))
     (define (phase2)
       (drscheme:language-configuration:add-language 
-	 (make-object ((drscheme:language:get-default-mixin) (make-frtime-language big-frtime-language%))))))))
+       (make-object ((drscheme:language:get-default-mixin) (make-frtime-language big-frtime-language%)))))))

collects/frtime/graphics-sig.ss

@@ -1,5 +1,5 @@
-(module graphics-sig mzscheme
+#lang scheme
-  (require mzlib/unit)
+(require scheme/unit)
 
 (provide graphics^ graphics:posn-less^ graphics:posn^)
 
@@ -66,7 +66,3 @@
 (define-signature graphics^
   ((open graphics:posn-less^)
    (open graphics:posn^)))
-)
-
-
-

collects/frtime/graphics-unit.ss

@@ -1,15 +1,14 @@
-(module graphics-unit mzscheme
+#lang scheme
-  (require mzlib/unit
+(require scheme/unit
          mred/mred-sig
          "graphics-sig.ss"
          "graphics-posn-less-unit.ss")
 (provide graphics@)
 
 (define-unit posn@ (import) (export graphics:posn^)
-    (define-struct posn (x y)))
+  (define-struct posn (x y) #:mutable))
 
 (define-compound-unit/infer graphics@
   (import mred^)
   (export graphics:posn^ graphics:posn-less^) 
-    (link posn@ graphics-posn-less@)))
+  (link posn@ graphics-posn-less@))
-

collects/frtime/graphics.ss

@@ -1,9 +1,9 @@
-(module graphics mzscheme
+#lang scheme
-  (require mzlib/unit
+(require scheme/unit
          mred/mred-sig
          mred
          "graphics-sig.ss"
          "graphics-unit.ss")
 (provide-signature-elements graphics:posn^ graphics:posn-less^)
 
-  (define-values/invoke-unit/infer graphics@))
+(define-values/invoke-unit/infer graphics@)

collects/frtime/lowered-equivs.ss

@@ -1,17 +1,19 @@
 ;; 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.
-(module lowered-equivs mzscheme
+#lang scheme
-  (provide (all-defined))
+(provide (except-out (all-defined-out)
-  (require mzlib/list)
+                     module-identifier=?))
-  (require (only srfi/1 any))
+(require (only-in srfi/1 any))
+
+(define module-identifier=? free-identifier=?)
 
 (define lowered-equiv-suffix ":lowered-equiv")
 
 ;; Given an identifier for a normal binding, return the identifier
 ;; to be used for the lowered equivalent of that binding.
 (define (make-lowered-equiv-id id-stx)
-    (datum->syntax-object
+  (datum->syntax
    id-stx
    (string->symbol
     (format "~a~a" (syntax-e id-stx) lowered-equiv-suffix))))
@@ -31,7 +33,7 @@
 ;; strip the lowered-equiv suffix from an identifier
 (define (lowered-equiv-id->lifted-id id-stx)
   (let ([name (symbol->string (syntax-e id-stx))])
-      (datum->syntax-object 
+    (datum->syntax 
      id-stx
      (string->symbol
       (substring name 0 (- (string-length name)
@@ -80,7 +82,7 @@
     (if ret
         ret
         (raise (make-exn:no-lowered-equiv 
-                  (format "no lowered equiv for ~s" (syntax-object->datum func)))))))
+                (format "no lowered equiv for ~s" (syntax->datum func)))))))
 
 ;; convert syntax of the form ((func lowered-equiv) ...) to an equiv map
 (define (stx-to-equiv-map stx)
@@ -91,7 +93,7 @@
 
 ;; convert an equiv map to syntax of the form ((func lowered-equiv) ...)
 (define (equiv-map-to-stx equiv-map)
-    (datum->syntax-object #'here
+  (datum->syntax #'here
                  (map (lambda (pair) (list (car pair) (cdr pair)))
                       equiv-map)))
 
@@ -111,5 +113,3 @@
                equiv-map))
          (empty-equiv-map) 
          symbol-list))
-  )
-