fixed a bug with holes used in certain places in patterns

svn: r14684

collects/redex/private/core-layout.ss

@@ -75,16 +75,6 @@
                               (equal? (lw-e thing-in-hole) 'hole))
                          (list (blank) context (blank))
                          (list (blank) context "" "[" thing-in-hole "]")))))
-       (in-named-hole ,(λ (args)
-                         (let ([name (lw-e (list-ref args 2))]
-                               [context (list-ref args 3)]
-                               [thing-in-hole (list-ref args 4)])
-                           (if (and (lw? thing-in-hole)
-                                    (equal? (lw-e thing-in-hole) 'hole))
-                               (list (blank) context "[]" 
-                                     (basic-text (format "~a" name) (non-terminal-subscript-style)))
-                               (list (blank) context "" "[" thing-in-hole "]" 
-                                     (basic-text (format "~a" name) (non-terminal-subscript-style)))))))
        (hide-hole ,(λ (args)
                      (list (blank)
                            (list-ref args 2)

collects/redex/private/reduction-semantics.ss

@@ -1008,8 +1008,8 @@
                    (with-syntax ([(side-conditions-rewritten ...) 
                                   (map (λ (x) (rewrite-side-conditions/check-errs
                                                lang-nts
-                                               #t
                                                'define-metafunction
+                                               #t
                                                x))
                                        (syntax->list (syntax ((side-condition lhs (and tl-side-conds ...)) ...))))]
                                  [dom-side-conditions-rewritten
@@ -1398,7 +1398,7 @@
          (for-each 
           (λ (name) 
             (let ([x (syntax->datum name)])
-              (when (memq x '(any number string variable natural integer real variable-except variable-prefix hole name in-hole in-named-hole hide-hole side-condition cross ...))
+              (when (memq x '(any number string variable natural integer real variable-except variable-prefix hole name in-hole hide-hole side-condition cross ...))
                 (raise-syntax-error 'language 
                                     (format "cannot use pattern language keyword ~a as non-terminal"
                                             x)

collects/redex/private/rewrite-side-conditions.ss

@@ -33,7 +33,7 @@
     (define (expected-arguments name stx)
       (raise-syntax-error what (format "~a expected to have arguments" name) orig-stx stx))
     (let loop ([term orig-stx])
-      (syntax-case term (side-condition variable-except variable-prefix hole name in-hole in-named-hole hide-hole side-condition cross)
+      (syntax-case term (side-condition variable-except variable-prefix hole name in-hole hide-hole side-condition cross)
         [(side-condition pre-pat (and))
          ;; rewriting metafunctions (and possibly other things) that have no where, etc clauses
          ;; end up with side-conditions that are empty 'and' expressions, so we just toss them here.
@@ -58,20 +58,15 @@
         [(variable-prefix a ...) (expected-exact 'variable-prefix 1 term)]
         [variable-prefix (expected-arguments 'variable-prefix term)]
         [hole term]
-        [(hole a) #`(hole #,(loop #'a))]
-        [(hole a ...) (raise-syntax-error what "hole expected to stand alone or to have one argument")]
         [(name x y) #`(name #,(loop #'x) #,(loop #'y))]
         [(name x ...) (expected-exact 'name 2 term)]
         [name (expected-arguments 'name term)]
         [(in-hole a b) #`(in-hole #,(loop #'a) #,(loop #'b))]
         [(in-hole a ...) (expected-exact 'in-hole 2 term)]
         [in-hole (expected-arguments 'in-hole term)]
-        [(in-named-hole a b c) #`(in-named-hole #,(loop #'a) #,(loop #'b) #,(loop #'c))]
-        [(in-named-hole a ...) (expected-exact 'in-named-hole 3 term)]
-        [in-named-hole (expected-arguments 'in-named-hole term)]
         [(hide-hole a) #`(hide-hole #,(loop #'a))]
-        [(in-named-hole a ...) (expected-exact 'hide-hole 1 term)]
+        [(hide-hole a ...) (expected-exact 'hide-hole 1 term)]
-        [in-named-hole (expected-arguments 'hide-hole term)]
+        [hide-hole (expected-arguments 'hide-hole term)]
         [(cross a) #`(cross #,(loop #'a))]
         [(cross a ...) (expected-exact 'cross 1 term)]
         [cross (expected-arguments 'cross term)]
@@ -96,17 +91,12 @@
             (let loop ([stx orig-stx]
                        [names null]
                        [depth 0])
-              (syntax-case stx (name in-hole in-named-hole side-condition)
+              (syntax-case stx (name in-hole side-condition)
                 [(name sym pat)
                  (identifier? (syntax sym))
                  (loop (syntax pat) 
                        (cons (make-id/depth (syntax sym) depth) names)
                        depth)]
-                [(in-named-hole hlnm sym pat1 pat2)
-                 (identifier? (syntax sym))
-                 (loop (syntax pat1)
-                       (loop (syntax pat2) names depth)
-                       depth)]
                 [(in-hole pat1 pat2)
                  (loop (syntax pat1)
                        (loop (syntax pat2) names depth)

collects/redex/private/term.ss

@@ -34,7 +34,7 @@
   (define (rewrite/has-term-let-bound-id? stx)
     (let loop ([stx stx]
                [depth 0])
-      (syntax-case stx (unquote unquote-splicing in-hole in-named-hole hole)
+      (syntax-case stx (unquote unquote-splicing in-hole hole)
         [(metafunc-name arg ...)
          (and (identifier? (syntax metafunc-name))
               (term-fn? (syntax-local-value (syntax metafunc-name) (λ () #f))))

collects/redex/private/tl-test.ss

@@ -546,6 +546,20 @@
     (test (term (f ((((x))))))
           (term x)))
   
+  (let ()
+    (define-language lamv
+      (z variable hole))
+
+    (define-metafunction lamv
+      foo : z  -> any
+      [(foo hole) dontcare]
+      [(foo variable) docare])
+
+    (test (term (foo hole))
+          (term dontcare))
+    (test (term (foo y))
+          (term docare)))
+  
   ;; test that tracing works properly
   ;; note that caching comes into play here (which is why we don't see the recursive calls)
   (let ()