From 9eaba7098a1b860e87f9826be46eb7105763ddc6 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Tue, 7 Jan 2014 22:27:08 -0800
Subject: [PATCH] Add custom printer for terminal contracts.

original commit: bb74b55f67087848d6eec057e00fd925b0877bc4
---
 .../static-contracts/combinators/parametric.rkt     |  1 +
 .../typed-racket/static-contracts/terminal.rkt      | 13 +++++++++++--
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
index 3fd44de1..07f09497 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
@@ -52,4 +52,5 @@
      #'(parametric-combinator (list body) vars)]))
 
 (define-terminal-sc parametric-var/sc (id) #:impersonator
+  #:printer (v p mode) (display (syntax-e (parametric-var/sc-id v)) p)
    id)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/terminal.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/terminal.rkt
index 0b01c9fb..66969c6a 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/terminal.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/terminal.rkt
@@ -18,14 +18,23 @@
   (define-syntax-class kind-keyword
     [pattern #:flat #:with sym 'flat]
     [pattern #:chaperone #:with sym 'chaperone]
-    [pattern #:impersonator #:with sym 'impersonator]))
+    [pattern #:impersonator #:with sym 'impersonator])
+
+  (define-splicing-syntax-class printer
+    [pattern (~seq #:printer (v p mode) body)
+      #:with (methods ...) #'(#:methods gen:custom-write [(define (write-proc v p mode) body)])]
+    [pattern (~seq)
+      #:with (methods ...) #'()])
+
+  )
 
 
 (define-syntax (define-terminal-sc stx)
   (syntax-parse stx
-    [(_ name:id (args:id ...) kind:kind-keyword body:expr)
+    [(_ name:id (args:id ...) kind:kind-keyword p:printer body:expr)
      #'(struct name static-contract (args ...)
          #:transparent
+         p.methods ...
          #:methods gen:sc
           [(define (sc-map v f) v)
            (define (sc-traverse v f) (void))