more v4-isms

svn: r11683

collects/handin-server/private/config.ss

@@ -1,21 +1,22 @@
-(module config mzscheme
+#lang scheme/base
-  (require mzlib/file mzlib/list)
 
-  ;; This module should be invoked when we're in the server directory
+(require scheme/file)
-  (provide server-dir)
-  (define server-dir (or (getenv "PLT_HANDINSERVER_DIR") (current-directory)))
 
-  (define config-file (path->complete-path "config.ss" server-dir))
+;; This module should be invoked when we're in the server directory
+(provide server-dir)
+(define server-dir (or (getenv "PLT_HANDINSERVER_DIR") (current-directory)))
 
-  (define poll-freq 2000.0) ; poll at most once every two seconds
+(define config-file (path->complete-path "config.ss" server-dir))
 
-  (define last-poll     #f)
+(define poll-freq 2000.0) ; poll at most once every two seconds
-  (define last-filetime #f)
-  (define raw-config    #f)
-  (define config-cache  #f)
 
-  (provide get-conf)
+(define last-poll     #f)
-  (define (get-conf key)
+(define last-filetime #f)
+(define raw-config    #f)
+(define config-cache  #f)
+
+(provide get-conf)
+(define (get-conf key)
   (unless (and raw-config
                (< (- (current-inexact-milliseconds) last-poll) poll-freq))
     (set! last-poll (current-inexact-milliseconds))
@@ -33,8 +34,8 @@
                            (format "loading configuration from ~a\n"
                                    config-file)))
                 (with-input-from-file config-file read)))
-          (set! config-cache (make-hash-table)))))
+        (set! config-cache (make-hasheq)))))
-    (hash-table-get config-cache key
+  (hash-ref config-cache key
     (lambda ()
       (let*-values ([(default translate) (config-default+translate key)]
                     ;; translate = #f => this is a computed value
@@ -42,16 +43,16 @@
                            (translate (cond [(assq key raw-config) => cadr]
                                             [else default]))
                            default)])
-          (hash-table-put! config-cache key v)
+        (hash-set! config-cache key v)
         v))))
 
-  (define (id x) x)
+(define (id x) x)
-  (define (rx s) (if (regexp? s) s (regexp s)))
+(define (rx s) (if (regexp? s) s (regexp s)))
-  (define (path p) (path->complete-path p server-dir))
+(define (path p) (path->complete-path p server-dir))
-  (define (path/false p) (and p (path p)))
+(define (path/false p) (and p (path p)))
-  (define (path-list l) (map path l))
+(define (path-list l) (map path l))
 
-  (define (config-default+translate which)
+(define (config-default+translate which)
   (case which
     [(active-dirs)             (values '()                   path-list    )]
     [(inactive-dirs)           (values '()                   path-list    )]
@@ -90,9 +91,9 @@
              #f)]
     [else (error 'get-conf "unknown configuration entry: ~s" which)]))
 
-  ;; This is used below to map names to submission directory paths and back
+;; This is used below to map names to submission directory paths and back
-  ;; returns a (list-of (either (list name path) (list path name)))
+;; returns a (list-of (either (list name path) (list path name)))
-  (define (paths->map dirs)
+(define (paths->map dirs)
   (define (path->name dir)
     (unless (directory-exists? dir)
       (error 'get-conf
@@ -102,10 +103,8 @@
   (let ([names (map path->name dirs)])
     (append (map list names dirs) (map list dirs names))))
 
-  ;; Translates an assignment name to a directory path or back
+;; Translates an assignment name to a directory path or back
-  (provide assignment<->dir)
+(provide assignment<->dir)
-  (define (assignment<->dir a/d)
+(define (assignment<->dir a/d)
   (cond [(assoc a/d (get-conf 'names-dirs)) => cadr]
         [else (error 'assignment<->dir "internal error: ~e" a/d)]))
-
-  )

collects/handin-server/private/logger.ss

@@ -1,23 +1,24 @@
-(module logger mzscheme
+#lang scheme/base
-  (require "config.ss" mzlib/date mzlib/port)
 
-  (provide current-session)
+(require "config.ss" scheme/date scheme/port)
-  (define current-session (make-parameter #f))
 
-  ;; A convenient function to print log lines (which really just assembles a
+(provide current-session)
-  ;; string to print in one shot, and flushes the output)
+(define current-session (make-parameter #f))
-  (provide log-line)
+
-  (define (log-line fmt . args)
+;; A convenient function to print log lines (which really just assembles a
+;; string to print in one shot, and flushes the output)
+(provide log-line)
+(define (log-line fmt . args)
   (let ([line (format "~a\n" (apply format fmt args))])
     (display line (current-error-port))))
 
-  (define (prefix)
+(define (prefix)
   (parameterize ([date-display-format 'iso-8601])
     (format "[~a|~a] "
             (or (current-session) '-)
             (date->string (seconds->date (current-seconds)) #t))))
 
-  (define (combine-outputs o1 o2)
+(define (combine-outputs o1 o2)
   (let-values ([(i o) (make-pipe)])
     (thread
      (lambda ()
@@ -30,9 +31,9 @@
                     (loop)))))))
     o))
 
-  ;; Implement a logger by making the current-error-port show prefix tags and
+;; Implement a logger by making the current-error-port show prefix tags and
-  ;; output the line on the output port
+;; output the line on the output port
-  (define (make-logger-port out log)
+(define (make-logger-port out log)
   (if (and (not out) (not log))
     ;; /dev/null-like output port
     (make-output-port 'nowhere
@@ -67,11 +68,11 @@
            (lambda () (semaphore-post sema))))
        (lambda () (close-output-port outp))))))
 
-  ;; Install this wrapper as the current error port
+;; Install this wrapper as the current error port
-  (provide install-logger-port)
+(provide install-logger-port)
-  (define (install-logger-port)
+(define (install-logger-port)
   (current-error-port
    (make-logger-port
     (and (get-conf 'log-output) (current-output-port))
     (cond [(get-conf 'log-file) => (lambda (f) (open-output-file f 'append))]
-            [else #f])))))
+          [else #f]))))

collects/handin-server/private/md5.ss

@@ -1,5 +1,5 @@
-(module md5 mzscheme
+#lang scheme/base
-  (require (prefix mz: mzlib/md5))
+(require (prefix-in mz: file/md5))
-  (define (md5 s)
+(define (md5 s)
   (bytes->string/latin-1 (mz:md5 (string->bytes/utf-8 s))))
-  (provide md5))
+(provide md5)