redex: fix for render-language with extend-language-show-union as #t

Merging base languages didn't add non-terminals that are included only
in the extension.

Also, add `extend-language-show-extended-order` for showing productions in
the order of an extended language instead of the original language.

pkgs/redex-pkgs/redex-doc/redex/scribblings/ref.scrbl

@@ -3041,7 +3041,8 @@ This function sets @racket[dc-for-text-size]. See also
 
 @defparam[extend-language-show-union show? boolean?]{
 
-If this is @racket[#t], then a language constructed with
+A parameter that controls the rendering of extended languages.
+If the parameter value is @racket[#t], then a language constructed with
 extend-language is shown as if the language had been
 constructed directly with @racket[language]. If it is @racket[#f], then only
 the last extension to the language is shown (with
@@ -3054,6 +3055,18 @@ Note that the @racket[#t] variant can look a little bit strange if
 multi-line right-hand sides.
 }
 
+@defparam[extend-language-show-extended-order ext-order? boolean?]{
+
+A parameter that controls the rendering of extended languages when
+@racket[extend-language-show-union] has a true value.  If this
+parameter's value is @racket[#t], then productions are shown as
+ordered in the language extension instead of the order of the
+original, unextended language.
+
+Defaults to @racket[#f].
+
+@history[#:added "1.2"]}
+
 @defparam[render-reduction-relation-rules 
           rules 
           (or/c false/c 

pkgs/redex-pkgs/redex-lib/info.rkt

@@ -18,4 +18,4 @@
 
 (define pkg-authors '(robby bfetscher))
 
-(define version "1.1")
+(define version "1.2")

pkgs/redex-pkgs/redex-pict-lib/redex/pict.rkt

@@ -61,6 +61,7 @@
 (provide/contract
  [render-language-nts (parameter/c (or/c false/c (listof (or/c string? symbol?))))]
  [extend-language-show-union (parameter/c boolean?)]
+ [extend-language-show-extended-order (parameter/c boolean?)]
  [current-text (parameter/c (-> string? text-style/c number? pict?))])
 
 (provide/contract

pkgs/redex-pkgs/redex-pict-lib/redex/private/pict.rkt

@@ -80,6 +80,7 @@
          judgment-form-cases
          compact-vertical-min-width
          extend-language-show-union
+         extend-language-show-extended-order
          set-arrow-pict!
          arrow->pict
          horizontal-bar-spacing
@@ -573,7 +574,7 @@
 ;; raw-info : language-pict-info
 ;; nts : (listof symbol) -- the nts that the user expects to see
 (define (make-grammar-pict raw-info nts all-nts)
-  (let* ([info (remove-unwanted-nts nts (flatten-grammar-info raw-info all-nts))]
+  (let* ([info (remove-unwanted-nts nts (flatten-grammar-info raw-info all-nts nts))]
          [term-space 
           (launder
            (ghost
@@ -604,6 +605,7 @@
 
 
 (define extend-language-show-union (make-parameter #f))
+(define extend-language-show-extended-order (make-parameter #f))
 
 ;; remove-unwanted-nts : (listof symbol) flattened-language-pict-info -> flattened-language-pict-info
 (define (remove-unwanted-nts nts info)
@@ -615,18 +617,10 @@
 
 
 ;; flatten-grammar-info : language-pict-info (listof symbol) -> flattened-language-pict-info
-(define (flatten-grammar-info info all-nts)
+(define (flatten-grammar-info info all-nts wanted-nts)
-  (let ([union? (extend-language-show-union)])
+  (define (merge-line nt extension orig-line)
-    (let loop ([info info])
     (cond
-        [(vector? info) 
+     [(and extension orig-line)
-         (let ([orig (loop (vector-ref info 0))]
-               [extensions (vector-ref info 1)])
-           (if union?
-               (map (λ (orig-line)
-                      (let* ([nt (car orig-line)]
-                             [extension (assoc nt extensions)])
-                        (if extension
       (let ([rhss (cdr extension)])
         (cons nt
               (map (λ (x)
@@ -638,9 +632,38 @@
                                                  (find-enclosing-loc-wrapper
                                                   (add-bars (cdr orig-line))))])
                          x))
-                                         (cdr extension))))
+                   (cdr extension))))]
-                            orig-line)))
+     [extension extension]
+     [else orig-line]))
+  (let ([union? (extend-language-show-union)]
+        [ext-order? (extend-language-show-extended-order)])
+    (let loop ([info info])
+      (cond
+        [(vector? info) 
+         (let ([orig (loop (vector-ref info 0))]
+               [extensions (vector-ref info 1)])
+           (if union?
+               (cond
+                [(not ext-order?)
+                 ;; Use original order, adding extra extensions after:
+                 (define orig-nts (list->set (map car orig)))
+                 (append
+                  (map (λ (orig-line)
+                         (define nt (car orig-line))
+                         (merge-line nt (assoc nt extensions) orig-line))
                        orig)
+                  (filter (lambda (extension) (not (set-member? orig-nts (car extension))))
+                          extensions))]
+                [else
+                 ;; Use extension order, adding any extra originals after:
+                 (define ext-nts (list->set (map car extensions)))
+                 (append
+                  (map (λ (extension)
+                         (define nt (car extension))
+                         (merge-line nt extension (assoc nt orig)))
+                       extensions)
+                  (filter (lambda (orig-line) (not (set-member? ext-nts (car orig-line))))
+                          orig))])
                extensions))]
         [else info]))))