Reformatted actions to merge procedures from multiple expansions of a nonterminal. Removed U_equiv form of functions.

git-svn-id: svn://10.0.0.236/trunk@104550 18797224-902f-48f8-a5cc-f745e15eee43

mozilla/js2/semantics/Calculus.lisp

@@ -27,7 +27,7 @@
 (defvar *trace-variables* nil)
 
 
-#+mcl (dolist (indent-spec '((? . 1) (apply . 1) (funcall . 1) (production . 3) (rule . 2) (function . 2)
+#+mcl (dolist (indent-spec '((? . 1) (apply . 1) (funcall . 1) (declare-action . 5) (production . 3) (rule . 2) (function . 2)
                              (deftag . 1) (defrecord . 1) (deftype . 1) (tag . 1) (%text . 1)
                              (var . 2) (const . 2) (rwhen . 1) (while . 1) (:narrow . 1) (:select . 1)
                              (let-local-var . 2)))
@@ -839,7 +839,7 @@
 ;;;   :action        list of (grammar-info . grammar-symbol) that declare this action if this identifier is an action name
 ;;;
 ;;;   :depict-command           depictor function ((markup-stream world depict-env . form-arg-list) -> void)
-;;;   :depict-statement         depictor function ((markup-stream world . form-annotated-arg-list) -> void)
+;;;   :depict-statement         depictor function ((markup-stream world semicolon last-paragraph-style . form-annotated-arg-list) -> void)
 ;;;   :depict-special-form      depictor function ((markup-stream world level . form-annotated-arg-list) -> void)
 ;;;   :depict-type-constructor  depictor function ((markup-stream world level . form-arg-list) -> void)
 ;;;
@@ -4209,22 +4209,38 @@
       (error "Grammar needed"))))
 
 
-; (declare-action <action-name> <general-grammar-symbol> <type> <n-productions>)
-(defun scan-declare-action (world grammar-info-var action-name general-grammar-symbol-source type-expr n-productions)
-  (declare (ignore n-productions))
+; (declare-action <action-name> <general-grammar-symbol> <type> <mode> <parameter-list> <command> ... <command>)
+; <mode> is one of:
+;    :hide      Don't depict this action declaration because it's for a hidden production
+;    :singleton Don't depict this action declaration because it contains a singleton production
+;    :action    Depict this action declaration; all corresponding actions will be depicted by depict-action;
+;    :actfun    Depict this action declaration; all corresponding actions will be depicted by depict-actfun;
+; <parameter-list> contains the names of the action parameters when <mode> is :actfun.
+(defun scan-declare-action (world grammar-info-var action-name general-grammar-symbol-source type-expr mode parameter-list &rest commands)
+  (declare (ignore parameter-list))
+  (unless (member mode '(:hide :singleton :action :actfun))
+    (error "Bad declare-action mode ~S" mode))
   (let* ((grammar (checked-grammar grammar-info-var))
          (action-symbol (scan-name world action-name))
          (general-grammar-symbol (grammar-parametrization-intern grammar general-grammar-symbol-source)))
     (declare-action grammar general-grammar-symbol action-symbol type-expr)
     (dolist (grammar-symbol (general-grammar-symbol-instances grammar general-grammar-symbol))
       (push (cons (car grammar-info-var) grammar-symbol) (symbol-action action-symbol)))
-    (export-symbol action-symbol)))
+    (export-symbol action-symbol))
+  (scan-commands world grammar-info-var commands))
 
 
-; (action <action-name> <production-name> <type> <n-productions> <value>)
-; (actfun <action-name> <production-name> <type> <n-productions> <value>)
-(defun scan-action (world grammar-info-var action-name production-name type-expr n-productions value-expr)
-  (declare (ignore n-productions))
+; (action <action-name> <production-name> <type> <mode> <value>)
+; (actfun <action-name> <production-name> <type> <mode> <value>)
+; <mode> is one of:
+;    :hide      Don't depict this action;
+;    :singleton Depict this action along with its declaration;
+;    :first     Depict this action, which is the first in the rule
+;    :middle    Depict this action, which is neither the first nor the last in the rule
+;    :last      Depict this action, which is the last in the rule
+(defun scan-action (world grammar-info-var action-name production-name type-expr mode value-expr)
+  (unless (member mode '(:hide :singleton :first :middle :last))
+    (error "Bad action mode ~S" mode))
   (let ((grammar (checked-grammar grammar-info-var))
         (action-symbol (world-intern world action-name)))
     (define-action grammar production-name action-symbol type-expr value-expr)))
@@ -4243,6 +4259,7 @@
 (defparameter *default-specials*
   '((:preprocess
      (? preprocess-?)
+     (declare-action preprocess-declare-action)
      (define preprocess-define)
      (action preprocess-action)
      (grammar preprocess-grammar)
@@ -4920,6 +4937,17 @@
          nil)))))
 
 
+; (declare-action <action-name> <general-grammar-symbol> <type> <mode> <parameter-list> <command> ... <command>)
+;   ==>
+; (declare-action <action-name> <general-grammar-symbol> <type> <mode> <parameter-list> <command> ... <command>)
+(defun preprocess-declare-action (preprocessor-state command action-name general-grammar-symbol-source type-expr mode parameter-list &rest commands)
+  (declare (ignore command))
+  (values
+   (list (list* 'declare-action action-name general-grammar-symbol-source type-expr mode parameter-list
+                (preprocess-list preprocessor-state commands)))
+   nil))
+
+
 ; commands is a list of commands and/or (? <conditional> ...), where the ... is a list of commands.
 ; Call f on each non-deleted command, passing it that command and the current value of highlight.
 ; f returns a list of preprocessed commands; return the destructive concatenation of these lists.
@@ -4932,7 +4960,7 @@
            (let* ((commands (cddr command))
                   (new-highlight (resolve-conditional (preprocessor-state-world preprocessor-state) (second command))))
              (cond
-              ((eq new-highlight 'delete))
+              ((eq new-highlight 'delete) nil)
               ((eq new-highlight highlight) (each-preprocessed-command f preprocessor-state commands new-highlight))
               (t (list (list* '? (second command) (each-preprocessed-command f preprocessor-state commands new-highlight)))))))
          (funcall f command highlight)))
@@ -4961,15 +4989,15 @@
    nil))
 
 
-; (action <action-name> <production-name> <type> <n-productions> <value>)
+; (action <action-name> <production-name> <type> <mode> <value>)
 ;   ==>
-; (action <action-name> <production-name> <type> <n-productions> <value>)
+; (action <action-name> <production-name> <type> <mode> <value>)
 ;
-; (action (<action-name> (<arg1>) ... (<argn>)) <production-name> (-> (<type1> ... <typen>) <result-type>) <n-productions> . <statements>)
+; (action (<action-name> (<arg1>) ... (<argn>)) <production-name> (-> (<type1> ... <typen>) <result-type>) <mode> . <statements>)
 ;   ==>
-; (actfun <action-name> <production-name> (-> (<type1> ... <typen>) <result-type>) <n-productions>
+; (actfun <action-name> <production-name> (-> (<type1> ... <typen>) <result-type>) <mode>
 ;    (lambda ((<arg1> <type1>) ... (<argn> <typen>)) <result-type> . <statements>))
-(defun preprocess-action (preprocessor-state command action-name production-name type n-productions &rest value-or-statements)
+(defun preprocess-action (preprocessor-state command action-name production-name type mode &rest value-or-statements)
   (declare (ignore command preprocessor-state))
   (values
    (list
@@ -4988,8 +5016,8 @@
                                         (list binding type)))
                                   abbreviated-bindings
                                   ->-parameters)))
-            (list 'actfun action-name production-name type n-productions (list* 'lambda bindings ->-result value-or-statements)))))
-      (list* 'action action-name production-name type n-productions value-or-statements)))
+            (list 'actfun action-name production-name type mode (list* 'lambda bindings ->-result value-or-statements)))))
+      (list* 'action action-name production-name type mode value-or-statements)))
    nil))
 
 
@@ -5068,27 +5096,19 @@
           nil))
 
 
-; (production <lhs> <rhs> <name> (<action-spec-1> <type-1> . <body-1>) ... (<action-spec-n> <type-n> . <body-n>))
+; (production <lhs> <rhs> <name>)
 ;   ==>
 ; grammar:
 ;   (<lhs> <rhs> <name> <current-highlight>)
 ; commands:
 ;   (%rule <lhs>)
