From c115b497c09f31391fcea258393d84e9640e2d1f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Tue, 26 Sep 2017 13:18:33 +0200
Subject: [PATCH] Attempt to fix extra level of let for typecheck-fail

---
 .../examples/tests/rackunit-typechecking.rkt  | 42 ++++++++++---------
 1 file changed, 23 insertions(+), 19 deletions(-)

diff --git a/turnstile/examples/tests/rackunit-typechecking.rkt b/turnstile/examples/tests/rackunit-typechecking.rkt
index 24b4f47..abc26bf 100644
--- a/turnstile/examples/tests/rackunit-typechecking.rkt
+++ b/turnstile/examples/tests/rackunit-typechecking.rkt
@@ -76,25 +76,29 @@
             (if (attribute msg-pat)
                 (eval-syntax (datum->stx #'h (stx->datum #'msg-pat)))
                 (eval-syntax (datum->stx #'h `(add-escs ,(stx->datum #'vmsg)))))
-     #`(let-syntax ([chk (λ (_stx)
-                           (with-check-info*
-                            ;; Most of these are actually ignored by rackunit's define-check.
-                            (list (make-check-expected (syntax-e #'msg))
-                                  (make-check-expression (syntax->datum #'stx))
-                                  (make-check-location (build-source-location-list #'stx))
-                                  (make-check-name 'typecheck-fail)
-                                  (make-check-params (list (syntax->datum #'e) (syntax-e #'msg))))
-                            (λ ()
-                              #,(syntax/loc stx
-                                  (check-exn
-                                   (λ (ex)
-                                     (and (or (exn:fail? ex) (exn:test:check? ex))
-                                          ; check err msg matches
-                                          (regexp-match? (syntax-e #'msg) (exn-message ex))))
-                                   (λ ()
-                                     (expand/df #'e))))))
-                           #'(void))])
-         chk)]))
+     #:with transformer-proc #`(λ (_stx)
+                                 (with-check-info*
+                                  ;; Most of these are actually ignored by rackunit's define-check.
+                                  (list (make-check-expected (syntax-e #'msg))
+                                        (make-check-expression (syntax->datum #'stx))
+                                        (make-check-location (build-source-location-list #'stx))
+                                        (make-check-name 'typecheck-fail)
+                                        (make-check-params (list (syntax->datum #'e) (syntax-e #'msg))))
+                                  (λ ()
+                                    #,(syntax/loc stx
+                                        (check-exn
+                                         (λ (ex)
+                                           (and (or (exn:fail? ex) (exn:test:check? ex))
+                                                ; check err msg matches
+                                                (regexp-match? (syntax-e #'msg) (exn-message ex))))
+                                         (λ ()
+                                           (expand/df #'e))))))
+                                 #'(void))
+     (if (eq? (syntax-local-context) 'expression)
+         #'(let-syntax ([chk transformer-proc])
+             chk)
+         #'(begin (define-syntax chk transformer-proc)
+                  chk))]))
 
 (define-syntax (typecheck-fail/toplvl stx)
   (syntax-parse stx #:datum-literals (:)