diff --git a/collects/syntax/private/stxparse/minimatch.ss b/collects/syntax/private/stxparse/minimatch.ss
index b0cf4080db..65c3889edd 100644
--- a/collects/syntax/private/stxparse/minimatch.ss
+++ b/collects/syntax/private/stxparse/minimatch.ss
@@ -1,7 +1,7 @@
 #lang scheme/base
 (require unstable/struct
-         (for-syntax scheme/base unstable/struct))
-(provide match)
+         (for-syntax scheme/base scheme/struct-info unstable/struct))
+(provide match make)
 
 (define-syntax (match stx)
   (syntax-case stx ()
@@ -25,7 +25,7 @@
 
 ;; (match-p id Pattern SuccessExpr FailureExpr)
 (define-syntax (match-p stx)
-  (syntax-case stx (quote cons list)
+  (syntax-case stx (quote cons list make struct)
     [(match-p x wildcard success failure)
      (and (identifier? #'wildcard) (free-identifier=? #'wildcard #'_))
      #'success]
@@ -46,6 +46,27 @@
     [(match-p x var success failure)
      (identifier? #'var)
      #'(let ([var x]) success)]
+    [(match-p x (make S p ...) success failure)
+     #'(match-p x (struct S (p ...)) success failure)]
+    [(match-p x (struct S (p ...)) success failure)
+     (identifier? #'S)
+     (let ()
+       (define (not-a-struct)
+         (raise-syntax-error #f "expected struct name" #'S))
+       (define si (syntax-local-value #'S not-a-struct))
+       (unless (struct-info? si)
+         (not-a-struct))
+       (let* ([si (extract-struct-info si)]
+              [predicate (list-ref si 2)]
+              [accessors (reverse (list-ref si 3))])
+         (unless (andmap identifier? accessors)
+           (raise-syntax-error #f "struct has incomplete information" #'S))
+         (with-syntax ([predicate predicate]
+                       [(accessor ...) accessors])
+           #'(if (predicate x)
+                 (let ([y (list (accessor x) ...)])
+                   (match-p y (list p ...) success failure))
+                 failure))))]
     [(match-p x s success failure)
      (prefab-struct-key (syntax-e #'s))
      (with-syntax ([key (prefab-struct-key (syntax-e #'s))]
@@ -55,3 +76,7 @@
                (let ([xps (cdr (vector->list (struct->vector x)))])
                  (match-p xps (list p ...) success failure))
                failure)))]))
+
+(define-syntax struct
+  (lambda (stx)
+    (raise-syntax-error #f "illegal use of keyword" stx)))
diff --git a/collects/syntax/private/stxparse/rep.ss b/collects/syntax/private/stxparse/rep.ss
index c6f02a7256..a907511461 100644
--- a/collects/syntax/private/stxparse/rep.ss
+++ b/collects/syntax/private/stxparse/rep.ss
@@ -693,13 +693,13 @@
 
 (define (check-list-pattern pattern stx)
   (match pattern
-    [#s(pat:datum _base '())
+    [(make pat:datum _base '())
      #t]
-    [#s(pat:head _base _head tail)
+    [(make pat:head _base _head tail)
      (check-list-pattern tail stx)]
-    [#s(pat:dots _base _head tail)
+    [(make pat:dots _base _head tail)
      (check-list-pattern tail stx)]
-    [#s(pat:compound _base '#:pair (list _head tail))
+    [(make pat:compound _base '#:pair (list _head tail))
      (check-list-pattern tail stx)]
     [_
      (wrong-syntax stx "expected proper list pattern")]))
diff --git a/collects/syntax/private/stxparse/runtime-prose.ss b/collects/syntax/private/stxparse/runtime-prose.ss
index 7aa46a6933..7cec766378 100644
--- a/collects/syntax/private/stxparse/runtime-prose.ss
+++ b/collects/syntax/private/stxparse/runtime-prose.ss
@@ -18,7 +18,7 @@
 
 (define (default-failure-handler stx0 f)
   (match (simplify-failure f)
-    [#s(failure x frontier expectation)
+    [(make failure x frontier expectation)
      (report-failure stx0 x (dfc->index frontier) (dfc->stx frontier) expectation)]))
 
 (define current-failure-handler
@@ -68,14 +68,14 @@
 ;; simplify* : Failure -> SimpleFailure
 (define (simplify* f)
   (match f
-    [#s(join-failures f1 f2)
+    [(make join-failures f1 f2)
      (choose-error (simplify* f1) (simplify* f2))]
-    [#s(failure x frontier expectation)
+    [(make failure x frontier expectation)
      (match expectation
-       [#s(expect:thing description '#t chained)
+       [(make expect:thing description '#t chained)
         (let ([chained* (simplify* chained)])
           (match chained*
-            [#s(failure _ chained*-frontier chained*-expectation)
+            [(make failure _ chained*-frontier chained*-expectation)
              (cond [(ineffable? chained*-expectation)
                     ;; If simplified chained failure is ineffable,
                     ;; keep (& adjust) its frontier
@@ -93,14 +93,14 @@
 ;; FIXME: try different selection/simplification algorithms/heuristics
 (define (simplify-failure0 f)
   (match f
-    [#s(join-failures f1 f2)
+    [(make join-failures f1 f2)
      (choose-error (simplify-failure0 f1) (simplify-failure0 f2))]
-    [#s(failure x frontier expectation)
+    [(make failure x frontier expectation)
      (match expectation
-       [#s(expect:thing description '#t chained)
+       [(make expect:thing description '#t chained)
         (let ([chained* (simplify-failure0 chained)])
           (match chained*
-            [#s(failure _ _ chained*-expectation)
+            [(make failure _ _ chained*-expectation)
              (cond [(ineffable? chained*-expectation)
                     ;; If simplified chained failure is ineffable, ignore it
                     ;; and stick to the one with the description
@@ -113,7 +113,7 @@
 
 (define (adjust-failure f base-frontier)
   (match f
-    [#s(failure x frontier expectation)
+    [(make failure x frontier expectation)
      (let ([frontier (dfc-append base-frontier frontier)])
        (make-failure x frontier expectation))]))
 
@@ -147,15 +147,15 @@
 
 (define (for-alternative e index stx)
   (match e
-    [#s(expect:thing description transparent? chained)
+    [(make expect:thing description transparent? chained)
      (format "expected ~a" description)]
-    [#s(expect:atom atom)
+    [(make expect:atom atom)
      (format "expected the literal ~s" atom)]
-    [#s(expect:literal literal)
+    [(make expect:literal literal)
      (format "expected the literal identifier ~s" (syntax-e literal))]
-    [#s(expect:message message)
+    [(make expect:message message)
      (format "~a" message)]
-    [#s(expect:pair)
+    [(make expect:pair)
      (cond [(= index 0)
             "expected sequence of terms"]
            [else
diff --git a/collects/syntax/private/stxparse/runtime.ss b/collects/syntax/private/stxparse/runtime.ss
index 29ee0e8578..5b34ed2353 100644
--- a/collects/syntax/private/stxparse/runtime.ss
+++ b/collects/syntax/private/stxparse/runtime.ss
@@ -2,6 +2,7 @@
 (require scheme/contract/base
          scheme/stxparam
          scheme/list
+         unstable/struct
          "minimatch.ss"
          (for-syntax scheme/base
                      syntax/stx
@@ -159,18 +160,18 @@ A Dynamic Frontier Context (DFC) is one of
 (define-struct dfc:pre (parent stx) #:prefab)
 (define-struct dfc:post (parent stx) #:prefab)
 
-(define (dfc-empty x) (make-dfc:empty x))
+(define (dfc-empty x) (make dfc:empty x))
 (define (dfc-add-car parent stx)
-  (make-dfc:car parent stx))
+  (make dfc:car parent stx))
 (define (dfc-add-cdr parent _)
   (match parent
-    [#s(dfc:cdr uberparent n)
-     (make-dfc:cdr uberparent (add1 n))]
-    [_ (make-dfc:cdr parent 1)]))
+    [(make dfc:cdr uberparent n)
+     (make dfc:cdr uberparent (add1 n))]
+    [_ (make dfc:cdr parent 1)]))
 (define (dfc-add-pre parent stx)
-  (make-dfc:pre parent stx))
+  (make dfc:pre parent stx))
 (define (dfc-add-post parent stx)
-  (make-dfc:post parent stx))
+  (make dfc:post parent stx))
 
 (define (dfc-add-unbox parent stx)
   (dfc-add-car parent stx))
@@ -181,16 +182,16 @@ A Dynamic Frontier Context (DFC) is one of
 
 (define (dfc->index dfc)
   (match dfc
-    [#s(dfc:cdr parent n) n]
+    [(make dfc:cdr parent n) n]
     [_ 0]))
 
 (define (dfc->stx dfc)
   (match dfc
-    [#s(dfc:empty stx) stx]
-    [#s(dfc:car parent stx) stx]
-    [#s(dfc:cdr parent n) (dfc->stx parent)]
-    [#s(dfc:pre parent stx) stx]
-    [#s(dfc:post parent stx) stx]))
+    [(make dfc:empty stx) stx]
+    [(make dfc:car parent stx) stx]
+    [(make dfc:cdr parent n) (dfc->stx parent)]
+    [(make dfc:pre parent stx) stx]
+    [(make dfc:post parent stx) stx]))
 
 ;; dfc-difference : DFC DFC -> nat
 ;; Returns N s.t. B = (dfc-add-cdr^N A)
@@ -199,10 +200,10 @@ A Dynamic Frontier Context (DFC) is one of
     (error 'dfc-difference "~e is not an extension of ~e"
            (frontier->sexpr b) (frontier->sexpr a)))
   (match (list a b)
-    [(list #s(dfc:cdr pa na) #s(dfc:cdr pb nb))
+    [(list (make dfc:cdr pa na) (make dfc:cdr pb nb))
      (unless (equal? pa pb) (whoops))
      (- nb na)]
-    [(list pa #s(dfc:cdr pb nb))
+    [(list pa (make dfc:cdr pb nb))
      (unless (equal? pa pb) (whoops))
      nb]
     [_
@@ -213,16 +214,16 @@ A Dynamic Frontier Context (DFC) is one of
 ;; puts A at the base, B on top
 (define (dfc-append a b)
   (match b
-    [#s(dfc:empty stx) a]
-    [#s(dfc:car pb stx) (make-dfc:car (dfc-append a pb) stx)]
-    [#s(dfc:cdr #s(dfc:empty _) nb)
+    [(make dfc:empty stx) a]
+    [(make dfc:car pb stx) (make dfc:car (dfc-append a pb) stx)]
+    [(make dfc:cdr (make dfc:empty _) nb)
      ;; Special case to merge "consecutive" cdr frames
      (match a
-       [#s(dfc:cdr pa na) (make-dfc:cdr pa (+ na nb))]
-       [_ (make-dfc:cdr a nb)])]
-    [#s(dfc:cdr pb nb) (make-dfc:cdr (dfc-append a pb) nb)]
-    [#s(dfc:pre pb stx) (make-dfc:pre (dfc-append a pb) stx)]
-    [#s(dfc:post pb stx) (make-dfc:post (dfc-append a pb) stx)]))
+       [(make dfc:cdr pa na) (make dfc:cdr pa (+ na nb))]
+       [_ (make dfc:cdr a nb)])]
+    [(make dfc:cdr pb nb) (make dfc:cdr (dfc-append a pb) nb)]
+    [(make dfc:pre pb stx) (make dfc:pre (dfc-append a pb) stx)]
+    [(make dfc:post pb stx) (make dfc:post (dfc-append a pb) stx)]))
 
 
 ;; An Inverted DFC (IDFC) is a DFC inverted for easy comparison.
@@ -230,15 +231,15 @@ A Dynamic Frontier Context (DFC) is one of
 (define (invert-dfc dfc)
   (define (invert dfc acc)
     (match dfc
-      [#s(dfc:empty _) acc]
-      [#s(dfc:car parent stx)
-       (invert parent (make-dfc:car acc stx))]
-      [#s(dfc:cdr parent n)
-       (invert parent (make-dfc:cdr acc n))]
-      [#s(dfc:pre parent stx)
-       (invert parent (make-dfc:pre acc stx))]
-      [#s(dfc:post parent stx)
-       (invert parent (make-dfc:post acc stx))]))
+      [(make dfc:empty _) acc]
+      [(make dfc:car parent stx)
+       (invert parent (make dfc:car acc stx))]
+      [(make dfc:cdr parent n)
+       (invert parent (make dfc:cdr acc n))]
+      [(make dfc:pre parent stx)
+       (invert parent (make dfc:pre acc stx))]
+      [(make dfc:post parent stx)
+       (invert parent (make dfc:post acc stx))]))
   (invert dfc (dfc-empty 'dummy)))
 
 ;; compare-idfcs : IDFC IDFC -> (one-of '< '= '>)
@@ -247,28 +248,28 @@ A Dynamic Frontier Context (DFC) is one of
 (define (compare-idfcs a b)
   (match (list a b)
     ;; Same constructors
-    [(list #s(dfc:empty _) #s(dfc:empty _)) '=]
-    [(list #s(dfc:car pa _) #s(dfc:car pb _))
+    [(list (make dfc:empty _) (make dfc:empty _)) '=]
+    [(list (make dfc:car pa _) (make dfc:car pb _))
      (compare-idfcs pa pb)]
-    [(list #s(dfc:cdr pa na) #s(dfc:cdr pb nb))
+    [(list (make dfc:cdr pa na) (make dfc:cdr pb nb))
      (cond [(< na nb) '<]
            [(> na nb) '>]
            [(= na nb) (compare-idfcs pa pb)])]
-    [(list #s(dfc:pre pa _) #s(dfc:pre pb _))
+    [(list (make dfc:pre pa _) (make dfc:pre pb _))
      ;; FIXME: possibly just '= here, treat all sides as equiv
      (compare-idfcs pa pb)]
-    [(list #s(dfc:post pa _) #s(dfc:post pb _))
+    [(list (make dfc:post pa _) (make dfc:post pb _))
      ;; FIXME: possibly just '= here, treat all sides as equiv
      (compare-idfcs pa pb)]
     ;; Different constructors
-    [(list #s(dfc:empty _) _) '<]
-    [(list _ #s(dfc:empty _)) '>]
-    [(list #s(dfc:pre _ _) _) '<]
-    [(list _ #s(dfc:pre _ _)) '>]
-    [(list #s(dfc:car _ _) _) '<]
-    [(list _ #s(dfc:car _ _)) '>]
-    [(list #s(dfc:cdr _ _) _) '<]
-    [(list _ #s(dfc:cdr _ _)) '>]))
+    [(list (make dfc:empty _) _) '<]
+    [(list _ (make dfc:empty _)) '>]
+    [(list (make dfc:pre _ _) _) '<]
+    [(list _ (make dfc:pre _ _)) '>]
+    [(list (make dfc:car _ _) _) '<]
+    [(list _ (make dfc:car _ _)) '>]
+    [(list (make dfc:cdr _ _) _) '<]
+    [(list _ (make dfc:cdr _ _)) '>]))
 
 (define (idfc>? a b)
   (eq? (compare-idfcs a b) '>))
@@ -344,7 +345,7 @@ A Dynamic Frontier Context (DFC) is one of
                (lambda (f1)
                  (let ([combining-fail
                         (lambda (f2)
-                          (fail (make-join-failures f1 f2)))])
+                          (fail (make join-failures f1 f2)))])
                    (try* rest-attempts combining-fail)))])
           (first-attempt next-fail)))))
 
@@ -380,7 +381,7 @@ An Expectation is one of
   (or/c expect? (symbols 'ineffable)))
 
 (define (merge-expectations a b)
-  (make-expect:disj a b))
+  (make expect:disj a b))
 
 ;; expect->alternatives : Expectation -> (listof Expectation)/#f
 ;; #f indicates 'ineffable somewhere in expectation
@@ -541,7 +542,7 @@ An Expectation is one of
   (define fs
     (let loop ([f f])
       (match f
-        [#s(join-failures f1 f2)
+        [(make join-failures f1 f2)
          (append (loop f1) (loop f2))]
         [_ (list f)])))
   (case (length fs)
@@ -550,20 +551,21 @@ An Expectation is one of
 
 (define (one-failure->sexpr f)
   (match f
-    [#s(failure x frontier expectation)
+    [(make failure x frontier expectation)
      `(failure ,(frontier->sexpr frontier)
                #:term ,(syntax->datum x)
                #:expected ,(expectation->sexpr expectation))]))
 
 (define (frontier->sexpr dfc)
   (match (invert-dfc dfc)
-    [#s(dfc:empty _) '()]
-    [#s(dfc:car p _) (cons 0 (frontier->sexpr p))]
-    [#s(dfc:cdr p n) (cons n (frontier->sexpr p))]
-    [#s(dfc:side p _) (cons 'side (frontier->sexpr p))]))
+    [(make dfc:empty _) '()]
+    [(make dfc:car p _) (cons 0 (frontier->sexpr p))]
+    [(make dfc:cdr p n) (cons n (frontier->sexpr p))]
+    [(make dfc:pre p _) (cons 'pre (frontier->sexpr p))]
+    [(make dfc:post p _) (cons 'post (frontier->sexpr p))]))
 
 (define (expectation->sexpr expectation)
   (match expectation
-    [#s(expect:thing thing '#t chained)
-     (make-expect:thing thing #t (failure->sexpr chained))]
+    [(make expect:thing thing '#t chained)
+     (make expect:thing thing #t (failure->sexpr chained))]
     [_ expectation]))
diff --git a/collects/unstable/scribblings/syntax.scrbl b/collects/unstable/scribblings/syntax.scrbl
index cca32cc1bb..ac2459fc98 100644
--- a/collects/unstable/scribblings/syntax.scrbl
+++ b/collects/unstable/scribblings/syntax.scrbl
@@ -88,6 +88,20 @@ expression.
 
 @;{----}
 
+@defform[(define/with-syntax pattern expr)]{
+
+Definition form of @scheme[with-syntax]. That is, it matches the
+syntax object result of @scheme[expr] against @scheme[pattern] and
+creates pattern variable definitions for the pattern variables of
+@scheme[pattern].
+
+@examples[#:eval the-eval
+(define/with-syntax (px ...) #'(a b c))
+(define/with-syntax (tmp ...) (generate-temporaries #'(px ...)))
+#'([tmp px] ...)
+]
+}
+
 @defform[(define-pattern-variable id expr)]{
 
 Evaluates @scheme[expr] and binds it to @scheme[id] as a pattern
@@ -234,6 +248,50 @@ in the argument list are automatically converted to symbols.
 the second error but not of the first.)
 }
 
+@defproc[(internal-definition-context-apply [intdef-ctx internal-definition-context?]
+                                            [stx syntax?])
+         syntax?]{
+
+Applies the renamings of @scheme[intdef-ctx] to @scheme[stx].
+
+}
+
+@defproc[(syntax-local-eval [stx syntax?]
+                            [intdef-ctx (or/c internal-definition-context? #f) #f])
+         any]{
+
+Evaluates @scheme[stx] as an expression in the current transformer
+environment (that is, at phase level 1), optionally extended with
+@scheme[intdef-ctx].
+
+@examples[#:eval the-eval
+(define-syntax (show-me stx)
+  (syntax-case stx ()
+    [(show-me expr)
+     (begin
+       (printf "at compile time produces ~s\n"
+               (syntax-local-eval #'expr))
+       #'(printf "at run time produes ~s\n"
+                 expr))]))
+(show-me (+ 2 5))
+(define-for-syntax fruit 'apple)
+(define fruit 'pear)
+(show-me fruit)
+#|
+(define-syntax (show-me* stx)
+  (syntax-case stx ()
+    [(show-me expr1)
+     (call-with-values (lambda () (syntax-local-eval #'expr1))
+                       (lambda vals
+                         (with-syntax ([vals vals])
+                           #'(quote vals))))]))
+(define-for-syntax (sum-and-difference a b)
+  (values (+ a b) (- a b)))
+(show-me* (sum-and-difference 12 9))
+|#
+]
+}
+
 @addition{Sam Tobin-Hochstadt}
                      
 @defform[(with-syntax* ([pattern stx-expr] ...)
diff --git a/collects/unstable/syntax.ss b/collects/unstable/syntax.ss
index e4f5e4fb6d..9397876fd8 100644
--- a/collects/unstable/syntax.ss
+++ b/collects/unstable/syntax.ss
@@ -9,6 +9,7 @@
 (provide unwrap-syntax
 
          define-pattern-variable
+         define/with-syntax
 
          with-temporaries
          generate-temporary
@@ -25,7 +26,10 @@
 
          current-syntax-context
          wrong-syntax
-         
+
+         internal-definition-context-apply
+         syntax-local-eval
+
          with-syntax*
          syntax-map)
 
@@ -182,6 +186,57 @@
                         extras)))
 ;; Eli: The `report-error-as' thing seems arbitrary to me.
 
+(define (internal-definition-context-apply intdefs stx)
+  (let ([qastx (local-expand #`(quote #,stx) 'expression (list #'quote) intdefs)])
+    (with-syntax ([(q astx) qastx]) #'astx)))
+
+(define (syntax-local-eval stx [intdef0 #f])
+  (let* ([name (generate-temporary)]
+         [intdefs (syntax-local-make-definition-context intdef0)])
+    (syntax-local-bind-syntaxes (list name)
+                                #`(call-with-values (lambda () #,stx) list)
+                                intdefs)
+    (internal-definition-context-seal intdefs)
+    (apply values
+           (syntax-local-value (internal-definition-context-apply intdefs name)
+                               #f intdefs))))
+
+(define-syntax (define/with-syntax stx)
+  (syntax-case stx ()
+    [(define/with-syntax pattern rhs)
+     (let* ([pvar-env (get-match-vars #'define/with-syntax
+                                      stx
+                                      #'pattern
+                                      '())]
+            [depthmap (for/list ([x pvar-env])
+                        (let loop ([x x] [d 0])
+                          (if (pair? x)
+                              (loop (car x) (add1 d))
+                              (cons x d))))]
+            [pvars (map car depthmap)]
+            [depths (map cdr depthmap)]
+            [mark (make-syntax-introducer)])
+       (with-syntax ([(pvar ...) pvars]
+                     [(depth ...) depths]
+                     [(valvar ...) (generate-temporaries pvars)])
+         #'(begin (define-values (valvar ...)
+                    (with-syntax ([pattern rhs])
+                      (values (pvar-value pvar) ...)))
+                  (define-syntax pvar
+                    (make-syntax-mapping 'depth (quote-syntax valvar)))
+                  ...)))]))
+
+;; auxiliary macro
+(define-syntax (pvar-value stx)
+  (syntax-case stx ()
+    [(_ pvar)
+     (identifier? #'pvar)
+     (let ([mapping (syntax-local-value #'pvar)])
+       (unless (syntax-pattern-variable? mapping)
+         (raise-syntax-error #f "not a pattern variable" #'pvar))
+       (syntax-mapping-valvar mapping))]))
+
+
 (define-syntax (with-syntax* stx)
   (syntax-case stx ()
     [(_ (cl) body ...) #'(with-syntax (cl) body ...)]
@@ -189,4 +244,4 @@
      #'(with-syntax (cl) (with-syntax* (cls ...) body ...))]))
 
 (define (syntax-map f . stxls)
-  (apply map f (map syntax->list stxls)))
\ No newline at end of file
+  (apply map f (map syntax->list stxls)))