From 30b60f8c4369972f8fb98732149bd99ce8d9fd98 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 14 Mar 2014 09:54:17 -0400
Subject: [PATCH] Raise a better message for ctc generation in TR

This provides a better explanation of contract generation
failures for module-provided bindings.
---
 .../typed-racket/typecheck/provide-handling.rkt     | 13 +++++++++----
 .../typed-racket/fail/contract-conversion-error.rkt | 12 ++++++++++++
 2 files changed, 21 insertions(+), 4 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/contract-conversion-error.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
index 37f4652bf8..6628f881ff 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/provide-handling.rkt
@@ -4,6 +4,7 @@
          unstable/list unstable/sequence syntax/id-table racket/dict racket/syntax
          racket/struct-info racket/match syntax/parse
          (only-in (private type-contract) type->contract)
+         (types printer)
          (typecheck renamer def-binding)
          (utils tc-utils)
          (for-syntax racket/base)
@@ -133,13 +134,13 @@
 
   ;; mk-value-triple : identifier? identifier? (or/c syntax? #f) -> triple/c
   (define (mk-value-triple internal-id new-id ty)
-    (define contract (type->contract ty (λ (#:reason [reason #f]) #f)))
+    (define contract (type->contract ty (λ (#:reason [reason #f]) reason)))
 
     (with-syntax* ([id internal-id]
                    [untyped-id (freshen-id #'id)]
                    [export-id new-id])
       (define/with-syntax definitions
-        (if contract
+        (if (syntax? contract)
             (with-syntax* ([module-source pos-blame-id]
                            [the-contract (generate-temporary 'generated-contract)])
               #`(define-module-boundary-contract untyped-id 
@@ -150,8 +151,12 @@
                                    #,(syntax-column #'id)
                                    #,(syntax-position #'id)
                                    #,(syntax-span #'id))))
-            #'(define-syntax (untyped-id stx)
-                (tc-error/stx stx "The type of ~a cannot be converted to a contract" (syntax-e #'id)))))
+            #`(define-syntax (untyped-id stx)
+                (tc-error/fields #:stx stx
+                                 "could not convert type to a contract"
+                                 #:more #,contract
+                                 "for identifier" #,(symbol->string (syntax-e #'id))
+                                 "type" #,(pretty-format-type ty #:indent 8)))))
       (values
         #'(begin
             definitions
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/contract-conversion-error.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/contract-conversion-error.rkt
new file mode 100644
index 0000000000..3503527048
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/contract-conversion-error.rkt
@@ -0,0 +1,12 @@
+#;
+(exn-pred #rx"function type has two cases of arity 1")
+#lang racket/load
+
+;; This tests the error message for contract generation errors
+;; that come from module provides.
+;;
+;; In particular, it should give a reason for why it failed
+
+(module a typed/racket (define v values) (provide v))
+(require 'a)
+v