* Added (module <lang>) as a specification for using

`make-module-evaluator' accepting only modules with the specified
  language.
* Fix a bug with deciding on how to convert values for printing.
* Improved code in checker.ss.

svn: r11955

collects/handin-server/checker.ss

@@ -488,6 +488,14 @@
                                     submission->bytes)
                                   submission maxwidth textualize? untabify?
                                   markup-prefix prefix-re))))
+                   (define (uem-handler e)
+                     (let ([m (if (exn? e) (exn-message e) (format "~a" e))])
+                       (cond
+                         [(procedure? uem) (uem m)]
+                         [(not (string? uem))
+                          (error* "badly configured user-error-message")]
+                         [(regexp-match? #rx"~[aesvAESV]" uem) (error* uem m)]
+                         [else (error* "~a" uem)])))
                    (when create-text? (make-directory "grading") (write-text))
                    (when value-printer (current-value-printer value-printer))
                    (when coverage? (sandbox-coverage-enabled #t))
@@ -495,24 +503,10 @@
                    (cond
                      [(not eval?) (let () body ...)]
                      [language
-                      (let ([eval
+                      (let ([eval (with-handlers ([void uem-handler])
-                             (with-handlers
+                                    (call-with-evaluator/submission
-                                 ([void
+                                     language (append requires teachpacks)
-                                   (lambda (e)
+                                     submission values))])
-                                     (let ([m (if (exn? e)
-                                                (exn-message e)
-                                                (format "~a" e))])
-                                       (cond
-                                         [(procedure? uem) (uem m)]
-                                         [(not (string? uem))
-                                          (error* "badly configured ~a"
-                                                  "user-error-message")]
-                                         [(regexp-match? #rx"~[aesvAESV]" uem)
-                                          (error* uem m)]
-                                         [else (error* "~a" uem)])))])
-                               (call-with-evaluator/submission
-                                language (append requires teachpacks)
-                                submission values))])
                         (set-run-status "running tests")
                         (parameterize ([submission-eval (wrap-evaluator eval)])
                           (let-syntax ([with-submission-bindings

collects/handin-server/scribblings/utils.scrbl

@@ -21,6 +21,7 @@
 @defproc[(make-evaluator/submission
           [language (or/c module-path?
                           (list/c (one-of/c 'special) symbol?)
+                          (list/c (one-of/c 'module) module-path?)
                           (cons/c (one-of/c 'begin) list?))]
           [require-paths (listof path-string?)]
           [content bytes?])
@@ -28,11 +29,19 @@
 
   Like @scheme[make-evaluator], but the definitions content is
   supplied as a submission byte string.  The byte string is opened for
-  reading, with line-counting enabled.}
+  reading, with line-counting enabled.
+
+  In addition to the language specification for
+  @scheme[make-evaluator], the @scheme[language] argument can be a
+  list that begins with @scheme['module].  In this case,
+  @scheme[make-module-language] is used to create an evaluator, and
+  the module code must be using the the specified language in its
+  language position.}
 
 @defproc[(call-with-evaluator
           [language (or/c module-path?
                           (list/c (one-of/c 'special) symbol?)
+                          (list/c (one-of/c 'module) module-path?)
                           (cons/c (one-of/c 'begin) list?))]
           [require-paths (listof path-string?)]
           [input-program any/c]
@@ -46,11 +55,13 @@
   suitable for @scheme[language], it initializes
   @scheme[set-run-status] with @scheme["executing your code"], and it
   catches all exceptions to re-raise them in a form suitable as a
-  submission error.}
+  submission error.  See @scheme[make-evaluator/submission] for
+  further details.}
 
 @defproc[(call-with-evaluator/submission [language
           (or/c module-path?
                 (list/c (one-of/c 'special) symbol?)
+                (list/c (one-of/c 'module) module-path?)
                 (cons/c (one-of/c 'begin) list?))]
           [require-paths (listof path-string?)]
           [submission bytes?]
@@ -59,7 +70,8 @@
 
   Like @scheme[call-with-evaluator], but the definitions content is
   supplied as a byte string.  The byte string is opened for reading,
-  with line-counting enabled.}
+  with line-counting enabled.  See @scheme[call-with-evaluator] and
+  @scheme[make-evaluator/submission] for further details.}
 
 @; JBC: this contract is probably wrong
 @; JBC: does this eval accept an optional namespace?

collects/handin-server/utils.ss

@@ -48,14 +48,18 @@
 
 ;; Execution ----------------------------------------
 
+(define (make-evaluator* lang reqs inp)
+  (if (and (list? lang) (= 2 (length lang)) (eq? 'module (car lang)))
+    (make-module-evaluator inp #:language (cadr lang) #:allow-read reqs)
+    (make-evaluator lang inp #:requires reqs)))
+
 (define (open-input-text-editor/lines str)
   (let ([inp (open-input-text-editor str)])
     (port-count-lines! inp) inp))
 
 (define (make-evaluator/submission language requires str)
   (let-values ([(defs interacts) (unpack-submission str)])
-    (make-evaluator language #:requires requires
+    (make-evaluator* language requires (open-input-text-editor defs))))
-                    (open-input-text-editor defs))))
 
 (define (evaluate-all source port eval)
   (let loop ()
@@ -164,11 +168,12 @@
 (define (call-with-evaluator lang requires program-port go)
   (parameterize ([error-value->string-handler (lambda (v s)
                                                 ((current-value-printer) v))]
-                 [list-abbreviation-enabled (not (or (eq? lang 'beginner)
+                 [list-abbreviation-enabled
-                                                     (eq? lang 'beginner-abbr)))])
+                  (not (or (equal? lang '(special beginner))
+                           (equal? lang '(special beginner-abbr))))])
     (reraise-exn-as-submission-problem
      (lambda ()
-       (let ([e (make-evaluator lang #:requires requires program-port)])
+       (let ([e (make-evaluator* lang requires program-port)])
          (set-run-status "executing your code")
          (go e))))))