From 9dbe7c808f645c85b4596d14f3240034986fbdfe Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 16 Nov 2009 16:58:11 +0000
Subject: [PATCH] Add unstable/match with == match expander. Add 'match
 expander' tech def.

svn: r16814

original commit: 0ae5843f1163a247f776b47ac29e38e31664bc03
---
 collects/typed-scheme/rep/rep-utils.ss              |  4 ++--
 collects/typed-scheme/typecheck/tc-expr-unit.ss     |  2 +-
 collects/typed-scheme/typecheck/tc-metafunctions.ss |  2 +-
 collects/typed-scheme/utils/utils.ss                | 10 +---------
 collects/unstable/match.ss                          | 13 +++++++++++++
 5 files changed, 18 insertions(+), 13 deletions(-)
 create mode 100644 collects/unstable/match.ss

diff --git a/collects/typed-scheme/rep/rep-utils.ss b/collects/typed-scheme/rep/rep-utils.ss
index 115c8e86..ca994b19 100644
--- a/collects/typed-scheme/rep/rep-utils.ss
+++ b/collects/typed-scheme/rep/rep-utils.ss
@@ -2,11 +2,11 @@
 (require "../utils/utils.ss")
 
 (require mzlib/struct 
-         mzlib/plt-match
+         scheme/match
          syntax/boundmap
          "free-variance.ss"
          "interning.ss"
-	 unstable/syntax
+	 unstable/syntax unstable/match
          mzlib/etc
          scheme/contract         
          (for-syntax 
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss
index 52e3fd79..b57abb2f 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.ss
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss
@@ -33,7 +33,7 @@
     [i:boolean (-val (syntax-e #'i))]
     [i:identifier (-val (syntax-e #'i))]
     [i:exact-integer -Integer]
-    [i:number -Number]
+    [(~var i (3d real?)) -Number]
     [i:str -String]
     [i:char -Char]
     [i:keyword (-val (syntax-e #'i))]
diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.ss b/collects/typed-scheme/typecheck/tc-metafunctions.ss
index a7b46e50..2d703756 100644
--- a/collects/typed-scheme/typecheck/tc-metafunctions.ss
+++ b/collects/typed-scheme/typecheck/tc-metafunctions.ss
@@ -6,7 +6,7 @@
                     [->* -->*]
                     [one-of/c -one-of/c])
          (rep type-rep)
-         scheme/contract scheme/match
+         scheme/contract scheme/match unstable/match
          (for-syntax scheme/base))
 
 (provide combine-filter apply-filter abstract-filter abstract-filters
diff --git a/collects/typed-scheme/utils/utils.ss b/collects/typed-scheme/utils/utils.ss
index 78a54952..8300d461 100644
--- a/collects/typed-scheme/utils/utils.ss
+++ b/collects/typed-scheme/utils/utils.ss
@@ -11,7 +11,7 @@ at least theoretically.
 	 scheme/pretty mzlib/pconvert syntax/parse)
 
 ;; to move to unstable
-(provide == debug reverse-begin)
+(provide debug reverse-begin)
 
 (provide
  ;; timing
@@ -140,14 +140,6 @@ at least theoretically.
               (printf "Timing ~a at ~a@~a~n" msg diff t)))]))
       (values (lambda _ #'(void)) (lambda _ #'(void)))))
 
-
-(define-match-expander
-  ==
-  (lambda (stx)
-    (syntax-case stx ()
-      [(_ val)
-       #'(? (lambda (x) (equal? val x)))])))
-
 ;; custom printing
 ;; this requires lots of work for two reasons:
 ;; - 1 printers have to be defined at the same time as the structs
diff --git a/collects/unstable/match.ss b/collects/unstable/match.ss
new file mode 100644
index 00000000..584b6651
--- /dev/null
+++ b/collects/unstable/match.ss
@@ -0,0 +1,13 @@
+#lang scheme/base
+
+(require scheme/match (for-syntax scheme/base))
+
+(provide ==)
+
+(define-match-expander
+  ==
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ val comp)
+       #'(? (lambda (x) (comp val x)))]
+      [(_ val) #'(== val equal?)])))