Improved docs and error messages for define-metafunction/extension

svn: r17635

collects/redex/private/reduction-semantics.ss

@@ -1077,6 +1077,11 @@
            (raise-syntax-error syn-error-name "expected an identifier in the language position" orig-stx #'lang))
          (when (null? (syntax-e #'rest))
            (raise-syntax-error syn-error-name "no clauses" orig-stx))
+         (when prev-metafunction
+           (syntax-local-value 
+            prev-metafunction
+            (λ ()
+              (raise-syntax-error syn-error-name "expected a previously defined metafunction" orig-stx prev-metafunction))))
          (prune-syntax
           (let ([lang-nts (language-id-nts #'lang 'define-metafunction)])  ;; keep this near the beginning, so it signals the first error (PR 10062)
           (let-values ([(contract-name dom-ctcs codom-contract pats)
@@ -1114,6 +1119,8 @@
                                              (list name
                                                    (car names)))))
                                          (loop name (cdr names))]))])
+                  (when (and prev-metafunction (eq? (syntax-e #'name) (syntax-e prev-metafunction)))
+                    (raise-syntax-error syn-error-name "the extended and extending metafunctions cannot share a name" orig-stx prev-metafunction))
                   (parse-extras #'((stuff ...) ...))
                     (with-syntax ([(((cp-let-bindings ...) rhs/wheres) ...)
                                    (map (λ (sc/b rhs)

collects/redex/redex.scrbl

@@ -628,18 +628,17 @@ extended non-terminals. For example, this language:
 @schemeblock[
   (define-extended-language lc-num-lang
     lc-lang
-    (e ....     (code:comment "extend the previous `e' non-terminal")
+    (v ....     (code:comment "extend the previous `v' non-terminal")
-       +
-       number)
-    (v ....
        +
        number)
     (x (variable-except lambda +)))
 ]
 
-extends lc-lang with two new alternatives for both the @scheme[e]
+extends lc-lang with two new alternatives for the @scheme[v]
-and @scheme[v] nonterminal, replaces the @scheme[x] non-terminal with a
+non-terminal, carries forward the @scheme[e] and @scheme[c]
-new one, and carries the @scheme[c] non-terminal forward. 
+non-terminals, and replaces the @scheme[x] non-terminal with a
+new one (which happens to be equivalent to the one that would 
+have been inherited).
 
 The four-period ellipses indicates that the new language's
 non-terminal has all of the alternatives from the original
@@ -886,16 +885,16 @@ all non-GUI portions of Redex) and also exported by
 @schememodname[redex] (which includes all of Redex).
 
 @defform/subs[#:literals (: ->)
-              (define-metafunction language-exp
+             (define-metafunction language
                contract
                [(name @#,ttpattern ...) @#,tttterm extras ...] 
                ...)
-               ([contract (code:line) 
+             ([contract (code:line) 
-                          (code:line id : @#,ttpattern ... -> @#,ttpattern)]
+                        (code:line id : @#,ttpattern ... -> @#,ttpattern)]
-                [extras (side-condition scheme-expression)
+              [extras (side-condition scheme-expression)
-                        (where tl-pat @#,tttterm)]
+                      (where tl-pat @#,tttterm)]
-                [tl-pat identifier (tl-pat-ele ...)]
+              [tl-pat identifier (tl-pat-ele ...)]
-                [tl-pat-ele tl-pat (code:line tl-pat ... (code:comment "a literal ellipsis"))])]{
+              [tl-pat-ele tl-pat (code:line tl-pat ... (code:comment "a literal ellipsis"))])]{
 
 The @scheme[define-metafunction] form builds a function on
 sexpressions according to the pattern and right-hand-side
@@ -969,17 +968,32 @@ match.
 
 }
 
-@defform[(define-metafunction/extension extending-name language-exp 
+@defform[(define-metafunction/extension f language 
            contract
-           [(name @#,ttpattern ...) @#,tttterm (side-condition scheme-expression) ...]
+           [(g @#,ttpattern ...) @#,tttterm extras ...] 
            ...)]{
 
-This defines a metafunction as an extension of an existing
+Defines a metafunction @scheme[g] as an extension of an existing
-one. The extended metafunction behaves as if the original
+metafunction @scheme[f]. The metafunction @scheme[g] behaves as 
-patterns were in this definitions, with the name of the
+if @scheme[f]'s clauses were appended to its definition (with the
-function fixed up to be @scheme[extending-name]. 
+function position of the left-hand sides changed to from @scheme[f]
+to @scheme[g]).
 }
 
+For example, @scheme[define-metafunction/extension] may be used to extend
+the free-vars function above to the forms introduced by the language
+lc-num-lang.
+                
+@schemeblock[
+(define-metafunction/extension free-vars lc-num-lang
+  free-vars-num : e -> (x ...)
+  [(free-vars-num number) 
+   ()]
+  [(free-vars-num (+ e_1 e_2))
+   (∪ (free-vars-num e_1)
+      (free-vars-num e_2))])
+]
+                
 @defform[(in-domain? (metafunction-name @#,tttterm ...))]{
 Returns @scheme[#t] if the inputs specified to @scheme[metafunction-name] are
 legtimate inputs according to @scheme[metafunction-name]'s contract,
@@ -987,7 +1001,7 @@ and @scheme[#f] otherwise.
 }
 
 @defform/subs[#:literals ()
-              (define-relation language-exp
+              (define-relation language
                [(name @#,ttpattern ...) @#,tttterm ...] ...)
                ([tl-pat identifier (tl-pat-ele ...)]
                 [tl-pat-ele tl-pat (code:line tl-pat ... (code:comment "a literal ellipsis"))])]{