(deftrans-defn-stmt names bodies extra-args extra-args-names) → *
Function:
(defun deftrans-defn-stmt (names bodies extra-args extra-args-names) (declare (xargs :guard (and (alistp names) (alistp bodies) (true-listp extra-args) (true-listp extra-args-names)))) (let ((__function__ 'deftrans-defn-stmt)) (declare (ignorable __function__)) (deftrans-defn 'stmt names bodies '((stmt stmtp)) extra-args (cons 'stmt-case (cons 'stmt (cons ':labeled (cons (cons 'make-stmt-labeled (cons ':label (cons (cons (cdr (assoc-eq 'label names)) (cons 'stmt.label extra-args-names)) (cons ':stmt (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.stmt extra-args-names)) 'nil))))) (cons ':compound (cons (cons 'stmt-compound (cons (cons (cdr (assoc-eq 'block-item-list names)) (cons 'stmt.items extra-args-names)) 'nil)) (cons ':expr (cons (cons 'stmt-expr (cons (cons (cdr (assoc-eq 'expr-option names)) (cons 'stmt.expr? extra-args-names)) 'nil)) (cons ':if (cons (cons 'make-stmt-if (cons ':test (cons (cons (cdr (assoc-eq 'expr names)) (cons 'stmt.test extra-args-names)) (cons ':then (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.then extra-args-names)) 'nil))))) (cons ':ifelse (cons (cons 'make-stmt-ifelse (cons ':test (cons (cons (cdr (assoc-eq 'expr names)) (cons 'stmt.test extra-args-names)) (cons ':then (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.then extra-args-names)) (cons ':else (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.else extra-args-names)) 'nil))))))) (cons ':switch (cons (cons 'make-stmt-switch (cons ':target (cons (cons (cdr (assoc-eq 'expr names)) (cons 'stmt.target extra-args-names)) (cons ':body (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.body extra-args-names)) 'nil))))) (cons ':while (cons (cons 'make-stmt-while (cons ':test (cons (cons (cdr (assoc-eq 'expr names)) (cons 'stmt.test extra-args-names)) (cons ':body (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.body extra-args-names)) 'nil))))) (cons ':dowhile (cons (cons 'make-stmt-dowhile (cons ':body (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.body extra-args-names)) (cons ':test (cons (cons (cdr (assoc-eq 'expr names)) (cons 'stmt.test extra-args-names)) 'nil))))) (cons ':for-expr (cons (cons 'make-stmt-for-expr (cons ':init (cons (cons (cdr (assoc-eq 'expr-option names)) (cons 'stmt.init extra-args-names)) (cons ':test (cons (cons (cdr (assoc-eq 'expr-option names)) (cons 'stmt.test extra-args-names)) (cons ':next (cons (cons (cdr (assoc-eq 'expr-option names)) (cons 'stmt.next extra-args-names)) (cons ':body (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.body extra-args-names)) 'nil))))))))) (cons ':for-decl (cons (cons 'make-stmt-for-decl (cons ':init (cons (cons (cdr (assoc-eq 'decl names)) (cons 'stmt.init extra-args-names)) (cons ':test (cons (cons (cdr (assoc-eq 'expr-option names)) (cons 'stmt.test extra-args-names)) (cons ':next (cons (cons (cdr (assoc-eq 'expr-option names)) (cons 'stmt.next extra-args-names)) (cons ':body (cons (cons (cdr (assoc-eq 'stmt names)) (cons 'stmt.body extra-args-names)) 'nil))))))))) (cons ':for-ambig (cons '(prog2$ (raise "Misusage error: ~x0." (stmt-fix stmt)) (stmt-fix stmt)) (cons ':goto (cons '(stmt-fix stmt) (cons ':continue (cons '(stmt-fix stmt) (cons ':break (cons '(stmt-fix stmt) (cons ':return (cons (cons 'stmt-return (cons (cons (cdr (assoc-eq 'expr-option names)) (cons 'stmt.expr? extra-args-names)) 'nil)) '(:asm (stmt-fix stmt)))))))))))))))))))))))))))))))))) '(:returns (new-stmt stmtp) :measure (stmt-count stmt)))))