-;   (action <action-spec-1> <name> <type-1> 1 . <body-1>)
-;   ...
-;   (action <action-spec-n> <name> <type-n> 1 . <body-n>)
-(defun preprocess-production (preprocessor-state command lhs rhs name &rest actions)
+(defun preprocess-production (preprocessor-state command lhs rhs name)
   (declare (ignore command))
-  (assert-type actions (list (cons t (cons t t))))
   (preprocess-ensure-grammar preprocessor-state)
   (push (list lhs rhs name (preprocessor-state-highlight preprocessor-state))
         (preprocessor-state-grammar-source-reverse preprocessor-state))
-  (values
-   (cons (list '%rule lhs)
-         (mapcar #'(lambda (action)
-                     (list* 'action (first action) name (second action) 1 (cddr action)))
-                 actions))
-   t))
+  (values (list (list '%rule lhs))
+          t))
 
 
 ; (rule <general-grammar-symbol>
@@ -5105,15 +5125,15 @@
 ;   (%rule <lhs-1>)
 ;   ...
 ;   (%rule <lhs-m>)
-;   (declare-action <action-name-1> <general-grammar-symbol> <type-1> <n-productions>)
-;      (action <action-spec-1-1> <name-1> <type-1> <n-productions> . <body-1-1>)
+;   (declare-action <action-name-1> <general-grammar-symbol> <type-1> <mode> <parameter-list>)
+;      (action <action-spec-1-1> <name-1> <type-1> <mode> . <body-1-1>)
 ;      ...
-;      (action <action-spec-m-1> <name-m> <type-1> <n-productions> . <body-m-1>)
+;      (action <action-spec-m-1> <name-m> <type-1> <mode> . <body-m-1>)
 ;   ...
-;   (declare-action <action-name-n> <general-grammar-symbol> <type-n> <n-productions>)
-;      (action <action-spec-1-n> <name-1> <type-n> <n-productions> . <body-1-n>)
+;   (declare-action <action-name-n> <general-grammar-symbol> <type-n> <mode> <parameter-list>)
+;      (action <action-spec-1-n> <name-1> <type-n> <mode> . <body-1-n>)
 ;      ...
-;      (action <action-spec-m-n> <name-m> <type-n> <n-productions> . <body-m-n>)
+;      (action <action-spec-m-n> <name-m> <type-n> <mode> . <body-m-n>)
 ;
 ; The productions may be enclosed by (? <conditional> ...) preprocessor actions.
 (defun preprocess-rule (preprocessor-state command general-grammar-symbol action-declarations &rest productions)
@@ -5121,16 +5141,26 @@
   (assert-type action-declarations (list (tuple symbol t)))
   (preprocess-ensure-grammar preprocessor-state)
   (labels
-    ((actions-match (action-declarations actions)
-       (or (and (endp action-declarations) (endp actions))
+    ((actions-match (action-declarations parameter-lists actions)
+       (or (and (endp action-declarations) (endp parameter-lists) (endp actions))
            (let ((declared-action-name (caar action-declarations))
-                 (action-name (caar actions)))
+                 (action-name (caar actions))
+                 (parameter-list :value))
              (when (consp action-name)
+               (setq parameter-list (mapcar #'(lambda (arg)
+                                                (if (consp arg)
+                                                  (first arg)
+                                                  arg))
+                                            (rest action-name)))
                (setq action-name (first action-name)))
+             (when (eq (first parameter-lists) t)
+               (setf (first parameter-lists) parameter-list))
              (and (eq declared-action-name action-name)
-                  (actions-match (rest action-declarations) (rest actions)))))))
+                  (equal (first parameter-lists) parameter-list)
+                  (actions-match (rest action-declarations) (rest parameter-lists) (rest actions)))))))
     
     (let* ((n-productions 0)
+           (parameter-lists (make-list (length action-declarations) :initial-element t))
            (commands-reverse
             (nreverse
              (each-preprocessed-command
@@ -5140,29 +5170,43 @@
                         (rhs (third production))
                         (name (assert-type (fourth production) symbol))
                         (actions (assert-type (cddddr production) (list (cons t t)))))
-                    (unless (actions-match action-declarations actions)
-                      (error "Action name mismatch: ~S vs. ~S" action-declarations actions))
+                    (unless (actions-match action-declarations parameter-lists actions)
+                      (error "Action name or parameter list mismatch: ~S vs. ~S" action-declarations actions))
                     (push (list lhs rhs name highlight) (preprocessor-state-grammar-source-reverse preprocessor-state))
                     (incf n-productions)
                     (list (list '%rule lhs))))
               preprocessor-state
               productions
               (preprocessor-state-highlight preprocessor-state)))))
+      (when (= n-productions 0)
+        (error "Empty rule"))
       (dotimes (i (length action-declarations))
-        (let ((action-declaration (nth i action-declarations)))
-          (push (list 'declare-action (first action-declaration) general-grammar-symbol (second action-declaration) n-productions) commands-reverse)
-          (setq commands-reverse
-                (nreconc
+        (let* ((action-declaration (pop action-declarations))
+               (parameter-list (pop parameter-lists))
+               (declare-mode (cond
+                              ((= n-productions 1) :singleton)
+                              ((eq parameter-list :value) :action)
+                              (t (assert-true (listp parameter-list)) :actfun)))
+               (j 0))
+          (push (list*
+                 'declare-action (first action-declaration) general-grammar-symbol (second action-declaration) declare-mode parameter-list
                  (each-preprocessed-command
                   #'(lambda (production highlight)
                       (declare (ignore highlight))
                       (let ((name (fourth production))
-                            (action (nth (+ i 4) production)))
-                        (list (list* 'action (first action) name (second action-declaration) n-productions (rest action)))))
+                            (action (nth (+ i 4) production))
+                            (mode (cond
+                                   ((= n-productions 1) :singleton)
+                                   ((= j 0) :first)
+                                   ((= j (1- n-productions)) :last)
+                                   (t :middle))))
+                        (incf j)
+                        (list (list* 'action (first action) name (second action-declaration) mode (rest action)))))
                   preprocessor-state
                   productions
-                  (preprocessor-state-highlight preprocessor-state))
-                 commands-reverse))))
+                  (preprocessor-state-highlight preprocessor-state)))
+                commands-reverse)
+          (assert-true (= j n-productions))))
       (values (nreverse commands-reverse) t))))
 
 

mozilla/js2/semantics/CalculusMarkup.lisp

@@ -25,6 +25,7 @@
 
 
 (defvar *hide-$-nonterminals* t) ; Should rules and actions expanding nonterminals starting with $ be invisible?
+(defvar *depict-trivial-functions-as-expressions* nil)
 
 (defvar *styled-text-world*)
 
@@ -914,15 +915,15 @@
      ,@body))
 
 
-(defmacro depict-statement-block-last (markup-stream &body body)
-  `(depict-division-block (,markup-stream :statement-last '(:statement :statement-last) '(:level))
+(defmacro depict-statement-block-using ((markup-stream paragraph-style) &body body)
+  `(depict-division-block (,markup-stream ,paragraph-style (list :statement ,paragraph-style) '(:level))
      ,@body))
 
 
 ; Emit markup for the annotated statement.  The markup stream should be collecting divisions.
 ; If semicolon is true, depict a semicolon after the statement.
-(defun depict-statement (markup-stream world semicolon annotated-stmt)
-  (apply (get (first annotated-stmt) :depict-statement) markup-stream world semicolon (rest annotated-stmt)))
+(defun depict-statement (markup-stream world semicolon last-paragraph-style annotated-stmt)
+  (apply (get (first annotated-stmt) :depict-statement) markup-stream world semicolon last-paragraph-style (rest annotated-stmt)))
 
 
 ; If semicolon is true, depict a semicolon.
@@ -934,11 +935,15 @@
 ; Emit markup for the block of annotated statements indented by one level.  The markup stream
 ; should be collecting divisions.
 ; If semicolon is true, depict a semicolon after the statements.
-(defun depict-statements (markup-stream world semicolon annotated-stmts)
+(defun depict-statements (markup-stream world semicolon last-paragraph-style annotated-stmts)
   (depict-division-style (markup-stream :level)
     (if annotated-stmts
       (mapl #'(lambda (annotated-stmts)
-                (depict-statement markup-stream world (or (rest annotated-stmts) semicolon) (first annotated-stmts)))
+                (depict-statement markup-stream
+                                  world
+                                  (or (rest annotated-stmts) semicolon)
+                                  (if (rest annotated-stmts) :statement last-paragraph-style)
+                                  (first annotated-stmts)))
             annotated-stmts)
       (depict-paragraph (markup-stream :statement)
         (depict-semantic-keyword markup-stream 'nothing nil)
@@ -946,16 +951,16 @@
 
 
 ; (exec <expr>)
-(defun depict-exec (markup-stream world semicolon annotated-expr)
-  (depict-paragraph (markup-stream :statement)
+(defun depict-exec (markup-stream world semicolon last-paragraph-style annotated-expr)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-expression markup-stream world annotated-expr %expr%)
     (depict-semicolon markup-stream semicolon)))
 
 
 ; (const <name> <type> <value>)
 ; (var <name> <type> <value>)
-(defun depict-var (markup-stream world semicolon name type-expr value-annotated-expr)
-  (depict-paragraph (markup-stream :statement)
+(defun depict-var (markup-stream world semicolon last-paragraph-style name type-expr value-annotated-expr)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-local-variable markup-stream name)
     (depict markup-stream ": ")
     (depict-type-expr markup-stream world type-expr)
@@ -967,18 +972,18 @@
 
 
 ; (function (<name> (<var1> <type1> [:unused]) ... (<varn> <typen> [:unused])) <result-type> . <statements>)
-(defun depict-function (markup-stream world semicolon name-and-arg-binding-exprs result-type-expr &rest body-annotated-stmts)
-  (depict-statement-block markup-stream
+(defun depict-function (markup-stream world semicolon last-paragraph-style name-and-arg-binding-exprs result-type-expr &rest body-annotated-stmts)
+  (depict-statement-block-using (markup-stream last-paragraph-style)
     (depict-paragraph (markup-stream :statement)
       (depict-semantic-keyword markup-stream 'proc :after)
       (depict-local-variable markup-stream (first name-and-arg-binding-exprs))
       (depict-function-signature markup-stream world (rest name-and-arg-binding-exprs) result-type-expr t))
-    (depict-function-body markup-stream world semicolon :statement body-annotated-stmts)))
+    (depict-function-body markup-stream world semicolon last-paragraph-style body-annotated-stmts)))
 
 
 ; (<- <name> <value>)
-(defun depict-<- (markup-stream world semicolon name value-annotated-expr)
-  (depict-paragraph (markup-stream :statement)
+(defun depict-<- (markup-stream world semicolon last-paragraph-style name value-annotated-expr)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-local-variable markup-stream name)
     (depict markup-stream " " :assign-10)
     (depict-logical-block (markup-stream 6)
@@ -988,8 +993,8 @@
 
 
 ; (&= <record-expr> <value-expr>)
-(defun depict-&= (markup-stream world semicolon record-type label record-annotated-expr value-annotated-expr)
-  (depict-paragraph (markup-stream :statement)
+(defun depict-&= (markup-stream world semicolon last-paragraph-style record-type label record-annotated-expr value-annotated-expr)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-& markup-stream world %unary% record-type label record-annotated-expr)
     (depict markup-stream " " :assign-10)
     (depict-logical-block (markup-stream 6)
@@ -999,8 +1004,8 @@
 
 
 ; (return [<value-expr>])
-(defun depict-return (markup-stream world semicolon value-annotated-expr)
-  (depict-paragraph (markup-stream :statement)
+(defun depict-return (markup-stream world semicolon last-paragraph-style value-annotated-expr)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-logical-block (markup-stream 4)
       (depict-semantic-keyword markup-stream 'return nil)
       (when value-annotated-expr
@@ -1010,9 +1015,9 @@
 
 
 ; (cond (<condition-expr> . <statements>) ... (<condition-expr> . <statements>) [(nil . <statements>)])
-(defun depict-cond (markup-stream world semicolon &rest annotated-cases)
+(defun depict-cond (markup-stream world semicolon last-paragraph-style &rest annotated-cases)
   (assert-true (and annotated-cases (caar annotated-cases)))
-  (depict-statement-block markup-stream
+  (depict-statement-block-using (markup-stream last-paragraph-style)
     (do ((annotated-cases annotated-cases (rest annotated-cases))
          (else nil t))
         ((endp annotated-cases))
@@ -1027,32 +1032,32 @@
                     (depict-expression markup-stream world condition-annotated-expr %expr%))
                   (depict-semantic-keyword markup-stream 'then :before))
                 (depict-semantic-keyword markup-stream 'else nil))))
-          (depict-statements markup-stream world nil (rest annotated-case)))))
-    (depict-paragraph (markup-stream :statement)
+          (depict-statements markup-stream world nil :statement (rest annotated-case)))))
+    (depict-paragraph (markup-stream last-paragraph-style)
       (depict-semantic-keyword markup-stream 'end :after)
       (depict-semantic-keyword markup-stream 'if nil)
       (depict-semicolon markup-stream semicolon))))
 
 
 ; (while <condition-expr> . <statements>)
-(defun depict-while (markup-stream world semicolon condition-annotated-expr &rest loop-annotated-stmts)
-  (depict-statement-block markup-stream
+(defun depict-while (markup-stream world semicolon last-paragraph-style condition-annotated-expr &rest loop-annotated-stmts)
+  (depict-statement-block-using (markup-stream last-paragraph-style)
     (depict-statement-block markup-stream
       (depict-paragraph (markup-stream :statement)
         (depict-semantic-keyword markup-stream 'while :after)
         (depict-logical-block (markup-stream 4)
           (depict-expression markup-stream world condition-annotated-expr %expr%))
         (depict-semantic-keyword markup-stream 'do :before))
-      (depict-statements markup-stream world nil loop-annotated-stmts))
-    (depict-paragraph (markup-stream :statement)
+      (depict-statements markup-stream world nil :statement loop-annotated-stmts))
+    (depict-paragraph (markup-stream last-paragraph-style)
       (depict-semantic-keyword markup-stream 'end :after)
       (depict-semantic-keyword markup-stream 'while nil)
       (depict-semicolon markup-stream semicolon))))
 
 
 ; (assert <condition-expr>)
-(defun depict-assert (markup-stream world semicolon condition-annotated-expr)
-  (depict-paragraph (markup-stream :statement)
+(defun depict-assert (markup-stream world semicolon last-paragraph-style condition-annotated-expr)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-logical-block (markup-stream 4)
       (depict-semantic-keyword markup-stream 'invariant :after)
       (depict-expression markup-stream world condition-annotated-expr %expr%)
@@ -1060,8 +1065,8 @@
 
 
 ; (throw <value-expr>)
-(defun depict-throw (markup-stream world semicolon value-annotated-expr)
-  (depict-paragraph (markup-stream :statement)
+(defun depict-throw (markup-stream world semicolon last-paragraph-style value-annotated-expr)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-logical-block (markup-stream 4)
       (depict-semantic-keyword markup-stream 'throw :after)
       (depict-expression markup-stream world value-annotated-expr %expr%)
@@ -1069,11 +1074,11 @@
 
 
 ; (catch <body-statements> (<var> [:unused]) . <handler-statements>)
-(defun depict-catch (markup-stream world semicolon body-annotated-stmts arg-binding-expr &rest handler-annotated-stmts)
+(defun depict-catch (markup-stream world semicolon last-paragraph-style body-annotated-stmts arg-binding-expr &rest handler-annotated-stmts)
   (depict-statement-block markup-stream
     (depict-paragraph (markup-stream :statement)
       (depict-semantic-keyword markup-stream 'try nil))
-    (depict-statements markup-stream world nil body-annotated-stmts))
+    (depict-statements markup-stream world nil :statement body-annotated-stmts))
   (depict-division-break markup-stream)
   (depict-statement-block markup-stream
     (depict-paragraph (markup-stream :statement)
@@ -1083,8 +1088,8 @@
         (depict markup-stream ": ")
         (depict-type-expr markup-stream world *semantic-exception-type-name*))
       (depict-semantic-keyword markup-stream 'do :before))
-    (depict-statements markup-stream world nil handler-annotated-stmts))
-  (depict-paragraph (markup-stream :statement)
+    (depict-statements markup-stream world nil :statement handler-annotated-stmts))
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-semantic-keyword markup-stream 'end :after)
     (depict-semantic-keyword markup-stream 'try nil)
     (depict-semicolon markup-stream semicolon)))
@@ -1095,7 +1100,7 @@
 ;    :select    No special action
 ;    :narrow    Narrow the type of <value-expr>, which must be a variable, to this case's <type>
 ;    :otherwise Catch-all else case; <type> should be either nil or the remaining catch-all type
-(defun depict-case (markup-stream world semicolon value-annotated-expr &rest annotated-cases)
+(defun depict-case (markup-stream world semicolon last-paragraph-style value-annotated-expr &rest annotated-cases)
   (depict-paragraph (markup-stream :statement)
     (depict-semantic-keyword markup-stream 'case :after)
     (depict-logical-block (markup-stream 8)
@@ -1112,9 +1117,9 @@
                         ((:select :narrow) (depict-type-expr markup-stream world (second annotated-case)))
                         ((:otherwise) (depict-semantic-keyword markup-stream 'else nil)))
                       (depict-semantic-keyword markup-stream 'do :before)))
-                  (depict-statements markup-stream world (cdr annotated-cases) (cddr annotated-case)))))
+                  (depict-statements markup-stream world (cdr annotated-cases) :statement (cddr annotated-case)))))
           annotated-cases))
-  (depict-paragraph (markup-stream :statement)
+  (depict-paragraph (markup-stream last-paragraph-style)
     (depict-semantic-keyword markup-stream 'end :after)
     (depict-semantic-keyword markup-stream 'case nil)
     (depict-semicolon markup-stream semicolon)))
@@ -1158,7 +1163,8 @@
 
 ; Return true if the function body given by body-annotated-stmts is a single return statement.
 (defun function-body-is-expression? (world body-annotated-stmts)
-  (and body-annotated-stmts
+  (and *depict-trivial-functions-as-expressions*
+       body-annotated-stmts
        (endp (cdr body-annotated-stmts))
        (special-form-annotated-stmt? world 'return (first body-annotated-stmts))
        (cdr (first body-annotated-stmts))))
@@ -1177,7 +1183,7 @@
     (progn
       (depict-division-break markup-stream)
       (when body-annotated-stmts
-        (depict-statements markup-stream world nil body-annotated-stmts))
+        (depict-statements markup-stream world nil :statement body-annotated-stmts))
       (depict-paragraph (markup-stream last-paragraph-style)
         (depict-semantic-keyword markup-stream 'end :after)
         (depict-semantic-keyword markup-stream 'proc nil)
@@ -1416,15 +1422,15 @@
     (depict markup-stream ";")))
 
 
-(defun depict-begin (markup-stream world value-annotated-expr)
+(defun depict-begin (markup-stream world value-annotated-expr last-paragraph-style)
   (assert-true (eq (car value-annotated-expr) 'expr-annotation:begin))
   (depict-division-style (markup-stream :level)
     (depict-paragraph (markup-stream :statement)
       (depict-semantic-keyword markup-stream 'begin nil))
     (let ((annotated-stmts (cdr value-annotated-expr)))
       (when annotated-stmts
-        (depict-statements markup-stream world nil annotated-stmts)))
-    (depict-paragraph (markup-stream :statement-last)
+        (depict-statements markup-stream world nil :statement annotated-stmts)))
+    (depict-paragraph (markup-stream last-paragraph-style)
       (depict-semantic-keyword markup-stream 'end nil)
       (depict markup-stream ";"))))
 
@@ -1438,7 +1444,7 @@
           (depict-logical-block (markup-stream 0)
             (depict-global-variable markup-stream name :definition)
             (depict-colon-and-type markup-stream world type-expr)))
-        (depict-begin markup-stream world value-annotated-expr))
+        (depict-begin markup-stream world value-annotated-expr :statement-last))
       (depict-semantics (markup-stream depict-env)
         (depict-logical-block (markup-stream 0)
           (depict-global-variable markup-stream name :definition)
@@ -1452,7 +1458,7 @@
   (let* ((value-annotated-expr (nth-value 2 (scan-value world *null-type-env* value-expr)))
          (body-annotated-stmts (lambda-body-annotated-stmts value-annotated-expr)))
     (depict-algorithm (markup-stream depict-env)
-      (depict-statement-block-last markup-stream
+      (depict-statement-block-using (markup-stream :statement-last)
         (depict-paragraph (markup-stream :statement)
           (depict-semantic-keyword markup-stream 'proc :after)
           (depict-global-variable markup-stream name :definition)
@@ -1501,29 +1507,63 @@
              (depict-env-pending-actions-reverse ,depict-env)))))
 
 
-(defun depict-declare-action-contents (markup-stream world action-name general-grammar-symbol type-expr)
+(defun depict-action-name-and-symbol (markup-stream action-name general-grammar-symbol)
   (depict-action-name markup-stream action-name)
   (depict markup-stream :action-begin)
   (depict-general-grammar-symbol markup-stream general-grammar-symbol :reference)
-  (depict markup-stream :action-end)
+  (depict markup-stream :action-end))
+
+
+(defun depict-declare-action-contents (markup-stream world action-name general-grammar-symbol type-expr)
+  (depict-action-name-and-symbol markup-stream action-name general-grammar-symbol)
   (depict-logical-block (markup-stream 2)
     (depict markup-stream ":")
     (depict-break markup-stream 1)
     (depict-type-expr markup-stream world type-expr)))
 
 
-; (declare-action <action-name> <general-grammar-symbol> <type> <n-productions>)
-(defun depict-declare-action (markup-stream world depict-env action-name general-grammar-symbol-source type-expr n-productions)
+; (declare-action <action-name> <general-grammar-symbol> <type> <mode> <parameter-list> <command> ... <command>)
+; <mode> is one of:
+;    :hide      Don't depict this action declaration because it's for a hidden production
+;    :singleton Don't depict this action declaration because it contains a singleton production
+;    :action    Depict this action declaration; all corresponding actions will be depicted by depict-action;
+;    :actfun    Depict this action declaration; all corresponding actions will be depicted by depict-actfun;
+; <parameter-list> contains the names of the action parameters when <mode> is :actfun.
+(defun depict-declare-action (markup-stream world depict-env action-name general-grammar-symbol-source type-expr mode parameter-list &rest commands)
   (let* ((grammar-info (checked-depict-env-grammar-info depict-env))
          (general-grammar-symbol (grammar-parametrization-intern (grammar-info-grammar grammar-info) general-grammar-symbol-source)))
-    (unless (or (and (general-nonterminal? general-grammar-symbol) (hidden-nonterminal? general-grammar-symbol))
-                (grammar-info-charclass-or-partition grammar-info general-grammar-symbol)
-                (= n-productions 1))
-      (depict-delayed-action (markup-stream depict-env action-name)
-        (depict-semantics (markup-stream depict-env :algorithm-stmt-narrow)
-          (depict-logical-block (markup-stream 4)
-            (depict-declare-action-contents markup-stream world action-name general-grammar-symbol type-expr)
-            (depict markup-stream ";")))))))
+    (unless (and (general-nonterminal? general-grammar-symbol) (hidden-nonterminal? general-grammar-symbol))
+      (ecase mode
+        (:hide)
+        (:singleton (depict-delayed-action (markup-stream depict-env action-name)
+                      (depict-algorithm (markup-stream depict-env)
+                        (depict-commands markup-stream world depict-env commands))))
+        ((:action :actfun)
+         (depict-delayed-action (markup-stream depict-env action-name)
+           (depict-algorithm (markup-stream depict-env)
+             (depict-paragraph (markup-stream :statement)
+               (if (eq mode :actfun)
+                 (depict-logical-block (markup-stream 0)
+                   (depict-semantic-keyword markup-stream 'proc :after)
+                   (depict-action-name-and-symbol markup-stream action-name general-grammar-symbol)
+                   (depict-break markup-stream 1)
+                   (unless (and (consp type-expr) (eq (first type-expr) '->))
+                     (error "Destructuring requires ~S to be a -> type" type-expr))
+                   (let ((->-parameters (second type-expr))
+                         (->-result (third type-expr)))
+                     (unless (= (length ->-parameters) (length parameter-list))
+                       (error "Parameter count mistmatch: ~S and ~S" ->-parameters parameter-list))
+                     (let ((bindings (mapcar #'list parameter-list ->-parameters)))
+                       (depict-function-signature markup-stream world bindings ->-result t))))
+                 (progn
+                   (depict-declare-action-contents markup-stream world action-name general-grammar-symbol type-expr)
+                   (depict markup-stream ";"))))
+             (depict-commands markup-stream world depict-env commands)
+             (when (eq mode :actfun)
+               (depict-paragraph (markup-stream :statement-last)
+                 (depict-semantic-keyword markup-stream 'end :after)
+                 (depict-semantic-keyword markup-stream 'proc nil)
+                 (depict markup-stream ";"))))))))))
 
 
 ; Declare and define the lexer-action on the charclass given by nonterminal.
@@ -1532,8 +1572,7 @@
     (depict-delayed-action (markup-stream depict-env action-name)
       (depict-semantics (markup-stream depict-env)
         (depict-logical-block (markup-stream 4)
-          (depict-declare-action-contents markup-stream world action-name
-                                          nonterminal (lexer-action-type-expr lexer-action))
+          (depict-declare-action-contents markup-stream world action-name nonterminal (lexer-action-type-expr lexer-action))
           (depict-break markup-stream 1)
           (depict-logical-block (markup-stream 3)
             (depict markup-stream "= ")
@@ -1544,14 +1583,26 @@
           (depict markup-stream ";"))))))
 
 
-; (action <action-name> <production-name> <type> <n-productions> <value>)
-(defun depict-action (markup-stream world depict-env action-name production-name type-expr n-productions value-expr)
-  (depict-general-action markup-stream world depict-env action-name production-name type-expr n-productions value-expr nil))
+; (action <action-name> <production-name> <type> <mode> <value>)
+; <mode> is one of:
+;    :hide      Don't depict this action;
+;    :singleton Depict this action along with its declaration;
+;    :first     Depict this action, which is the first in the rule
+;    :middle    Depict this action, which is neither the first nor the last in the rule
+;    :last      Depict this action, which is the last in the rule
+(defun depict-action (markup-stream world depict-env action-name production-name type-expr mode value-expr)
+  (depict-general-action markup-stream world depict-env action-name production-name type-expr mode value-expr nil))
 
-; (actfun <action-name> <production-name> (-> (<type1> ... <typen>) <result-type>) <n-productions>
+; (actfun <action-name> <production-name> (-> (<type1> ... <typen>) <result-type>) <mode>
 ;    (lambda ((<arg1> <type1>) ... (<argn> <typen>)) <result-type> . <statements>))
-(defun depict-actfun (markup-stream world depict-env action-name production-name type-expr n-productions value-expr)
-  (depict-general-action markup-stream world depict-env action-name production-name type-expr n-productions value-expr t))
+; <mode> is one of:
+;    :hide      Don't depict this action;
+;    :singleton Depict this action along with its declaration;
+;    :first     Depict this action, which is the first in the rule
+;    :middle    Depict this action, which is neither the first nor the last in the rule
+;    :last      Depict this action, which is the last in the rule
+(defun depict-actfun (markup-stream world depict-env action-name production-name type-expr mode value-expr)
+  (depict-general-action markup-stream world depict-env action-name production-name type-expr mode value-expr t))
 
 (defun depict-action-signature (markup-stream action-name general-production action-grammar-symbols)
   (depict-action-name markup-stream action-name)
@@ -1559,45 +1610,57 @@
   (depict-general-production markup-stream general-production :reference action-grammar-symbols)
   (depict markup-stream :action-end))
 
-(defun depict-general-action (markup-stream world depict-env action-name production-name type-expr n-productions value-expr destructured)
-  (let* ((grammar-info (checked-depict-env-grammar-info depict-env))
-         (grammar (grammar-info-grammar grammar-info))
-         (general-production (grammar-general-production grammar production-name))
-         (lhs (general-production-lhs general-production))
-         (show-type (= n-productions 1)))
-    (unless (or (grammar-info-charclass grammar-info lhs)
-                (hidden-nonterminal? lhs))
-      (depict-delayed-action (markup-stream depict-env action-name)
+(defun depict-general-action (markup-stream world depict-env action-name production-name type-expr mode value-expr destructured)
+  (unless (eq mode :hide)
+    (let* ((grammar-info (checked-depict-env-grammar-info depict-env))
+           (grammar (grammar-info-grammar grammar-info))
+           (general-production (grammar-general-production grammar production-name))
+           (lhs (general-production-lhs general-production)))
+      (unless (hidden-nonterminal? lhs)
         (let* ((initial-env (general-production-action-env grammar general-production))
                (type (scan-type world type-expr))
                (value-annotated-expr (nth-value 1 (scan-typed-value-or-begin world initial-env value-expr type)))
-               (action-grammar-symbols (annotated-expr-grammar-symbols value-annotated-expr)))
-          (if destructured
-            (let ((body-annotated-stmts (lambda-body-annotated-stmts value-annotated-expr)))
-              (depict-algorithm (markup-stream depict-env (if show-type :algorithm :algorithm-next))
-                (depict-statement-block-last markup-stream
-                  (depict-paragraph (markup-stream :statement)
+               (action-grammar-symbols (annotated-expr-grammar-symbols value-annotated-expr))
+               (mode-style (cdr (assert-non-null (assoc mode '((:singleton . nil) (:first . :level-wide) (:middle . :level-wide) (:last . :level)))))))
+          (depict-division-style (markup-stream mode-style)
+            (if destructured
+              (let* ((body-annotated-stmts (lambda-body-annotated-stmts value-annotated-expr))
+                     (semicolon (not (eq mode :last)))
+                     (last-paragraph-style (if semicolon :statement-last :statement)))
+                (depict-statement-block-using (markup-stream last-paragraph-style)
+                  (if (eq mode :singleton)
+                    (progn
+                      (depict-paragraph (markup-stream :statement)
+                        (depict-logical-block (markup-stream 0)
+                          (depict-semantic-keyword markup-stream 'proc :after)
+                          (depict-action-signature markup-stream action-name general-production action-grammar-symbols)
+                          (depict-break markup-stream 1)
+                          (depict-lambda-signature markup-stream world type-expr value-annotated-expr t)))
+                      (depict-function-body markup-stream world semicolon last-paragraph-style body-annotated-stmts))
+                    (progn
+                      (depict-paragraph (markup-stream :statement)
+                        (depict markup-stream :action-begin)
+                        (depict-general-production markup-stream general-production :reference action-grammar-symbols)
+                        (depict markup-stream :action-end)
+                        (depict-semantic-keyword markup-stream 'do :before))
+                      (depict-statements markup-stream world semicolon last-paragraph-style body-annotated-stmts)))))
+              
+              (let ((last-paragraph-style (if (member mode '(:singleton :last)) :statement-last :statement)))
+                (if (eq (car value-annotated-expr) 'expr-annotation:begin)
+                  (progn
+                    (depict-paragraph (markup-stream :statement)
+                      (depict-logical-block (markup-stream 0)
+                        (depict-action-signature markup-stream action-name general-production action-grammar-symbols)
+                        (when (eq mode :singleton)
+                          (depict-colon-and-type markup-stream world type-expr))))
+                    (depict-begin markup-stream world value-annotated-expr last-paragraph-style))
+                  
+                  (depict-paragraph (markup-stream last-paragraph-style)
                     (depict-logical-block (markup-stream 0)
-                      (depict-semantic-keyword markup-stream 'proc :after)
                       (depict-action-signature markup-stream action-name general-production action-grammar-symbols)
-                      (depict-break markup-stream 1)
-                      (depict-lambda-signature markup-stream world type-expr value-annotated-expr show-type)))
-                  (depict-function-body markup-stream world t :statement-last body-annotated-stmts))))
-            
-            (if (eq (car value-annotated-expr) 'expr-annotation:begin)
-              (depict-algorithm (markup-stream depict-env (if show-type :algorithm :algorithm-next))
-                (depict-paragraph (markup-stream :statement)
-                  (depict-logical-block (markup-stream 0)
-                    (depict-action-signature markup-stream action-name general-production action-grammar-symbols)
-                    (when show-type
-                      (depict-colon-and-type markup-stream world type-expr))))
-                (depict-begin markup-stream world value-annotated-expr))
-              (depict-semantics (markup-stream depict-env (if show-type :algorithm-stmt :algorithm-next-stmt))
-                (depict-logical-block (markup-stream 0)
-                  (depict-action-signature markup-stream action-name general-production action-grammar-symbols)
-                  (when show-type
-                    (depict-colon-and-type markup-stream world type-expr))
-                  (depict-equals-and-value markup-stream world value-annotated-expr))))))))))
+                      (when (eq mode :singleton)
+                        (depict-colon-and-type markup-stream world type-expr))
+                      (depict-equals-and-value markup-stream world value-annotated-expr))))))))))))
 
 
 ; (terminal-action <action-name> <terminal> <lisp-function>)

mozilla/js2/semantics/HTML-To-RTF/Convert.lisp

@@ -344,8 +344,7 @@
     ("grammar-argument" . :grammar-argument)
     ("indent" . :body-text)
     ("operator-heading" . :heading4)
-    ("algorithm-stmt" . :algorithm-stmt)
-    ("algorithm-next-stmt" . :algorithm-next-stmt)))
+    ("algorithm-stmt" . :algorithm-stmt)))
 
 
 (defun class-to-paragraph-style (element)
@@ -392,10 +391,10 @@
    ((equal class "algorithm")
     (let ((*algorithm-level* 0))
       (emit-paragraph-elements markup-stream element)))
-   ((or (equal class "algorithm-next") (equal class "algorithm-indent"))
+   ((equal class "algorithm-indent")
     (let ((*algorithm-level* 1))
       (emit-paragraph-elements markup-stream element)))
-   ((equal class "lvl")
+   ((or (equal class "lvl") (equal class "lvl-wide"))
     (let ((*algorithm-level* (1+ *algorithm-level*)))
       (emit-paragraph-elements markup-stream element)))
    ((equal class "stmt")
@@ -514,6 +513,8 @@
 
 (translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:stages.html"
                        "HTML-To-RTF/Stages.rtf" "Stages")
+(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:es4:core:expressions.html"
+                       "HTML-To-RTF/Expressions.rtf" "Expressions")
 (translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:notation.html"
                        "HTML-To-RTF/FormalNotation.rtf" "Formal Notation")
 |#

mozilla/js2/semantics/HTML.lisp

@@ -480,11 +480,9 @@
     (:grammar-argument (:nest :nowrap (div (class "grammar-argument"))))
     (:semantic-comment (div (class "semantic-comment")))
     (:algorithm (div (class "algorithm")))
-    (:algorithm-next (div (class "algorithm-next")))
     (:algorithm-stmt (div (class "algorithm-stmt")))
-    (:algorithm-stmt-narrow :algorithm-stmt)
-    (:algorithm-next-stmt (div (class "algorithm-next-stmt")))
     ((:level 4) (div (class "lvl")))
+    ((:level-wide 4) (div (class "lvl-wide")))
     (:statement (div (class "stmt")))
     (:statement-last :statement)
     

mozilla/js2/semantics/JS20/Parser.lisp

@@ -771,13 +771,12 @@
     
     (%section "Terminal Actions")
     
-    (declare-action name $identifier string 1)
-    (declare-action eval $number float64 1)
-    (declare-action eval $string string 1)
-    
-    (terminal-action name $identifier identity)
-    (terminal-action eval $number identity)
-    (terminal-action eval $string identity)
+    (declare-action name $identifier string :action nil
+      (terminal-action name $identifier identity))
+    (declare-action eval $number float64 :action nil
+      (terminal-action eval $number identity))
+    (declare-action eval $string string :action nil
+      (terminal-action eval $string identity))
     (%print-actions)
     
     
@@ -820,7 +819,7 @@
         ((name e) (return (new partial-name (dynamic-env-uses e) (name :identifier))))
         ((eval e) (return (lookup-variable e (name :identifier) false))))
       (production :simple-qualified-identifier (:qualifier \:\: :identifier) simple-qualified-identifier-qualifier
-        (constrain (constrain :qualifier))
+        ((constrain s) ((constrain :qualifier) s))
         ((name e)
          (const q namespace ((eval :qualifier) e))
          (return (new partial-name (list-set q) (name :identifier))))
@@ -857,8 +856,8 @@
     (%subsection "Unit Expressions")
     (rule :unit-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :unit-expression (:paren-list-expression) unit-expression-paren-list-expression
-        (constrain (constrain :paren-list-expression))
-        (eval (eval :paren-list-expression)))
+        ((constrain s) ((constrain :paren-list-expression) s))
+        ((eval e) (return ((eval :paren-list-expression) e))))
       (production :unit-expression ($number :no-line-break $string) unit-expression-number-with-unit
         ((constrain (s :unused)) (todo))
         ((eval (e :unused)) (todo)))
@@ -889,13 +888,13 @@
         ((eval (e :unused)) (return (eval $string))))
       (production :primary-expression (this) primary-expression-this
         ((constrain (s :unused)) (todo))
-        (eval lookup-this))
+        ((eval e) (return (lookup-this e))))
       (production :primary-expression ($regular-expression) primary-expression-regular-expression
         ((constrain (s :unused)))
         ((eval (e :unused)) (todo)))
       (production :primary-expression (:unit-expression) primary-expression-unit-expression
-        (constrain (constrain :unit-expression))
-        (eval (eval :unit-expression)))
+        ((constrain s) ((constrain :unit-expression) s))
+        ((eval e) (return ((eval :unit-expression) e))))
       (production :primary-expression (:array-literal) primary-expression-array-literal
         ((constrain (s :unused)) (todo))
         ((eval (e :unused)) (todo)))
@@ -903,8 +902,8 @@
         ((constrain (s :unused)) (todo))
         ((eval (e :unused)) (todo)))
       (production :primary-expression (:function-expression) primary-expression-function-expression
-        (constrain (constrain :function-expression))
-        (eval (eval :function-expression))))
+        ((constrain s) ((constrain :function-expression) s))
+        ((eval e) (return ((eval :function-expression) e)))))
     
     (rule :paren-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :paren-expression (\( (:assignment-expression allow-in) \)) paren-expression-assignment-expression
@@ -913,8 +912,8 @@
     
     (rule :paren-list-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)) (eval-as-list (-> (dynamic-env) (vector object))))
       (production :paren-list-expression (:paren-expression) paren-list-expression-paren-expression
-        (constrain (constrain :paren-expression))
-        (eval (eval :paren-expression))
+        ((constrain s) ((constrain :paren-expression) s))
+        ((eval e) (return ((eval :paren-expression) e)))
         ((eval-as-list e)
          (const elt object (read-reference ((eval :paren-expression) e)))
          (return (vector elt))))
@@ -995,12 +994,12 @@
         ((constrain s)
          (rwhen (not (inside-class s))
            (throw syntax-error)))
-        (eval lookup-this)
+        ((eval e) (return (lookup-this e)))
         ((super e) (return (lexical-class e))))
       (production :super-expression (:full-super-expression) super-expression-full-super-expression
-        (constrain (constrain :full-super-expression))
-        (eval (eval :full-super-expression))
-        (super (super :full-super-expression))))
+        ((constrain s) ((constrain :full-super-expression) s))
+        ((eval e) (return ((eval :full-super-expression) e)))
+        ((super e) (return ((super :full-super-expression) e)))))
     
     (rule :full-super-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) object)) (super (-> (dynamic-env) class)))
       (production :full-super-expression (super :paren-expression) full-super-expression-super-paren-expression
@@ -1038,12 +1037,12 @@
       (production :postfix-expression-or-super (:super-expression) postfix-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     
     (rule :attribute-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :attribute-expression (:simple-qualified-identifier) attribute-expression-simple-qualified-identifier
-        (constrain (constrain :simple-qualified-identifier))
-        (eval (eval :simple-qualified-identifier)))
+        ((constrain s) ((constrain :simple-qualified-identifier) s))
+        ((eval e) (return ((eval :simple-qualified-identifier) e))))
       (production :attribute-expression (:attribute-expression :member-operator) attribute-expression-member-operator
         ((constrain s)
          ((constrain :attribute-expression) s)
@@ -1064,14 +1063,14 @@
     
     (rule :full-postfix-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :full-postfix-expression (:primary-expression) full-postfix-expression-primary-expression
-        (constrain (constrain :primary-expression))
-        (eval (eval :primary-expression)))
+        ((constrain s) ((constrain :primary-expression) s))
+        ((eval e) (return ((eval :primary-expression) e))))
       (production :full-postfix-expression (:expression-qualified-identifier) full-postfix-expression-expression-qualified-identifier
-        (constrain (constrain :expression-qualified-identifier))
-        (eval (eval :expression-qualified-identifier)))
+        ((constrain s) ((constrain :expression-qualified-identifier) s))
+        ((eval e) (return ((eval :expression-qualified-identifier) e))))
       (production :full-postfix-expression (:full-new-expression) full-postfix-expression-full-new-expression
-        (constrain (constrain :full-new-expression))
-        (eval (eval :full-new-expression)))
+        ((constrain s) ((constrain :full-new-expression) s))
+        ((eval e) (return ((eval :full-new-expression) e))))
       (production :full-postfix-expression (:full-postfix-expression :member-operator) full-postfix-expression-member-operator
         ((constrain s)
          ((constrain :full-postfix-expression) s)
@@ -1109,7 +1108,7 @@
          (const args argument-list ((eval :arguments) e))
          (return (unary-dispatch call-table sf base f args))))
       (production :full-postfix-expression (:postfix-expression-or-super :no-line-break ++) full-postfix-expression-increment
-        (constrain (constrain :postfix-expression-or-super))
+        ((constrain s) ((constrain :postfix-expression-or-super) s))
         ((eval e)
          (const r reference ((eval :postfix-expression-or-super) e))
          (const a object (read-reference r))
@@ -1118,7 +1117,7 @@
          (write-reference r b)
          (return a)))
       (production :full-postfix-expression (:postfix-expression-or-super :no-line-break --) full-postfix-expression-decrement
-        (constrain (constrain :postfix-expression-or-super))
+        ((constrain s) ((constrain :postfix-expression-or-super) s))
         ((eval e)
          (const r reference ((eval :postfix-expression-or-super) e))
          (const a object (read-reference r))
@@ -1148,14 +1147,14 @@
     
     (rule :full-new-subexpression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :full-new-subexpression (:primary-expression) full-new-subexpression-primary-expression
-        (constrain (constrain :primary-expression))
-        (eval (eval :primary-expression)))
+        ((constrain s) ((constrain :primary-expression) s))
+        ((eval e) (return ((eval :primary-expression) e))))
       (production :full-new-subexpression (:qualified-identifier) full-new-subexpression-qualified-identifier
-        (constrain (constrain :qualified-identifier))
-        (eval (eval :qualified-identifier)))
+        ((constrain s) ((constrain :qualified-identifier) s))
+        ((eval e) (return ((eval :qualified-identifier) e))))
       (production :full-new-subexpression (:full-new-expression) full-new-subexpression-full-new-expression
-        (constrain (constrain :full-new-expression))
-        (eval (eval :full-new-expression)))
+        ((constrain s) ((constrain :full-new-expression) s))
+        ((eval e) (return ((eval :full-new-expression) e))))
       (production :full-new-subexpression (:full-new-subexpression :member-operator) full-new-subexpression-member-operator
         ((constrain s)
          ((constrain :full-new-subexpression) s)
@@ -1174,12 +1173,12 @@
     
     (rule :short-new-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :short-new-expression (new :short-new-subexpression) short-new-expression-new
-        (constrain (constrain :short-new-subexpression))
+        ((constrain s) ((constrain :short-new-subexpression) s))
         ((eval e)
          (const f object (read-reference ((eval :short-new-subexpression) e)))
          (return (unary-dispatch construct-table null null f (new argument-list (vector-of object) (list-set-of named-argument))))))
       (production :short-new-expression (new :super-expression) short-new-expression-super-new
-        (constrain (constrain :super-expression))
+        ((constrain s) ((constrain :super-expression) s))
         ((eval e)
          (const f object (read-reference ((eval :super-expression) e)))
          (const sf class ((super :super-expression) e))
@@ -1198,20 +1197,20 @@
     (%subsection "Member Operators")
     (rule :member-operator ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env object) reference)))
       (production :member-operator (:dot-operator) member-operator-dot-operator
-        (constrain (constrain :dot-operator))
+        ((constrain s) ((constrain :dot-operator) s))
         ((eval e a) (return ((eval :dot-operator) e a null))))
       (production :member-operator (\. :paren-expression) member-operator-indirect
-        (constrain (constrain :paren-expression))
+        ((constrain s) ((constrain :paren-expression) s))
         ((eval (e :unused) (a :unused)) (todo))))
     
     (rule :dot-operator ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env object class-opt) reference)))
       (production :dot-operator (\. :qualified-identifier) dot-operator-qualified-identifier
-        (constrain (constrain :qualified-identifier))
+        ((constrain s) ((constrain :qualified-identifier) s))
         ((eval e a sa)
          (const n partial-name ((name :qualified-identifier) e))
          (return (new dot-reference a sa n))))
       (production :dot-operator (:brackets) dot-operator-brackets
-        (constrain (constrain :brackets))
+        ((constrain s) ((constrain :brackets) s))
         ((eval e a sa)
          (const args argument-list ((eval :brackets) e))
          (return (new bracket-reference a sa args)))))
@@ -1221,35 +1220,35 @@
         ((constrain (s :unused)))
         ((eval (e :unused)) (return (new argument-list (vector-of object) (list-set-of named-argument)))))
       (production :brackets ([ (:list-expression allow-in) ]) brackets-unnamed
-        (constrain (constrain :list-expression))
+        ((constrain s) ((constrain :list-expression) s))
         ((eval e)
          (const positional (vector object) ((eval-as-list :list-expression) e))
          (return (new argument-list positional (list-set-of named-argument)))))
       (production :brackets ([ :named-argument-list ]) brackets-named
         ((constrain s) (exec ((constrain :named-argument-list) s)))
-        (eval (eval :named-argument-list))))
+        ((eval e) (return ((eval :named-argument-list) e)))))
     
     (rule :arguments ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) argument-list)))
       (production :arguments (:paren-expressions) arguments-paren-expressions
-        (constrain (constrain :paren-expressions))
-        (eval (eval :paren-expressions)))
+        ((constrain s) ((constrain :paren-expressions) s))
+        ((eval e) (return ((eval :paren-expressions) e))))
       (production :arguments (\( :named-argument-list \)) arguments-named
         ((constrain s) (exec ((constrain :named-argument-list) s)))
-        (eval (eval :named-argument-list))))
+        ((eval e) (return ((eval :named-argument-list) e)))))
     
     (rule :paren-expressions ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) argument-list)))
       (production :paren-expressions (\( \)) paren-expressions-none
         ((constrain (s :unused)))
         ((eval (e :unused)) (return (new argument-list (vector-of object) (list-set-of named-argument)))))
       (production :paren-expressions (:paren-list-expression) paren-expressions-some
-        (constrain (constrain :paren-list-expression))
+        ((constrain s) ((constrain :paren-list-expression) s))
         ((eval e)
          (const positional (vector object) ((eval-as-list :paren-list-expression) e))
          (return (new argument-list positional (list-set-of named-argument))))))
     
     (rule :named-argument-list ((constrain (-> (constraint-env) (list-set string))) (eval (-> (dynamic-env) argument-list)))
       (production :named-argument-list (:literal-field) named-argument-list-one
-        (constrain (constrain :literal-field))
+        ((constrain s) (return ((constrain :literal-field) s)))
         ((eval e)
          (const na named-argument ((eval :literal-field) e))
          (return (new argument-list (vector-of object) (list-set na)))))
@@ -1280,18 +1279,18 @@
     (%subsection "Unary Operators")
     (rule :unary-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :unary-expression (:postfix-expression) unary-expression-postfix
-        (constrain (constrain :postfix-expression))
-        (eval (eval :postfix-expression)))
+        ((constrain s) ((constrain :postfix-expression) s))
+        ((eval e) (return ((eval :postfix-expression) e))))
       (production :unary-expression (delete :postfix-expression) unary-expression-delete
-        (constrain (constrain :postfix-expression))
+        ((constrain s) ((constrain :postfix-expression) s))
         ((eval e) (return (delete-reference ((eval :postfix-expression) e)))))
       (production :unary-expression (void :unary-expression) unary-expression-void
-        (constrain (constrain :unary-expression))
+        ((constrain s) ((constrain :unary-expression) s))
         ((eval e)
          (exec (read-reference ((eval :unary-expression) e)))
          (return undefined)))
       (production :unary-expression (typeof :unary-expression) unary-expression-typeof
-        (constrain (constrain :unary-expression))
+        ((constrain s) ((constrain :unary-expression) s))
         ((eval e)
          (const a object (read-reference ((eval :unary-expression) e)))
          (case a
@@ -1305,7 +1304,7 @@
            (:select (union class method-closure) (return "function"))
            (:narrow instance (return (& typeof-string a))))))
       (production :unary-expression (++ :postfix-expression-or-super) unary-expression-increment
-        (constrain (constrain :postfix-expression-or-super))
+        ((constrain s) ((constrain :postfix-expression-or-super) s))
         ((eval e)
          (const r reference ((eval :postfix-expression-or-super) e))
          (const a object (read-reference r))
@@ -1314,7 +1313,7 @@
          (write-reference r b)
          (return b)))
       (production :unary-expression (-- :postfix-expression-or-super) unary-expression-decrement
-        (constrain (constrain :postfix-expression-or-super))
+        ((constrain s) ((constrain :postfix-expression-or-super) s))
         ((eval e)
          (const r reference ((eval :postfix-expression-or-super) e))
          (const a object (read-reference r))
@@ -1323,25 +1322,25 @@
          (write-reference r b)
          (return b)))
       (production :unary-expression (+ :unary-expression-or-super) unary-expression-plus
-        (constrain (constrain :unary-expression-or-super))
+        ((constrain s) ((constrain :unary-expression-or-super) s))
         ((eval e)
          (const a object (read-reference ((eval :unary-expression-or-super) e)))
          (const sa class-opt ((super :unary-expression-or-super) e))
          (return (unary-dispatch plus-table sa null a (new argument-list (vector-of object) (list-set-of named-argument))))))
       (production :unary-expression (- :unary-expression-or-super) unary-expression-minus
-        (constrain (constrain :unary-expression-or-super))
+        ((constrain s) ((constrain :unary-expression-or-super) s))
         ((eval e)
          (const a object (read-reference ((eval :unary-expression-or-super) e)))
          (const sa class-opt ((super :unary-expression-or-super) e))
          (return (unary-dispatch minus-table sa null a (new argument-list (vector-of object) (list-set-of named-argument))))))
       (production :unary-expression (~ :unary-expression-or-super) unary-expression-bitwise-not
-        (constrain (constrain :unary-expression-or-super))
+        ((constrain s) ((constrain :unary-expression-or-super) s))
         ((eval e)
          (const a object (read-reference ((eval :unary-expression-or-super) e)))
          (const sa class-opt ((super :unary-expression-or-super) e))
          (return (unary-dispatch bitwise-not-table sa null a (new argument-list (vector-of object) (list-set-of named-argument))))))
       (production :unary-expression (! :unary-expression) unary-expression-logical-not
-        (constrain (constrain :unary-expression))
+        ((constrain s) ((constrain :unary-expression) s))
         ((eval e)
          (const a object (read-reference ((eval :unary-expression) e)))
          (return (unary-not a)))))
@@ -1354,15 +1353,15 @@
       (production :unary-expression-or-super (:super-expression) unary-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
     
     (%subsection "Multiplicative Operators")
     (rule :multiplicative-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :multiplicative-expression (:unary-expression) multiplicative-expression-unary
-        (constrain (constrain :unary-expression))
-        (eval (eval :unary-expression)))
+        ((constrain s) ((constrain :unary-expression) s))
+        ((eval e) (return ((eval :unary-expression) e))))
       (production :multiplicative-expression (:multiplicative-expression-or-super * :unary-expression-or-super) multiplicative-expression-multiply
         ((constrain s)
          ((constrain :multiplicative-expression-or-super) s)
@@ -1402,15 +1401,15 @@
       (production :multiplicative-expression-or-super (:super-expression) multiplicative-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
     
     (%subsection "Additive Operators")
     (rule :additive-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :additive-expression (:multiplicative-expression) additive-expression-multiplicative
-        (constrain (constrain :multiplicative-expression))
-        (eval (eval :multiplicative-expression)))
+        ((constrain s) ((constrain :multiplicative-expression) s))
+        ((eval e) (return ((eval :multiplicative-expression) e))))
       (production :additive-expression (:additive-expression-or-super + :multiplicative-expression-or-super) additive-expression-add
         ((constrain s)
          ((constrain :additive-expression-or-super) s)
@@ -1440,15 +1439,15 @@
       (production :additive-expression-or-super (:super-expression) additive-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
     
     (%subsection "Bitwise Shift Operators")
     (rule :shift-expression ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production :shift-expression (:additive-expression) shift-expression-additive
-        (constrain (constrain :additive-expression))
-        (eval (eval :additive-expression)))
+        ((constrain s) ((constrain :additive-expression) s))
+        ((eval e) (return ((eval :additive-expression) e))))
       (production :shift-expression (:shift-expression-or-super << :additive-expression-or-super) shift-expression-left
         ((constrain s)
          ((constrain :shift-expression-or-super) s)
@@ -1488,15 +1487,15 @@
       (production :shift-expression-or-super (:super-expression) shift-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
     
     (%subsection "Relational Operators")
     (rule (:relational-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:relational-expression :beta) (:shift-expression) relational-expression-shift
-        (constrain (constrain :shift-expression))
-        (eval (eval :shift-expression)))
+        ((constrain s) ((constrain :shift-expression) s))
+        ((eval e) (return ((eval :shift-expression) e))))
       (production (:relational-expression :beta) ((:relational-expression-or-super :beta) < :shift-expression-or-super) relational-expression-less
         ((constrain s)
          ((constrain :relational-expression-or-super) s)
@@ -1566,15 +1565,15 @@
       (production (:relational-expression-or-super :beta) (:super-expression) relational-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
     
     (%subsection "Equality Operators")
     (rule (:equality-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:equality-expression :beta) ((:relational-expression :beta)) equality-expression-relational
-        (constrain (constrain :relational-expression))
-        (eval (eval :relational-expression)))
+        ((constrain s) ((constrain :relational-expression) s))
+        ((eval e) (return ((eval :relational-expression) e))))
       (production (:equality-expression :beta) ((:equality-expression-or-super :beta) == (:relational-expression-or-super :beta)) equality-expression-equal
         ((constrain s)
          ((constrain :equality-expression-or-super) s)
@@ -1624,15 +1623,15 @@
       (production (:equality-expression-or-super :beta) (:super-expression) equality-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
     
     (%subsection "Binary Bitwise Operators")
     (rule (:bitwise-and-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:bitwise-and-expression :beta) ((:equality-expression :beta)) bitwise-and-expression-equality
-        (constrain (constrain :equality-expression))
-        (eval (eval :equality-expression)))
+        ((constrain s) ((constrain :equality-expression) s))
+        ((eval e) (return ((eval :equality-expression) e))))
       (production (:bitwise-and-expression :beta) ((:bitwise-and-expression-or-super :beta) & (:equality-expression-or-super :beta)) bitwise-and-expression-and
         ((constrain s)
          ((constrain :bitwise-and-expression-or-super) s)
@@ -1646,8 +1645,8 @@
     
     (rule (:bitwise-xor-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:bitwise-xor-expression :beta) ((:bitwise-and-expression :beta)) bitwise-xor-expression-bitwise-and
-        (constrain (constrain :bitwise-and-expression))
-        (eval (eval :bitwise-and-expression)))
+        ((constrain s) ((constrain :bitwise-and-expression) s))
+        ((eval e) (return ((eval :bitwise-and-expression) e))))
       (production (:bitwise-xor-expression :beta) ((:bitwise-xor-expression-or-super :beta) ^ (:bitwise-and-expression-or-super :beta)) bitwise-xor-expression-xor
         ((constrain s)
          ((constrain :bitwise-xor-expression-or-super) s)
@@ -1661,8 +1660,8 @@
     
     (rule (:bitwise-or-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:bitwise-or-expression :beta) ((:bitwise-xor-expression :beta)) bitwise-or-expression-bitwise-xor
-        (constrain (constrain :bitwise-xor-expression))
-        (eval (eval :bitwise-xor-expression)))
+        ((constrain s) ((constrain :bitwise-xor-expression) s))
+        ((eval e) (return ((eval :bitwise-xor-expression) e))))
       (production (:bitwise-or-expression :beta) ((:bitwise-or-expression-or-super :beta) \| (:bitwise-xor-expression-or-super :beta)) bitwise-or-expression-or
         ((constrain s)
          ((constrain :bitwise-or-expression-or-super) s)
@@ -1683,7 +1682,7 @@
       (production (:bitwise-and-expression-or-super :beta) (:super-expression) bitwise-and-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     
     (rule (:bitwise-xor-expression-or-super :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)) (super (-> (dynamic-env) class-opt)))
       (production (:bitwise-xor-expression-or-super :beta) ((:bitwise-xor-expression :beta)) bitwise-xor-expression-or-super-bitwise-xor-expression
@@ -1693,7 +1692,7 @@
       (production (:bitwise-xor-expression-or-super :beta) (:super-expression) bitwise-xor-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     
     (rule (:bitwise-or-expression-or-super :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)) (super (-> (dynamic-env) class-opt)))
       (production (:bitwise-or-expression-or-super :beta) ((:bitwise-or-expression :beta)) bitwise-or-expression-or-super-bitwise-or-expression
@@ -1703,15 +1702,15 @@
       (production (:bitwise-or-expression-or-super :beta) (:super-expression) bitwise-or-expression-or-super-super
         (constrain (constrain :super-expression))
         (eval (eval :super-expression))
-        (super (super :super-expression))))
+        ((super e) (return ((super :super-expression) e)))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
     
     (%subsection "Binary Logical Operators")
     (rule (:logical-and-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:logical-and-expression :beta) ((:bitwise-or-expression :beta)) logical-and-expression-bitwise-or
-        (constrain (constrain :bitwise-or-expression))
-        (eval (eval :bitwise-or-expression)))
+        ((constrain s) ((constrain :bitwise-or-expression) s))
+        ((eval e) (return ((eval :bitwise-or-expression) e))))
       (production (:logical-and-expression :beta) ((:logical-and-expression :beta) && (:bitwise-or-expression :beta)) logical-and-expression-and
         ((constrain s)
          ((constrain :logical-and-expression) s)
@@ -1724,8 +1723,8 @@
     
     (rule (:logical-xor-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:logical-xor-expression :beta) ((:logical-and-expression :beta)) logical-xor-expression-logical-and
-        (constrain (constrain :logical-and-expression))
-        (eval (eval :logical-and-expression)))
+        ((constrain s) ((constrain :logical-and-expression) s))
+        ((eval e) (return ((eval :logical-and-expression) e))))
       (production (:logical-xor-expression :beta) ((:logical-xor-expression :beta) ^^ (:logical-and-expression :beta)) logical-xor-expression-xor
         ((constrain s)
          ((constrain :logical-xor-expression) s)
@@ -1739,8 +1738,8 @@
     
     (rule (:logical-or-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:logical-or-expression :beta) ((:logical-xor-expression :beta)) logical-or-expression-logical-xor
-        (constrain (constrain :logical-xor-expression))
-        (eval (eval :logical-xor-expression)))
+        ((constrain s) ((constrain :logical-xor-expression) s))
+        ((eval e) (return ((eval :logical-xor-expression) e))))
       (production (:logical-or-expression :beta) ((:logical-or-expression :beta) \|\| (:logical-xor-expression :beta)) logical-or-expression-or
         ((constrain s)
          ((constrain :logical-or-expression) s)
@@ -1756,8 +1755,8 @@
     (%subsection "Conditional Operator")
     (rule (:conditional-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:conditional-expression :beta) ((:logical-or-expression :beta)) conditional-expression-logical-or
-        (constrain (constrain :logical-or-expression))
-        (eval (eval :logical-or-expression)))
+        ((constrain s) ((constrain :logical-or-expression) s))
+        ((eval e) (return ((eval :logical-or-expression) e))))
       (production (:conditional-expression :beta) ((:logical-or-expression :beta) ? (:assignment-expression :beta) \: (:assignment-expression :beta)) conditional-expression-conditional
         ((constrain s)
          ((constrain :logical-or-expression) s)
@@ -1776,8 +1775,8 @@
     (%subsection "Assignment Operators")
     (rule (:assignment-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)))
       (production (:assignment-expression :beta) ((:conditional-expression :beta)) assignment-expression-conditional
-        (constrain (constrain :conditional-expression))
-        (eval (eval :conditional-expression)))
+        ((constrain s) ((constrain :conditional-expression) s))
+        ((eval e) (return ((eval :conditional-expression) e))))
       (production (:assignment-expression :beta) (:postfix-expression = (:assignment-expression :beta)) assignment-expression-assignment
         ((constrain s)
          ((constrain :postfix-expression) s)
@@ -1838,8 +1837,8 @@
     (%subsection "Comma Expressions")
     (rule (:list-expression :beta) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) reference)) (eval-as-list (-> (dynamic-env) (vector object))))
       (production (:list-expression :beta) ((:assignment-expression :beta)) list-expression-assignment
-        (constrain (constrain :assignment-expression))
-        (eval (eval :assignment-expression))
+        ((constrain s) ((constrain :assignment-expression) s))
+        ((eval e) (return ((eval :assignment-expression) e)))
         ((eval-as-list e)
          (const elt object (read-reference ((eval :assignment-expression) e)))
          (return (vector elt))))
@@ -1878,20 +1877,20 @@
         ((constrain (s :unused)))
         ((eval (e :unused) d) (return d)))
       (production (:statement :omega) (:expression-statement (:semicolon :omega)) statement-expression-statement
-        (constrain (constrain :expression-statement))
+        ((constrain s) ((constrain :expression-statement) s))
         ((eval e (d :unused)) (return ((eval :expression-statement) e))))
       (production (:statement :omega) (:super-statement (:semicolon :omega)) statement-super-statement
         ((constrain (s :unused)) (todo))
         ((eval (e :unused) (d :unused)) (todo)))
       (production (:statement :omega) (:annotated-block) statement-annotated-block
-        (constrain (constrain :annotated-block))
-        (eval (eval :annotated-block)))
+        ((constrain s) ((constrain :annotated-block) s))
+        ((eval e d) (return ((eval :annotated-block) e d))))
       (production (:statement :omega) ((:labeled-statement :omega)) statement-labeled-statement
-        (constrain (constrain :labeled-statement))
-        (eval (eval :labeled-statement)))
+        ((constrain s) ((constrain :labeled-statement) s))
+        ((eval e d) (return ((eval :labeled-statement) e d))))
       (production (:statement :omega) ((:if-statement :omega)) statement-if-statement
-        (constrain (constrain :if-statement))
-        (eval (eval :if-statement)))
+        ((constrain s) ((constrain :if-statement) s))
+        ((eval e d) (return ((eval :if-statement) e d))))
       (production (:statement :omega) (:switch-statement) statement-switch-statement
         ((constrain (s :unused)) (todo))
         ((eval (e :unused) (d :unused)) (todo)))
@@ -1908,13 +1907,13 @@
         ((constrain (s :unused)) (todo))
         ((eval (e :unused) (d :unused)) (todo)))
       (production (:statement :omega) (:continue-statement (:semicolon :omega)) statement-continue-statement
-        (constrain (constrain :continue-statement))
-        (eval (eval :continue-statement)))
+        ((constrain s) ((constrain :continue-statement) s))
+        ((eval e d) (return ((eval :continue-statement) e d))))
       (production (:statement :omega) (:break-statement (:semicolon :omega)) statement-break-statement
-        (constrain (constrain :break-statement))
-        (eval (eval :break-statement)))
+        ((constrain s) ((constrain :break-statement) s))
+        ((eval e d) (return ((eval :break-statement) e d))))
       (production (:statement :omega) (:return-statement (:semicolon :omega)) statement-return-statement
-        (constrain (constrain :return-statement))
+        ((constrain s) ((constrain :return-statement) s))
         ((eval e (d :unused)) (return ((eval :return-statement) e))))
       (production (:statement :omega) (:throw-statement (:semicolon :omega)) statement-throw-statement
         ((constrain (s :unused)) (todo))
@@ -1925,8 +1924,8 @@
     
     (rule (:substatement :omega) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env object) object)))
       (production (:substatement :omega) ((:statement :omega)) substatement-statement
-        (constrain (constrain :statement))
-        (eval (eval :statement)))
+        ((constrain s) ((constrain :statement) s))
+        ((eval e d) (return ((eval :statement) e d))))
       (production (:substatement :omega) (:simple-variable-definition (:semicolon :omega)) substatement-simple-variable-definition
         ((constrain (s :unused)) (todo))
         ((eval (e :unused) (d :unused)) (todo))))
@@ -1945,7 +1944,7 @@
     (%subsection "Expression Statement")
     (rule :expression-statement ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env) object)))
       (production :expression-statement ((:- function {) (:list-expression allow-in)) expression-statement-list-expression
-        (constrain (constrain :list-expression))
+        ((constrain s) ((constrain :list-expression) s))
         ((eval e) (return (read-reference ((eval :list-expression) e))))))
     (%print-actions ("Static Constraints" constrain) ("Evaluation" eval))
     
@@ -2139,8 +2138,8 @@
     (%section "Directives")
     (rule (:directive :omega_2) ((constrain (-> (constraint-env) void)) (eval (-> (dynamic-env object) object)))
       (production (:directive :omega_2) ((:statement :omega_2)) directive-statement
-        (constrain (constrain :statement))
-        (eval (eval :statement)))
+        ((constrain s) ((constrain :statement) s))
+        ((eval e d) (return ((eval :statement) e d))))
       (production (:directive :omega_2) ((:annotatable-directive :omega_2)) directive-annotatable-directive
         ((constrain (s :unused)) (todo))
         ((eval (e :unused) (d :unused)) (todo)))

mozilla/js2/semantics/JS20/RegExp.lisp

@@ -158,7 +158,7 @@
        
        (rule :disjunction ((gen-matcher (-> (integer) matcher)) (count-parens integer))
          (production :disjunction (:alternative) disjunction-one
-           (gen-matcher (gen-matcher :alternative))
+           ((gen-matcher paren-index) (return ((gen-matcher :alternative) paren-index)))
            (count-parens (count-parens :alternative)))
          (production :disjunction (:alternative #\| :disjunction) disjunction-more
            ((gen-matcher paren-index)
@@ -210,7 +210,7 @@
             (return m))
            (count-parens 0))
          (production :term (:atom) term-atom
-           (gen-matcher (gen-matcher :atom))
+           ((gen-matcher paren-index) (return ((gen-matcher :atom) paren-index)))
            (count-parens (count-parens :atom)))
          (production :term (:atom :quantifier) term-quantified-atom
            ((gen-matcher paren-index)
@@ -361,7 +361,7 @@
             (return m))
            (count-parens 0))
          (production :atom (#\\ :atom-escape) atom-atom-escape
-           (gen-matcher (gen-matcher :atom-escape))
+           ((gen-matcher paren-index) (return ((gen-matcher :atom-escape) paren-index)))
            (count-parens 0))
          (production :atom (:character-class) atom-character-class
            ((gen-matcher (paren-index :unused))
@@ -381,7 +381,7 @@
             (return m2))
            (count-parens (+ (count-parens :disjunction) 1)))
          (production :atom (#\( #\? #\: :disjunction #\)) atom-non-capturing-parentheses
-           (gen-matcher (gen-matcher :disjunction))
+           ((gen-matcher paren-index) (return ((gen-matcher :disjunction) paren-index)))
            (count-parens (count-parens :disjunction)))
          (production :atom (#\( #\? #\= :disjunction #\)) atom-positive-lookahead
            ((gen-matcher paren-index)

mozilla/js2/semantics/Lexer.lisp

@@ -639,7 +639,7 @@
                  (production-number 0))
             (dolist (action (charclass-actions charclass))
               (let ((lexer-action (cdr action)))
-                (push (list 'declare-action (car action) nonterminal-source (lexer-action-type-expr lexer-action) 1) commands)))
+                (push (list 'declare-action (car action) nonterminal-source (lexer-action-type-expr lexer-action) :hide nil) commands)))
             (do ((charset (charclass-charset charclass)))
                 ((charset-empty? charset))
               (let* ((partition-name (if (charset-infinite? charset)
@@ -662,7 +662,7 @@
                                      ((eql t) 'true)
                                      (t (error "Cannot infer the type of ~S's result ~S" lexer-action-function result))))
                                  (list (lexer-action-name lexer-action) partition-name))))
-                    (push (list 'action (car action) production-name (lexer-action-type-expr lexer-action) 1 body) commands)))
+                    (push (list 'action (car action) production-name (lexer-action-type-expr lexer-action) :hide body) commands)))
                 (setq charset (charset-difference charset partition-charset)))))))
       
       (let ((partition-commands
@@ -671,8 +671,8 @@
                   (mapcan #'(lambda (lexer-action)
                               (let ((lexer-action-name (lexer-action-name lexer-action)))
                                 (list
-                                 (list 'declare-action lexer-action-name partition-name (lexer-action-type-expr lexer-action) 1)
-                                 (list 'terminal-action lexer-action-name partition-name (lexer-action-function lexer-action)))))
+                                 (list 'declare-action lexer-action-name partition-name (lexer-action-type-expr lexer-action) :hide nil
+                                       (list 'terminal-action lexer-action-name partition-name (lexer-action-function lexer-action))))))
                           (partition-lexer-actions (gethash partition-name (lexer-partitions lexer)))))
               (lexer-partition-names lexer))))
         (values

mozilla/js2/semantics/RTF.lisp

@@ -239,19 +239,14 @@
     (:grammar-argument s :grammar-argument-num fi -540 li 720 sa 180 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
     ((+ :styles) (:grammar-argument sbasedon :grammar-num snext :grammar-lhs-num "Grammar Argument;"))
     
-    (:algorithm-simple-num 15)
+    (:algorithm-simple-num 16)
     (:algorithm-simple s :algorithm-simple-num li 480 sa 180 keep widctlpar :asian-keywords hyphpar 0 :10-pt :english)
     ((+ :styles) (:algorithm-simple sbasedon :body-text-num snext :algorithm-simple-num "Algorithm Simple;"))
     
-    (:algorithm-0-num 16)
+    (:algorithm-0-num 17)
     (:algorithm-0 s :algorithm-0-num fi -480 li 720 keep keepn nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
     ((+ :styles) (:algorithm-0 sbasedon :normal-num snext :algorithm-0-num "Algorithm 0;"))
     
-    (:algorithm-0-narrow-num 17)
-    (:algorithm-0-narrow s :algorithm-0-narrow-num fi -480 li 720 sa 40 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
-    ((+ :styles) (:algorithm-0-narrow sbasedon :algorithm-0-num snext :body-text-num "Algorithm 0 Narrow;"))
-    (:algorithm-stmt-narrow :algorithm-0-narrow)
-    
     (:algorithm-0-last-num 18)
     (:algorithm-0-last s :algorithm-0-last-num fi -480 li 720 sa 180 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
     ((+ :styles) (:algorithm-0-last sbasedon :algorithm-0-num snext :body-text-num "Algorithm 0 Last;"))
@@ -264,7 +259,6 @@
     (:algorithm-1-last-num 20)
     (:algorithm-1-last s :algorithm-1-last-num fi -480 li 960 sa 180 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
     ((+ :styles) (:algorithm-1-last sbasedon :algorithm-1-num snext :body-text-num "Algorithm 1 Last;"))
-    (:algorithm-next-stmt :algorithm-1-last)
     
     (:algorithm-2-num 21)
     (:algorithm-2 s :algorithm-2-num fi -480 li 1200 keep keepn nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
@@ -302,67 +296,87 @@
     (:algorithm-9 s :algorithm-9-num fi -480 li 2880 keep keepn nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
     ((+ :styles) (:algorithm-9 sbasedon :algorithm-8-num snext :algorithm-9-num "Algorithm 9;"))
     
-    (:default-paragraph-font-num 30)
+    (:algorithm-0-wide-num 30)
+    (:algorithm-0-wide s :algorithm-0-wide-num fi -480 li 720 sa 40 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
+    ((+ :styles) (:algorithm-0-wide sbasedon :algorithm-0-num snext :algorithm-0-num "Algorithm 0 Wide;"))
+    
+    (:algorithm-1-wide-num 31)
+    (:algorithm-1-wide s :algorithm-1-wide-num fi -480 li 960 sa 40 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
+    ((+ :styles) (:algorithm-1-wide sbasedon :algorithm-1-num snext :algorithm-1-num "Algorithm 1 Wide;"))
+    
+    (:algorithm-2-wide-num 32)
+    (:algorithm-2-wide s :algorithm-2-wide-num fi -480 li 1200 sa 40 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
+    ((+ :styles) (:algorithm-2-wide sbasedon :algorithm-2-num snext :algorithm-2-num "Algorithm 2 Wide;"))
+    
+    (:algorithm-3-wide-num 33)
+    (:algorithm-3-wide s :algorithm-3-wide-num fi -480 li 1440 sa 40 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
+    ((+ :styles) (:algorithm-3-wide sbasedon :algorithm-3-num snext :algorithm-3-num "Algorithm 3 Wide;"))
+    
+    (:algorithm-4-wide-num 34)
+    (:algorithm-4-wide s :algorithm-4-wide-num fi -480 li 1680 sa 40 keep nowidctlpar :asian-keywords hyphpar 0 :10-pt :english)
+    ((+ :styles) (:algorithm-4-wide sbasedon :algorithm-4-num snext :algorithm-4-num "Algorithm 4 Wide;"))
+    
+    (:default-paragraph-font-num 40)
     (:default-paragraph-font cs :default-paragraph-font-num)
     ((+ :styles) (* :default-paragraph-font additive "Default Paragraph Font;"))
     
-    (:page-number-num 31)
+    (:page-number-num 41)
     (:page-number cs :page-number-num)
     ((+ :styles) (* :page-number additive sbasedon :default-paragraph-font-num "page number;"))
     
-    (:character-literal-num 32)
+    (:character-literal-num 42)
     (:character-literal cs :character-literal-num :courier :navy :no-language)
     ((+ :styles) (* :character-literal additive sbasedon :default-paragraph-font-num "Character Literal;"))
     
-    (:character-literal-control-num 33)
+    (:character-literal-control-num 43)
     (:character-literal-control cs :character-literal-control-num :times :navy :no-language)
     ((+ :styles) (* :character-literal-control additive sbasedon :default-paragraph-font-num "Character Literal Control;"))
     
-    (:terminal-num 34)
+    (:terminal-num 44)
     (:terminal cs :terminal-num b :palatino :teal :no-language)
     ((+ :styles) (* :terminal additive sbasedon :default-paragraph-font-num "Terminal;"))
     
-    (:terminal-keyword-num 35)
+    (:terminal-keyword-num 45)
     (:terminal-keyword cs :terminal-keyword-num b :courier :blue :no-language)
     ((+ :styles) (* :terminal-keyword additive sbasedon :terminal-num "Terminal Keyword;"))
     
-    (:nonterminal-num 36)
+    (:nonterminal-num 46)
     (:nonterminal cs :nonterminal-num i :palatino :maroon :no-language)
     ((+ :styles) (* :nonterminal additive sbasedon :default-paragraph-font-num "Nonterminal;"))
     
-    (:nonterminal-attribute-num 37)
+    (:nonterminal-attribute-num 47)
     (:nonterminal-attribute cs :nonterminal-attribute-num i 0 :no-language)
     ((+ :styles) (* :nonterminal-attribute additive sbasedon :default-paragraph-font-num "Nonterminal Attribute;"))
     
-    (:nonterminal-argument-num 38)
+    (:nonterminal-argument-num 48)
     (:nonterminal-argument cs :nonterminal-argument-num :no-language)
     ((+ :styles) (* :nonterminal-argument additive sbasedon :default-paragraph-font-num "Nonterminal Argument;"))
     
-    (:semantic-keyword-num 40)
+    (:semantic-keyword-num 50)
     (:semantic-keyword cs :semantic-keyword-num b :times)
     ((+ :styles) (* :semantic-keyword additive sbasedon :default-paragraph-font-num "Semantic Keyword;"))
     
-    (:type-name-num 41)
+    (:type-name-num 51)
     (:type-name cs :type-name-num scaps :times :red :no-language)
     ((+ :styles) (* :type-name additive sbasedon :default-paragraph-font-num "Type Name;"))
     
-    (:field-name-num 42)
+    (:field-name-num 52)
     (:field-name cs :field-name-num :helvetica :no-language)
     ((+ :styles) (* :field-name additive sbasedon :default-paragraph-font-num "Field Name;"))
     
-    (:tag-name-num 43)
+    (:tag-name-num 53)
     (:tag-name cs :tag-name-num :helvetica b :no-language)
     ((+ :styles) (* :tag-name additive sbasedon :default-paragraph-font-num "Tag Name;"))
     
-    (:global-variable-num 44)
+    (:global-variable-num 54)
     (:global-variable cs :global-variable-num i :times :dark-green :no-language)
     ((+ :styles) (* :global-variable additive sbasedon :default-paragraph-font-num "Global Variable;"))
     
-    (:variable-num 45)
+    (:variable-num 55)
     (:variable cs :variable-num i :times :green :no-language)
     ((+ :styles) (* :variable additive sbasedon :default-paragraph-font-num "Variable;"))
     
-    (:action-name-num 46)
+    (:action-name-num 56)
     (:action-name cs :action-name-num :zapf-chancery :purple :no-language)
     ((+ :styles) (* :action-name additive sbasedon :default-paragraph-font-num "Action Name;"))
     
@@ -455,8 +469,8 @@
 (defparameter *division-widths*
   '((:nowrap . 0)
     (:level . 4)
+    (:level-wide . 4)
     (:algorithm . 0)
-    (:algorithm-next . 4)
     (:grammar-rule . 0)
     (:js2 . 0)
     (:es4 . 0)))
@@ -473,7 +487,23 @@
             (:statement-6 . :statement-7)
             (:statement-7 . :statement-8)
             (:statement-8 . :statement-9)
-            (:statement-last . :statement-1-last))
+            (:statement-last . :statement-1-last)
+            (:statement-1-last . :statement-2-last)
+            (:statement-2-last . :statement-3-last)
+            (:statement-3-last . :statement-4-last))
+    (:level-wide (:statement . :statement-1)
+                 (:statement-1 . :statement-2)
+                 (:statement-2 . :statement-3)
+                 (:statement-3 . :statement-4)
+                 (:statement-4 . :statement-5)
+                 (:statement-5 . :statement-6)
+                 (:statement-6 . :statement-7)
+                 (:statement-7 . :statement-8)
+                 (:statement-8 . :statement-9)
+                 (:statement-last . :statement-1-wide)
+                 (:statement-1-last . :statement-2-wide)
+                 (:statement-2-last . :statement-3-wide)
+                 (:statement-3-last . :statement-4-wide))
     (:algorithm (:statement . :algorithm-0)
                 (:statement-1 . :algorithm-1)
                 (:statement-2 . :algorithm-2)
@@ -485,18 +515,12 @@
                 (:statement-8 . :algorithm-8)
                 (:statement-9 . :algorithm-9)
                 (:statement-last . :algorithm-0-last)
-                (:statement-1-last . :algorithm-1-last))
-    (:algorithm-next (:statement . :algorithm-1)
-                     (:statement-1 . :algorithm-2)
-                     (:statement-2 . :algorithm-3)
-                     (:statement-3 . :algorithm-4)
-                     (:statement-4 . :algorithm-5)
-                     (:statement-5 . :algorithm-6)
-                     (:statement-6 . :algorithm-7)
-                     (:statement-7 . :algorithm-8)
-                     (:statement-8 . :algorithm-9)
-                     (:statement-last . :algorithm-1-last)
-                     (:statement-1-last . :algorithm-2-last))
+                (:statement-1-last . :algorithm-1-last)
+                (:statement-2-last . :algorithm-2-last)
+                (:statement-1-wide . :algorithm-1-wide)
+                (:statement-2-wide . :algorithm-2-wide)
+                (:statement-3-wide . :algorithm-3-wide)
+                (:statement-4-wide . :algorithm-4-wide))
     (:grammar-rule . t)
     (:js2 . t)
     (:es4 . t)))

mozilla/js2/semantics/styles.css

@@ -35,11 +35,10 @@ DT {font-style: italic; margin-top: 3pt}
 
 .stmt {margin-left: 36pt; text-indent: -36pt}
 .lvl {margin-left: 18pt}
+.lvl-wide {margin-left: 18pt; margin-bottom: 6pt}
 .algorithm {margin-left: 9pt; margin-top: 6pt; margin-bottom: 6pt}
-.algorithm-next {margin-left: 27pt; margin-bottom: 6pt}
 .algorithm-indent {margin-left: 36pt; margin-top: 6pt; margin-bottom: 6pt}
 .algorithm-stmt {margin-left: 45pt; text-indent: -36pt; margin-top: 6pt; margin-bottom: 6pt}
-.algorithm-next-stmt {margin-left: 63pt; text-indent: -36pt; margin-bottom: 6pt}
 
 .symbol {font-family: Symbol}
 .unicode {font-family: "Lucida Sans Unicode", serif}