Add unstable/match with == match expander.

Add 'match expander' tech def.

svn: r16814

collects/scribblings/reference/match.scrbl

@@ -423,7 +423,7 @@ A predicate for the exception raised by in the case of a match failure.
 @defform*[((define-match-expander id proc-expr)
            (define-match-expander id proc-expr proc-expr))]{
 
-Binds @scheme[id] to a pattern transformer.
+Binds @scheme[id] to a @deftech{match expander}.
 
 The first @scheme[proc-expr] subexpression must evaluate to a
  transformer that produces a @scheme[_pat] for @scheme[match].

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 

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))]

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

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

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?)])))

collects/unstable/scribblings/match.scrbl

@@ -0,0 +1,37 @@
+#lang scribble/doc
+@(require scribble/base
+          scribble/manual
+          scribble/eval	  
+	  "utils.ss"
+         (for-label unstable/match
+		    scheme/match
+                    scheme/contract
+                    scheme/base))
+
+@(define the-eval (make-base-eval))
+@(the-eval '(require unstable/match scheme/match))
+
+@title[#:tag "match"]{Match}
+
+@defmodule[unstable/match]
+
+@unstable[@author+email["Sam Tobin-Hochstadt" "samth@ccs.neu.edu"]]
+
+@defform*[[(== val comparator) (== val)]]{
+A @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{match expander} 
+which checks if the matched value is the same as @scheme[val] when
+compared by @scheme[comparator].  If @scheme[comparator] is
+not provided, it defaults to @scheme[equal?].  
+
+@examples[#:eval the-eval
+(match (list 1 2 3)
+  [(== (list 1 2 3)) 'yes]
+  [_ 'no])
+(match (list 1 2 3)
+  [(== (list 1 2 3) eq?) 'yes]
+  [_ 'no])
+(match (list 1 2 3)
+  [(list 1 2 (== 3 =)) 'yes]
+  [_ 'no])
+]
+}

collects/unstable/scribblings/unstable.scrbl

@@ -86,6 +86,7 @@ Keep documentation and tests up to date.
 @include-section["class-iop.scrbl"]
 @include-section["sequence.scrbl"]
 @include-section["hash.scrbl"]
+@include-section["match.scrbl"]
 
 @;{--------}