Moving unit system from mzscheme->scheme/base, reformatting and small changes

as necessary.  Ran the quiet testsuite, unit tests, and setup-plt, all good.

svn: r17582

original commit: 73d68593af6b7c3a389013527f9b2a46618d1642

collects/mzlib/private/unitidmap.ss

@@ -1,36 +1,35 @@
+#lang scheme/base
 
-(module unitidmap mzscheme
+;; Help Desk binding info:
+(define (binding binder bound stx)
+  stx
+  ;; This 'bound-in-source is no longer needed
+  #;
+  (syntax-property
+   stx
+   'bound-in-source
+   (cons binder (syntax-local-introduce bound))))
 
-  ;; Help Desk binding info:
+(define (make-id-mapper unbox-stx the-binder)
-  (define (binding binder bound stx)
+  (let ([set!-stx (datum->syntax unbox-stx 'set! #f)])
-    stx
+    (make-set!-transformer
-    ;; This 'bound-in-source is no longer needed
+     (lambda (sstx)
-    #;
+       (cond
-    (syntax-property
+         [(identifier? sstx) 
-     stx
+          (binding the-binder sstx
-     'bound-in-source
+                   unbox-stx)]
-     (cons binder (syntax-local-introduce bound))))
+         [(free-identifier=? set!-stx (car (syntax-e sstx)))
+          (raise-syntax-error
+           'unit
+           "cannot set! imported or exported variables"
+           sstx)]
+         [else
+          (binding
+           the-binder (car (syntax-e sstx))
+           (datum->syntax
+            sstx
+            (cons unbox-stx (cdr (syntax-e sstx)))
+            sstx))])))))
 
-  (define (make-id-mapper unbox-stx the-binder)
+(provide make-id-mapper)
-    (let ([set!-stx (datum->syntax-object unbox-stx 'set! #f)])
-      (make-set!-transformer
-       (lambda (sstx)
-	 (cond
-	  [(identifier? sstx) 
-	   (binding the-binder sstx
-		    unbox-stx)]
-	  [(module-identifier=? set!-stx (car (syntax-e sstx)))
-	   (raise-syntax-error
-	    'unit
-	    "cannot set! imported or exported variables"
-	    sstx)]
-	  [else
-	   (binding
-	    the-binder (car (syntax-e sstx))
-	    (datum->syntax-object
-	     sstx
-	     (cons unbox-stx (cdr (syntax-e sstx)))
-	     sstx))])))))
-
-  (provide make-id-mapper))
 

collects/mzlib/unit-exptime.ss

@@ -1,26 +1,27 @@
-(module unit-exptime mzscheme
+#lang scheme/base
-  (require "private/unit-syntax.ss"
-           "private/unit-compiletime.ss")
 
-  (provide unit-static-signatures
+(require "private/unit-syntax.ss"
-           signature-members)
+         "private/unit-compiletime.ss")
 
-  (define (unit-static-signatures name err-stx)
+(provide unit-static-signatures
-    (parameterize ((error-syntax err-stx))
+         signature-members)
-      (let ((ui (lookup-def-unit name)))
-        (values (apply list (unit-info-import-sig-ids ui))
-                (apply list (unit-info-export-sig-ids ui))))))
 
-  (define (signature-members name err-stx)
+(define (unit-static-signatures name err-stx)
-    (parameterize ((error-syntax err-stx))
+  (parameterize ((error-syntax err-stx))
-      (let ([s (lookup-signature name)])
+    (let ((ui (lookup-def-unit name)))
-        (values 
+      (values (apply list (unit-info-import-sig-ids ui))
-         ;; extends: 
+              (apply list (unit-info-export-sig-ids ui))))))
-         (and (pair? (cdr (siginfo-names (signature-siginfo s))))
+
-              (cadr (siginfo-names (signature-siginfo s))))
+(define (signature-members name err-stx)
-         ;; vars
+  (parameterize ((error-syntax err-stx))
-         (apply list (signature-vars s))
+    (let ([s (lookup-signature name)])
-         ;; defined vars
+      (values 
-         (apply list (apply append (map car (signature-val-defs s))))
+       ;; extends: 
-         ;; defined stxs
+       (and (pair? (cdr (siginfo-names (signature-siginfo s))))
-         (apply list (apply append (map car (signature-stx-defs s)))))))))
+            (cadr (siginfo-names (signature-siginfo s))))
+       ;; vars
+       (apply list (signature-vars s))
+       ;; defined vars
+       (apply list (apply append (map car (signature-val-defs s))))
+       ;; defined stxs
+       (apply list (apply append (map car (signature-stx-defs s))))))))