From 4214bde9fccf4980c49d4cf5e7a261ff116fe2b3 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Sun, 26 Sep 2021 08:29:17 -0400
Subject: [PATCH] Allow controlling the `#:readers` value

In some cases (notably, complicated readers like I use: `#lang pl 03`),
there is no way that I see to guess what the right readers should be, so
allow setting them.
---
 handin-server/checker.rkt |  3 +++
 handin-server/utils.rkt   | 15 ++++++++++-----
 2 files changed, 13 insertions(+), 5 deletions(-)

diff --git a/handin-server/checker.rkt b/handin-server/checker.rkt
index a549c56..3138f41 100644
--- a/handin-server/checker.rkt
+++ b/handin-server/checker.rkt
@@ -375,6 +375,7 @@
             [requires*      (get ':requires      #''())]
             [teachpacks*    (get ':teachpacks    #''())]
             [allowed-requires* (get ':allowed-requires #'#f)]
+            [readers*       (get ':readers       #''auto)]
             [create-text?*  (get ':create-text?  #'#t)]
             [untabify?*     (get ':untabify?     #'#t)]
             [textualize?*   (get ':textualize?   #'#f)]
@@ -421,6 +422,7 @@
                      [language       language*]
                      [requires       requires*]
                      [allowed-requires allowed-requires*]
+                     [readers        readers*]
                      [teachpacks     teachpacks*]
                      [create-text?   create-text?*]
                      [untabify?      untabify?*]
@@ -523,6 +525,7 @@
                                       (call-with-evaluator/submission
                                        language (append requires teachpacks)
                                        #:allowed-requires allowed-requires
+                                       #:readers readers
                                        submission values)))])
                         (set-run-status "running tests")
                         (parameterize ([submission-eval (wrap-evaluator eval)])
diff --git a/handin-server/utils.rkt b/handin-server/utils.rkt
index 26e9985..0241a28 100644
--- a/handin-server/utils.rkt
+++ b/handin-server/utils.rkt
@@ -57,12 +57,14 @@
 
 ;; Execution ----------------------------------------
 
-(define (make-evaluator* lang reqs allowed-requires inp)
+(define (make-evaluator* lang reqs allowed-requires readers inp)
+  (define-syntax-rule (w/readers f x ...)
+    (if (eq? readers 'auto) (f x ...) (f x ... #:readers readers)))
   (reraise-exn-as-submission-problem
    (lambda ()
      (if (and (list? lang) (= 2 (length lang)) (eq? 'module (car lang)))
-         (make-module-evaluator inp #:language (cadr lang) #:allow-read reqs
-                                #:allow-syntactic-requires allowed-requires)
+         (w/readers make-module-evaluator inp #:language (cadr lang) #:allow-read reqs
+                    #:allow-syntactic-requires allowed-requires)
          (make-evaluator lang inp #:requires reqs
                          #:allow-syntactic-requires allowed-requires)))))
 
@@ -72,7 +74,7 @@
 
 (define (make-evaluator/submission language requires str)
   (let-values ([(defs interacts) (unpack-submission str)])
-    (make-evaluator* language requires (open-input-text-editor defs))))
+    (make-evaluator* language requires 'auto (open-input-text-editor defs))))
 
 (define (evaluate-all source port eval)
   (let loop ()
@@ -180,6 +182,7 @@
 
 (define (call-with-evaluator lang requires program-port
                              #:allowed-requires [allowed-requires #f]
+                             #:readers [readers 'auto]
                              go)
   (parameterize ([error-value->string-handler (lambda (v s)
                                                 ((current-value-printer) v))]
@@ -188,14 +191,16 @@
                            (equal? lang '(special beginner-abbr))))])
     (reraise-exn-as-submission-problem
      (lambda ()
-       (let ([e (make-evaluator* lang requires allowed-requires program-port)])
+       (let ([e (make-evaluator* lang requires allowed-requires readers program-port)])
          (set-run-status "executing your code")
          (go e))))))
 
 (define (call-with-evaluator/submission lang requires str
                                         #:allowed-requires [allowed-requires #f]
+                                        #:readers [readers 'auto]
                                         go)
   (let-values ([(defs interacts) (unpack-submission str)])
     (call-with-evaluator lang requires (open-input-text-editor defs)
                          #:allowed-requires allowed-requires
+                         #:readers readers
                          go)))