; We will define what it is to be an expression.
; We will define how to substitute an expression for a variable in an expression.
; We will prove that that produces an expression.
; Example Expressions: X, (F X), (F X (G Y)), (F A (G (G (G (H X Y)))))
; expr := variable | (sym expr-lst)
; expr-lst := {} | expr expr-lst
; Informally, an expression is either a variable symbol or a function symbol
; followed by a list of expressions.
(mutual-recursion
(defun exprp (x)
; An expression is either a symbol, or a list beginning with a symbol and
; followed by a list of expressions.
(if (atom x)
(symbolp x)
(and (symbolp (car x))
(expr-listp (cdr x)))))
(defun expr-listp (x)
; An expression list is either nil or an expression followed by an expression list.
(if (atom x)
(equal x nil)
(and (exprp (car x))
(expr-listp (cdr x))))))
; Test:
(exprp '(F A (G B (H (H (H X))))))
(exprp '(F A (G B (123 (H (H X))))))
(exprp '(F A (G B (H (H (H X . 27))))))
(mutual-recursion
(defun subst-expr-for-var (z v x)
; Substitute expression z for variable v in expression x.
(cond ((atom x)
(if (equal x v) z x))
(t (cons (car x)
(subst-expr-for-var-in-expr-list z v (cdr x))))))
(defun subst-expr-for-var-in-expr-list (z v x)
(cond ((endp x) nil)
(t (cons (subst-expr-for-var z v (car x))
(subst-expr-for-var-in-expr-list z v (cdr x)))))))
(subst-expr-for-var '(AAA X Y) 'V '(F A (G V (H (H (H X V))))))
; This formula is not provable right now...
;(defthm main-theorem
; (implies (and (exprp z)
; (symbolp v)
; (exprp x))
; (exprp (subst-expr-for-var z v x))))
(defun expr-fn (fn x)
; An expression is either a symbol, or a list beginning with a symbol and
; followed by a list of expressions.
(if (equal fn 'expr)
(if (atom x)
(symbolp x)
(and (symbolp (car x))
(expr-fn 'list (cdr x))))
; An expression list is either nil or an expression followed by an expression list.
(if (atom x)
(equal x nil)
(and (expr-fn 'expr (car x))
(expr-fn 'list (cdr x))))))
(expr-fn 'expr '(F A (G B (H (H (H X))))))
(defun subst-fn (fn z v x)
; Substitute expression z for variable v in expression x.
(if (equal fn 'expr)
(cond ((atom x)
(if (equal x v) z x))
(t (cons (car x)
(subst-fn 'list z v (cdr x)))))
(cond ((endp x) nil)
(t (cons (subst-fn 'expr z v (car x))
(subst-fn 'list z v (cdr x)))))))
(subst-fn 'expr '(AAA X Y) 'V '(F V (G B (H (V V (H X))))))
(defthm very-strong-main
(implies (and (expr-fn 'expr z)
(symbolp v)
(expr-fn fnx x))
(expr-fn fnx (subst-fn fnx z v x))))
; In the proof of main-theorem below, we use very-strong-main above.
; That use produces this subgoal:
; Goal'
; (IMPLIES (IMPLIES (AND (EXPR-FN 'EXPR Z)
; (SYMBOLP V)
; (EXPR-FN 'EXPR X))
; (EXPR-FN 'EXPR (SUBST-FN 'EXPR Z V X)))
; (IMPLIES (AND (EXPRP Z) (SYMBOLP V) (EXPRP X))
; (EXPRP (SUBST-EXPR-FOR-VAR Z V X))))
(defthm expr-revealed
(equal (expr-fn fn x)
(if (equal fn 'expr)
(exprp x)
(expr-listp x))))
(defthm subst-revealed
(equal (subst-fn fn z v x)
(if (equal fn 'expr)
(subst-expr-for-var z v x)
(subst-expr-for-var-in-expr-list z v x))))
(defthm main-theorem
(implies (and (exprp z)
(symbolp v)
(exprp x))
(exprp (subst-expr-for-var z v x)))
:hints (("Goal" :use (:instance very-strong-main
(fnx 'expr)))))
(defthm main-theorem-list-version
(implies (and (exprp z)
(symbolp v)
(expr-listp x))
(expr-listp (subst-expr-for-var-in-expr-list z v x)))
:hints (("Goal" :use (:instance very-strong-main
(fnx 'list)))))
; To deal with mutual recursion we usually have two choices:
; (1) eliminate one of the functions in favor of the other -- this is only possible
; if one of the functions calls the other but not itself.
; (2) define a ``dispatcher'' function which mimics both mutually-recursive functions
; and then prove general theorems about the dispatcher and later instantiate them
; Method (2) always works. You can always eliminate mutual recursion by using the
; dispatcher trick.