diff --git a/mozilla/js2/semantics/Calculus.lisp b/mozilla/js2/semantics/Calculus.lisp index f7fcce287ce..db98e922874 100644 --- a/mozilla/js2/semantics/Calculus.lisp +++ b/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 ) -(defun scan-declare-action (world grammar-info-var action-name general-grammar-symbol-source type-expr n-productions) - (declare (ignore n-productions)) +; (declare-action ... ) +; 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; +; contains the names of the action parameters when 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 ) -; (actfun ) -(defun scan-action (world grammar-info-var action-name production-name type-expr n-productions value-expr) - (declare (ignore n-productions)) +; (action ) +; (actfun ) +; 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 ... ) +; ==> +; (declare-action ... ) +(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 (? ...), 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 ) ; ==> -; (action ) +; (action ) ; -; (action ( () ... ()) (-> ( ... ) ) . ) +; (action ( () ... ()) (-> ( ... ) ) . ) ; ==> -; (actfun (-> ( ... ) ) +; (actfun (-> ( ... ) ) ; (lambda (( ) ... ( )) . )) -(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 ( . ) ... ( . )) +; (production ) ; ==> ; grammar: ; ( ) ; commands: ; (%rule ) -; (action 1 . ) -; ... -; (action 1 . ) -(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 @@ -5105,15 +5125,15 @@ ; (%rule ) ; ... ; (%rule ) -; (declare-action ) -; (action . ) +; (declare-action ) +; (action . ) ; ... -; (action . ) +; (action . ) ; ... -; (declare-action ) -; (action . ) +; (declare-action ) +; (action . ) ; ... -; (action . ) +; (action . ) ; ; The productions may be enclosed by (? ...) 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)))) diff --git a/mozilla/js2/semantics/CalculusMarkup.lisp b/mozilla/js2/semantics/CalculusMarkup.lisp index 0794a212e93..b47ab918ccb 100644 --- a/mozilla/js2/semantics/CalculusMarkup.lisp +++ b/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 ) -(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 ) ; (var ) -(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 ( ( [:unused]) ... ( [:unused])) . ) -(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))) ; (<- ) -(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 @@ ; (&= ) -(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 []) -(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 ( . ) ... ( . ) [(nil . )]) -(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 . ) -(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 ) -(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 ) -(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 ( [:unused]) . ) -(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 , which must be a variable, to this case's ; :otherwise Catch-all else case; 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 ) -(defun depict-declare-action (markup-stream world depict-env action-name general-grammar-symbol-source type-expr n-productions) +; (declare-action ... ) +; 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; +; contains the names of the action parameters when 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 ) -(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 ) +; 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 (-> ( ... ) ) +; (actfun (-> ( ... ) ) ; (lambda (( ) ... ( )) . )) -(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)) +; 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 ) diff --git a/mozilla/js2/semantics/HTML-To-RTF/Convert.lisp b/mozilla/js2/semantics/HTML-To-RTF/Convert.lisp index a70839da505..16b06688e52 100644 --- a/mozilla/js2/semantics/HTML-To-RTF/Convert.lisp +++ b/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") |# diff --git a/mozilla/js2/semantics/HTML.lisp b/mozilla/js2/semantics/HTML.lisp index 1d358f8af81..515caaa49bb 100644 --- a/mozilla/js2/semantics/HTML.lisp +++ b/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) diff --git a/mozilla/js2/semantics/JS20/Parser.lisp b/mozilla/js2/semantics/JS20/Parser.lisp index 1e2ee477ed6..6b9dbc7fc81 100644 --- a/mozilla/js2/semantics/JS20/Parser.lisp +++ b/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))) diff --git a/mozilla/js2/semantics/JS20/RegExp.lisp b/mozilla/js2/semantics/JS20/RegExp.lisp index 13cac2a6c8e..69570149201 100644 --- a/mozilla/js2/semantics/JS20/RegExp.lisp +++ b/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) diff --git a/mozilla/js2/semantics/Lexer.lisp b/mozilla/js2/semantics/Lexer.lisp index a88faab52f7..86d625d2ad0 100644 --- a/mozilla/js2/semantics/Lexer.lisp +++ b/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 diff --git a/mozilla/js2/semantics/RTF.lisp b/mozilla/js2/semantics/RTF.lisp index da7049a91fe..4a6d017eccf 100644 --- a/mozilla/js2/semantics/RTF.lisp +++ b/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))) diff --git a/mozilla/js2/semantics/styles.css b/mozilla/js2/semantics/styles.css index 1485df0e780..12e5b979edc 100644 --- a/mozilla/js2/semantics/styles.css +++ b/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}