From 4cc86cc8c808d375f10c2c1fa2e4b54b126a26da Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 15 Jun 2010 16:02:16 -0400
Subject: [PATCH] set-mc[ad]r!, inference, printing, tests for mpairs

---
 collects/tests/typed-scheme/succeed/mpair.rkt | 6 ++++++
 collects/typed-scheme/infer/infer-unit.rkt    | 2 ++
 collects/typed-scheme/private/base-env.rkt    | 2 ++
 collects/typed-scheme/types/printer.rkt       | 1 +
 4 files changed, 11 insertions(+)
 create mode 100644 collects/tests/typed-scheme/succeed/mpair.rkt

diff --git a/collects/tests/typed-scheme/succeed/mpair.rkt b/collects/tests/typed-scheme/succeed/mpair.rkt
new file mode 100644
index 0000000000..72475e8e26
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/mpair.rkt
@@ -0,0 +1,6 @@
+#lang typed/racket
+
+(define: x : (MPairof Integer Integer) (mcons 1 2))
+(set-mcar! x -7)
+(mcar x)
+(mcdr x)
\ No newline at end of file
diff --git a/collects/typed-scheme/infer/infer-unit.rkt b/collects/typed-scheme/infer/infer-unit.rkt
index 5b5a2d8eca..bbd15f9fb1 100644
--- a/collects/typed-scheme/infer/infer-unit.rkt
+++ b/collects/typed-scheme/infer/infer-unit.rkt
@@ -414,6 +414,8 @@
            (cset-meet (cg e e*) (cg e* e))]
           [((Box: e) (Box: e*))
            (cset-meet (cg e e*) (cg e* e))]
+          [((MPair: s t) (MPair: s* t*))
+           (cset-meet* (list (cg s s*) (cg s* s) (cg t t*) (cg t* t)))]
           [((Channel: e) (Channel: e*))
            (cset-meet (cg e e*) (cg e* e))]
           [((Hashtable: s1 s2) (Hashtable: t1 t2))
diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index d2e869e84a..c23347efbf 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -918,4 +918,6 @@
 [mcons (-poly (a b) (-> a b (-mpair a b)))]
 [mcar (-poly (a b) (-> (-mpair a b) a))]
 [mcdr (-poly (a b) (-> (-mpair a b) b))]
+[set-mcar! (-poly (a b) (-> (-mpair a b) a -Void))]
+[set-mcdr! (-poly (a b) (-> (-mpair a b) b -Void))]
 [mpair? (make-pred-ty (make-MPairTop))]
diff --git a/collects/typed-scheme/types/printer.rkt b/collects/typed-scheme/types/printer.rkt
index ebcb31962c..2ae5a06c56 100644
--- a/collects/typed-scheme/types/printer.rkt
+++ b/collects/typed-scheme/types/printer.rkt
@@ -209,6 +209,7 @@
     [(Result: t (FilterSet: (Top:) (Top:)) (Empty:)) (fp "~a" t)]
     [(Result: t fs (Empty:)) (fp "(~a : ~a)" t fs)]
     [(Result: t fs lo) (fp "(~a : ~a : ~a)" t fs lo)]
+    [(MPair: s t) (fp "(MPairof ~a ~a)" s t)]
     [(Refinement: parent p? _)
      (fp "(Refinement ~a ~a)" parent (syntax-e p?))]
     [(Sequence: ts)