# HG changeset patch # User kleing # Date 1049552338 -7200 # Node ID 8018173a79799e099fb4f91b9360a3cc14afc82c # Parent 19849d25889013d56eda5fed546d7302b28ae5e5 cleanup, mark old (<1994) deleted files as dead diff -r 19849d258890 -r 8018173a7979 doc-src/Errata.txt --- a/doc-src/Errata.txt Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -ERRATA FOR ISABELLE MANUAL - -** THM : BASIC INFERENCE ** - -Pure/tactic/lift_inst_rule: now checks for distinct parameters (could also -compare with free variable names, though). Variables in the insts are now -lifted over all parameters; their index is also increased. Type vars in -the lhs variables are also increased by maxidx+1; this is essential for HOL -examples to work. - - -** THEORY MATTERS (GENERAL) ** - -Definitions: users must ensure that the left-hand side is nothing -more complex than a function application -- never using fancy syntax. E.g. -never -> ("the_def", "THE y. P(y) == Union({y . x:{0}, P(y)})" ), -but -< ("the_def", "The(P) == Union({y . x:{0}, P(y)})" ), - -Provers/classical, simp (new simplifier), tsimp (old simplifier), ind - -** SYSTEMS MATTERS ** - -explain make system? maketest - -expandshort diff -r 19849d258890 -r 8018173a7979 doc-src/Intro/intro.toc --- a/doc-src/Intro/intro.toc Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,70 +0,0 @@ -\contentsline {part}{\uppercase {i}\phspace {1em}Foundations}{1} -\contentsline {section}{\numberline {1}Formalizing logical syntax in Isabelle}{1} -\contentsline {subsection}{\numberline {1.1}Simple types and constants}{1} -\contentsline {subsection}{\numberline {1.2}Polymorphic types and constants}{3} -\contentsline {subsection}{\numberline {1.3}Higher types and quantifiers}{5} -\contentsline {section}{\numberline {2}Formalizing logical rules in Isabelle}{5} -\contentsline {subsection}{\numberline {2.1}Expressing propositional rules}{6} -\contentsline {subsection}{\numberline {2.2}Quantifier rules and substitution}{7} -\contentsline {subsection}{\numberline {2.3}Signatures and theories}{8} -\contentsline {section}{\numberline {3}Proof construction in Isabelle}{9} -\contentsline {subsection}{\numberline {3.1}Higher-order unification}{10} -\contentsline {subsection}{\numberline {3.2}Joining rules by resolution}{11} -\contentsline {section}{\numberline {4}Lifting a rule into a context}{13} -\contentsline {subsection}{\numberline {4.1}Lifting over assumptions}{13} -\contentsline {subsection}{\numberline {4.2}Lifting over parameters}{14} -\contentsline {section}{\numberline {5}Backward proof by resolution}{15} -\contentsline {subsection}{\numberline {5.1}Refinement by resolution}{15} -\contentsline {subsection}{\numberline {5.2}Proof by assumption}{16} -\contentsline {subsection}{\numberline {5.3}A propositional proof}{16} -\contentsline {subsection}{\numberline {5.4}A quantifier proof}{17} -\contentsline {subsection}{\numberline {5.5}Tactics and tacticals}{18} -\contentsline {section}{\numberline {6}Variations on resolution}{18} -\contentsline {subsection}{\numberline {6.1}Elim-resolution}{19} -\contentsline {subsection}{\numberline {6.2}Destruction rules}{20} -\contentsline {subsection}{\numberline {6.3}Deriving rules by resolution}{21} -\contentsline {part}{\uppercase {ii}\phspace {1em}Getting Started with Isabelle}{23} -\contentsline {section}{\numberline {7}Forward proof}{23} -\contentsline {subsection}{\numberline {7.1}Lexical matters}{23} -\contentsline {subsection}{\numberline {7.2}Syntax of types and terms}{24} -\contentsline {subsection}{\numberline {7.3}Basic operations on theorems}{25} -\contentsline {subsection}{\numberline {7.4}*Flex-flex constraints}{27} -\contentsline {section}{\numberline {8}Backward proof}{28} -\contentsline {subsection}{\numberline {8.1}The basic tactics}{28} -\contentsline {subsection}{\numberline {8.2}Commands for backward proof}{29} -\contentsline {subsection}{\numberline {8.3}A trivial example in propositional logic}{29} -\contentsline {subsection}{\numberline {8.4}Part of a distributive law}{31} -\contentsline {section}{\numberline {9}Quantifier reasoning}{32} -\contentsline {subsection}{\numberline {9.1}Two quantifier proofs: a success and a failure}{32} -\contentsline {paragraph}{The successful proof.}{32} -\contentsline {paragraph}{The unsuccessful proof.}{33} -\contentsline {subsection}{\numberline {9.2}Nested quantifiers}{33} -\contentsline {paragraph}{The wrong approach.}{34} -\contentsline {paragraph}{The right approach.}{34} -\contentsline {paragraph}{A one-step proof using tacticals.}{35} -\contentsline {subsection}{\numberline {9.3}A realistic quantifier proof}{36} -\contentsline {subsection}{\numberline {9.4}The classical reasoner}{37} -\contentsline {part}{\uppercase {iii}\phspace {1em}Advanced Methods}{39} -\contentsline {section}{\numberline {10}Deriving rules in Isabelle}{39} -\contentsline {subsection}{\numberline {10.1}Deriving a rule using tactics and meta-level assumptions}{39} -\contentsline {subsection}{\numberline {10.2}Definitions and derived rules}{41} -\contentsline {subsection}{\numberline {10.3}Deriving the $\neg $ introduction rule}{41} -\contentsline {subsection}{\numberline {10.4}Deriving the $\neg $ elimination rule}{42} -\contentsline {section}{\numberline {11}Defining theories}{44} -\contentsline {subsection}{\numberline {11.1}Declaring constants, definitions and rules}{46} -\contentsline {subsection}{\numberline {11.2}Declaring type constructors}{46} -\contentsline {subsection}{\numberline {11.3}Type synonyms}{48} -\contentsline {subsection}{\numberline {11.4}Infix and mixfix operators}{48} -\contentsline {subsection}{\numberline {11.5}Overloading}{50} -\contentsline {section}{\numberline {12}Theory example: the natural numbers}{51} -\contentsline {subsection}{\numberline {12.1}Extending first-order logic with the natural numbers}{51} -\contentsline {subsection}{\numberline {12.2}Declaring the theory to Isabelle}{52} -\contentsline {subsection}{\numberline {12.3}Proving some recursion equations}{52} -\contentsline {section}{\numberline {13}Refinement with explicit instantiation}{53} -\contentsline {subsection}{\numberline {13.1}A simple proof by induction}{53} -\contentsline {subsection}{\numberline {13.2}An example of ambiguity in {\ptt resolve_tac}}{54} -\contentsline {subsection}{\numberline {13.3}Proving that addition is associative}{55} -\contentsline {section}{\numberline {14}A Prolog interpreter}{56} -\contentsline {subsection}{\numberline {14.1}Simple executions}{57} -\contentsline {subsection}{\numberline {14.2}Backtracking}{58} -\contentsline {subsection}{\numberline {14.3}Depth-first search}{59} diff -r 19849d258890 -r 8018173a7979 doc-src/Logics/defining.tex --- a/doc-src/Logics/defining.tex Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1582 +0,0 @@ -%% $Id$ -%% \([a-zA-Z][a-zA-Z]}\.\) \([^ ]\) \1 \2 -%% @\([a-z0-9]\) ^{(\1)} - -\newcommand\rmindex[1]{{#1}\index{#1}\@} -\newcommand\mtt[1]{\mbox{\tt #1}} -\newcommand\ttfct[1]{\mathop{\mtt{#1}}\nolimits} -\newcommand\ttapp{\mathrel{\hbox{\tt\$}}} -\newcommand\Constant{\ttfct{Constant}} -\newcommand\Variable{\ttfct{Variable}} -\newcommand\Appl[1]{\ttfct{Appl}\mathopen{\mtt[}#1\mathclose{\mtt]}} -\newcommand\AST{{\sc ast}} -\let\rew=\longrightarrow - - -\chapter{Defining Logics} \label{Defining-Logics} - -This chapter explains how to define new formal systems --- in particular, -their concrete syntax. While Isabelle can be regarded as a theorem prover -for set theory, higher-order logic or the sequent calculus, its -distinguishing feature is support for the definition of new logics. - -Isabelle logics are hierarchies of theories, which are described and -illustrated in {\em Introduction to Isabelle}. That material, together -with the theory files provided in the examples directories, should suffice -for all simple applications. The easiest way to define a new theory is by -modifying a copy of an existing theory. - -This chapter is intended for experienced Isabelle users. It documents all -aspects of theories concerned with syntax: mixfix declarations, pretty -printing, macros and translation functions. The extended examples of -\S\ref{sec:min_logics} demonstrate the logical aspects of the definition of -theories. Sections marked with * are highly technical and might be skipped -on the first reading. - - -\section{Priority grammars} \label{sec:priority_grammars} -\index{grammars!priority|(} - -The syntax of an Isabelle logic is specified by a {\bf priority grammar}. -A context-free grammar\index{grammars!context-free} contains a set of -productions of the form $A=\gamma$, where $A$ is a nonterminal and -$\gamma$, the right-hand side, is a string of terminals and nonterminals. -Isabelle uses an extended format permitting {\bf priorities}, or -precedences. Each nonterminal is decorated by an integer priority, as -in~$A^{(p)}$. A nonterminal $A^{(p)}$ in a derivation may be replaced -using a production $A^{(q)} = \gamma$ only if $p \le q$. Any priority -grammar can be translated into a normal context free grammar by introducing -new nonterminals and productions. - -Formally, a set of context free productions $G$ induces a derivation -relation $\rew@G$. Let $\alpha$ and $\beta$ denote strings of terminal or -nonterminal symbols. Then -\[ \alpha\, A^{(p)}\, \beta ~\rew@G~ \alpha\,\gamma\,\beta \] -if and only if $G$ contains some production $A^{(q)}=\gamma$ for~$q\ge p$. - -The following simple grammar for arithmetic expressions demonstrates how -binding power and associativity of operators can be enforced by priorities. -\begin{center} -\begin{tabular}{rclr} - $A^{(9)}$ & = & {\tt0} \\ - $A^{(9)}$ & = & {\tt(} $A^{(0)}$ {\tt)} \\ - $A^{(0)}$ & = & $A^{(0)}$ {\tt+} $A^{(1)}$ \\ - $A^{(2)}$ & = & $A^{(3)}$ {\tt*} $A^{(2)}$ \\ - $A^{(3)}$ & = & {\tt-} $A^{(3)}$ -\end{tabular} -\end{center} -The choice of priorities determines that {\tt -} binds tighter than {\tt *}, -which binds tighter than {\tt +}. Furthermore {\tt +} associates to the -left and {\tt *} to the right. - -To minimize the number of subscripts, we adopt the following conventions: -\begin{itemize} -\item All priorities $p$ must be in the range $0 \leq p \leq max_pri$ for - some fixed integer $max_pri$. -\item Priority $0$ on the right-hand side and priority $max_pri$ on the - left-hand side may be omitted. -\end{itemize} -The production $A^{(p)} = \alpha$ is written as $A = \alpha~(p)$; -the priority of the left-hand side actually appears in a column on the far -right. Finally, alternatives may be separated by $|$, and repetition -indicated by \dots. - -Using these conventions and assuming $max_pri=9$, the grammar takes the form -\begin{center} -\begin{tabular}{rclc} -$A$ & = & {\tt0} & \hspace*{4em} \\ - & $|$ & {\tt(} $A$ {\tt)} \\ - & $|$ & $A$ {\tt+} $A^{(1)}$ & (0) \\ - & $|$ & $A^{(3)}$ {\tt*} $A^{(2)}$ & (2) \\ - & $|$ & {\tt-} $A^{(3)}$ & (3) -\end{tabular} -\end{center} -\index{grammars!priority|)} - - -\begin{figure} -\begin{center} -\begin{tabular}{rclc} -$prop$ &=& \ttindex{PROP} $aprop$ ~~$|$~~ {\tt(} $prop$ {\tt)} \\ - &$|$& $logic^{(3)}$ \ttindex{==} $logic^{(2)}$ & (2) \\ - &$|$& $logic^{(3)}$ \ttindex{=?=} $logic^{(2)}$ & (2) \\ - &$|$& $prop^{(2)}$ \ttindex{==>} $prop^{(1)}$ & (1) \\ - &$|$& {\tt[|} $prop$ {\tt;} \dots {\tt;} $prop$ {\tt|]} {\tt==>} $prop^{(1)}$ & (1) \\ - &$|$& {\tt!!} $idts$ {\tt.} $prop$ & (0) \\\\ -$logic$ &=& $prop$ ~~$|$~~ $fun$ \\\\ -$aprop$ &=& $id$ ~~$|$~~ $var$ - ~~$|$~~ $fun^{(max_pri)}$ {\tt(} $logic$ {\tt,} \dots {\tt,} $logic$ {\tt)} \\\\ -$fun$ &=& $id$ ~~$|$~~ $var$ ~~$|$~~ {\tt(} $fun$ {\tt)} \\ - &$|$& $fun^{(max_pri)}$ {\tt(} $logic$ {\tt,} \dots {\tt,} $logic$ {\tt)} \\ - &$|$& $fun^{(max_pri)}$ {\tt::} $type$ \\ - &$|$& \ttindex{\%} $idts$ {\tt.} $logic$ & (0) \\\\ -$idts$ &=& $idt$ ~~$|$~~ $idt^{(1)}$ $idts$ \\\\ -$idt$ &=& $id$ ~~$|$~~ {\tt(} $idt$ {\tt)} \\ - &$|$& $id$ \ttindex{::} $type$ & (0) \\\\ -$type$ &=& $tid$ ~~$|$~~ $tvar$ ~~$|$~~ $tid$ {\tt::} $sort$ - ~~$|$~~ $tvar$ {\tt::} $sort$ \\ - &$|$& $id$ ~~$|$~~ $type^{(max_pri)}$ $id$ - ~~$|$~~ {\tt(} $type$ {\tt,} \dots {\tt,} $type$ {\tt)} $id$ \\ - &$|$& $type^{(1)}$ \ttindex{=>} $type$ & (0) \\ - &$|$& {\tt[} $type$ {\tt,} \dots {\tt,} $type$ {\tt]} {\tt=>} $type$&(0)\\ - &$|$& {\tt(} $type$ {\tt)} \\\\ -$sort$ &=& $id$ ~~$|$~~ {\tt\ttlbrace\ttrbrace} - ~~$|$~~ {\tt\ttlbrace} $id$ {\tt,} \dots {\tt,} $id$ {\tt\ttrbrace} -\end{tabular}\index{*"!"!}\index{*"["|}\index{*"|"]} -\indexbold{type@$type$} \indexbold{sort@$sort$} \indexbold{idt@$idt$} -\indexbold{idts@$idts$} \indexbold{logic@$logic$} \indexbold{prop@$prop$} -\indexbold{fun@$fun$} -\end{center} -\caption{Meta-logic syntax}\label{fig:pure_gram} -\end{figure} - - -\section{The Pure syntax} \label{sec:basic_syntax} -\index{syntax!Pure|(} - -At the root of all object-logics lies the Pure theory,\index{theory!Pure} -bound to the \ML{} identifier \ttindex{Pure.thy}. It contains, among many -other things, the Pure syntax. An informal account of this basic syntax -(meta-logic, types, \ldots) may be found in {\em Introduction to Isabelle}. -A more precise description using a priority grammar is shown in -Fig.\ts\ref{fig:pure_gram}. The following nonterminals are defined: -\begin{description} - \item[$prop$] Terms of type $prop$. These are formulae of the meta-logic. - - \item[$aprop$] Atomic propositions. These typically include the - judgement forms of the object-logic; its definition introduces a - meta-level predicate for each judgement form. - - \item[$logic$] Terms whose type belongs to class $logic$. Initially, - this category contains just $prop$. As the syntax is extended by new - object-logics, more productions for $logic$ are added automatically - (see below). - - \item[$fun$] Terms potentially of function type. - - \item[$type$] Types of the meta-logic. - - \item[$idts$] A list of identifiers, possibly constrained by types. -\end{description} - -\begin{warn} - Note that \verb|x::nat y| is parsed as \verb|x::(nat y)|, treating {\tt - y} like a type constructor applied to {\tt nat}. The likely result is - an error message. To avoid this interpretation, use parentheses and - write \verb|(x::nat) y|. - - Similarly, \verb|x::nat y::nat| is parsed as \verb|x::(nat y::nat)| and - yields a syntax error. The correct form is \verb|(x::nat) (y::nat)|. -\end{warn} - -\subsection{Logical types and default syntax}\label{logical-types} -Isabelle's representation of mathematical languages is based on the typed -$\lambda$-calculus. All logical types, namely those of class $logic$, are -automatically equipped with a basic syntax of types, identifiers, -variables, parentheses, $\lambda$-abstractions and applications. - -More precisely, for each type constructor $ty$ with arity $(\vec{s})c$, -where $c$ is a subclass of $logic$, several productions are added: -\begin{center} -\begin{tabular}{rclc} -$ty$ &=& $id$ ~~$|$~~ $var$ ~~$|$~~ {\tt(} $ty$ {\tt)} \\ - &$|$& $fun^{(max_pri)}$ {\tt(} $logic$ {\tt,} \dots {\tt,} $logic$ {\tt)}\\ - &$|$& $ty^{(max_pri)}$ {\tt::} $type$\\\\ -$logic$ &=& $ty$ -\end{tabular} -\end{center} - - -\subsection{Lexical matters} -The parser does not process input strings directly. It operates on token -lists provided by Isabelle's \bfindex{lexer}. There are two kinds of -tokens: \bfindex{delimiters} and \bfindex{name tokens}. - -Delimiters can be regarded as reserved words of the syntax. You can -add new ones when extending theories. In Fig.\ts\ref{fig:pure_gram} they -appear in typewriter font, for example {\tt ==}, {\tt =?=} and -{\tt PROP}\@. - -Name tokens have a predefined syntax. The lexer distinguishes four -disjoint classes of names: \rmindex{identifiers}, \rmindex{unknowns}, type -identifiers\index{identifiers!type}, type unknowns\index{unknowns!type}. -They are denoted by $id$\index{id@$id$}, $var$\index{var@$var$}, -$tid$\index{tid@$tid$}, $tvar$\index{tvar@$tvar$}, respectively. Typical -examples are {\tt x}, {\tt ?x7}, {\tt 'a}, {\tt ?'a3}. Here is the precise -syntax: -\begin{eqnarray*} -id & = & letter~quasiletter^* \\ -var & = & \mbox{\tt ?}id ~~|~~ \mbox{\tt ?}id\mbox{\tt .}nat \\ -tid & = & \mbox{\tt '}id \\ -tvar & = & \mbox{\tt ?}tid ~~|~~ - \mbox{\tt ?}tid\mbox{\tt .}nat \\[1ex] -letter & = & \mbox{one of {\tt a}\dots {\tt z} {\tt A}\dots {\tt Z}} \\ -digit & = & \mbox{one of {\tt 0}\dots {\tt 9}} \\ -quasiletter & = & letter ~~|~~ digit ~~|~~ \mbox{\tt _} ~~|~~ \mbox{\tt '} \\ -nat & = & digit^+ -\end{eqnarray*} -A $var$ or $tvar$ describes an unknown, which is internally a pair -of base name and index (\ML\ type \ttindex{indexname}). These components are -either separated by a dot as in {\tt ?x.1} or {\tt ?x7.3} or -run together as in {\tt ?x1}. The latter form is possible if the -base name does not end with digits. If the index is 0, it may be dropped -altogether: {\tt ?x} abbreviates both {\tt ?x0} and {\tt ?x.0}. - -The lexer repeatedly takes the maximal prefix of the input string that -forms a valid token. A maximal prefix that is both a delimiter and a name -is treated as a delimiter. Spaces, tabs and newlines are separators; they -never occur within tokens. - -Delimiters need not be separated by white space. For example, if {\tt -} -is a delimiter but {\tt --} is not, then the string {\tt --} is treated as -two consecutive occurrences of the token~{\tt -}. In contrast, \ML\ -treats {\tt --} as a single symbolic name. The consequence of Isabelle's -more liberal scheme is that the same string may be parsed in different ways -after extending the syntax: after adding {\tt --} as a delimiter, the input -{\tt --} is treated as a single token. - -Name tokens are terminal symbols, strictly speaking, but we can generally -regard them as nonterminals. This is because a name token carries with it -useful information, the name. Delimiters, on the other hand, are nothing -but than syntactic sugar. - - -\subsection{*Inspecting the syntax} -\begin{ttbox} -syn_of : theory -> Syntax.syntax -Syntax.print_syntax : Syntax.syntax -> unit -Syntax.print_gram : Syntax.syntax -> unit -Syntax.print_trans : Syntax.syntax -> unit -\end{ttbox} -The abstract type \ttindex{Syntax.syntax} allows manipulation of syntaxes -in \ML. You can display values of this type by calling the following -functions: -\begin{description} -\item[\ttindexbold{syn_of} {\it thy}] returns the syntax of the Isabelle - theory~{\it thy} as an \ML\ value. - -\item[\ttindexbold{Syntax.print_syntax} {\it syn}] shows virtually all - information contained in the syntax {\it syn}. The displayed output can - be large. The following two functions are more selective. - -\item[\ttindexbold{Syntax.print_gram} {\it syn}] shows the grammar part - of~{\it syn}, namely the lexicon, roots and productions. - -\item[\ttindexbold{Syntax.print_trans} {\it syn}] shows the translation - part of~{\it syn}, namely the constants, parse/print macros and - parse/print translations. -\end{description} - -Let us demonstrate these functions by inspecting Pure's syntax. Even that -is too verbose to display in full. -\begin{ttbox} -Syntax.print_syntax (syn_of Pure.thy); -{\out lexicon: "!!" "\%" "(" ")" "," "." "::" ";" "==" "==>" \dots} -{\out roots: logic type fun prop} -{\out prods:} -{\out type = tid (1000)} -{\out type = tvar (1000)} -{\out type = id (1000)} -{\out type = tid "::" sort[0] => "_ofsort" (1000)} -{\out type = tvar "::" sort[0] => "_ofsort" (1000)} -{\out \vdots} -\ttbreak -{\out consts: "_K" "_appl" "_aprop" "_args" "_asms" "_bigimpl" \dots} -{\out parse_ast_translation: "_appl" "_bigimpl" "_bracket"} -{\out "_idtyp" "_lambda" "_tapp" "_tappl"} -{\out parse_rules:} -{\out parse_translation: "!!" "_K" "_abs" "_aprop"} -{\out print_translation: "all"} -{\out print_rules:} -{\out print_ast_translation: "==>" "_abs" "_idts" "fun"} -\end{ttbox} - -As you can see, the output is divided into labeled sections. The grammar -is represented by {\tt lexicon}, {\tt roots} and {\tt prods}. The rest -refers to syntactic translations and macro expansion. Here is an -explanation of the various sections. -\begin{description} - \item[\ttindex{lexicon}] lists the delimiters used for lexical - analysis.\index{delimiters} - - \item[\ttindex{roots}] lists the grammar's nonterminal symbols. You must - name the desired root when calling lower level functions or specifying - macros. Higher level functions usually expect a type and derive the - actual root as described in~\S\ref{sec:grammar}. - - \item[\ttindex{prods}] lists the productions of the priority grammar. - The nonterminal $A^{(n)}$ is rendered in {\sc ascii} as {\tt $A$[$n$]}. - Each delimiter is quoted. Some productions are shown with {\tt =>} and - an attached string. These strings later become the heads of parse - trees; they also play a vital role when terms are printed (see - \S\ref{sec:asts}). - - Productions with no strings attached are called {\bf copy - productions}\indexbold{productions!copy}. Their right-hand side must - have exactly one nonterminal symbol (or name token). The parser does - not create a new parse tree node for copy productions, but simply - returns the parse tree of the right-hand symbol. - - If the right-hand side consists of a single nonterminal with no - delimiters, then the copy production is called a {\bf chain - production}\indexbold{productions!chain}. Chain productions should - be seen as abbreviations: conceptually, they are removed from the - grammar by adding new productions. Priority information - attached to chain productions is ignored, only the dummy value $-1$ is - displayed. - - \item[\ttindex{consts}, \ttindex{parse_rules}, \ttindex{print_rules}] - relate to macros (see \S\ref{sec:macros}). - - \item[\ttindex{parse_ast_translation}, \ttindex{print_ast_translation}] - list sets of constants that invoke translation functions for abstract - syntax trees. Section \S\ref{sec:asts} below discusses this obscure - matter. - - \item[\ttindex{parse_translation}, \ttindex{print_translation}] list sets - of constants that invoke translation functions for terms (see - \S\ref{sec:tr_funs}). -\end{description} -\index{syntax!Pure|)} - - -\section{Mixfix declarations} \label{sec:mixfix} -\index{mixfix declaration|(} - -When defining a theory, you declare new constants by giving their names, -their type, and an optional {\bf mixfix annotation}. Mixfix annotations -allow you to extend Isabelle's basic $\lambda$-calculus syntax with -readable notation. They can express any context-free priority grammar. -Isabelle syntax definitions are inspired by \OBJ~\cite{OBJ}; they are more -general than the priority declarations of \ML\ and Prolog. - -A mixfix annotation defines a production of the priority grammar. It -describes the concrete syntax, the translation to abstract syntax, and the -pretty printing. Special case annotations provide a simple means of -specifying infix operators, binders and so forth. - -\subsection{Grammar productions}\label{sec:grammar} -Let us examine the treatment of the production -\[ A^{(p)}= w@0\, A@1^{(p@1)}\, w@1\, A@2^{(p@2)}\, \ldots\, - A@n^{(p@n)}\, w@n. \] -Here $A@i^{(p@i)}$ is a nonterminal with priority~$p@i$ for $i=1$, -\ldots,~$n$, while $w@0$, \ldots,~$w@n$ are strings of terminals. -In the corresponding mixfix annotation, the priorities are given separately -as $[p@1,\ldots,p@n]$ and~$p$. The nonterminal symbols are identified with -types~$\tau$, $\tau@1$, \ldots,~$\tau@n$ respectively, and the production's -effect on nonterminals is expressed as the function type -\[ [\tau@1, \ldots, \tau@n]\To \tau. \] -Finally, the template -\[ w@0 \;_\; w@1 \;_\; \ldots \;_\; w@n \] -describes the strings of terminals. - -A simple type is typically declared for each nonterminal symbol. In -first-order logic, type~$i$ stands for terms and~$o$ for formulae. Only -the outermost type constructor is taken into account. For example, any -type of the form $\sigma list$ stands for a list; productions may refer -to the symbol {\tt list} and will apply lists of any type. - -The symbol associated with a type is called its {\bf root} since it may -serve as the root of a parse tree. Precisely, the root of $(\tau@1, \dots, -\tau@n)ty$ is $ty$, where $\tau@1$, \ldots, $\tau@n$ are types and $ty$ is -a type constructor. Type infixes are a special case of this; in -particular, the root of $\tau@1 \To \tau@2$ is {\tt fun}. Finally, the -root of a type variable is {\tt logic}; general productions might -refer to this nonterminal. - -Identifying nonterminals with types allows a constant's type to specify -syntax as well. We can declare the function~$f$ to have type $[\tau@1, -\ldots, \tau@n]\To \tau$ and, through a mixfix annotation, specify the -layout of the function's $n$ arguments. The constant's name, in this -case~$f$, will also serve as the label in the abstract syntax tree. There -are two exceptions to this treatment of constants: -\begin{enumerate} - \item A production need not map directly to a logical function. In this - case, you must declare a constant whose purpose is purely syntactic. - By convention such constants begin with the symbol~{\tt\at}, - ensuring that they can never be written in formulae. - - \item A copy production has no associated constant. -\end{enumerate} -There is something artificial about this representation of productions, -but it is convenient, particularly for simple theory extensions. - -\subsection{The general mixfix form} -Here is a detailed account of the general \bfindex{mixfix declaration} as -it may occur within the {\tt consts} section of a {\tt .thy} file. -\begin{center} - {\tt "$c$" ::\ "$\sigma$" ("$template$" $ps$ $p$)} -\end{center} -This constant declaration and mixfix annotation is interpreted as follows: -\begin{itemize} -\item The string {\tt "$c$"} is the name of the constant associated with - the production. If $c$ is empty (given as~{\tt ""}) then this is a copy - production.\index{productions!copy} Otherwise, parsing an instance of the - phrase $template$ generates the \AST{} {\tt ("$c$" $a@1$ $\ldots$ - $a@n$)}, where $a@i$ is the \AST{} generated by parsing the $i$-th - argument. - - \item The constant $c$, if non-empty, is declared to have type $\sigma$. - - \item The string $template$ specifies the right-hand side of - the production. It has the form - \[ w@0 \;_\; w@1 \;_\; \ldots \;_\; w@n, \] - where each occurrence of \ttindex{_} denotes an - argument\index{argument!mixfix} position and the~$w@i$ do not - contain~{\tt _}. (If you want a literal~{\tt _} in the concrete - syntax, you must escape it as described below.) The $w@i$ may - consist of \rmindex{delimiters}, spaces or \rmindex{pretty - printing} annotations (see below). - - \item The type $\sigma$ specifies the production's nonterminal symbols (or name - tokens). If $template$ is of the form above then $\sigma$ must be a - function type with at least~$n$ argument positions, say $\sigma = - [\tau@1, \dots, \tau@n] \To \tau$. Nonterminal symbols are derived - from the type $\tau@1$, \ldots,~$\tau@n$, $\tau$ as described above. - Any of these may be function types; the corresponding root is then {\tt - fun}. - - \item The optional list~$ps$ may contain at most $n$ integers, say {\tt - [$p@1$, $\ldots$, $p@m$]}, where $p@i$ is the minimal - priority\indexbold{priorities} required of any phrase that may appear - as the $i$-th argument. Missing priorities default to~$0$. - - \item The integer $p$ is the priority of this production. If omitted, it - defaults to the maximal priority. - - Priorities, or precedences, range between $0$ and - $max_pri$\indexbold{max_pri@$max_pri$} (= 1000). -\end{itemize} - -The declaration {\tt $c$ ::\ "$\sigma$" ("$template$")} specifies no -priorities. The resulting production puts no priority constraints on any -of its arguments and has maximal priority itself. Omitting priorities in -this manner will introduce syntactic ambiguities unless the production's -right-hand side is fully bracketed, as in \verb|"if _ then _ else _ fi"|. - -\begin{warn} - Theories must sometimes declare types for purely syntactic purposes. One - example is {\tt type}, the built-in type of types. This is a `type of - all types' in the syntactic sense only. Do not declare such types under - {\tt arities} as belonging to class $logic$, for that would allow their - use in arbitrary Isabelle expressions~(\S\ref{logical-types}). -\end{warn} - -\subsection{Example: arithmetic expressions} -This theory specification contains a {\tt consts} section with mixfix -declarations encoding the priority grammar from -\S\ref{sec:priority_grammars}: -\begin{ttbox} -EXP = Pure + -types - exp -arities - exp :: logic -consts - "0" :: "exp" ("0" 9) - "+" :: "[exp, exp] => exp" ("_ + _" [0, 1] 0) - "*" :: "[exp, exp] => exp" ("_ * _" [3, 2] 2) - "-" :: "exp => exp" ("- _" [3] 3) -end -\end{ttbox} -Note that the {\tt arities} declaration causes {\tt exp} to be added to the -syntax' roots. If you put the text above into a file {\tt exp.thy} and load -it via {\tt use_thy "EXP"}, you can run some tests: -\begin{ttbox} -val read_exp = Syntax.test_read (syn_of EXP.thy) "exp"; -{\out val it = fn : string -> unit} -read_exp "0 * 0 * 0 * 0 + 0 + 0 + 0"; -{\out tokens: "0" "*" "0" "*" "0" "*" "0" "+" "0" "+" "0" "+" "0"} -{\out raw: ("+" ("+" ("+" ("*" "0" ("*" "0" ("*" "0" "0"))) "0") "0") "0")} -{\out \vdots} -read_exp "0 + - 0 + 0"; -{\out tokens: "0" "+" "-" "0" "+" "0"} -{\out raw: ("+" ("+" "0" ("-" "0")) "0")} -{\out \vdots} -\end{ttbox} -The output of \ttindex{Syntax.test_read} includes the token list ({\tt - tokens}) and the raw \AST{} directly derived from the parse tree, -ignoring parse \AST{} translations. The rest is tracing information -provided by the macro expander (see \S\ref{sec:macros}). - -Executing {\tt Syntax.print_gram} reveals the productions derived -from our mixfix declarations (lots of additional information deleted): -\begin{ttbox} -Syntax.print_gram (syn_of EXP.thy); -{\out exp = "0" => "0" (9)} -{\out exp = exp[0] "+" exp[1] => "+" (0)} -{\out exp = exp[3] "*" exp[2] => "*" (2)} -{\out exp = "-" exp[3] => "-" (3)} -\end{ttbox} - - -\subsection{The mixfix template} -Let us take a closer look at the string $template$ appearing in mixfix -annotations. This string specifies a list of parsing and printing -directives: delimiters\index{delimiter}, arguments\index{argument!mixfix}, -spaces, blocks of indentation and line breaks. These are encoded via the -following character sequences: - -\index{pretty printing|(} -\begin{description} - \item[~\ttindex_~] An argument\index{argument!mixfix} position, which - stands for a nonterminal symbol or name token. - - \item[~$d$~] A \rmindex{delimiter}, namely a non-empty sequence of - non-special or escaped characters. Escaping a character\index{escape - character} means preceding it with a {\tt '} (single quote). Thus - you have to write {\tt ''} if you really want a single quote. You must - also escape {\tt _}, {\tt (}, {\tt )} and {\tt /}. Delimiters may - never contain white space, though. - - \item[~$s$~] A non-empty sequence of spaces for printing. This - and the following specifications do not affect parsing at all. - - \item[~{\ttindex($n$}~] Open a pretty printing block. The optional - number $n$ specifies how much indentation to add when a line break - occurs within the block. If {\tt(} is not followed by digits, the - indentation defaults to~$0$. - - \item[~\ttindex)~] Close a pretty printing block. - - \item[~\ttindex{//}~] Force a line break. - - \item[~\ttindex/$s$~] Allow a line break. Here $s$ stands for the string - of spaces (zero or more) right after the {\tt /} character. These - spaces are printed if the break is not taken. -\end{description} -Isabelle's pretty printer resembles the one described in -Paulson~\cite{paulson91}. \index{pretty printing|)} - - -\subsection{Infixes} -\indexbold{infix operators} -Infix operators associating to the left or right can be declared -using {\tt infixl} or {\tt infixr}. -Roughly speaking, the form {\tt $c$ ::\ "$\sigma$" (infixl $p$)} -abbreviates the declarations -\begin{ttbox} -"op \(c\)" :: "\(\sigma\)" ("op \(c\)") -"op \(c\)" :: "\(\sigma\)" ("(_ \(c\)/ _)" [\(p\), \(p+1\)] \(p\)) -\end{ttbox} -and {\tt $c$ ::\ "$\sigma$" (infixr $p$)} abbreviates the declarations -\begin{ttbox} -"op \(c\)" :: "\(\sigma\)" ("op \(c\)") -"op \(c\)" :: "\(\sigma\)" ("(_ \(c\)/ _)" [\(p+1\), \(p\)] \(p\)) -\end{ttbox} -The infix operator is declared as a constant with the prefix {\tt op}. -Thus, prefixing infixes with \ttindex{op} makes them behave like ordinary -function symbols, as in \ML. Special characters occurring in~$c$ must be -escaped, as in delimiters, using a single quote. - -The expanded forms above would be actually illegal in a {\tt .thy} file -because they declare the constant \hbox{\tt"op \(c\)"} twice. - - -\subsection{Binders} -\indexbold{binders} -\begingroup -\def\Q{{\cal Q}} -A {\bf binder} is a variable-binding construct such as a quantifier. The -binder declaration \indexbold{*binder} -\begin{ttbox} -\(c\) :: "\(\sigma\)" (binder "\(\Q\)" \(p\)) -\end{ttbox} -introduces a constant~$c$ of type~$\sigma$, which must have the form -$(\tau@1 \To \tau@2) \To \tau@3$. Its concrete syntax is $\Q~x.P$, where -$x$ is a bound variable of type~$\tau@1$, the body~$P$ has type $\tau@2$ -and the whole term has type~$\tau@3$. Special characters in $\Q$ must be -escaped using a single quote. - -Let us declare the quantifier~$\forall$: -\begin{ttbox} -All :: "('a => o) => o" (binder "ALL " 10) -\end{ttbox} -This let us write $\forall x.P$ as either {\tt All(\%$x$.$P$)} or {\tt ALL - $x$.$P$}. When printing, Isabelle prefers the latter form, but must fall -back on $\mtt{All}(P)$ if $P$ is not an abstraction. Both $P$ and {\tt ALL - $x$.$P$} have type~$o$, the type of formulae, while the bound variable -can be polymorphic. - -The binder~$c$ of type $(\sigma \To \tau) \To \tau$ can be nested. The -external form $\Q~x@1~x@2 \ldots x@n. P$ corresponds to the internal form -\[ c(\lambda x@1. c(\lambda x@2. \ldots c(\lambda x@n. P) \ldots)) \] - -\medskip -The general binder declaration -\begin{ttbox} -\(c\) :: "(\(\tau@1\) => \(\tau@2\)) => \(\tau@3\)" (binder "\(\Q\)" \(p\)) -\end{ttbox} -is internally expanded to -\begin{ttbox} -\(c\) :: "(\(\tau@1\) => \(\tau@2\)) => \(\tau@3\)" -"\(\Q\)"\hskip-3pt :: "[idts, \(\tau@2\)] => \(\tau@3\)" ("(3\(\Q\)_./ _)" \(p\)) -\end{ttbox} -with $idts$ being the nonterminal symbol for a list of $id$s optionally -constrained (see Fig.\ts\ref{fig:pure_gram}). The declaration also -installs a parse translation\index{translations!parse} for~$\Q$ and a print -translation\index{translations!print} for~$c$ to translate between the -internal and external forms. -\endgroup - -\index{mixfix declaration|)} - - -\section{Example: some minimal logics} \label{sec:min_logics} -This section presents some examples that have a simple syntax. They -demonstrate how to define new object-logics from scratch. - -First we must define how an object-logic syntax embedded into the -meta-logic. Since all theorems must conform to the syntax for~$prop$ (see -Fig.\ts\ref{fig:pure_gram}), that syntax has to be extended with the -object-level syntax. Assume that the syntax of your object-logic defines a -nonterminal symbol~$o$ of formulae. These formulae can now appear in -axioms and theorems wherever $prop$ does if you add the production -\[ prop ~=~ o. \] -This is not a copy production but a coercion from formulae to propositions: -\begin{ttbox} -Base = Pure + -types - o -arities - o :: logic -consts - Trueprop :: "o => prop" ("_" 5) -end -\end{ttbox} -The constant {\tt Trueprop} (the name is arbitrary) acts as an invisible -coercion function. Assuming this definition resides in a file {\tt base.thy}, -you have to load it with the command {\tt use_thy "Base"}. - -One of the simplest nontrivial logics is {\bf minimal logic} of -implication. Its definition in Isabelle needs no advanced features but -illustrates the overall mechanism nicely: -\begin{ttbox} -Hilbert = Base + -consts - "-->" :: "[o, o] => o" (infixr 10) -rules - K "P --> Q --> P" - S "(P --> Q --> R) --> (P --> Q) --> P --> R" - MP "[| P --> Q; P |] ==> Q" -end -\end{ttbox} -After loading this definition from the file {\tt hilbert.thy}, you can -start to prove theorems in the logic: -\begin{ttbox} -goal Hilbert.thy "P --> P"; -{\out Level 0} -{\out P --> P} -{\out 1. P --> P} -\ttbreak -by (resolve_tac [Hilbert.MP] 1); -{\out Level 1} -{\out P --> P} -{\out 1. ?P --> P --> P} -{\out 2. ?P} -\ttbreak -by (resolve_tac [Hilbert.MP] 1); -{\out Level 2} -{\out P --> P} -{\out 1. ?P1 --> ?P --> P --> P} -{\out 2. ?P1} -{\out 3. ?P} -\ttbreak -by (resolve_tac [Hilbert.S] 1); -{\out Level 3} -{\out P --> P} -{\out 1. P --> ?Q2 --> P} -{\out 2. P --> ?Q2} -\ttbreak -by (resolve_tac [Hilbert.K] 1); -{\out Level 4} -{\out P --> P} -{\out 1. P --> ?Q2} -\ttbreak -by (resolve_tac [Hilbert.K] 1); -{\out Level 5} -{\out P --> P} -{\out No subgoals!} -\end{ttbox} -As we can see, this Hilbert-style formulation of minimal logic is easy to -define but difficult to use. The following natural deduction formulation is -better: -\begin{ttbox} -MinI = Base + -consts - "-->" :: "[o, o] => o" (infixr 10) -rules - impI "(P ==> Q) ==> P --> Q" - impE "[| P --> Q; P |] ==> Q" -end -\end{ttbox} -Note, however, that although the two systems are equivalent, this fact -cannot be proved within Isabelle. Axioms {\tt S} and {\tt K} can be -derived in {\tt MinI} (exercise!), but {\tt impI} cannot be derived in {\tt - Hilbert}. The reason is that {\tt impI} is only an {\bf admissible} rule -in {\tt Hilbert}, something that can only be shown by induction over all -possible proofs in {\tt Hilbert}. - -We may easily extend minimal logic with falsity: -\begin{ttbox} -MinIF = MinI + -consts - False :: "o" -rules - FalseE "False ==> P" -end -\end{ttbox} -On the other hand, we may wish to introduce conjunction only: -\begin{ttbox} -MinC = Base + -consts - "&" :: "[o, o] => o" (infixr 30) -\ttbreak -rules - conjI "[| P; Q |] ==> P & Q" - conjE1 "P & Q ==> P" - conjE2 "P & Q ==> Q" -end -\end{ttbox} -And if we want to have all three connectives together, we create and load a -theory file consisting of a single line:\footnote{We can combine the - theories without creating a theory file using the ML declaration -\begin{ttbox} -val MinIFC_thy = merge_theories(MinIF,MinC) -\end{ttbox} -\index{*merge_theories|fnote}} -\begin{ttbox} -MinIFC = MinIF + MinC -\end{ttbox} -Now we can prove mixed theorems like -\begin{ttbox} -goal MinIFC.thy "P & False --> Q"; -by (resolve_tac [MinI.impI] 1); -by (dresolve_tac [MinC.conjE2] 1); -by (eresolve_tac [MinIF.FalseE] 1); -\end{ttbox} -Try this as an exercise! - -\medskip -Unless you need to define macros or syntax translation functions, you may -skip the rest of this chapter. - - -\section{*Abstract syntax trees} \label{sec:asts} -\index{trees!abstract syntax|(} The parser, given a token list from the -lexer, applies productions to yield a parse tree\index{trees!parse}. By -applying some internal transformations the parse tree becomes an abstract -syntax tree, or \AST{}. Macro expansion, further translations and finally -type inference yields a well-typed term\index{terms!obtained from ASTs}. -The printing process is the reverse, except for some subtleties to be -discussed later. - -Figure~\ref{fig:parse_print} outlines the parsing and printing process. -Much of the complexity is due to the macro mechanism. Using macros, you -can specify most forms of concrete syntax without writing any \ML{} code. - -\begin{figure} -\begin{center} -\begin{tabular}{cl} -string & \\ -$\downarrow$ & parser \\ -parse tree & \\ -$\downarrow$ & parse \AST{} translation \\ -\AST{} & \\ -$\downarrow$ & \AST{} rewriting (macros) \\ -\AST{} & \\ -$\downarrow$ & parse translation, type inference \\ ---- well-typed term --- & \\ -$\downarrow$ & print translation \\ -\AST{} & \\ -$\downarrow$ & \AST{} rewriting (macros) \\ -\AST{} & \\ -$\downarrow$ & print \AST{} translation, printer \\ -string & -\end{tabular} -\index{translations!parse}\index{translations!parse AST} -\index{translations!print}\index{translations!print AST} - -\end{center} -\caption{Parsing and printing}\label{fig:parse_print} -\end{figure} - -Abstract syntax trees are an intermediate form between the raw parse trees -and the typed $\lambda$-terms. An \AST{} is either an atom (constant or -variable) or a list of {\em at least two\/} subtrees. Internally, they -have type \ttindex{Syntax.ast}: \index{*Constant} \index{*Variable} -\index{*Appl} -\begin{ttbox} -datatype ast = Constant of string - | Variable of string - | Appl of ast list -\end{ttbox} - -Isabelle uses an S-expression syntax for abstract syntax trees. Constant -atoms are shown as quoted strings, variable atoms as non-quoted strings and -applications as a parenthesized list of subtrees. For example, the \AST -\begin{ttbox} -Appl [Constant "_constrain", - Appl [Constant "_abs", Variable "x", Variable "t"], - Appl [Constant "fun", Variable "'a", Variable "'b"]] -\end{ttbox} -is shown as {\tt ("_constrain" ("_abs" x t) ("fun" 'a 'b))}. -Both {\tt ()} and {\tt (f)} are illegal because they have too few -subtrees. - -The resemblance of Lisp's S-expressions is intentional, but there are two -kinds of atomic symbols: $\Constant x$ and $\Variable x$. Do not take the -names ``{\tt Constant}'' and ``{\tt Variable}'' too literally; in the later -translation to terms, $\Variable x$ may become a constant, free or bound -variable, even a type constructor or class name; the actual outcome depends -on the context. - -Similarly, you can think of ${\tt (} f~x@1~\ldots~x@n{\tt )}$ as the -application of~$f$ to the arguments $x@1, \ldots, x@n$. But the kind of -application is determined later by context; it could be a type constructor -applied to types. - -Forms like {\tt (("_abs" x $t$) $u$)} are legal, but \AST{}s are -first-order: the {\tt "_abs"} does not bind the {\tt x} in any way. Later -at the term level, {\tt ("_abs" x $t$)} will become an {\tt Abs} node and -occurrences of {\tt x} in $t$ will be replaced by bound variables (the term -constructor \ttindex{Bound}). - - -\subsection{Transforming parse trees to \AST{}s} -The parse tree is the raw output of the parser. Translation functions, -called {\bf parse AST translations}\indexbold{translations!parse AST}, -transform the parse tree into an abstract syntax tree. - -The parse tree is constructed by nesting the right-hand sides of the -productions used to recognize the input. Such parse trees are simply lists -of tokens and constituent parse trees, the latter representing the -nonterminals of the productions. Let us refer to the actual productions in -the form displayed by {\tt Syntax.print_syntax}. - -Ignoring parse \AST{} translations, parse trees are transformed to \AST{}s -by stripping out delimiters and copy productions. More precisely, the -mapping $ast_of_pt$\index{ast_of_pt@$ast_of_pt$} is derived from the -productions as follows: -\begin{itemize} - \item Name tokens: $ast_of_pt(t) = \Variable s$, where $t$ is an $id$, - $var$, $tid$ or $tvar$ token, and $s$ its associated string. - - \item Copy productions: $ast_of_pt(\ldots P \ldots) = ast_of_pt(P)$. - Here $\ldots$ stands for strings of delimiters, which are - discarded. $P$ stands for the single constituent that is not a - delimiter; it is either a nonterminal symbol or a name token. - - \item $0$-ary productions: $ast_of_pt(\ldots \mtt{=>} c) = \Constant c$. - Here there are no constituents other than delimiters, which are - discarded. - - \item $n$-ary productions, where $n \ge 1$: delimiters are discarded and - the remaining constituents $P@1$, \ldots, $P@n$ are built into an - application whose head constant is~$c$: - \begin{eqnarray*} - \lefteqn{ast_of_pt(\ldots P@1 \ldots P@n \ldots \mtt{=>} c)} \\ - &&\qquad{}= \Appl{\Constant c, ast_of_pt(P@1), \ldots, ast_of_pt(P@n)} - \end{eqnarray*} -\end{itemize} -Figure~\ref{fig:parse_ast} presents some simple examples, where {\tt ==}, -{\tt _appl}, {\tt _args}, and so forth name productions of the Pure syntax. -These examples illustrate the need for further translations to make \AST{}s -closer to the typed $\lambda$-calculus. The Pure syntax provides -predefined parse \AST{} translations\index{translations!parse AST} for -ordinary applications, type applications, nested abstractions, meta -implications and function types. Figure~\ref{fig:parse_ast_tr} shows their -effect on some representative input strings. - - -\begin{figure} -\begin{center} -\tt\begin{tabular}{ll} -\rm input string & \rm \AST \\\hline -"f" & f \\ -"'a" & 'a \\ -"t == u" & ("==" t u) \\ -"f(x)" & ("_appl" f x) \\ -"f(x, y)" & ("_appl" f ("_args" x y)) \\ -"f(x, y, z)" & ("_appl" f ("_args" x ("_args" y z))) \\ -"\%x y.\ t" & ("_lambda" ("_idts" x y) t) \\ -\end{tabular} -\end{center} -\caption{Parsing examples using the Pure syntax}\label{fig:parse_ast} -\end{figure} - -\begin{figure} -\begin{center} -\tt\begin{tabular}{ll} -\rm input string & \rm \AST{} \\\hline -"f(x, y, z)" & (f x y z) \\ -"'a ty" & (ty 'a) \\ -"('a, 'b) ty" & (ty 'a 'b) \\ -"\%x y z.\ t" & ("_abs" x ("_abs" y ("_abs" z t))) \\ -"\%x ::\ 'a.\ t" & ("_abs" ("_constrain" x 'a) t) \\ -"[| P; Q; R |] => S" & ("==>" P ("==>" Q ("==>" R S))) \\ -"['a, 'b, 'c] => 'd" & ("fun" 'a ("fun" 'b ("fun" 'c 'd))) -\end{tabular} -\end{center} -\caption{Built-in parse \AST{} translations}\label{fig:parse_ast_tr} -\end{figure} - -The names of constant heads in the \AST{} control the translation process. -The list of constants invoking parse \AST{} translations appears in the -output of {\tt Syntax.print_syntax} under {\tt parse_ast_translation}. - - -\subsection{Transforming \AST{}s to terms} -The \AST{}, after application of macros (see \S\ref{sec:macros}), is -transformed into a term. This term is probably ill-typed since type -inference has not occurred yet. The term may contain type constraints -consisting of applications with head {\tt "_constrain"}; the second -argument is a type encoded as a term. Type inference later introduces -correct types or rejects the input. - -Another set of translation functions, namely parse -translations,\index{translations!parse}, may affect this process. If we -ignore parse translations for the time being, then \AST{}s are transformed -to terms by mapping \AST{} constants to constants, \AST{} variables to -schematic or free variables and \AST{} applications to applications. - -More precisely, the mapping $term_of_ast$\index{term_of_ast@$term_of_ast$} -is defined by -\begin{itemize} -\item Constants: $term_of_ast(\Constant x) = \ttfct{Const} (x, - \mtt{dummyT})$. - -\item Schematic variables: $term_of_ast(\Variable \mtt{"?}xi\mtt") = - \ttfct{Var} ((x, i), \mtt{dummyT})$, where $x$ is the base name and $i$ - the index extracted from $xi$. - -\item Free variables: $term_of_ast(\Variable x) = \ttfct{Free} (x, - \mtt{dummyT})$. - -\item Function applications with $n$ arguments: - \begin{eqnarray*} - \lefteqn{term_of_ast(\Appl{f, x@1, \ldots, x@n})} \\ - &&\qquad{}= term_of_ast(f) \ttapp - term_of_ast(x@1) \ttapp \ldots \ttapp term_of_ast(x@n) - \end{eqnarray*} -\end{itemize} -Here \ttindex{Const}, \ttindex{Var}, \ttindex{Free} and -\verb|$|\index{$@{\tt\$}} are constructors of the datatype {\tt term}, -while \ttindex{dummyT} stands for some dummy type that is ignored during -type inference. - -So far the outcome is still a first-order term. Abstractions and bound -variables (constructors \ttindex{Abs} and \ttindex{Bound}) are introduced -by parse translations. Such translations are attached to {\tt "_abs"}, -{\tt "!!"} and user-defined binders. - - -\subsection{Printing of terms} -The output phase is essentially the inverse of the input phase. Terms are -translated via abstract syntax trees into strings. Finally the strings are -pretty printed. - -Print translations (\S\ref{sec:tr_funs}) may affect the transformation of -terms into \AST{}s. Ignoring those, the transformation maps -term constants, variables and applications to the corresponding constructs -on \AST{}s. Abstractions are mapped to applications of the special -constant {\tt _abs}. - -More precisely, the mapping $ast_of_term$\index{ast_of_term@$ast_of_term$} -is defined as follows: -\begin{itemize} - \item $ast_of_term(\ttfct{Const} (x, \tau)) = \Constant x$. - - \item $ast_of_term(\ttfct{Free} (x, \tau)) = constrain (\Variable x, - \tau)$. - - \item $ast_of_term(\ttfct{Var} ((x, i), \tau)) = constrain (\Variable - \mtt{"?}xi\mtt", \tau)$, where $\mtt?xi$ is the string representation of - the {\tt indexname} $(x, i)$. - - \item For the abstraction $\lambda x::\tau.t$, let $x'$ be a variant - of~$x$ renamed to differ from all names occurring in~$t$, and let $t'$ - be obtained from~$t$ by replacing all bound occurrences of~$x$ by - the free variable $x'$. This replaces corresponding occurrences of the - constructor \ttindex{Bound} by the term $\ttfct{Free} (x', - \mtt{dummyT})$: - \begin{eqnarray*} - \lefteqn{ast_of_term(\ttfct{Abs} (x, \tau, t))} \\ - &&\qquad{}= \ttfct{Appl} - \mathopen{\mtt[} - \Constant \mtt{"_abs"}, constrain(\Variable x', \tau), \\ - &&\qquad\qquad\qquad ast_of_term(t') \mathclose{\mtt]}. - \end{eqnarray*} - - \item $ast_of_term(\ttfct{Bound} i) = \Variable \mtt{"B.}i\mtt"$. - The occurrence of constructor \ttindex{Bound} should never happen - when printing well-typed terms; it indicates a de Bruijn index with no - matching abstraction. - - \item Where $f$ is not an application, - \begin{eqnarray*} - \lefteqn{ast_of_term(f \ttapp x@1 \ttapp \ldots \ttapp x@n)} \\ - &&\qquad{}= \ttfct{Appl} - \mathopen{\mtt[} ast_of_term(f), - ast_of_term(x@1), \ldots,ast_of_term(x@n) - \mathclose{\mtt]} - \end{eqnarray*} -\end{itemize} - -Type constraints are inserted to allow the printing of types, which is -governed by the boolean variable \ttindex{show_types}. Constraints are -treated as follows: -\begin{itemize} - \item $constrain(x, \tau) = x$, if $\tau = \mtt{dummyT}$ \index{*dummyT} or - \ttindex{show_types} not set to {\tt true}. - - \item $constrain(x, \tau) = \Appl{\Constant \mtt{"_constrain"}, x, ty}$, - where $ty$ is the \AST{} encoding of $\tau$. That is, type constructors as - {\tt Constant}s, type identifiers as {\tt Variable}s and type applications - as {\tt Appl}s with the head type constructor as first element. - Additionally, if \ttindex{show_sorts} is set to {\tt true}, some type - variables are decorated with an \AST{} encoding of their sort. -\end{itemize} - -The \AST{}, after application of macros (see \S\ref{sec:macros}), is -transformed into the final output string. The built-in {\bf print AST - translations}\indexbold{translations!print AST} effectively reverse the -parse \AST{} translations of Fig.\ts\ref{fig:parse_ast_tr}. - -For the actual printing process, the names attached to productions -of the form $\ldots A^{(p@1)}@1 \ldots A^{(p@n)}@n \ldots \mtt{=>} c$ play -a vital role. Each \AST{} with constant head $c$, namely $\mtt"c\mtt"$ or -$(\mtt"c\mtt"~ x@1 \ldots x@n)$, is printed according to the production -for~$c$. Each argument~$x@i$ is converted to a string, and put in -parentheses if its priority~$(p@i)$ requires this. The resulting strings -and their syntactic sugar (denoted by ``\dots'' above) are joined to make a -single string. - -If an application $(\mtt"c\mtt"~ x@1 \ldots x@m)$ has more arguments than the -corresponding production, it is first split into $((\mtt"c\mtt"~ x@1 \ldots -x@n) ~ x@{n+1} \ldots x@m)$. Applications with too few arguments or with -non-constant head or without a corresponding production are printed as -$f(x@1, \ldots, x@l)$ or $(\alpha@1, \ldots, \alpha@l) ty$. An occurrence of -$\Variable x$ is simply printed as~$x$. - -Blanks are {\em not\/} inserted automatically. If blanks are required to -separate tokens, specify them in the mixfix declaration, possibly preceeded -by a slash~({\tt/}) to allow a line break. -\index{trees!abstract syntax|)} - - - -\section{*Macros: Syntactic rewriting} \label{sec:macros} -\index{macros|(}\index{rewriting!syntactic|(} - -Mixfix declarations alone can handle situations where there is a direct -connection between the concrete syntax and the underlying term. Sometimes -we require a more elaborate concrete syntax, such as quantifiers and list -notation. Isabelle's {\bf macros} and {\bf translation functions} can -perform translations such as -\begin{center}\tt - \begin{tabular}{r@{$\quad\protect\rightleftharpoons\quad$}l} - ALL x:A.P & Ball(A, \%x.P) \\ \relax - [x, y, z] & Cons(x, Cons(y, Cons(z, Nil))) - \end{tabular} -\end{center} -Translation functions (see \S\ref{sec:tr_funs}) must be coded in ML; they -are the most powerful translation mechanism but are difficult to read or -write. Macros are specified by first-order rewriting systems that operate -on abstract syntax trees. They are usually easy to read and write, and can -express all but the most obscure translations. - -Figure~\ref{fig:set_trans} defines a fragment of first-order logic and set -theory.\footnote{This and the following theories are complete working - examples, though they specify only syntax, no axioms. The file {\tt - ZF/zf.thy} presents the full set theory definition, including many - macro rules.} Theory {\tt SET} defines constants for set comprehension -({\tt Collect}), replacement ({\tt Replace}) and bounded universal -quantification ({\tt Ball}). Each of these binds some variables. Without -additional syntax we should have to express $\forall x \in A. P$ as {\tt - Ball(A,\%x.P)}, and similarly for the others. - -\begin{figure} -\begin{ttbox} -SET = Pure + -types - i, o -arities - i, o :: logic -consts - Trueprop :: "o => prop" ("_" 5) - Collect :: "[i, i => o] => i" - "{\at}Collect" :: "[idt, i, o] => i" ("(1{\ttlbrace}_:_./ _{\ttrbrace})") - Replace :: "[i, [i, i] => o] => i" - "{\at}Replace" :: "[idt, idt, i, o] => i" ("(1{\ttlbrace}_./ _:_, _{\ttrbrace})") - Ball :: "[i, i => o] => o" - "{\at}Ball" :: "[idt, i, o] => o" ("(3ALL _:_./ _)" 10) -translations - "{\ttlbrace}x:A. P{\ttrbrace}" == "Collect(A, \%x. P)" - "{\ttlbrace}y. x:A, Q{\ttrbrace}" == "Replace(A, \%x y. Q)" - "ALL x:A. P" == "Ball(A, \%x. P)" -end -\end{ttbox} -\caption{Macro example: set theory}\label{fig:set_trans} -\end{figure} - -The theory specifies a variable-binding syntax through additional -productions that have mixfix declarations. Each non-copy production must -specify some constant, which is used for building \AST{}s. The additional -constants are decorated with {\tt\at} to stress their purely syntactic -purpose; they should never occur within the final well-typed terms. -Furthermore, they cannot be written in formulae because they are not legal -identifiers. - -The translations cause the replacement of external forms by internal forms -after parsing, and vice versa before printing of terms. As a specification -of the set theory notation, they should be largely self-explanatory. The -syntactic constants, {\tt\at Collect}, {\tt\at Replace} and {\tt\at Ball}, -appear implicitly in the macro rules via their mixfix forms. - -Macros can define variable-binding syntax because they operate on \AST{}s, -which have no inbuilt notion of bound variable. The macro variables {\tt - x} and~{\tt y} have type~{\tt idt} and therefore range over identifiers, -in this case bound variables. The macro variables {\tt P} and~{\tt Q} -range over formulae containing bound variable occurrences. - -Other applications of the macro system can be less straightforward, and -there are peculiarities. The rest of this section will describe in detail -how Isabelle macros are preprocessed and applied. - - -\subsection{Specifying macros} -Macros are basically rewrite rules on \AST{}s. But unlike other macro -systems found in programming languages, Isabelle's macros work in both -directions. Therefore a syntax contains two lists of rewrites: one for -parsing and one for printing. - -The {\tt translations} section\index{translations section@{\tt translations} -section} specifies macros. The syntax for a macro is -\[ (root)\; string \quad - \left\{\begin{array}[c]{c} \mtt{=>} \\ \mtt{<=} \\ \mtt{==} \end{array} - \right\} \quad - (root)\; string -\] -% -This specifies a parse rule ({\tt =>}), a print rule ({\tt <=}), or both -({\tt ==}). The two strings specify the left and right-hand sides of the -macro rule. The $(root)$ specification is optional; it specifies the -nonterminal for parsing the $string$ and if omitted defaults to {\tt - logic}. \AST{} rewrite rules $(l, r)$ must obey certain conditions: -\begin{itemize} -\item Rules must be left linear: $l$ must not contain repeated variables. - -\item Rules must have constant heads, namely $l = \mtt"c\mtt"$ or $l = - (\mtt"c\mtt" ~ x@1 \ldots x@n)$. - -\item Every variable in~$r$ must also occur in~$l$. -\end{itemize} - -Macro rules may refer to any syntax from the parent theories. They may -also refer to anything defined before the the {\tt .thy} file's {\tt - translations} section --- including any mixfix declarations. - -Upon declaration, both sides of the macro rule undergo parsing and parse -\AST{} translations (see \S\ref{sec:asts}), but do not themselves undergo -macro expansion. The lexer runs in a different mode that additionally -accepts identifiers of the form $\_~letter~quasiletter^*$ (like {\tt _idt}, -{\tt _K}). Thus, a constant whose name starts with an underscore can -appear in macro rules but not in ordinary terms. - -Some atoms of the macro rule's \AST{} are designated as constants for -matching. These are all names that have been declared as classes, types or -constants. - -The result of this preprocessing is two lists of macro rules, each stored -as a pair of \AST{}s. They can be viewed using {\tt Syntax.print_syntax} -(sections \ttindex{parse_rules} and \ttindex{print_rules}). For -theory~{\tt SET} of Fig.~\ref{fig:set_trans} these are -\begin{ttbox} -parse_rules: - ("{\at}Collect" x A P) -> ("Collect" A ("_abs" x P)) - ("{\at}Replace" y x A Q) -> ("Replace" A ("_abs" x ("_abs" y Q))) - ("{\at}Ball" x A P) -> ("Ball" A ("_abs" x P)) -print_rules: - ("Collect" A ("_abs" x P)) -> ("{\at}Collect" x A P) - ("Replace" A ("_abs" x ("_abs" y Q))) -> ("{\at}Replace" y x A Q) - ("Ball" A ("_abs" x P)) -> ("{\at}Ball" x A P) -\end{ttbox} - -\begin{warn} - Avoid choosing variable names that have previously been used as - constants, types or type classes; the {\tt consts} section in the output - of {\tt Syntax.print_syntax} lists all such names. If a macro rule works - incorrectly, inspect its internal form as shown above, recalling that - constants appear as quoted strings and variables without quotes. -\end{warn} - -\begin{warn} -If \ttindex{eta_contract} is set to {\tt true}, terms will be -$\eta$-contracted {\em before\/} the \AST{} rewriter sees them. Thus some -abstraction nodes needed for print rules to match may vanish. For example, -\verb|Ball(A, %x. P(x))| contracts {\tt Ball(A, P)}; the print rule does -not apply and the output will be {\tt Ball(A, P)}. This problem would not -occur if \ML{} translation functions were used instead of macros (as is -done for binder declarations). -\end{warn} - - -\begin{warn} -Another trap concerns type constraints. If \ttindex{show_types} is set to -{\tt true}, bound variables will be decorated by their meta types at the -binding place (but not at occurrences in the body). Matching with -\verb|Collect(A, %x. P)| binds {\tt x} to something like {\tt ("_constrain" y -"i")} rather than only {\tt y}. \AST{} rewriting will cause the constraint to -appear in the external form, say \verb|{y::i:A::i. P::o}|. - -To allow such constraints to be re-read, your syntax should specify bound -variables using the nonterminal~\ttindex{idt}. This is the case in our -example. Choosing {\tt id} instead of {\tt idt} is a common error, -especially since it appears in former versions of most of Isabelle's -object-logics. -\end{warn} - - - -\subsection{Applying rules} -As a term is being parsed or printed, an \AST{} is generated as an -intermediate form (recall Fig.\ts\ref{fig:parse_print}). The \AST{} is -normalized by applying macro rules in the manner of a traditional term -rewriting system. We first examine how a single rule is applied. - -Let $t$ be the abstract syntax tree to be normalized and $(l, r)$ some -translation rule. A subtree~$u$ of $t$ is a {\bf redex} if it is an -instance of~$l$; in this case $l$ is said to {\bf match}~$u$. A redex -matched by $l$ may be replaced by the corresponding instance of~$r$, thus -{\bf rewriting} the \AST~$t$. Matching requires some notion of {\bf - place-holders} that may occur in rule patterns but not in ordinary -\AST{}s; {\tt Variable} atoms serve this purpose. - -The matching of the object~$u$ by the pattern~$l$ is performed as follows: -\begin{itemize} - \item Every constant matches itself. - - \item $\Variable x$ in the object matches $\Constant x$ in the pattern. - This point is discussed further below. - - \item Every \AST{} in the object matches $\Variable x$ in the pattern, - binding~$x$ to~$u$. - - \item One application matches another if they have the same number of - subtrees and corresponding subtrees match. - - \item In every other case, matching fails. In particular, {\tt - Constant}~$x$ can only match itself. -\end{itemize} -A successful match yields a substitution that is applied to~$r$, generating -the instance that replaces~$u$. - -The second case above may look odd. This is where {\tt Variable}s of -non-rule \AST{}s behave like {\tt Constant}s. Recall that \AST{}s are not -far removed from parse trees; at this level it is not yet known which -identifiers will become constants, bounds, frees, types or classes. As -\S\ref{sec:asts} describes, former parse tree heads appear in \AST{}s as -{\tt Constant}s, while $id$s, $var$s, $tid$s and $tvar$s become {\tt - Variable}s. On the other hand, when \AST{}s generated from terms for -printing, all constants and type constructors become {\tt Constant}s; see -\S\ref{sec:asts}. Thus \AST{}s may contain a messy mixture of {\tt - Variable}s and {\tt Constant}s. This is insignificant at macro level -because matching treats them alike. - -Because of this behaviour, different kinds of atoms with the same name are -indistinguishable, which may make some rules prone to misbehaviour. Example: -\begin{ttbox} -types - Nil -consts - Nil :: "'a list" - "[]" :: "'a list" ("[]") -translations - "[]" == "Nil" -\end{ttbox} -The term {\tt Nil} will be printed as {\tt []}, just as expected. What -happens with \verb|%Nil.t| or {\tt x::Nil} is left as an exercise. - -Normalizing an \AST{} involves repeatedly applying macro rules until none -is applicable. Macro rules are chosen in the order that they appear in the -{\tt translations} section. You can watch the normalization of \AST{}s -during parsing and printing by setting \ttindex{Syntax.trace_norm_ast} to -{\tt true}.\index{tracing!of macros} Alternatively, use -\ttindex{Syntax.test_read}. The information displayed when tracing -includes the \AST{} before normalization ({\tt pre}), redexes with results -({\tt rewrote}), the normal form finally reached ({\tt post}) and some -statistics ({\tt normalize}). If tracing is off, -\ttindex{Syntax.stat_norm_ast} can be set to {\tt true} in order to enable -printing of the normal form and statistics only. - - -\subsection{Example: the syntax of finite sets} -This example demonstrates the use of recursive macros to implement a -convenient notation for finite sets. -\begin{ttbox} -FINSET = SET + -types - is -consts - "" :: "i => is" ("_") - "{\at}Enum" :: "[i, is] => is" ("_,/ _") - empty :: "i" ("{\ttlbrace}{\ttrbrace}") - insert :: "[i, i] => i" - "{\at}Finset" :: "is => i" ("{\ttlbrace}(_){\ttrbrace}") -translations - "{\ttlbrace}x, xs{\ttrbrace}" == "insert(x, {\ttlbrace}xs{\ttrbrace})" - "{\ttlbrace}x{\ttrbrace}" == "insert(x, {\ttlbrace}{\ttrbrace})" -end -\end{ttbox} -Finite sets are internally built up by {\tt empty} and {\tt insert}. The -declarations above specify \verb|{x, y, z}| as the external representation -of -\begin{ttbox} -insert(x, insert(y, insert(z, empty))) -\end{ttbox} - -The nonterminal symbol~{\tt is} stands for one or more objects of type~{\tt - i} separated by commas. The mixfix declaration \hbox{\verb|"_,/ _"|} -allows a line break after the comma for pretty printing; if no line break -is required then a space is printed instead. - -The nonterminal is declared as the type~{\tt is}, but with no {\tt arities} -declaration. Hence {\tt is} is not a logical type and no default -productions are added. If we had needed enumerations of the nonterminal -{\tt logic}, which would include all the logical types, we could have used -the predefined nonterminal symbol \ttindex{args} and skipped this part -altogether. The nonterminal~{\tt is} can later be reused for other -enumerations of type~{\tt i} like lists or tuples. - -Next follows {\tt empty}, which is already equipped with its syntax -\verb|{}|, and {\tt insert} without concrete syntax. The syntactic -constant {\tt\at Finset} provides concrete syntax for enumerations of~{\tt - i} enclosed in curly braces. Remember that a pair of parentheses, as in -\verb|"{(_)}"|, specifies a block of indentation for pretty printing. - -The translations may look strange at first. Macro rules are best -understood in their internal forms: -\begin{ttbox} -parse_rules: - ("{\at}Finset" ("{\at}Enum" x xs)) -> ("insert" x ("{\at}Finset" xs)) - ("{\at}Finset" x) -> ("insert" x "empty") -print_rules: - ("insert" x ("{\at}Finset" xs)) -> ("{\at}Finset" ("{\at}Enum" x xs)) - ("insert" x "empty") -> ("{\at}Finset" x) -\end{ttbox} -This shows that \verb|{x, xs}| indeed matches any set enumeration of at least -two elements, binding the first to {\tt x} and the rest to {\tt xs}. -Likewise, \verb|{xs}| and \verb|{x}| represent any set enumeration. -The parse rules only work in the order given. - -\begin{warn} - The \AST{} rewriter cannot discern constants from variables and looks - only for names of atoms. Thus the names of {\tt Constant}s occurring in - the (internal) left-hand side of translation rules should be regarded as - reserved keywords. Choose non-identifiers like {\tt\at Finset} or - sufficiently long and strange names. If a bound variable's name gets - rewritten, the result will be incorrect; for example, the term -\begin{ttbox} -\%empty insert. insert(x, empty) -\end{ttbox} - gets printed as \verb|%empty insert. {x}|. -\end{warn} - - -\subsection{Example: a parse macro for dependent types}\label{prod_trans} -As stated earlier, a macro rule may not introduce new {\tt Variable}s on -the right-hand side. Something like \verb|"K(B)" => "%x. B"| is illegal; -it allowed, it could cause variable capture. In such cases you usually -must fall back on translation functions. But a trick can make things -readable in some cases: {\em calling translation functions by parse - macros}: -\begin{ttbox} -PROD = FINSET + -consts - Pi :: "[i, i => i] => i" - "{\at}PROD" :: "[idt, i, i] => i" ("(3PROD _:_./ _)" 10) - "{\at}->" :: "[i, i] => i" ("(_ ->/ _)" [51, 50] 50) -\ttbreak -translations - "PROD x:A. B" => "Pi(A, \%x. B)" - "A -> B" => "Pi(A, _K(B))" -end -ML - val print_translation = [("Pi", dependent_tr' ("{\at}PROD", "{\at}->"))]; -\end{ttbox} - -Here {\tt Pi} is an internal constant for constructing general products. -Two external forms exist: the general case {\tt PROD x:A.B} and the -function space {\tt A -> B}, which abbreviates \verb|Pi(A, %x.B)| when {\tt B} -does not depend on~{\tt x}. - -The second parse macro introduces {\tt _K(B)}, which later becomes \verb|%x.B| -due to a parse translation associated with \ttindex{_K}. The order of the -parse rules is critical. Unfortunately there is no such trick for -printing, so we have to add a {\tt ML} section for the print translation -\ttindex{dependent_tr'}. - -Recall that identifiers with a leading {\tt _} are allowed in translation -rules, but not in ordinary terms. Thus we can create \AST{}s containing -names that are not directly expressible. - -The parse translation for {\tt _K} is already installed in Pure, and {\tt -dependent_tr'} is exported by the syntax module for public use. See -\S\ref{sec:tr_funs} below for more of the arcane lore of translation functions. -\index{macros|)}\index{rewriting!syntactic|)} - - - -\section{*Translation functions} \label{sec:tr_funs} -\index{translations|(} -% -This section describes the translation function mechanism. By writing -\ML{} functions, you can do almost everything with terms or \AST{}s during -parsing and printing. The logic \LK\ is a good example of sophisticated -transformations between internal and external representations of -associative sequences; here, macros would be useless. - -A full understanding of translations requires some familiarity -with Isabelle's internals, especially the datatypes {\tt term}, {\tt typ}, -{\tt Syntax.ast} and the encodings of types and terms as such at the various -stages of the parsing or printing process. Most users should never need to -use translation functions. - -\subsection{Declaring translation functions} -There are four kinds of translation functions. Each such function is -associated with a name, which triggers calls to it. Such names can be -constants (logical or syntactic) or type constructors. - -{\tt Syntax.print_syntax} displays the sets of names associated with the -translation functions of a {\tt Syntax.syntax} under -\ttindex{parse_ast_translation}, \ttindex{parse_translation}, -\ttindex{print_translation} and \ttindex{print_ast_translation}. You can -add new ones via the {\tt ML} section\index{ML section@{\tt ML} section} of -a {\tt .thy} file. There may never be more than one function of the same -kind per name. Conceptually, the {\tt ML} section should appear between -{\tt consts} and {\tt translations}; newly installed translation functions -are already effective when macros and logical rules are parsed. - -The {\tt ML} section is copied verbatim into the \ML\ file generated from a -{\tt .thy} file. Definitions made here are accessible as components of an -\ML\ structure; to make some definitions private, use an \ML{} {\tt local} -declaration. The {\tt ML} section may install translation functions by -declaring any of the following identifiers: -\begin{ttbox} -val parse_ast_translation : (string * (ast list -> ast)) list -val print_ast_translation : (string * (ast list -> ast)) list -val parse_translation : (string * (term list -> term)) list -val print_translation : (string * (term list -> term)) list -\end{ttbox} - -\subsection{The translation strategy} -All four kinds of translation functions are treated similarly. They are -called during the transformations between parse trees, \AST{}s and terms -(recall Fig.\ts\ref{fig:parse_print}). Whenever a combination of the form -$(\mtt"c\mtt"~x@1 \ldots x@n)$ is encountered, and a translation function -$f$ of appropriate kind exists for $c$, the result is computed by the \ML{} -function call $f \mtt[ x@1, \ldots, x@n \mtt]$. - -For \AST{} translations, the arguments $x@1, \ldots, x@n$ are \AST{}s. A -combination has the form $\Constant c$ or $\Appl{\Constant c, x@1, \ldots, - x@n}$. For term translations, the arguments are terms and a combination -has the form $\ttfct{Const} (c, \tau)$ or $\ttfct{Const} (c, \tau) \ttapp -x@1 \ttapp \ldots \ttapp x@n$. Terms allow more sophisticated -transformations than \AST{}s do, typically involving abstractions and bound -variables. - -Regardless of whether they act on terms or \AST{}s, -parse translations differ from print translations fundamentally: -\begin{description} -\item[Parse translations] are applied bottom-up. The arguments are already - in translated form. The translations must not fail; exceptions trigger - an error message. - -\item[Print translations] are applied top-down. They are supplied with - arguments that are partly still in internal form. The result again - undergoes translation; therefore a print translation should not introduce - as head the very constant that invoked it. The function may raise - exception \ttindex{Match} to indicate failure; in this event it has no - effect. -\end{description} - -Only constant atoms --- constructor \ttindex{Constant} for \AST{}s and -\ttindex{Const} for terms --- can invoke translation functions. This -causes another difference between parsing and printing. - -Parsing starts with a string and the constants are not yet identified. -Only parse tree heads create {\tt Constant}s in the resulting \AST; recall -$ast_of_pt$ in \S\ref{sec:asts}. Macros and parse \AST{} translations may -introduce further {\tt Constant}s. When the final \AST{} is converted to a -term, all {\tt Constant}s become {\tt Const}s; recall $term_of_ast$ in -\S\ref{sec:asts}. - -Printing starts with a well-typed term and all the constants are known. So -all logical constants and type constructors may invoke print translations. -These, and macros, may introduce further constants. - - -\subsection{Example: a print translation for dependent types} -\indexbold{*_K}\indexbold{*dependent_tr'} -Let us continue the dependent type example (page~\pageref{prod_trans}) by -examining the parse translation for {\tt _K} and the print translation -{\tt dependent_tr'}, which are both built-in. By convention, parse -translations have names ending with {\tt _tr} and print translations have -names ending with {\tt _tr'}. Search for such names in the Isabelle -sources to locate more examples. - -Here is the parse translation for {\tt _K}: -\begin{ttbox} -fun k_tr [t] = Abs ("x", dummyT, incr_boundvars 1 t) - | k_tr ts = raise TERM("k_tr",ts); -\end{ttbox} -If {\tt k_tr} is called with exactly one argument~$t$, it creates a new -{\tt Abs} node with a body derived from $t$. Since terms given to parse -translations are not yet typed, the type of the bound variable in the new -{\tt Abs} is simply {\tt dummyT}. The function increments all {\tt Bound} -nodes referring to outer abstractions by calling \ttindex{incr_boundvars}, -a basic term manipulation function defined in {\tt Pure/term.ML}. - -Here is the print translation for dependent types: -\begin{ttbox} -fun dependent_tr' (q,r) (A :: Abs (x, T, B) :: ts) = - if 0 mem (loose_bnos B) then - let val (x', B') = variant_abs (x, dummyT, B); - in list_comb (Const (q, dummyT) $ Free (x', T) $ A $ B', ts) - end - else list_comb (Const (r, dummyT) $ A $ B, ts) - | dependent_tr' _ _ = raise Match; -\end{ttbox} -The argument {\tt (q,r)} is supplied to {\tt dependent_tr'} by a curried -function application during its installation. We could set up print -translations for both {\tt Pi} and {\tt Sigma} by including -\begin{ttbox} -val print_translation = - [("Pi", dependent_tr' ("{\at}PROD", "{\at}->")), - ("Sigma", dependent_tr' ("{\at}SUM", "{\at}*"))]; -\end{ttbox} -within the {\tt ML} section. The first of these transforms ${\tt Pi}(A, -\mtt{Abs}(x, T, B))$ into $\hbox{\tt{\at}PROD}(x', A, B')$ or -$\hbox{\tt{\at}->}r(A, B)$, choosing the latter form if $B$ does not depend -on~$x$. It checks this using \ttindex{loose_bnos}, yet another function -from {\tt Pure/term.ML}. Note that $x'$ is a version of $x$ renamed away -from all names in $B$, and $B'$ the body $B$ with {\tt Bound} nodes -referring to our {\tt Abs} node replaced by $\ttfct{Free} (x', -\mtt{dummyT})$. - -We must be careful with types here. While types of {\tt Const}s are -ignored, type constraints may be printed for some {\tt Free}s and -{\tt Var}s if \ttindex{show_types} is set to {\tt true}. Variables of type -\ttindex{dummyT} are never printed with constraint, though. The line -\begin{ttbox} - let val (x', B') = variant_abs (x, dummyT, B); -\end{ttbox}\index{*variant_abs} -replaces bound variable occurrences in~$B$ by the free variable $x'$ with -type {\tt dummyT}. Only the binding occurrence of~$x'$ is given the -correct type~{\tt T}, so this is the only place where a type -constraint might appear. -\index{translations|)} - - - diff -r 19849d258890 -r 8018173a7979 doc-src/Logics/logics.toc --- a/doc-src/Logics/logics.toc Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,83 +0,0 @@ -\contentsline {chapter}{\numberline {1}Basic Concepts}{1} -\contentsline {section}{\numberline {1.1}Syntax definitions}{2} -\contentsline {section}{\numberline {1.2}Proof procedures}{3} -\contentsline {chapter}{\numberline {2}First-Order Logic}{4} -\contentsline {section}{\numberline {2.1}Syntax and rules of inference}{4} -\contentsline {section}{\numberline {2.2}Generic packages}{8} -\contentsline {section}{\numberline {2.3}Intuitionistic proof procedures}{8} -\contentsline {section}{\numberline {2.4}Classical proof procedures}{10} -\contentsline {section}{\numberline {2.5}An intuitionistic example}{11} -\contentsline {section}{\numberline {2.6}An example of intuitionistic negation}{12} -\contentsline {section}{\numberline {2.7}A classical example}{14} -\contentsline {section}{\numberline {2.8}Derived rules and the classical tactics}{15} -\contentsline {subsection}{\numberline {2.8.1}Deriving the introduction rule}{16} -\contentsline {subsection}{\numberline {2.8.2}Deriving the elimination rule}{17} -\contentsline {subsection}{\numberline {2.8.3}Using the derived rules}{17} -\contentsline {subsection}{\numberline {2.8.4}Derived rules versus definitions}{19} -\contentsline {chapter}{\numberline {3}Zermelo-Fraenkel Set Theory}{22} -\contentsline {section}{\numberline {3.1}Which version of axiomatic set theory?}{22} -\contentsline {section}{\numberline {3.2}The syntax of set theory}{23} -\contentsline {section}{\numberline {3.3}Binding operators}{25} -\contentsline {section}{\numberline {3.4}The Zermelo-Fraenkel axioms}{27} -\contentsline {section}{\numberline {3.5}From basic lemmas to function spaces}{30} -\contentsline {subsection}{\numberline {3.5.1}Fundamental lemmas}{30} -\contentsline {subsection}{\numberline {3.5.2}Unordered pairs and finite sets}{32} -\contentsline {subsection}{\numberline {3.5.3}Subset and lattice properties}{32} -\contentsline {subsection}{\numberline {3.5.4}Ordered pairs}{36} -\contentsline {subsection}{\numberline {3.5.5}Relations}{36} -\contentsline {subsection}{\numberline {3.5.6}Functions}{37} -\contentsline {section}{\numberline {3.6}Further developments}{38} -\contentsline {section}{\numberline {3.7}Simplification rules}{47} -\contentsline {section}{\numberline {3.8}The examples directory}{47} -\contentsline {section}{\numberline {3.9}A proof about powersets}{48} -\contentsline {section}{\numberline {3.10}Monotonicity of the union operator}{51} -\contentsline {section}{\numberline {3.11}Low-level reasoning about functions}{52} -\contentsline {chapter}{\numberline {4}Higher-Order Logic}{55} -\contentsline {section}{\numberline {4.1}Syntax}{55} -\contentsline {subsection}{\numberline {4.1.1}Types}{57} -\contentsline {subsection}{\numberline {4.1.2}Binders}{58} -\contentsline {subsection}{\numberline {4.1.3}The {\ptt let} and {\ptt case} constructions}{58} -\contentsline {section}{\numberline {4.2}Rules of inference}{58} -\contentsline {section}{\numberline {4.3}A formulation of set theory}{60} -\contentsline {subsection}{\numberline {4.3.1}Syntax of set theory}{65} -\contentsline {subsection}{\numberline {4.3.2}Axioms and rules of set theory}{69} -\contentsline {section}{\numberline {4.4}Generic packages and classical reasoning}{71} -\contentsline {section}{\numberline {4.5}Types}{73} -\contentsline {subsection}{\numberline {4.5.1}Product and sum types}{73} -\contentsline {subsection}{\numberline {4.5.2}The type of natural numbers, {\ptt nat}}{73} -\contentsline {subsection}{\numberline {4.5.3}The type constructor for lists, {\ptt list}}{76} -\contentsline {subsection}{\numberline {4.5.4}The type constructor for lazy lists, {\ptt llist}}{76} -\contentsline {section}{\numberline {4.6}Datatype declarations}{79} -\contentsline {subsection}{\numberline {4.6.1}Foundations}{79} -\contentsline {subsection}{\numberline {4.6.2}Defining datatypes}{80} -\contentsline {subsection}{\numberline {4.6.3}Examples}{82} -\contentsline {subsubsection}{The datatype $\alpha \penalty \@M \ list$}{82} -\contentsline {subsubsection}{The datatype $\alpha \penalty \@M \ list$ with mixfix syntax}{83} -\contentsline {subsubsection}{Defining functions on datatypes}{83} -\contentsline {subsubsection}{A datatype for weekdays}{84} -\contentsline {section}{\numberline {4.7}The examples directories}{84} -\contentsline {section}{\numberline {4.8}Example: Cantor's Theorem}{85} -\contentsline {chapter}{\numberline {5}First-Order Sequent Calculus}{88} -\contentsline {section}{\numberline {5.1}Unification for lists}{88} -\contentsline {section}{\numberline {5.2}Syntax and rules of inference}{90} -\contentsline {section}{\numberline {5.3}Tactics for the cut rule}{92} -\contentsline {section}{\numberline {5.4}Tactics for sequents}{93} -\contentsline {section}{\numberline {5.5}Packaging sequent rules}{94} -\contentsline {section}{\numberline {5.6}Proof procedures}{94} -\contentsline {subsection}{\numberline {5.6.1}Method A}{95} -\contentsline {subsection}{\numberline {5.6.2}Method B}{95} -\contentsline {section}{\numberline {5.7}A simple example of classical reasoning}{96} -\contentsline {section}{\numberline {5.8}A more complex proof}{97} -\contentsline {chapter}{\numberline {6}Constructive Type Theory}{99} -\contentsline {section}{\numberline {6.1}Syntax}{101} -\contentsline {section}{\numberline {6.2}Rules of inference}{101} -\contentsline {section}{\numberline {6.3}Rule lists}{107} -\contentsline {section}{\numberline {6.4}Tactics for subgoal reordering}{107} -\contentsline {section}{\numberline {6.5}Rewriting tactics}{108} -\contentsline {section}{\numberline {6.6}Tactics for logical reasoning}{109} -\contentsline {section}{\numberline {6.7}A theory of arithmetic}{111} -\contentsline {section}{\numberline {6.8}The examples directory}{111} -\contentsline {section}{\numberline {6.9}Example: type inference}{111} -\contentsline {section}{\numberline {6.10}An example of logical reasoning}{113} -\contentsline {section}{\numberline {6.11}Example: deriving a currying functional}{116} -\contentsline {section}{\numberline {6.12}Example: proving the Axiom of Choice}{117} diff -r 19849d258890 -r 8018173a7979 doc-src/Logics/old.defining.tex --- a/doc-src/Logics/old.defining.tex Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,871 +0,0 @@ -\chapter{Defining Logics} \label{Defining-Logics} -This chapter is intended for Isabelle experts. It explains how to define new -logical systems, Isabelle's {\it raison d'\^etre}. Isabelle logics are -hierarchies of theories. A number of simple examples are contained in the -introductory manual; the full syntax of theory definitions is shown in the -{\em Reference Manual}. The purpose of this chapter is to explain the -remaining subtleties, especially some context conditions on the class -structure and the definition of new mixfix syntax. A full understanding of -the material requires knowledge of the internal representation of terms (data -type {\tt term}) as detailed in the {\em Reference Manual}. Sections marked -with a * can be skipped on first reading. - - -\section{Classes and Types *} -\index{*arities!context conditions} - -Type declarations are subject to the following two well-formedness -conditions: -\begin{itemize} -\item There are no two declarations $ty :: (\vec{r})c$ and $ty :: (\vec{s})c$ - with $\vec{r} \neq \vec{s}$. For example -\begin{ttbox} -types ty 1 -arities ty :: (\{logic\}) logic - ty :: (\{\})logic -\end{ttbox} -leads to an error message and fails. -\item If there are two declarations $ty :: (s@1,\dots,s@n)c$ and $ty :: - (s@1',\dots,s@n')c'$ such that $c' < c$ then $s@i' \preceq s@i$ must hold - for $i=1,\dots,n$. The relationship $\preceq$, defined as -\[ s' \preceq s \iff \forall c\in s. \exists c'\in s'.~ c'\le c, \] -expresses that the set of types represented by $s'$ is a subset of the set of -types represented by $s$. For example -\begin{ttbox} -classes term < logic -types ty 1 -arities ty :: (\{logic\})logic - ty :: (\{\})term -\end{ttbox} -leads to an error message and fails. -\end{itemize} -These conditions guarantee principal types~\cite{nipkow-prehofer}. - -\section{Precedence Grammars} -\label{PrecedenceGrammars} -\index{precedence grammar|(} - -The precise syntax of a logic is best defined by a context-free grammar. -These grammars obey the following conventions: identifiers denote -nonterminals, {\tt typewriter} fount denotes terminals, repetition is -indicated by \dots, and alternatives are separated by $|$. - -In order to simplify the description of mathematical languages, we introduce -an extended format which permits {\bf precedences}\index{precedence}. This -scheme generalizes precedence declarations in \ML\ and {\sc prolog}. In this -extended grammar format, nonterminals are decorated by integers, their -precedence. In the sequel, precedences are shown as subscripts. A nonterminal -$A@p$ on the right-hand side of a production may only be replaced using a -production $A@q = \gamma$ where $p \le q$. - -Formally, a set of context free productions $G$ induces a derivation -relation $\rew@G$ on strings as follows: -\[ \alpha A@p \beta ~\rew@G~ \alpha\gamma\beta ~~~iff~~~ - \exists q \ge p.~(A@q=\gamma) \in G -\] -Any extended grammar of this kind can be translated into a normal context -free grammar. However, this translation may require the introduction of a -large number of new nonterminals and productions. - -\begin{example} -\label{PrecedenceEx} -The following simple grammar for arithmetic expressions demonstrates how -binding power and associativity of operators can be enforced by precedences. -\begin{center} -\begin{tabular}{rclr} -$A@9$ & = & {\tt0} \\ -$A@9$ & = & {\tt(} $A@0$ {\tt)} \\ -$A@0$ & = & $A@0$ {\tt+} $A@1$ \\ -$A@2$ & = & $A@3$ {\tt*} $A@2$ \\ -$A@3$ & = & {\tt-} $A@3$ -\end{tabular} -\end{center} -The choice of precedences determines that \verb$-$ binds tighter than -\verb$*$ which binds tighter than \verb$+$, and that \verb$+$ and \verb$*$ -associate to the left and right, respectively. -\end{example} - -To minimize the number of subscripts, we adopt the following conventions: -\begin{itemize} -\item all precedences $p$ must be in the range $0 \leq p \leq max_pri$ for - some fixed $max_pri$. -\item precedence $0$ on the right-hand side and precedence $max_pri$ on the - left-hand side may be omitted. -\end{itemize} -In addition, we write the production $A@p = \alpha$ as $A = \alpha~(p)$. - -Using these conventions and assuming $max_pri=9$, the grammar in -Example~\ref{PrecedenceEx} becomes -\begin{center} -\begin{tabular}{rclc} -$A$ & = & {\tt0} & \hspace*{4em} \\ - & $|$ & {\tt(} $A$ {\tt)} \\ - & $|$ & $A$ {\tt+} $A@1$ & (0) \\ - & $|$ & $A@3$ {\tt*} $A@2$ & (2) \\ - & $|$ & {\tt-} $A@3$ & (3) -\end{tabular} -\end{center} - -\index{precedence grammar|)} - -\section{Basic syntax *} - -An informal account of most of Isabelle's syntax (meta-logic, types etc) is -contained in {\em Introduction to Isabelle}. A precise description using a -precedence grammar is shown in Figure~\ref{MetaLogicSyntax}. This description -is the basis of all extensions by object-logics. -\begin{figure}[htb] -\begin{center} -\begin{tabular}{rclc} -$prop$ &=& \ttindex{PROP} $aprop$ ~~$|$~~ {\tt(} $prop$ {\tt)} \\ - &$|$& $logic@3$ \ttindex{==} $logic@2$ & (2) \\ - &$|$& $prop@2$ \ttindex{==>} $prop@1$ & (1) \\ - &$|$& {\tt[|} $prop$ {\tt;} \dots {\tt;} $prop$ {\tt|]} {\tt==>} $prop@1$ & (1) \\ - &$|$& {\tt!!} $idts$ {\tt.} $prop$ & (0) \\\\ -$logic$ &=& $prop$ ~~$|$~~ $fun$ \\\\ -$aprop$ &=& $id$ ~~$|$~~ $var$ - ~~$|$~~ $fun@{max_pri}$ {\tt(} $logic$ {\tt,} \dots {\tt,} $logic$ {\tt)} \\\\ -$fun$ &=& $id$ ~~$|$~~ $var$ ~~$|$~~ {\tt(} $fun$ {\tt)} \\ - &$|$& \ttindex{\%} $idts$ {\tt.} $logic$ & (0) \\\\ -$idts$ &=& $idt$ ~~$|$~~ $idt@1$ $idts$ \\\\ -$idt$ &=& $id$ ~~$|$~~ {\tt(} $idt$ {\tt)} \\ - &$|$& $id$ \ttindex{::} $type$ & (0) \\\\ -$type$ &=& $tfree$ ~~$|$~~ $tvar$ \\ - &$|$& $tfree$ {\tt::} $sort$ ~~$|$~~ $tvar$ {\tt::} $sort$ \\ - &$|$& $id$ ~~$|$~~ $type@{max_pri}$ $id$ - ~~$|$~~ {\tt(} $type$ {\tt,} \dots {\tt,} $type$ {\tt)} $id$ \\ - &$|$& $type@1$ \ttindex{=>} $type$ & (0) \\ - &$|$& {\tt[} $type$ {\tt,} \dots {\tt,} $type$ {\tt]} {\tt=>} $type$&(0)\\ - &$|$& {\tt(} $type$ {\tt)} \\\\ -$sort$ &=& $id$ ~~$|$~~ {\tt\{\}} - ~~$|$~~ {\tt\{} $id$ {\tt,} \dots {\tt,} $id$ {\tt\}} -\end{tabular}\index{*"!"!}\index{*"["|}\index{*"|"]} -\indexbold{type@$type$}\indexbold{sort@$sort$}\indexbold{idts@$idts$} -\indexbold{logic@$logic$}\indexbold{prop@$prop$}\indexbold{fun@$fun$} -\end{center} -\caption{Meta-Logic Syntax} -\label{MetaLogicSyntax} -\end{figure} -The following main categories are defined: -\begin{description} -\item[$prop$] Terms of type $prop$, i.e.\ formulae of the meta-logic. -\item[$aprop$] Atomic propositions. -\item[$logic$] Terms of types in class $logic$. Initially, $logic$ contains - merely $prop$. As the syntax is extended by new object-logics, more - productions for $logic$ are added (see below). -\item[$fun$] Terms potentially of function type. -\item[$type$] Types. -\item[$idts$] a list of identifiers, possibly constrained by types. Note - that $x::nat~y$ is parsed as $x::(nat~y)$, i.e.\ $y$ is treated like a - type constructor applied to $nat$. -\end{description} - -The predefined types $id$, $var$, $tfree$ and $tvar$ represent identifiers -({\tt f}), unknowns ({\tt ?f}), type variables ({\tt 'a}), and type unknowns -({\tt ?'a}) respectively. If we think of them as nonterminals with -predefined syntax, we may assume that all their productions have precedence -$max_pri$. - -\subsection{Logical types and default syntax} - -Isabelle is concerned with mathematical languages which have a certain -minimal vocabulary: identifiers, variables, parentheses, and the lambda -calculus. Logical types, i.e.\ those of class $logic$, are automatically -equipped with this basic syntax. More precisely, for any type constructor -$ty$ with arity $(\dots)c$, where $c$ is a subclass of $logic$, the following -productions are added: -\begin{center} -\begin{tabular}{rclc} -$ty$ &=& $id$ ~~$|$~~ $var$ ~~$|$~~ {\tt(} $ty$ {\tt)} \\ - &$|$& $fun@{max_pri}$ {\tt(} $logic$ {\tt,} \dots {\tt,} $logic$ {\tt)}\\ - &$|$& $ty@{max_pri}$ {\tt::} $type$\\\\ -$logic$ &=& $ty$ -\end{tabular} -\end{center} - - -\section{Mixfix syntax} -\index{mixfix|(} - -We distinguish between abstract and concrete syntax. The {\em abstract} -syntax is given by the typed constants of a theory. Abstract syntax trees are -well-typed terms, i.e.\ values of \ML\ type {\tt term}. If none of the -constants are introduced with mixfix annotations, there is no concrete syntax -to speak of: terms can only be abstractions or applications of the form -$f(t@1,\dots,t@n)$, where $f$ is a constant or variable. Since this notation -quickly becomes unreadable, Isabelle supports syntax definitions in the form -of unrestricted context-free grammars using mixfix annotations. - -Mixfix annotations describe the {\em concrete} syntax, its translation into -the abstract syntax, and a pretty-printing scheme, all in one. Isabelle -syntax definitions are inspired by \OBJ's~\cite{OBJ} {\em mixfix\/} syntax. -Each mixfix annotation defines a precedence grammar production and associates -an Isabelle constant with it. - -A {\em mixfix declaration} {\tt consts $c$ ::\ $\tau$ ($sy$ $ps$ $p$)} is -interpreted as a grammar pro\-duction as follows: -\begin{itemize} -\item $sy$ is the right-hand side of this production, specified as a {\em - mixfix annotation}. In general, $sy$ is of the form - $\alpha@0\_\alpha@1\dots\alpha@{n-1}\_\alpha@n$, where each occurrence of - ``\ttindex{_}'' denotes an argument/nonterminal and the strings - $\alpha@i$ do not contain ``{\tt_}''. -\item $\tau$ specifies the types of the nonterminals on the left and right - hand side. If $sy$ is of the form above, $\tau$ must be of the form - $[\tau@1,\dots,\tau@n] \To \tau'$. Then argument $i$ is of type $\tau@i$ - and the result, i.e.\ the left-hand side of the production, is of type - $\tau'$. Both the $\tau@i$ and $\tau'$ may be function types. -\item $c$ is the name of the Isabelle constant associated with this production. - Parsing an instance of the phrase $sy$ generates the {\tt term} {\tt - Const($c$,dummyT\footnote{Proper types are inserted later on. See - \S\ref{Typing}})\$$a@1$\$$\dots$\$$a@n$}\index{*dummyT}, where $a@i$ is - the term generated by parsing the $i^{th}$ argument. -\item $ps$ must be of the form $[p@1,\dots,p@n]$, where $p@i$ is the - minimal precedence\index{precedence} required of any phrase that may appear - as the $i^{th}$ argument. The null list is interpreted as a list of 0's of - the appropriate length. -\item $p$ is the precedence of this production. -\end{itemize} -Notice that there is a close connection between abstract and concrete syntax: -each production has an associated constant, and types act as {\bf syntactic - categories} in the concrete syntax. To emphasize this connection, we -sometimes refer to the nonterminals on the right-hand side of a production as -its arguments and to the nonterminal on the left-hand side as its result. - -The maximal legal precedence is called \ttindexbold{max_pri}, which is -currently 1000. If you want to ignore precedences, the safest way to do so is -to use the annotation {\tt($sy$)}: this production puts no precedence -constraints on any of its arguments and has maximal precedence itself, i.e.\ -it is always applicable and does not exclude any productions of its -arguments. - -\begin{example} -In mixfix notation the grammar in Example~\ref{PrecedenceEx} can be written -as follows: -\begin{ttbox} -types exp 0 -consts "0" :: "exp" ("0" 9) - "+" :: "[exp,exp] => exp" ("_ + _" [0,1] 0) - "*" :: "[exp,exp] => exp" ("_ * _" [3,2] 2) - "-" :: "exp => exp" ("- _" [3] 3) -\end{ttbox} -Parsing the string \verb!"0 + - 0 + 0"! produces the term {\tt - $p$\$($p$\$($m$\$$z$)\$$z$)\$$z$} where {\tt$p =$ Const("+",dummyT)}, -{\tt$m =$ Const("-",dummyT)}, and {\tt$z =$ Const("0",dummyT)}. -\end{example} - -The interpretation of \ttindex{_} in a mixfix annotation is always as a {\bf - meta-character}\index{meta-character} which does not represent itself but -an argument position. The following characters are also meta-characters: -\begin{ttbox} -' ( ) / -\end{ttbox} -Preceding any character with a quote (\verb$'$) turns it into an ordinary -character. Thus you can write \verb!''! if you really want a single quote. -The purpose of the other meta-characters is explained in -\S\ref{PrettyPrinting}. Remember that in \ML\ strings \verb$\$ is already a -(different kind of) meta-character. - - -\subsection{Types and syntactic categories *} - -The precise mapping from types to syntactic categories is defined by the -following function: -\begin{eqnarray*} -N(\tau@1\To\tau@2) &=& fun \\ -N((\tau@1,\dots,\tau@n)ty) &=& ty \\ -N(\alpha) &=& logic -\end{eqnarray*} -Only the outermost type constructor is taken into account and type variables -can range over all logical types. This catches some ill-typed terms (like -$Cons(x,0)$, where $Cons :: [\alpha,\alpha list] \To \alpha list$ and $0 :: -nat$) but leaves the real work to the type checker. - -In terms of the precedence grammar format introduced in -\S\ref{PrecedenceGrammars}, the declaration -\begin{ttbox} -consts \(c\) :: "[\(\tau@1\),\dots,\(\tau@n\)]\(\To\tau\)" ("\(\alpha@0\_\alpha@1\dots\alpha@{n-1}\_\alpha@n\)") [\(p@1\),\dots,\(p@n\)] \(p\)) -\end{ttbox} -defines the production -\[ N(\tau)@p ~~=~~ \alpha@0 ~N(\tau@1)@{p@1}~ \alpha@1~ \dots - ~\alpha@{n-1} ~N(\tau@n)@{p@n}~ \alpha@n -\] - -\subsection{Copy productions *} - -Productions which do not create a new node in the abstract syntax tree are -called {\bf copy productions}. They must have exactly one nonterminal on -the right hand side. The term generated when parsing that nonterminal is -simply passed up as the result of parsing the whole copy production. In -Isabelle a copy production is indicated by an empty constant name, i.e.\ by -\begin{ttbox} -consts "" :: \(\tau\) (\(sy\) \(ps\) \(p\)) -\end{ttbox} - -A special kind of copy production is one where, modulo white space, $sy$ is -{\tt"_"}. It is called a {\bf chain production}. Chain productions should be -seen as an abbreviation mechanism. Conceptually, they are removed from the -grammar by adding appropriate new rules. Precedence information attached to -chain productions is ignored. The following example demonstrates the effect: -the grammar defined by -\begin{ttbox} -types A,B,C 0 -consts AB :: "B => A" ("A _" [10] 517) - "" :: "C => B" ("_" [0] 100) - x :: "C" ("x" 5) - y :: "C" ("y" 15) -\end{ttbox} -admits {\tt"A y"} but not {\tt"A x"}. Had the constant in the second -production been some non-empty string, both {\tt"A y"} and {\tt"A x"} would -be legal. - -\index{mixfix|)} - -\section{Lexical conventions} - -The lexical analyzer distinguishes the following kinds of tokens: delimiters, -identifiers, unknowns, type variables and type unknowns. - -Delimiters are user-defined, i.e.\ they are extracted from the syntax -definition. If $\alpha@0\_\alpha@1\dots\alpha@{n-1}\_\alpha@n$ is a mixfix -annotation, each $\alpha@i$ is decomposed into substrings -$\beta@1~\dots~\beta@k$ which are separated by and do not contain -\bfindex{white space} ( = blanks, tabs, newlines). Each $\beta@j$ becomes a -delimiter. Thus a delimiter can be an arbitrary string not containing white -space. - -The lexical syntax of identifiers and variables ( = unknowns) is defined in -the introductory manual. Parsing an identifier $f$ generates {\tt - Free($f$,dummyT)}\index{*dummyT}. Parsing a variable {\tt?}$v$ generates -{\tt Var(($u$,$i$),dummyT)} where $i$ is the integer value of the longest -numeric suffix of $v$ (possibly $0$), and $u$ is the remaining prefix. -Parsing a variable {\tt?}$v{.}i$ generates {\tt Var(($v$,$i$),dummyT)}. The -following table covers the four different cases that can arise: -\begin{center}\tt -\begin{tabular}{cccc} -"?v" & "?v.7" & "?v5" & "?v7.5" \\ -Var(("v",0),$d$) & Var(("v",7),$d$) & Var(("v",5),$d$) & Var(("v7",5),$d$) -\end{tabular} -\end{center} -where $d = {\tt dummyT}$. - -In mixfix annotations, \ttindexbold{id}, \ttindexbold{var}, -\ttindexbold{tfree} and \ttindexbold{tvar} are the predefined categories of -identifiers, unknowns, type variables and type unknowns, respectively. - - -The lexical analyzer translates input strings to token lists by repeatedly -taking the maximal prefix of the input string that forms a valid token. A -maximal prefix that is both a delimiter and an identifier or variable (like -{\tt ALL}) is treated as a delimiter. White spaces are separators. - -An important consequence of this translation scheme is that delimiters need -not be separated by white space to be recognized as separate. If \verb$"-"$ -is a delimiter but \verb$"--"$ is not, the string \verb$"--"$ is treated as -two consecutive occurrences of \verb$"-"$. This is in contrast to \ML\ which -would treat \verb$"--"$ as a single (undeclared) identifier. The -consequence of Isabelle's more liberal scheme is that the same string may be -parsed in a different way after extending the syntax: after adding -\verb$"--"$ as a delimiter, the input \verb$"--"$ is treated as -a single occurrence of \verb$"--"$. - -\section{Infix operators} - -{\tt Infixl} and {\tt infixr} declare infix operators which associate to the -left and right respectively. As in \ML, prefixing infix operators with -\ttindexbold{op} turns them into curried functions. Infix declarations can -be reduced to mixfix ones as follows: -\begin{center}\tt -\begin{tabular}{l@{~~$\Longrightarrow$~~}l} -"$c$" ::~$\tau$ (\ttindexbold{infixl} $p$) & -"op $c$" ::~$\tau$ ("_ $c$ _" [$p$,$p+1$] $p$) \\ -"$c$" ::~$\tau$ (\ttindexbold{infixr} $p$) & -"op $c$" ::~$\tau$ ("_ $c$ _" [$p+1$,$p$] $p$) -\end{tabular} -\end{center} - - -\section{Binders} -A {\bf binder} is a variable-binding constant, such as a quantifier. -The declaration -\begin{ttbox} -consts \(c\) :: \(\tau\) (binder \(Q\) \(p\)) -\end{ttbox}\indexbold{*binder} -introduces a binder $c$ of type $\tau$, -which must have the form $(\tau@1\To\tau@2)\To\tau@3$. Its concrete syntax -is $Q~x.t$. A binder is like a generalized quantifier where $\tau@1$ is the -type of the bound variable $x$, $\tau@2$ the type of the body $t$, and -$\tau@3$ the type of the whole term. For example $\forall$ can be declared -like this: -\begin{ttbox} -consts All :: "('a => o) => o" (binder "ALL " 10) -\end{ttbox} -This allows us to write $\forall x.P$ either as {\tt ALL $x$.$P$} or {\tt - All(\%$x$.$P$)}; the latter form is for purists only. - -In case $\tau@2 = \tau@3$, nested quantifications can be written as $Q~x@1 -\dots x@n.t$. From a syntactic point of view, -\begin{ttbox} -consts \(c\) :: "\((\tau@1\To\tau@2)\To\tau@3\)" (binder "\(Q\)" \(p\)) -\end{ttbox} -is equivalent to -\begin{ttbox} -consts \(c\) :: "\((\tau@1\To\tau@2)\To\tau@3\)" - "\(Q\)" :: "[idts,\(\tau@2\)] => \(\tau@3\)" ("\(Q\)_. _" \(p\)) -\end{ttbox} -where {\tt idts} is the syntactic category $idts$ defined in -Figure~\ref{MetaLogicSyntax}. - -However, there is more to binders than concrete syntax: behind the scenes the -body of the quantified expression has to be converted into a -$\lambda$-abstraction (when parsing) and back again (when printing). This -is performed by the translation mechanism, which is discussed below. For -binders, the definition of the required translation functions has been -automated. Many other syntactic forms, such as set comprehension, require -special treatment. - - -\section{Parse translations *} -\label{Parse-translations} -\index{parse translation|(} - -So far we have pretended that there is a close enough relationship between -concrete and abstract syntax to allow an automatic translation from one to -the other using the constant name supplied with each production. In many -cases this scheme is not powerful enough, especially for constructs involving -variable bindings. Therefore the $ML$-section of a theory definition can -associate constant names with user-defined translation functions by including -a line -\begin{ttbox} -val parse_translation = \dots -\end{ttbox} -where the right-hand side of this binding must be an \ML-expression of type -\verb$(string * (term list -> term))list$. - -After the input string has been translated into a term according to the -syntax definition, there is a second phase in which the term is translated -using the user-supplied functions in a bottom-up manner. Given a list $tab$ -of the above type, a term $t$ is translated as follows. If $t$ is not of the -form {\tt Const($c$,$\tau$)\$$t@1$\$\dots\$$t@n$}, then $t$ is returned -unchanged. Otherwise all $t@i$ are translated into $t@i'$. Let {\tt $t' =$ - Const($c$,$\tau$)\$$t@1'$\$\dots\$$t@n'$}. If there is no pair $(c,f)$ in -$tab$, return $t'$. Otherwise apply $f$ to $[t@1',\dots,t@n']$. If that -raises an exception, return $t'$, otherwise return the result. -\begin{example}\label{list-enum} -\ML-lists are constructed by {\tt[]} and {\tt::}. For readability the -list \hbox{\tt$x$::$y$::$z$::[]} can be written \hbox{\tt[$x$,$y$,$z$]}. -In Isabelle the two forms of lists are declared as follows: -\begin{ttbox} -types list 1 - enum 0 -arities list :: (term)term -consts "[]" :: "'a list" ("[]") - ":" :: "['a, 'a list] => 'a list" (infixr 50) - enum :: "enum => 'a list" ("[_]") - sing :: "'a => enum" ("_") - cons :: "['a,enum] => enum" ("_, _") -end -\end{ttbox} -Because \verb$::$ is already used for type constraints, it is replaced by -\verb$:$ as the infix list constructor. - -In order to allow list enumeration, the new type {\tt enum} is introduced. -Its only purpose is syntactic and hence it does not need an arity, in -contrast to the logical type {\tt list}. Although \hbox{\tt[$x$,$y$,$z$]} is -syntactically legal, it needs to be translated into a term built up from -\verb$[]$ and \verb$:$. This is what \verb$make_list$ accomplishes: -\begin{ttbox} -val cons = Const("op :", dummyT); - -fun make_list (Const("sing",_)$e) = cons $ e $ Const("[]", dummyT) - | make_list (Const("cons",_)$e$es) = cons $ e $ make_list es; -\end{ttbox} -To hook this translation up to Isabelle's parser, the theory definition needs -to contain the following $ML$-section: -\begin{ttbox} -ML -fun enum_tr[enum] = make_list enum; -val parse_translation = [("enum",enum_tr)] -\end{ttbox} -This causes \verb!Const("enum",_)$!$t$ to be replaced by -\verb$enum_tr[$$t$\verb$]$. - -Of course the definition of \verb$make_list$ should be included in the -$ML$-section. -\end{example} -\begin{example}\label{SET} - Isabelle represents the set $\{ x \mid P(x) \}$ internally by $Set(\lambda - x.P(x))$. The internal and external forms need separate -constants:\footnote{In practice, the external form typically has a name -beginning with an {\at} sign, such as {\tt {\at}SET}. This emphasizes that -the constant should be used only for parsing/printing.} -\begin{ttbox} -types set 1 -arities set :: (term)term -consts Set :: "('a => o) => 'a set" - SET :: "[id,o] => 'a set" ("\{_ | _\}") -\end{ttbox} -Parsing {\tt"\{$x$ | $P$\}"} according to this syntax yields the term {\tt - Const("SET",dummyT) \$ Free("\(x\)",dummyT) \$ \(p\)}, where $p$ is the -result of parsing $P$. What we need is the term {\tt - Const("Set",dummyT)\$Abs("$x$",dummyT,$p'$)}, where $p'$ is some -``abstracted'' version of $p$. Therefore we define a function -\begin{ttbox} -fun set_tr[Free(s,T), p] = Const("Set", dummyT) $ - Abs(s, T, abstract_over(Free(s,T), p)); -\end{ttbox} -where \verb$abstract_over: term*term -> term$ is a predefined function such -that {\tt abstract_over($u$,$t$)} replaces every occurrence of $u$ in $t$ by -a {\tt Bound} variable of the correct index (i.e.\ 0 at top level). Remember -that {\tt dummyT} is replaced by the correct types at a later stage (see -\S\ref{Typing}). Function {\tt set_tr} is associated with {\tt SET} by -including the \ML-text -\begin{ttbox} -val parse_translation = [("SET", set_tr)]; -\end{ttbox} -\end{example} - -If you want to run the above examples in Isabelle, you should note that an -$ML$-section needs to contain not just a definition of -\verb$parse_translation$ but also of a variable \verb$print_translation$. The -purpose of the latter is to reverse the effect of the former during printing; -details are found in \S\ref{Print-translations}. Hence you need to include -the line -\begin{ttbox} -val print_translation = []; -\end{ttbox} -This is instructive because the terms are then printed out in their internal -form. For example the input \hbox{\tt[$x$,$y$,$z$]} is echoed as -\hbox{\tt$x$:$y$:$z$:[]}. This helps to check that your parse translation is -working correctly. - -%\begin{warn} -%Explicit type constraints disappear with type checking but are still -%visible to the parse translation functions. -%\end{warn} - -\index{parse translation|)} - -\section{Printing} - -Syntax definitions provide printing information in three distinct ways: -through -\begin{itemize} -\item the syntax of the language (as used for parsing), -\item pretty printing information, and -\item print translation functions. -\end{itemize} -The bare mixfix declarations enable Isabelle to print terms, but the result -will not necessarily be pretty and may look different from what you expected. -To produce a pleasing layout, you need to read the following sections. - -\subsection{Printing with mixfix declarations} - -Let {\tt$t =$ Const($c$,_)\$$t@1$\$\dots\$$t@n$} be a term and let -\begin{ttbox} -consts \(c\) :: \(\tau\) (\(sy\)) -\end{ttbox} -be a mixfix declaration where $sy$ is of the form -$\alpha@0\_\alpha@1\dots\alpha@{n-1}\_\alpha@n$. Printing $t$ according to -$sy$ means printing the string -$\alpha@0\beta@1\alpha@1\ldots\alpha@{n-1}\beta@n\alpha@n$, where $\beta@i$ -is the result of printing $t@i$. - -Note that the system does {\em not\/} insert blanks. They should be part of -the mixfix syntax if they are required to separate tokens or achieve a -certain layout. - -\subsection{Pretty printing} -\label{PrettyPrinting} -\index{pretty printing} - -In order to format the output, it is possible to embed pretty printing -directives in mixfix annotations. These directives are ignored during parsing -and affect only printing. The characters {\tt(}, {\tt)} and {\tt/} are -interpreted as meta-characters\index{meta-character} when found in a mixfix -annotation. Their meaning is -\begin{description} -\item[~{\tt(}~] Open a block. A sequence of digits following it is - interpreted as the \bfindex{indentation} of this block. It causes the - output to be indented by $n$ positions if a line break occurs within the - block. If {\tt(} is not followed by a digit, the indentation defaults to - $0$. -\item[~{\tt)}~] Close a block. -\item[~\ttindex{/}~] Allow a \bfindex{line break}. White space immediately - following {\tt/} is not printed if the line is broken at this point. -\end{description} - -\subsection{Print translations *} -\label{Print-translations} -\index{print translation|(} - -Since terms are translated after parsing (see \S\ref{Parse-translations}), -there is a similar mechanism to translate them back before printing. -Therefore the $ML$-section of a theory definition can associate constant -names with user-defined translation functions by including a line -\begin{ttbox} -val print_translation = \dots -\end{ttbox} -where the right-hand side of this binding is again an \ML-expression of type -\verb$(string * (term list -> term))list$. -Including a pair $(c,f)$ in this list causes the printer to print -$f[t@1,\dots,t@n]$ whenever it finds {\tt Const($c$,_)\$$t@1$\$\dots\$$t@n$}. -\begin{example} -Reversing the effect of the parse translation in Example~\ref{list-enum} is -accomplished by the following function: -\begin{ttbox} -fun make_enum (Const("op :",_) $ e $ es) = case es of - Const("[]",_) => Const("sing",dummyT) $ e - | _ => Const("enum",dummyT) $ e $ make_enum es; -\end{ttbox} -It translates \hbox{\tt$x$:$y$:$z$:[]} to \hbox{\tt[$x$,$y$,$z$]}. However, -if the input does not terminate with an empty list, e.g.\ \hbox{\tt$x$:$xs$}, -\verb$make_enum$ raises exception {\tt Match}. This signals that the -attempted translation has failed and the term should be printed as is. -The connection with Isabelle's pretty printer is established as follows: -\begin{ttbox} -fun enum_tr'[x,xs] = Const("enum",dummyT) $ - make_enum(Const("op :",dummyT)$x$xs); -val print_translation = [("op :", enum_tr')]; -\end{ttbox} -This declaration causes the printer to print \hbox{\tt enum_tr'[$x$,$y$]} -whenever it finds \verb!Const("op :",_)$!$x$\verb!$!$y$. -\end{example} -\begin{example} - In Example~\ref{SET} we showed how to translate the concrete syntax for set - comprehension into the proper internal form. The string {\tt"\{$x$ | - $P$\}"} now becomes {\tt Const("Set",_)\$Abs("$x$",_,$p$)}. If, however, - the latter term were printed without translating it back, it would result - in {\tt"Set(\%$x$.$P$)"}. Therefore the abstraction has to be turned back - into a term that matches the concrete mixfix syntax: -\begin{ttbox} -fun set_tr'[Abs(x,T,P)] = - let val (x',P') = variant_abs(x,T,P) - in Const("SET",dummyT) $ Free(x',T) $ P' end; -\end{ttbox} -The function \verb$variant_abs$, a basic term manipulation function, replaces -the bound variable $x$ by a {\tt Free} variable $x'$ having a unique name. A -term produced by {\tt set_tr'} can now be printed according to the concrete -syntax defined in Example~\ref{SET} above. - -Notice that the application of {\tt set_tr'} fails if the second component of -the argument is not an abstraction, but for example just a {\tt Free} -variable. This is intentional because it signals to the caller that the -translation is inapplicable. As a result {\tt Const("Set",_)\$Free("P",_)} -prints as {\tt"Set(P)"}. - -The full theory extension, including concrete syntax and both translation -functions, has the following form: -\begin{ttbox} -types set 1 -arities set :: (term)term -consts Set :: "('a => o) => 'a set" - SET :: "[id,o] => 'a set" ("\{_ | _\}") -end -ML -fun set_tr[Free(s,T), p] = \dots; -val parse_translation = [("SET", set_tr)]; -fun set_tr'[Abs(x,T,P)] = \dots; -val print_translation = [("Set", set_tr')]; -\end{ttbox} -\end{example} -As during the parse translation process, the types attached to constants -during print translation are ignored. Thus {\tt Const("SET",dummyT)} in -{\tt set_tr'} above is acceptable. The types of {\tt Free}s and {\tt Var}s -however must be preserved because they may get printed (see {\tt -show_types}). - -\index{print translation|)} - -\subsection{Printing a term} - -Let $tab$ be the set of all string-function pairs of print translations in the -current syntax. - -Terms are printed recursively; print translations are applied top down: -\begin{itemize} -\item {\tt Free($x$,_)} is printed as $x$. -\item {\tt Var(($x$,$i$),_)} is printed as $x$, if $i = 0$ and $x$ does not - end with a digit, as $x$ followed by $i$, if $i \neq 0$ and $x$ does not - end with a digit, and as {\tt $x$.$i$}, if $x$ ends with a digit. Thus the - following cases can arise: -\begin{center} -{\tt\begin{tabular}{cccc} -\verb$Var(("v",0),_)$ & \verb$Var(("v",7),_)$ & \verb$Var(("v5",0),_)$ \\ -"?v" & "?v7" & "?v5.0" -\end{tabular}} -\end{center} -\item {\tt Abs($x@1$,_,Abs($x@2$,_,\dots Abs($x@n$,_,$p$)\dots))}, where $p$ - is not an abstraction, is printed as {\tt \%$y@1\dots y@n$.$P$}, where $P$ - is the result of printing $p$, and the $x@i$ are replaced by $y@i$. The - latter are (possibly new) unique names. -\item {\tt Bound($i$)} is printed as {\tt B.$i$} \footnote{The occurrence of - such ``loose'' bound variables indicates that either you are trying to - print a subterm of an abstraction, or there is something wrong with your - print translations.}. -\item The application {\tt$t =$ Const($c$,_)\$$t@1$\$\dots\$$t@n$} (where - $n$ may be $0$!) is printed as follows: - - If there is a pair $(c,f)$ in $tab$, print $f[t@1,\dots,t@n]$. If this - application raises exception {\tt Match} or there is no pair $(c,f)$ in - $tab$, let $sy$ be the mixfix annotation associated with $c$. If there is - no such $sy$, or if $sy$ does not have exactly $n$ argument positions, $t$ - is printed as an application; otherwise $t$ is printed according to $sy$. - - All other applications are printed as applications. -\end{itemize} -Printing a term {\tt $c$\$$t@1$\$\dots\$$t@n$} as an application means -printing it as {\tt $s$($s@1$,\dots,$s@n$)}, where $s@i$ is the result of -printing $t@i$. If $c$ is a {\tt Const}, $s$ is its first argument; -otherwise $s$ is the result of printing $c$ as described above. -\medskip - -The printer also inserts parentheses where they are necessary for reasons -of precedence. - -\section{Identifiers, constants, and type inference *} -\label{Typing} - -There is one final step in the translation from strings to terms that we have -not covered yet. It explains how constants are distinguished from {\tt Free}s -and how {\tt Free}s and {\tt Var}s are typed. Both issues arise because {\tt - Free}s and {\tt Var}s are not declared. - -An identifier $f$ that does not appear as a delimiter in the concrete syntax -can be either a free variable or a constant. Since the parser knows only -about those constants which appear in mixfix annotations, it parses $f$ as -{\tt Free("$f$",dummyT)}, where \ttindex{dummyT} is the predefined dummy {\tt - typ}. Although the parser produces these very raw terms, most user -interface level functions like {\tt goal} type terms according to the given -theory, say $T$. In a first step, every occurrence of {\tt Free($f$,_)} or -{\tt Const($f$,_)} is replaced by {\tt Const($f$,$\tau$)}, provided there is -a constant $f$ of {\tt typ} $\tau$ in $T$. This means that identifiers are -treated as {\tt Free}s iff they are not declared in the theory. The types of -the remaining {\tt Free}s (and {\tt Var}s) are inferred as in \ML. Type -constraints can be used to remove ambiguities. - -One peculiarity of the current type inference algorithm is that variables -with the same name must have the same type, irrespective of whether they are -schematic, free or bound. For example, take the first-order formula $f(x) = x -\land (\forall f.~ f=f)$ where ${=} :: [\alpha{::}term,\alpha]\To o$ and -$\forall :: (\alpha{::}term\To o)\To o$. The first conjunct forces -$x::\alpha{::}term$ and $f::\alpha\To\alpha$, the second one -$f::\beta{::}term$. Although the two $f$'s are distinct, they are required to -have the same type. Unifying $\alpha\To\alpha$ and $\beta{::}term$ fails -because, in first-order logic, function types are not in class $term$. - - -\section{Putting it all together} - -Having discussed the individual building blocks of a logic definition, it -remains to be shown how they fit together. In particular we need to say how -an object-logic syntax is hooked up to the meta-logic. Since all theorems -must conform to the syntax for $prop$ (see Figure~\ref{MetaLogicSyntax}), -that syntax has to be extended with the object-level syntax. Assume that the -syntax of your object-logic defines a category $o$ of formulae. These -formulae can now appear in axioms and theorems wherever $prop$ does if you -add the production -\[ prop ~=~ form. \] -More precisely, you need a coercion from formulae to propositions: -\begin{ttbox} -Base = Pure + -types o 0 -arities o :: logic -consts Trueprop :: "o => prop" ("_" 5) -end -\end{ttbox} -The constant {\tt Trueprop} (the name is arbitrary) acts as an invisible -coercion function. Assuming this definition resides in a file {\tt base.thy}, -you have to load it with the command {\tt use_thy"base"}. - -One of the simplest nontrivial logics is {\em minimal logic} of -implication. Its definition in Isabelle needs no advanced features but -illustrates the overall mechanism quite nicely: -\begin{ttbox} -Hilbert = Base + -consts "-->" :: "[o,o] => o" (infixr 10) -rules -K "P --> Q --> P" -S "(P --> Q --> R) --> (P --> Q) --> P --> R" -MP "[| P --> Q; P |] ==> Q" -end -\end{ttbox} -After loading this definition you can start to prove theorems in this logic: -\begin{ttbox} -goal Hilbert.thy "P --> P"; -{\out Level 0} -{\out P --> P} -{\out 1. P --> P} -by (resolve_tac [Hilbert.MP] 1); -{\out Level 1} -{\out P --> P} -{\out 1. ?P --> P --> P} -{\out 2. ?P} -by (resolve_tac [Hilbert.MP] 1); -{\out Level 2} -{\out P --> P} -{\out 1. ?P1 --> ?P --> P --> P} -{\out 2. ?P1} -{\out 3. ?P} -by (resolve_tac [Hilbert.S] 1); -{\out Level 3} -{\out P --> P} -{\out 1. P --> ?Q2 --> P} -{\out 2. P --> ?Q2} -by (resolve_tac [Hilbert.K] 1); -{\out Level 4} -{\out P --> P} -{\out 1. P --> ?Q2} -by (resolve_tac [Hilbert.K] 1); -{\out Level 5} -{\out P --> P} -{\out No subgoals!} -\end{ttbox} -As you can see, this Hilbert-style formulation of minimal logic is easy to -define but difficult to use. The following natural deduction formulation is -far preferable: -\begin{ttbox} -MinI = Base + -consts "-->" :: "[o,o] => o" (infixr 10) -rules -impI "(P ==> Q) ==> P --> Q" -impE "[| P --> Q; P |] ==> Q" -end -\end{ttbox} -Note, however, that although the two systems are equivalent, this fact cannot -be proved within Isabelle: {\tt S} and {\tt K} can be derived in \verb$MinI$ -(exercise!), but {\tt impI} cannot be derived in \verb!Hilbert!. The reason -is that {\tt impI} is only an {\em admissible} rule in \verb!Hilbert!, -something that can only be shown by induction over all possible proofs in -\verb!Hilbert!. - -It is a very simple matter to extend minimal logic with falsity: -\begin{ttbox} -MinIF = MinI + -consts False :: "o" -rules -FalseE "False ==> P" -end -\end{ttbox} -On the other hand, we may wish to introduce conjunction only: -\begin{ttbox} -MinC = Base + -consts "&" :: "[o,o] => o" (infixr 30) -rules -conjI "[| P; Q |] ==> P & Q" -conjE1 "P & Q ==> P" -conjE2 "P & Q ==> Q" -end -\end{ttbox} -And if we want to have all three connectives together, we define: -\begin{ttbox} -MinIFC = MinIF + MinC -\end{ttbox} -Now we can prove mixed theorems like -\begin{ttbox} -goal MinIFC.thy "P & False --> Q"; -by (resolve_tac [MinI.impI] 1); -by (dresolve_tac [MinC.conjE2] 1); -by (eresolve_tac [MinIF.FalseE] 1); -\end{ttbox} -Try this as an exercise! diff -r 19849d258890 -r 8018173a7979 doc-src/Ref/ref.toc --- a/doc-src/Ref/ref.toc Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,180 +0,0 @@ -\contentsline {chapter}{\numberline {1}Basic Use of Isabelle}{1} -\contentsline {section}{\numberline {1.1}Basic interaction with Isabelle}{1} -\contentsline {section}{\numberline {1.2}Ending a session}{2} -\contentsline {section}{\numberline {1.3}Reading ML files}{2} -\contentsline {section}{\numberline {1.4}Printing of terms and theorems}{2} -\contentsline {subsection}{Printing limits}{2} -\contentsline {subsection}{Printing of hypotheses, types and sorts}{3} -\contentsline {subsection}{$\eta $-contraction before printing}{3} -\contentsline {section}{\numberline {1.5}Displaying exceptions as error messages}{3} -\contentsline {section}{\numberline {1.6}Shell scripts}{4} -\contentsline {chapter}{\numberline {2}Proof Management: The Subgoal Module}{5} -\contentsline {section}{\numberline {2.1}Basic commands}{5} -\contentsline {subsection}{Starting a backward proof}{5} -\contentsline {subsection}{Applying a tactic}{6} -\contentsline {subsection}{Extracting the proved theorem}{7} -\contentsline {subsection}{Undoing and backtracking}{7} -\contentsline {subsection}{Printing the proof state}{8} -\contentsline {subsection}{Timing}{8} -\contentsline {section}{\numberline {2.2}Shortcuts for applying tactics}{8} -\contentsline {subsection}{Refining a given subgoal}{8} -\contentsline {subsection}{Scanning shortcuts}{9} -\contentsline {subsection}{Other shortcuts}{9} -\contentsline {section}{\numberline {2.3}Executing batch proofs}{9} -\contentsline {section}{\numberline {2.4}Managing multiple proofs}{10} -\contentsline {subsection}{The stack of proof states}{11} -\contentsline {subsection}{Saving and restoring proof states}{11} -\contentsline {section}{\numberline {2.5}Debugging and inspecting}{11} -\contentsline {subsection}{Reading and printing terms}{11} -\contentsline {subsection}{Inspecting the proof state}{12} -\contentsline {subsection}{Filtering lists of rules}{12} -\contentsline {chapter}{\numberline {3}Tactics}{13} -\contentsline {section}{\numberline {3.1}Resolution and assumption tactics}{13} -\contentsline {subsection}{Resolution tactics}{13} -\contentsline {subsection}{Assumption tactics}{14} -\contentsline {subsection}{Matching tactics}{14} -\contentsline {subsection}{Resolution with instantiation}{14} -\contentsline {section}{\numberline {3.2}Other basic tactics}{15} -\contentsline {subsection}{Definitions and meta-level rewriting}{15} -\contentsline {subsection}{Tactic shortcuts}{16} -\contentsline {subsection}{Inserting premises and facts}{16} -\contentsline {subsection}{Theorems useful with tactics}{17} -\contentsline {section}{\numberline {3.3}Obscure tactics}{17} -\contentsline {subsection}{Tidying the proof state}{17} -\contentsline {subsection}{Renaming parameters in a goal}{17} -\contentsline {subsection}{Composition: resolution without lifting}{18} -\contentsline {section}{\numberline {3.4}Managing lots of rules}{18} -\contentsline {subsection}{Combined resolution and elim-resolution}{19} -\contentsline {subsection}{Discrimination nets for fast resolution}{19} -\contentsline {section}{\numberline {3.5}Programming tools for proof strategies}{20} -\contentsline {subsection}{Operations on type {\ptt tactic}}{21} -\contentsline {subsection}{Tracing}{21} -\contentsline {section}{\numberline {3.6}Sequences}{22} -\contentsline {subsection}{Basic operations on sequences}{22} -\contentsline {subsection}{Converting between sequences and lists}{22} -\contentsline {subsection}{Combining sequences}{22} -\contentsline {chapter}{\numberline {4}Tacticals}{24} -\contentsline {section}{\numberline {4.1}The basic tacticals}{24} -\contentsline {subsection}{Joining two tactics}{24} -\contentsline {subsection}{Joining a list of tactics}{24} -\contentsline {subsection}{Repetition tacticals}{25} -\contentsline {subsection}{Identities for tacticals}{25} -\contentsline {section}{\numberline {4.2}Control and search tacticals}{26} -\contentsline {subsection}{Filtering a tactic's results}{26} -\contentsline {subsection}{Depth-first search}{26} -\contentsline {subsection}{Other search strategies}{27} -\contentsline {subsection}{Auxiliary tacticals for searching}{27} -\contentsline {subsection}{Predicates and functions useful for searching}{28} -\contentsline {section}{\numberline {4.3}Tacticals for subgoal numbering}{28} -\contentsline {subsection}{Restricting a tactic to one subgoal}{28} -\contentsline {subsection}{Scanning for a subgoal by number}{29} -\contentsline {subsection}{Joining tactic functions}{30} -\contentsline {subsection}{Applying a list of tactics to 1}{31} -\contentsline {chapter}{\numberline {5}Theorems and Forward Proof}{32} -\contentsline {section}{\numberline {5.1}Basic operations on theorems}{32} -\contentsline {subsection}{Pretty-printing a theorem}{32} -\contentsline {subsection}{Forward proof: joining rules by resolution}{33} -\contentsline {subsection}{Expanding definitions in theorems}{33} -\contentsline {subsection}{Instantiating a theorem}{34} -\contentsline {subsection}{Miscellaneous forward rules}{34} -\contentsline {subsection}{Taking a theorem apart}{35} -\contentsline {subsection}{Tracing flags for unification}{35} -\contentsline {section}{\numberline {5.2}Primitive meta-level inference rules}{36} -\contentsline {subsection}{Assumption rule}{37} -\contentsline {subsection}{Implication rules}{37} -\contentsline {subsection}{Logical equivalence rules}{38} -\contentsline {subsection}{Equality rules}{38} -\contentsline {subsection}{The $\lambda $-conversion rules}{38} -\contentsline {subsection}{Forall introduction rules}{39} -\contentsline {subsection}{Forall elimination rules}{39} -\contentsline {subsection}{Instantiation of unknowns}{39} -\contentsline {subsection}{Freezing/thawing type unknowns}{40} -\contentsline {section}{\numberline {5.3}Derived rules for goal-directed proof}{40} -\contentsline {subsection}{Proof by assumption}{40} -\contentsline {subsection}{Resolution}{40} -\contentsline {subsection}{Composition: resolution without lifting}{40} -\contentsline {subsection}{Other meta-rules}{41} -\contentsline {chapter}{\numberline {6}Theories, Terms and Types}{42} -\contentsline {section}{\numberline {6.1}Defining theories}{42} -\contentsline {subsection}{*Classes and arities}{44} -\contentsline {section}{\numberline {6.2}Loading a new theory}{44} -\contentsline {section}{\numberline {6.3}Reloading modified theories}{45} -\contentsline {subsection}{Important note for Poly/ML users}{45} -\contentsline {subsection}{*Pseudo theories}{46} -\contentsline {section}{\numberline {6.4}Basic operations on theories}{47} -\contentsline {subsection}{Extracting an axiom from a theory}{47} -\contentsline {subsection}{Building a theory}{47} -\contentsline {subsection}{Inspecting a theory}{47} -\contentsline {section}{\numberline {6.5}Terms}{48} -\contentsline {section}{\numberline {6.6}Variable binding}{49} -\contentsline {section}{\numberline {6.7}Certified terms}{50} -\contentsline {subsection}{Printing terms}{50} -\contentsline {subsection}{Making and inspecting certified terms}{50} -\contentsline {section}{\numberline {6.8}Types}{50} -\contentsline {section}{\numberline {6.9}Certified types}{51} -\contentsline {subsection}{Printing types}{51} -\contentsline {subsection}{Making and inspecting certified types}{51} -\contentsline {chapter}{\numberline {7}Defining Logics}{52} -\contentsline {section}{\numberline {7.1}Priority grammars}{52} -\contentsline {section}{\numberline {7.2}The Pure syntax}{53} -\contentsline {subsection}{Logical types and default syntax}{55} -\contentsline {subsection}{Lexical matters}{55} -\contentsline {subsection}{*Inspecting the syntax}{56} -\contentsline {section}{\numberline {7.3}Mixfix declarations}{58} -\contentsline {subsection}{Grammar productions}{58} -\contentsline {subsection}{The general mixfix form}{59} -\contentsline {subsection}{Example: arithmetic expressions}{60} -\contentsline {subsection}{The mixfix template}{61} -\contentsline {subsection}{Infixes}{61} -\contentsline {subsection}{Binders}{62} -\contentsline {section}{\numberline {7.4}Example: some minimal logics}{62} -\contentsline {chapter}{\numberline {8}Syntax Transformations}{66} -\contentsline {section}{\numberline {8.1}Abstract syntax trees}{66} -\contentsline {section}{\numberline {8.2}Transforming parse trees to {\psc ast}{}s}{67} -\contentsline {section}{\numberline {8.3}Transforming {\psc ast}{}s to terms}{69} -\contentsline {section}{\numberline {8.4}Printing of terms}{69} -\contentsline {section}{\numberline {8.5}Macros: Syntactic rewriting}{71} -\contentsline {subsection}{Specifying macros}{72} -\contentsline {subsection}{Applying rules}{73} -\contentsline {subsection}{Example: the syntax of finite sets}{75} -\contentsline {subsection}{Example: a parse macro for dependent types}{76} -\contentsline {section}{\numberline {8.6}Translation functions}{76} -\contentsline {subsection}{Declaring translation functions}{77} -\contentsline {subsection}{The translation strategy}{77} -\contentsline {subsection}{Example: a print translation for dependent types}{78} -\contentsline {chapter}{\numberline {9}Substitution Tactics}{80} -\contentsline {section}{\numberline {9.1}Substitution rules}{80} -\contentsline {section}{\numberline {9.2}Substitution in the hypotheses}{81} -\contentsline {section}{\numberline {9.3}Setting up {\ptt hyp_subst_tac}}{82} -\contentsline {chapter}{\numberline {10}Simplification}{84} -\contentsline {section}{\numberline {10.1}Simplification sets}{84} -\contentsline {subsection}{Rewrite rules}{84} -\contentsline {subsection}{*Congruence rules}{85} -\contentsline {subsection}{*The subgoaler}{85} -\contentsline {subsection}{*The solver}{86} -\contentsline {subsection}{*The looper}{86} -\contentsline {section}{\numberline {10.2}The simplification tactics}{87} -\contentsline {section}{\numberline {10.3}Examples using the simplifier}{88} -\contentsline {subsection}{A trivial example}{88} -\contentsline {subsection}{An example of tracing}{89} -\contentsline {subsection}{Free variables and simplification}{90} -\contentsline {section}{\numberline {10.4}Permutative rewrite rules}{90} -\contentsline {subsection}{Example: sums of integers}{91} -\contentsline {subsection}{Re-orienting equalities}{93} -\contentsline {section}{\numberline {10.5}*Setting up the simplifier}{93} -\contentsline {subsection}{A collection of standard rewrite rules}{94} -\contentsline {subsection}{Functions for preprocessing the rewrite rules}{94} -\contentsline {subsection}{Making the initial simpset}{96} -\contentsline {subsection}{Case splitting}{97} -\contentsline {chapter}{\numberline {11}The Classical Reasoner}{98} -\contentsline {section}{\numberline {11.1}The sequent calculus}{98} -\contentsline {section}{\numberline {11.2}Simulating sequents by natural deduction}{99} -\contentsline {section}{\numberline {11.3}Extra rules for the sequent calculus}{100} -\contentsline {section}{\numberline {11.4}Classical rule sets}{101} -\contentsline {section}{\numberline {11.5}The classical tactics}{103} -\contentsline {subsection}{The automatic tactics}{103} -\contentsline {subsection}{Single-step tactics}{103} -\contentsline {subsection}{Other useful tactics}{104} -\contentsline {subsection}{Creating swapped rules}{104} -\contentsline {section}{\numberline {11.6}Setting up the classical reasoner}{104} -\contentsline {chapter}{\numberline {A}Syntax of Isabelle Theories}{107} diff -r 19849d258890 -r 8018173a7979 doc-src/TutorialI/tutorial.ind --- a/doc-src/TutorialI/tutorial.ind Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,666 +0,0 @@ -\begin{theindex} - - \item \ttall, \bold{209} - \item \texttt{?}, \bold{209} - \item \isasymuniqex, \bold{209} - \item \ttuniquex, \bold{209} - \item {\texttt {\&}}, \bold{209} - \item \verb$~$, \bold{209} - \item \verb$~=$, \bold{209} - \item \ttor, \bold{209} - \item \texttt{[]}, \bold{9} - \item \texttt{\#}, \bold{9} - \item \texttt{\at}, \bold{10}, 209 - \item \isasymnotin, \bold{209} - \item \verb$~:$, \bold{209} - \item \isasymInter, \bold{209} - \item \isasymUnion, \bold{209} - \item \isasyminverse, \bold{209} - \item \verb$^-1$, \bold{209} - \item \isactrlsup{\isacharasterisk}, \bold{209} - \item \verb$^$\texttt{*}, \bold{209} - \item \isasymAnd, \bold{12}, \bold{209} - \item \ttAnd, \bold{209} - \item \emph {$\Rightarrow $}, \bold{5} - \item \ttlbr, \bold{209} - \item \ttrbr, \bold{209} - \item \texttt {\%}, \bold{209} - \item \texttt {;}, \bold{7} - \item \isa {()} (constant), 24 - \item * trace_unify_fail (flag), 76 - \item \isa {+} (tactical), 99 - \item \isa {<*lex*>}, \see{lexicographic product}{1} - \item \isa {?} (tactical), 100 - \item \texttt{|} (tactical), 100 - - \indexspace - - \item \isa {0} (constant), 22, 23, 150 - \item \isa {1} (constant), 23, 150, 151 - - \indexspace - - \item abandoning a proof, \bold{13} - \item abandoning a theory, \bold{16} - \item \isa {abs} (constant), 153 - \item \texttt {abs}, \bold{209} - \item absolute value, 153 - \item \isa {add} (modifier), 29 - \item \isa {add_ac} (theorems), 152 - \item \isa {add_assoc} (theorem), \bold{152} - \item \isa {add_commute} (theorem), \bold{152} - \item \isa {add_mult_distrib} (theorem), \bold{151} - \item \texttt {ALL}, \bold{209} - \item \isa {All} (constant), 109 - \item \isa {allE} (theorem), \bold{81} - \item \isa {allI} (theorem), \bold{80} - \item antiquotation, \bold{61} - \item append function, 10--14 - \item \isacommand {apply} (command), 15 - \item \isa {arg_cong} (theorem), \bold{96} - \item \isa {arith} (method), 23, 149 - \item arithmetic operations - \subitem for \protect\isa{nat}, 23 - \item \textsc {ascii} symbols, \bold{209} - \item Aspinall, David, viii - \item associative-commutative function, 176 - \item \isa {assumption} (method), 69 - \item assumptions - \subitem of subgoal, 12 - \subitem renaming, 83 - \subitem reusing, 83--84 - \item \isa {auto} (method), 38, 92 - \item \isa {axclass}, 164--171 - \item axiom of choice, 87 - \item axiomatic type classes, 164--171 - - \indexspace - - \item \isacommand {back} (command), 79 - \item \isa {Ball} (constant), 109 - \item \isa {ballI} (theorem), \bold{108} - \item \isa {best} (method), 92 - \item \isa {Bex} (constant), 109 - \item \isa {bexE} (theorem), \bold{108} - \item \isa {bexI} (theorem), \bold{108} - \item \isa {bij_def} (theorem), \bold{110} - \item bijections, 110 - \item binary trees, 18 - \item binomial coefficients, 109 - \item bisimulations, 116 - \item \isa {blast} (method), 89--92 - \item \isa {bool} (type), 4, 5 - \item boolean expressions example, 20--22 - \item \isa {bspec} (theorem), \bold{108} - \item \isacommand{by} (command), 73 - - \indexspace - - \item \isa {card} (constant), 109 - \item \isa {card_Pow} (theorem), \bold{109} - \item \isa {card_Un_Int} (theorem), \bold{109} - \item cardinality, 109 - \item \isa {case} (symbol), 32, 33 - \item \isa {case} expressions, 5, 6, 18 - \item case distinctions, 19 - \item case splits, \bold{31} - \item \isa {case_tac} (method), 19, 102, 158 - \item \isa {cases} (method), 162 - \item \isacommand {chapter} (command), 59 - \item \isa {clarify} (method), 91, 92 - \item \isa {clarsimp} (method), 91, 92 - \item \isa {classical} (theorem), \bold{73} - \item coinduction, \bold{116} - \item \isa {Collect} (constant), 109 - \item compiling expressions example, 36--38 - \item \isa {Compl_iff} (theorem), \bold{106} - \item complement - \subitem of a set, 105 - \item composition - \subitem of functions, \bold{110} - \subitem of relations, \bold{112} - \item conclusion - \subitem of subgoal, 12 - \item conditional expressions, \see{\isa{if} expressions}{1} - \item conditional simplification rules, 31 - \item \isa {cong} (attribute), 176 - \item congruence rules, \bold{175} - \item \isa {conjE} (theorem), \bold{71} - \item \isa {conjI} (theorem), \bold{68} - \item \isa {Cons} (constant), 9 - \item \isacommand {constdefs} (command), 25 - \item \isacommand {consts} (command), 10 - \item contrapositives, 73 - \item converse - \subitem of a relation, \bold{112} - \item \isa {converse_iff} (theorem), \bold{112} - \item CTL, 121--126, 191--193 - - \indexspace - - \item \isacommand {datatype} (command), 9, 38--44 - \item datatypes, 17--22 - \subitem and nested recursion, 40, 44 - \subitem mutually recursive, 38 - \subitem nested, 180 - \item \isacommand {defer} (command), 16, 101 - \item Definitional Approach, 26 - \item definitions, \bold{25} - \subitem unfolding, \bold{30} - \item \isacommand {defs} (command), 25 - \item \isa {del} (modifier), 29 - \item description operators, 85--87 - \item descriptions - \subitem definite, 85 - \subitem indefinite, 86 - \item \isa {dest} (attribute), 103 - \item destruction rules, 71 - \item \isa {diff_mult_distrib} (theorem), \bold{151} - \item difference - \subitem of sets, \bold{106} - \item \isa {disjCI} (theorem), \bold{74} - \item \isa {disjE} (theorem), \bold{70} - \item \isa {div} (symbol), 23 - \item divides relation, 84, 95, 102--104, 152 - \item division - \subitem by negative numbers, 153 - \subitem by zero, 152 - \subitem for type \protect\isa{nat}, 151 - \item documents, \bold{57} - \item domain - \subitem of a relation, 112 - \item \isa {Domain_iff} (theorem), \bold{112} - \item \isacommand {done} (command), 13 - \item \isa {drule_tac} (method), 76, 96 - \item \isa {dvd_add} (theorem), \bold{152} - \item \isa {dvd_anti_sym} (theorem), \bold{152} - \item \isa {dvd_def} (theorem), \bold{152} - - \indexspace - - \item \isa {elim!} (attribute), 131 - \item elimination rules, 69--70 - \item \isacommand {end} (command), 14 - \item \isa {Eps} (constant), 109 - \item equality, 6 - \subitem of functions, \bold{109} - \subitem of records, 161 - \subitem of sets, \bold{106} - \item \isa {equalityE} (theorem), \bold{106} - \item \isa {equalityI} (theorem), \bold{106} - \item \isa {erule} (method), 70 - \item \isa {erule_tac} (method), 76 - \item Euclid's algorithm, 102--104 - \item even numbers - \subitem defining inductively, 127--131 - \item \texttt {EX}, \bold{209} - \item \isa {Ex} (constant), 109 - \item \isa {exE} (theorem), \bold{82} - \item \isa {exI} (theorem), \bold{82} - \item \isa {ext} (theorem), \bold{109} - \item \isa {extend} (constant), 163 - \item extensionality - \subitem for functions, \bold{109, 110} - \subitem for records, 162 - \subitem for sets, \bold{106} - \item \ttEXU, \bold{209} - - \indexspace - - \item \isa {False} (constant), 5 - \item \isa {fast} (method), 92, 124 - \item Fibonacci function, 47 - \item \isa {fields} (constant), 163 - \item \isa {finite} (symbol), 109 - \item \isa {Finites} (constant), 109 - \item fixed points, 116 - \item flags, 5, 6, 33, 76 - \subitem setting and resetting, 5 - \item \isa {force} (method), 91, 92 - \item formal comments, \bold{61} - \item formal proof documents, \bold{57} - \item formulae, 5--6 - \item forward proof, 93--99 - \item \isa {frule} (method), 83--84 - \item \isa {frule_tac} (method), 76 - \item \isa {fst} (constant), 24 - \item function types, 5 - \item functions, 109--111 - \subitem partial, 182 - \subitem total, 11, 47--52 - \subitem underdefined, 183 - - \indexspace - - \item \isa {gcd} (constant), 93--95, 102--104 - \item generalizing for induction, 129 - \item generalizing induction formulae, 34 - \item Girard, Jean-Yves, \fnote{71} - \item Gordon, Mike, 3 - \item grammars - \subitem defining inductively, 140--145 - \item ground terms example, 135--140 - - \indexspace - - \item \isa {hd} (constant), 17, 37 - \item \isacommand {header} (command), 59 - \item Hilbert's $\varepsilon$-operator, 86 - \item \isacommand {hints} (command), 49, 180, 182 - \item HOLCF, 44 - \item Hopcroft, J. E., 145 - \item \isa {hypreal} (type), 155 - - \indexspace - - \item \isa {Id_def} (theorem), \bold{112} - \item \isa {id_def} (theorem), \bold{110} - \item identifiers, \bold{6} - \subitem qualified, \bold{4} - \item identity function, \bold{110} - \item identity relation, \bold{112} - \item \isa {if} expressions, 5, 6 - \subitem simplification of, 33 - \subitem splitting of, 31, 49 - \item if-and-only-if, 6 - \item \isa {iff} (attribute), 90, 91, 103, 130 - \item \isa {iffD1} (theorem), \bold{94} - \item \isa {iffD2} (theorem), \bold{94} - \item ignored material, \bold{64} - \item image - \subitem under a function, \bold{111} - \subitem under a relation, \bold{112} - \item \isa {image_def} (theorem), \bold{111} - \item \isa {Image_iff} (theorem), \bold{112} - \item \isa {impI} (theorem), \bold{72} - \item implication, 72--73 - \item \isa {ind_cases} (method), 131 - \item \isa {induct_tac} (method), 12, 19, 52, 190 - \item induction, 186--193 - \subitem complete, 188 - \subitem deriving new schemas, 190 - \subitem on a term, 187 - \subitem recursion, 51--52 - \subitem structural, 19 - \subitem well-founded, 115 - \item induction heuristics, 33--35 - \item \isacommand {inductive} (command), 127 - \item inductive definition - \subitem simultaneous, 141 - \item inductive definitions, 127--145 - \item \isacommand {inductive\_cases} (command), 131, 139 - \item infinitely branching trees, 43 - \item infix annotations, 53 - \item \isacommand{infixr} (annotation), 10 - \item \isa {inj_on_def} (theorem), \bold{110} - \item injections, 110 - \item \isa {insert} (constant), 107 - \item \isa {insert} (method), 97--99 - \item instance, \bold{166} - \item \texttt {INT}, \bold{209} - \item \texttt {Int}, \bold{209} - \item \isa {int} (type), 153--154 - \item \isa {INT_iff} (theorem), \bold{108} - \item \isa {IntD1} (theorem), \bold{105} - \item \isa {IntD2} (theorem), \bold{105} - \item integers, 153--154 - \item \isa {INTER} (constant), 109 - \item \texttt {Inter}, \bold{209} - \item \isa {Inter_iff} (theorem), \bold{108} - \item intersection, 105 - \subitem indexed, 108 - \item \isa {IntI} (theorem), \bold{105} - \item \isa {intro} (method), 74 - \item \isa {intro!} (attribute), 128 - \item \isa {intro_classes} (method), 166 - \item introduction rules, 68--69 - \item \isa {inv} (constant), 86 - \item \isa {inv_image_def} (theorem), \bold{115} - \item inverse - \subitem of a function, \bold{110} - \subitem of a relation, \bold{112} - \item inverse image - \subitem of a function, 111 - \subitem of a relation, 114 - \item \isa {itrev} (constant), 34 - - \indexspace - - \item \isacommand {kill} (command), 16 - - \indexspace - - \item $\lambda$ expressions, 5 - \item LCF, 43 - \item \isa {LEAST} (symbol), 23, 86 - \item least number operator, \see{\protect\isa{LEAST}}{86} - \item Leibniz, Gottfried Wilhelm, 53 - \item \isacommand {lemma} (command), 13 - \item \isacommand {lemmas} (command), 93, 103 - \item \isa {length} (symbol), 18 - \item \isa {length_induct}, \bold{190} - \item \isa {less_than} (constant), 114 - \item \isa {less_than_iff} (theorem), \bold{114} - \item \isa {let} expressions, 5, 6, 31 - \item \isa {Let_def} (theorem), 31 - \item \isa {lex_prod_def} (theorem), \bold{115} - \item lexicographic product, \bold{115}, 178 - \item {\texttt{lfp}} - \subitem applications of, \see{CTL}{116} - \item Library, 4 - \item linear arithmetic, 22--24, 149 - \item \isa {List} (theory), 17 - \item \isa {list} (type), 5, 9, 17 - \item \isa {list.split} (theorem), 32 - \item \isa {lists_mono} (theorem), \bold{137} - \item Lowe, Gavin, 196--197 - - \indexspace - - \item \isa {Main} (theory), 4 - \item major premise, \bold{75} - \item \isa {make} (constant), 163 - \item marginal comments, \bold{61} - \item markup commands, \bold{59} - \item \isa {max} (constant), 23, 24 - \item measure functions, 47, 114 - \item \isa {measure_def} (theorem), \bold{115} - \item meta-logic, \bold{80} - \item methods, \bold{16} - \item \isa {min} (constant), 23, 24 - \item mixfix annotations, \bold{53} - \item \isa {mod} (symbol), 23 - \item \isa {mod_div_equality} (theorem), \bold{151} - \item \isa {mod_mult_distrib} (theorem), \bold{151} - \item model checking example, 116--126 - \item \emph{modus ponens}, 67, 72 - \item \isa {mono_def} (theorem), \bold{116} - \item monotone functions, \bold{116}, 139 - \subitem and inductive definitions, 137--138 - \item \isa {more} (constant), 159, 160 - \item \isa {mp} (theorem), \bold{72} - \item \isa {mult_ac} (theorems), 152 - \item multiple inheritance, \bold{170} - \item multiset ordering, \bold{115} - - \indexspace - - \item \isa {nat} (type), 4, 22, 151--153 - \item \isa {nat_less_induct} (theorem), 188 - \item natural deduction, 67--68 - \item natural numbers, 22, 151--153 - \item Needham-Schroeder protocol, 195--197 - \item negation, 73--75 - \item \isa {Nil} (constant), 9 - \item \isa {no_asm} (modifier), 29 - \item \isa {no_asm_simp} (modifier), 30 - \item \isa {no_asm_use} (modifier), 30 - \item \isa {no_vars} (attribute), 62 - \item non-standard reals, 155 - \item \isa {None} (constant), \bold{24} - \item \isa {notE} (theorem), \bold{73} - \item \isa {notI} (theorem), \bold{73} - \item numbers, 149--155 - \item numeric literals, 150 - \subitem for type \protect\isa{nat}, 151 - \subitem for type \protect\isa{real}, 155 - - \indexspace - - \item \isa {O} (symbol), 112 - \item \texttt {o}, \bold{209} - \item \isa {o_def} (theorem), \bold{110} - \item \isa {OF} (attribute), 95--96 - \item \isa {of} (attribute), 93, 96 - \item \isa {only} (modifier), 29 - \item \isacommand {oops} (command), 13 - \item \isa {option} (type), \bold{24} - \item ordered rewriting, \bold{176} - \item overloading, 23, 165--167 - \subitem and arithmetic, 150 - - \indexspace - - \item pairs and tuples, 24, 155--158 - \item parent theories, \bold{4} - \item pattern matching - \subitem and \isacommand{recdef}, 47 - \item patterns - \subitem higher-order, \bold{177} - \item PDL, 118--120 - \item \isacommand {pr} (command), 16, 100 - \item \isacommand {prefer} (command), 16, 101 - \item prefix annotation, 55 - \item primitive recursion, \see{recursion, primitive}{1} - \item \isacommand {primrec} (command), 10, 18, 38--44 - \item print mode, \bold{55} - \item product type, \see{pairs and tuples}{1} - \item Proof General, \bold{7} - \item proof state, 12 - \item proofs - \subitem abandoning, \bold{13} - \subitem examples of failing, 88--89 - \item protocols - \subitem security, 195--205 - - \indexspace - - \item quantifiers, 6 - \subitem and inductive definitions, 135--137 - \subitem existential, 82--83 - \subitem for sets, 108 - \subitem instantiating, 84 - \subitem universal, 80--82 - - \indexspace - - \item \isa {r_into_rtrancl} (theorem), \bold{112} - \item \isa {r_into_trancl} (theorem), \bold{113} - \item range - \subitem of a function, 111 - \subitem of a relation, 112 - \item \isa {range} (symbol), 111 - \item \isa {Range_iff} (theorem), \bold{112} - \item \isa {Real} (theory), 155 - \item \isa {real} (type), 154--155 - \item real numbers, 154--155 - \item \isacommand {recdef} (command), 47--52, 114, 178--186 - \subitem and numeric literals, 150 - \item \isa {recdef_cong} (attribute), 182 - \item \isa {recdef_simp} (attribute), 49 - \item \isa {recdef_wf} (attribute), 180 - \item \isacommand {record} (command), 159 - \item records, 158--164 - \subitem extensible, 160--161 - \item recursion - \subitem guarded, 183 - \subitem primitive, 18 - \subitem well-founded, \bold{179} - \item recursion induction, 51--52 - \item \isacommand {redo} (command), 16 - \item reflexive and transitive closure, 112--114 - \item reflexive transitive closure - \subitem defining inductively, 132--135 - \item \isa {rel_comp_def} (theorem), \bold{112} - \item relations, 111--114 - \subitem well-founded, 114--115 - \item \isa {rename_tac} (method), 83 - \item \isa {rev} (constant), 10--14, 34 - \item rewrite rules, \bold{27} - \subitem permutative, \bold{176} - \item rewriting, \bold{27} - \item \isa {rtrancl_refl} (theorem), \bold{112} - \item \isa {rtrancl_trans} (theorem), \bold{112} - \item rule induction, 128--130 - \item rule inversion, 130--131, 139--140 - \item \isa {rule_format} (attribute), 187 - \item \isa {rule_tac} (method), 76 - \subitem and renaming, 83 - - \indexspace - - \item \isa {safe} (method), 91, 92 - \item safe rules, \bold{90} - \item \isacommand {sect} (command), 59 - \item \isacommand {section} (command), 59 - \item selector - \subitem record, 159 - \item session, \bold{58} - \item \isa {set} (type), 5, 105 - \item set comprehensions, 107--108 - \item \isa {set_ext} (theorem), \bold{106} - \item sets, 105--109 - \subitem finite, 109 - \subitem notation for finite, \bold{107} - \item settings, \see{flags}{1} - \item \isa {show_brackets} (flag), 6 - \item \isa {show_types} (flag), 5, 16 - \item \isa {simp} (attribute), 11, 28 - \item \isa {simp} (method), \bold{28} - \item \isa {simp} del (attribute), 28 - \item \isa {simp_all} (method), 29, 38 - \item simplification, 27--33, 175--178 - \subitem of \isa{let}-expressions, 31 - \subitem with definitions, 30 - \subitem with/of assumptions, 29 - \item simplification rule, 177--178 - \item simplification rules, 28 - \subitem adding and deleting, 29 - \item \isa {simplified} (attribute), 94, 96 - \item \isa {size} (constant), 17 - \item \isa {snd} (constant), 24 - \item \isa {SOME} (symbol), 86 - \item \texttt {SOME}, \bold{209} - \item \isa {Some} (constant), \bold{24} - \item \isa {some_equality} (theorem), \bold{87} - \item \isa {someI} (theorem), \bold{87} - \item \isa {someI2} (theorem), \bold{87} - \item \isa {someI_ex} (theorem), \bold{87} - \item sorts, 170 - \item source comments, \bold{60} - \item \isa {spec} (theorem), \bold{81} - \item \isa {split} (attribute), 32 - \item \isa {split} (constant), 156 - \item \isa {split} (method), 31, 156 - \item \isa {split} (modifier), 32 - \item split rule, \bold{32} - \item \isa {split_if} (theorem), 32 - \item \isa {split_if_asm} (theorem), 32 - \item \isa {ssubst} (theorem), \bold{77} - \item structural induction, \see{induction, structural}{1} - \item subclasses, 165, 169 - \item subgoal numbering, 46 - \item \isa {subgoal_tac} (method), 98, 99 - \item subgoals, 12 - \item \isacommand {subsect} (command), 59 - \item \isacommand {subsection} (command), 59 - \item subset relation, \bold{106} - \item \isa {subsetD} (theorem), \bold{106} - \item \isa {subsetI} (theorem), \bold{106} - \item \isa {subst} (method), 77 - \item substitution, 77--80 - \item \isacommand {subsubsect} (command), 59 - \item \isacommand {subsubsection} (command), 59 - \item \isa {Suc} (constant), 22 - \item \isa {surj_def} (theorem), \bold{110} - \item surjections, 110 - \item \isa {sym} (theorem), \bold{94} - \item symbols, \bold{54} - \item syntax, 6, 11 - \item \isacommand {syntax} (command), 55 - \item syntax (command), 56 - \item syntax translations, \bold{56} - - \indexspace - - \item tacticals, 99--100 - \item tactics, 12 - \item \isacommand {term} (command), 16 - \item term rewriting, \bold{27} - \item termination, \see{functions, total}{1} - \item terms, 5 - \item text, \bold{61} - \item text blocks, \bold{61} - \item \isa {THE} (symbol), 85 - \item \isa {the_equality} (theorem), \bold{86} - \item \isa {THEN} (attribute), \bold{94}, 96, 103 - \item \isacommand {theorem} (command), \bold{11}, 13 - \item theories, 4 - \subitem abandoning, \bold{16} - \item \isacommand {theory} (command), 16 - \item theory files, 4 - \item \isacommand {thm} (command), 16 - \item \isa {tl} (constant), 17 - \item \isa {ToyList} example, 9--14 - \item \isa {trace_simp} (flag), 33 - \item tracing the simplifier, \bold{33} - \item \isa {trancl_trans} (theorem), \bold{113} - \item transition systems, 117 - \item \isacommand {translations} (command), 56 - \item tries, 44--46 - \item \isa {True} (constant), 5 - \item \isa {truncate} (constant), 163 - \item tuples, \see{pairs and tuples}{1} - \item txt, \bold{61} - \item \isacommand {typ} (command), 16 - \item type constraints, \bold{6} - \item type constructors, 5 - \item type inference, \bold{5} - \item type synonyms, 25 - \item type variables, 5 - \item \isacommand {typedecl} (command), 117, 171 - \item \isacommand {typedef} (command), 172--174 - \item types, 4--5 - \subitem declaring, 171 - \subitem defining, 172--174 - \item \isacommand {types} (command), 25 - - \indexspace - - \item Ullman, J. D., 145 - \item \texttt {UN}, \bold{209} - \item \texttt {Un}, \bold{209} - \item \isa {UN_E} (theorem), \bold{108} - \item \isa {UN_I} (theorem), \bold{108} - \item \isa {UN_iff} (theorem), \bold{108} - \item \isa {Un_subset_iff} (theorem), \bold{106} - \item \isacommand {undo} (command), 16 - \item \isa {unfold} (method), \bold{30} - \item unification, 76--79 - \item \isa {UNION} (constant), 109 - \item \texttt {Union}, \bold{209} - \item union - \subitem indexed, 108 - \item \isa {Union_iff} (theorem), \bold{108} - \item \isa {unit} (type), 24 - \item unknowns, 7, \bold{68} - \item unsafe rules, \bold{90} - \item update - \subitem record, 159 - \item updating a function, \bold{109} - - \indexspace - - \item variables, 7 - \subitem schematic, 7 - \subitem type, 5 - \item \isa {vimage_def} (theorem), \bold{111} - - \indexspace - - \item \isa {wf_induct} (theorem), \bold{115} - \item \isa {wf_inv_image} (theorem), \bold{115} - \item \isa {wf_less_than} (theorem), \bold{114} - \item \isa {wf_lex_prod} (theorem), \bold{115} - \item \isa {wf_measure} (theorem), \bold{115} - \item \isa {wf_subset} (theorem), 180 - \item \isa {while} (constant), 185 - \item \isa {While_Combinator} (theory), 185 - \item \isa {while_rule} (theorem), 185 - - \indexspace - - \item \isa {zadd_ac} (theorems), 153 - \item \isa {zmult_ac} (theorems), 153 - -\end{theindex} diff -r 19849d258890 -r 8018173a7979 doc-src/ind-defs.toc --- a/doc-src/ind-defs.toc Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -\contentsline {section}{\numberline {1}Introduction}{1} -\contentsline {section}{\numberline {2}Fixedpoint operators}{1} -\contentsline {section}{\numberline {3}Elements of an inductive or coinductive definition}{2} -\contentsline {subsection}{\numberline {3.1}The form of the introduction rules}{2} -\contentsline {subsection}{\numberline {3.2}The fixedpoint definitions}{3} -\contentsline {subsection}{\numberline {3.3}Mutual recursion}{3} -\contentsline {subsection}{\numberline {3.4}Proving the introduction rules}{4} -\contentsline {subsection}{\numberline {3.5}The elimination rule}{4} -\contentsline {section}{\numberline {4}Induction and coinduction rules}{4} -\contentsline {subsection}{\numberline {4.1}The basic induction rule}{4} -\contentsline {subsection}{\numberline {4.2}Mutual induction}{5} -\contentsline {subsection}{\numberline {4.3}Coinduction}{5} -\contentsline {section}{\numberline {5}Examples of inductive and coinductive definitions}{6} -\contentsline {subsection}{\numberline {5.1}The finite set operator}{6} -\contentsline {subsection}{\numberline {5.2}Lists of $n$ elements}{6} -\contentsline {subsection}{\numberline {5.3}A coinductive definition: bisimulations on lazy lists}{7} -\contentsline {subsection}{\numberline {5.4}The accessible part of a relation}{8} -\contentsline {subsection}{\numberline {5.5}The primitive recursive functions}{9} -\contentsline {section}{\numberline {6}Datatypes and codatatypes}{11} -\contentsline {subsection}{\numberline {6.1}Constructors and their domain}{11} -\contentsline {subsection}{\numberline {6.2}The case analysis operator}{11} -\contentsline {section}{\numberline {7}Conclusions and future work}{12} diff -r 19849d258890 -r 8018173a7979 src/CCL/ccl.ML --- a/src/CCL/ccl.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,334 +0,0 @@ -(* Title: CCL/ccl - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For ccl.thy. -*) - -open CCL; - -val ccl_data_defs = [apply_def,fix_def]; - -val CCL_ss = FOL_ss addcongs set_congs - addsimps ([po_refl RS P_iff_T] @ mem_rews); - -(*** Congruence Rules ***) - -(*similar to AP_THM in Gordon's HOL*) -val fun_cong = prove_goal CCL.thy "(f::'a=>'b) = g ==> f(x)=g(x)" - (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]); - -(*similar to AP_TERM in Gordon's HOL and FOL's subst_context*) -val arg_cong = prove_goal CCL.thy "x=y ==> f(x)=f(y)" - (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]); - -goal CCL.thy "(ALL x. f(x) = g(x)) --> (%x.f(x)) = (%x.g(x))"; -by (simp_tac (CCL_ss addsimps [eq_iff]) 1); -by (fast_tac (set_cs addIs [po_abstractn]) 1); -val abstractn = standard (allI RS (result() RS mp)); - -fun type_of_terms (Const("Trueprop",_) $ - (Const("op =",(Type ("fun", [t,_]))) $ _ $ _)) = t; - -fun abs_prems thm = - let fun do_abs n thm (Type ("fun", [_,t])) = do_abs n (abstractn RSN (n,thm)) t - | do_abs n thm _ = thm - fun do_prems n [] thm = thm - | do_prems n (x::xs) thm = do_prems (n+1) xs (do_abs n thm (type_of_terms x)); - in do_prems 1 (prems_of thm) thm - end; - -val caseBs = [caseBtrue,caseBfalse,caseBpair,caseBlam,caseBbot]; - -(*** Termination and Divergence ***) - -goalw CCL.thy [Trm_def,Dvg_def] "Trm(t) <-> ~ t = bot"; -br iff_refl 1; -val Trm_iff = result(); - -goalw CCL.thy [Trm_def,Dvg_def] "Dvg(t) <-> t = bot"; -br iff_refl 1; -val Dvg_iff = result(); - -(*** Constructors are injective ***) - -val prems = goal CCL.thy - "[| x=a; y=b; x=y |] ==> a=b"; -by (REPEAT (SOMEGOAL (ares_tac (prems@[box_equals])))); -val eq_lemma = result(); - -fun mk_inj_rl thy rews s = - let fun mk_inj_lemmas r = ([arg_cong] RL [(r RS (r RS eq_lemma))]); - val inj_lemmas = flat (map mk_inj_lemmas rews); - val tac = REPEAT (ares_tac [iffI,allI,conjI] 1 ORELSE - eresolve_tac inj_lemmas 1 ORELSE - asm_simp_tac (CCL_ss addsimps rews) 1) - in prove_goal thy s (fn _ => [tac]) - end; - -val ccl_injs = map (mk_inj_rl CCL.thy caseBs) - [" = <-> (a=a' & b=b')", - "(lam x.b(x) = lam x.b'(x)) <-> ((ALL z.b(z)=b'(z)))"]; - -val pair_inject = ((hd ccl_injs) RS iffD1) RS conjE; - -(*** Constructors are distinct ***) - -local - fun pairs_of f x [] = [] - | pairs_of f x (y::ys) = (f x y) :: (f y x) :: (pairs_of f x ys); - - fun mk_combs ff [] = [] - | mk_combs ff (x::xs) = (pairs_of ff x xs) @ mk_combs ff xs; - -(* Doesn't handle binder types correctly *) - fun saturate thy sy name = - let fun arg_str 0 a s = s - | arg_str 1 a s = "(" ^ a ^ "a" ^ s ^ ")" - | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s); - val sg = sign_of thy; - val T = case Sign.Symtab.lookup(#const_tab(Sign.rep_sg sg),sy) of - None => error(sy^" not declared") | Some(T) => T; - val arity = length (fst (strip_type T)); - in sy ^ (arg_str arity name "") end; - - fun mk_thm_str thy a b = "~ " ^ (saturate thy a "a") ^ " = " ^ (saturate thy b "b"); - - val lemma = prove_goal CCL.thy "t=t' --> case(t,b,c,d,e) = case(t',b,c,d,e)" - (fn _ => [simp_tac CCL_ss 1]) RS mp; - fun mk_lemma (ra,rb) = [lemma] RL [ra RS (rb RS eq_lemma)] RL - [distinctness RS notE,sym RS (distinctness RS notE)]; -in - fun mk_lemmas rls = flat (map mk_lemma (mk_combs pair rls)); - fun mk_dstnct_rls thy xs = mk_combs (mk_thm_str thy) xs; -end; - - -val caseB_lemmas = mk_lemmas caseBs; - -val ccl_dstncts = - let fun mk_raw_dstnct_thm rls s = - prove_goal CCL.thy s (fn _=> [rtac notI 1,eresolve_tac rls 1]) - in map (mk_raw_dstnct_thm caseB_lemmas) - (mk_dstnct_rls CCL.thy ["bot","true","false","pair","lambda"]) end; - -fun mk_dstnct_thms thy defs inj_rls xs = - let fun mk_dstnct_thm rls s = prove_goalw thy defs s - (fn _ => [simp_tac (CCL_ss addsimps (rls@inj_rls)) 1]) - in map (mk_dstnct_thm ccl_dstncts) (mk_dstnct_rls thy xs) end; - -fun mkall_dstnct_thms thy defs i_rls xss = flat (map (mk_dstnct_thms thy defs i_rls) xss); - -(*** Rewriting and Proving ***) - -fun XH_to_I rl = rl RS iffD2; -fun XH_to_D rl = rl RS iffD1; -val XH_to_E = make_elim o XH_to_D; -val XH_to_Is = map XH_to_I; -val XH_to_Ds = map XH_to_D; -val XH_to_Es = map XH_to_E; - -val ccl_rews = caseBs @ ccl_injs @ ccl_dstncts; -val ccl_ss = CCL_ss addsimps ccl_rews; - -val ccl_cs = set_cs addSEs (pair_inject::(ccl_dstncts RL [notE])) - addSDs (XH_to_Ds ccl_injs); - -(****** Facts from gfp Definition of [= and = ******) - -val major::prems = goal Set.thy "[| A=B; a:B <-> P |] ==> a:A <-> P"; -brs (prems RL [major RS ssubst]) 1; -val XHlemma1 = result(); - -goal CCL.thy "(P(t,t') <-> Q) --> ( : {p.EX t t'.p= & P(t,t')} <-> Q)"; -by (fast_tac ccl_cs 1); -val XHlemma2 = result() RS mp; - -(*** Pre-Order ***) - -goalw CCL.thy [POgen_def,SIM_def] "mono(%X.POgen(X))"; -br monoI 1; -by (safe_tac ccl_cs); -by (REPEAT_SOME (resolve_tac [exI,conjI,refl])); -by (ALLGOALS (simp_tac ccl_ss)); -by (ALLGOALS (fast_tac set_cs)); -val POgen_mono = result(); - -goalw CCL.thy [POgen_def,SIM_def] - " : POgen(R) <-> t= bot | (t=true & t'=true) | (t=false & t'=false) | \ -\ (EX a a' b b'.t= & t'= & : R & : R) | \ -\ (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x. : R))"; -br (iff_refl RS XHlemma2) 1; -val POgenXH = result(); - -goal CCL.thy - "t [= t' <-> t=bot | (t=true & t'=true) | (t=false & t'=false) | \ -\ (EX a a' b b'.t= & t'= & a [= a' & b [= b') | \ -\ (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x.f(x) [= f'(x)))"; -by (simp_tac (ccl_ss addsimps [PO_iff]) 1); -br (rewrite_rule [POgen_def,SIM_def] - (POgen_mono RS (PO_def RS def_gfp_Tarski) RS XHlemma1)) 1; -br (iff_refl RS XHlemma2) 1; -val poXH = result(); - -goal CCL.thy "bot [= b"; -br (poXH RS iffD2) 1; -by (simp_tac ccl_ss 1); -val po_bot = result(); - -goal CCL.thy "a [= bot --> a=bot"; -br impI 1; -bd (poXH RS iffD1) 1; -be rev_mp 1; -by (simp_tac ccl_ss 1); -val bot_poleast = result() RS mp; - -goal CCL.thy " [= <-> a [= a' & b [= b'"; -br (poXH RS iff_trans) 1; -by (simp_tac ccl_ss 1); -by (fast_tac ccl_cs 1); -val po_pair = result(); - -goal CCL.thy "lam x.f(x) [= lam x.f'(x) <-> (ALL x. f(x) [= f'(x))"; -br (poXH RS iff_trans) 1; -by (simp_tac ccl_ss 1); -by (REPEAT (ares_tac [iffI,allI] 1 ORELSE eresolve_tac [exE,conjE] 1)); -by (asm_simp_tac ccl_ss 1); -by (fast_tac ccl_cs 1); -val po_lam = result(); - -val ccl_porews = [po_bot,po_pair,po_lam]; - -val [p1,p2,p3,p4,p5] = goal CCL.thy - "[| t [= t'; a [= a'; b [= b'; !!x y.c(x,y) [= c'(x,y); \ -\ !!u.d(u) [= d'(u) |] ==> case(t,a,b,c,d) [= case(t',a',b',c',d')"; -br (p1 RS po_cong RS po_trans) 1; -br (p2 RS po_cong RS po_trans) 1; -br (p3 RS po_cong RS po_trans) 1; -br (p4 RS po_abstractn RS po_abstractn RS po_cong RS po_trans) 1; -by (res_inst_tac [("f1","%d.case(t',a',b',c',d)")] - (p5 RS po_abstractn RS po_cong RS po_trans) 1); -br po_refl 1; -val case_pocong = result(); - -val [p1,p2] = goalw CCL.thy ccl_data_defs - "[| f [= f'; a [= a' |] ==> f ` a [= f' ` a'"; -by (REPEAT (ares_tac [po_refl,case_pocong,p1,p2 RS po_cong] 1)); -val apply_pocong = result(); - - -val prems = goal CCL.thy "~ lam x.b(x) [= bot"; -br notI 1; -bd bot_poleast 1; -be (distinctness RS notE) 1; -val npo_lam_bot = result(); - -val eq1::eq2::prems = goal CCL.thy - "[| x=a; y=b; x[=y |] ==> a[=b"; -br (eq1 RS subst) 1; -br (eq2 RS subst) 1; -brs prems 1; -val po_lemma = result(); - -goal CCL.thy "~ [= lam x.f(x)"; -br notI 1; -br (npo_lam_bot RS notE) 1; -be (case_pocong RS (caseBlam RS (caseBpair RS po_lemma))) 1; -by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1)); -val npo_pair_lam = result(); - -goal CCL.thy "~ lam x.f(x) [= "; -br notI 1; -br (npo_lam_bot RS notE) 1; -be (case_pocong RS (caseBpair RS (caseBlam RS po_lemma))) 1; -by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1)); -val npo_lam_pair = result(); - -fun mk_thm s = prove_goal CCL.thy s (fn _ => - [rtac notI 1,dtac case_pocong 1,etac rev_mp 5, - ALLGOALS (simp_tac ccl_ss), - REPEAT (resolve_tac [po_refl,npo_lam_bot] 1)]); - -val npo_rls = [npo_pair_lam,npo_lam_pair] @ map mk_thm - ["~ true [= false", "~ false [= true", - "~ true [= ", "~ [= true", - "~ true [= lam x.f(x)","~ lam x.f(x) [= true", - "~ false [= ", "~ [= false", - "~ false [= lam x.f(x)","~ lam x.f(x) [= false"]; - -(* Coinduction for [= *) - -val prems = goal CCL.thy "[| : R; R <= POgen(R) |] ==> t [= u"; -br (PO_def RS def_coinduct RS (PO_iff RS iffD2)) 1; -by (REPEAT (ares_tac prems 1)); -val po_coinduct = result(); - -fun po_coinduct_tac s i = res_inst_tac [("R",s)] po_coinduct i; - -(*************** EQUALITY *******************) - -goalw CCL.thy [EQgen_def,SIM_def] "mono(%X.EQgen(X))"; -br monoI 1; -by (safe_tac set_cs); -by (REPEAT_SOME (resolve_tac [exI,conjI,refl])); -by (ALLGOALS (simp_tac ccl_ss)); -by (ALLGOALS (fast_tac set_cs)); -val EQgen_mono = result(); - -goalw CCL.thy [EQgen_def,SIM_def] - " : EQgen(R) <-> (t=bot & t'=bot) | (t=true & t'=true) | \ -\ (t=false & t'=false) | \ -\ (EX a a' b b'.t= & t'= & : R & : R) | \ -\ (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x. : R))"; -br (iff_refl RS XHlemma2) 1; -val EQgenXH = result(); - -goal CCL.thy - "t=t' <-> (t=bot & t'=bot) | (t=true & t'=true) | (t=false & t'=false) | \ -\ (EX a a' b b'.t= & t'= & a=a' & b=b') | \ -\ (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x.f(x)=f'(x)))"; -by (subgoal_tac - " : EQ <-> (t=bot & t'=bot) | (t=true & t'=true) | (t=false & t'=false) | \ -\ (EX a a' b b'.t= & t'= & : EQ & : EQ) | \ -\ (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x. : EQ))" 1); -be rev_mp 1; -by (simp_tac (CCL_ss addsimps [EQ_iff RS iff_sym]) 1); -br (rewrite_rule [EQgen_def,SIM_def] - (EQgen_mono RS (EQ_def RS def_gfp_Tarski) RS XHlemma1)) 1; -br (iff_refl RS XHlemma2) 1; -val eqXH = result(); - -val prems = goal CCL.thy "[| : R; R <= EQgen(R) |] ==> t = u"; -br (EQ_def RS def_coinduct RS (EQ_iff RS iffD2)) 1; -by (REPEAT (ares_tac prems 1)); -val eq_coinduct = result(); - -val prems = goal CCL.thy - "[| : R; R <= EQgen(lfp(%x.EQgen(x) Un R Un EQ)) |] ==> t = u"; -br (EQ_def RS def_coinduct3 RS (EQ_iff RS iffD2)) 1; -by (REPEAT (ares_tac (EQgen_mono::prems) 1)); -val eq_coinduct3 = result(); - -fun eq_coinduct_tac s i = res_inst_tac [("R",s)] eq_coinduct i; -fun eq_coinduct3_tac s i = res_inst_tac [("R",s)] eq_coinduct3 i; - -(*** Untyped Case Analysis and Other Facts ***) - -goalw CCL.thy [apply_def] "(EX f.t=lam x.f(x)) --> t = lam x.(t ` x)"; -by (safe_tac ccl_cs); -by (simp_tac ccl_ss 1); -val cond_eta = result() RS mp; - -goal CCL.thy "(t=bot) | (t=true) | (t=false) | (EX a b.t=) | (EX f.t=lam x.f(x))"; -by (cut_facts_tac [refl RS (eqXH RS iffD1)] 1); -by (fast_tac set_cs 1); -val exhaustion = result(); - -val prems = goal CCL.thy - "[| P(bot); P(true); P(false); !!x y.P(); !!b.P(lam x.b(x)) |] ==> P(t)"; -by (cut_facts_tac [exhaustion] 1); -by (REPEAT_SOME (ares_tac prems ORELSE' eresolve_tac [disjE,exE,ssubst])); -val term_case = result(); - -fun term_case_tac a i = res_inst_tac [("t",a)] term_case i; diff -r 19849d258890 -r 8018173a7979 src/CCL/ccl.thy --- a/src/CCL/ccl.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,148 +0,0 @@ -(* Title: CCL/ccl.thy - ID: $Id$ - Author: Martin Coen - Copyright 1993 University of Cambridge - -Classical Computational Logic for Untyped Lambda Calculus with reduction to -weak head-normal form. - -Based on FOL extended with set collection, a primitive higher-order logic. -HOL is too strong - descriptions prevent a type of programs being defined -which contains only executable terms. -*) - -CCL = Gfp + - -classes prog < term - -default prog - -types i - -arities - i :: prog - fun :: (prog,prog)prog - -consts - (*** Evaluation Judgement ***) - "--->" :: "[i,i]=>prop" (infixl 20) - - (*** Bisimulations for pre-order and equality ***) - "[=" :: "['a,'a]=>o" (infixl 50) - SIM :: "[i,i,i set]=>o" - POgen,EQgen :: "i set => i set" - PO,EQ :: "i set" - - (*** Term Formers ***) - true,false :: "i" - pair :: "[i,i]=>i" ("(1<_,/_>)") - lambda :: "(i=>i)=>i" (binder "lam " 55) - case :: "[i,i,i,[i,i]=>i,(i=>i)=>i]=>i" - "`" :: "[i,i]=>i" (infixl 56) - bot :: "i" - fix :: "(i=>i)=>i" - - (*** Defined Predicates ***) - Trm,Dvg :: "i => o" - -rules - - (******* EVALUATION SEMANTICS *******) - - (** This is the evaluation semantics from which the axioms below were derived. **) - (** It is included here just as an evaluator for FUN and has no influence on **) - (** inference in the theory CCL. **) - - trueV "true ---> true" - falseV "false ---> false" - pairV " ---> " - lamV "lam x.b(x) ---> lam x.b(x)" - caseVtrue "[| t ---> true; d ---> c |] ==> case(t,d,e,f,g) ---> c" - caseVfalse "[| t ---> false; e ---> c |] ==> case(t,d,e,f,g) ---> c" - caseVpair "[| t ---> ; f(a,b) ---> c |] ==> case(t,d,e,f,g) ---> c" - caseVlam "[| t ---> lam x.b(x); g(b) ---> c |] ==> case(t,d,e,f,g) ---> c" - - (*** Properties of evaluation: note that "t ---> c" impies that c is canonical ***) - - canonical "[| t ---> c; c==true ==> u--->v; \ -\ c==false ==> u--->v; \ -\ !!a b.c== ==> u--->v; \ -\ !!f.c==lam x.f(x) ==> u--->v |] ==> \ -\ u--->v" - - (* Should be derivable - but probably a bitch! *) - substitute "[| a==a'; t(a)--->c(a) |] ==> t(a')--->c(a')" - - (************** LOGIC ***************) - - (*** Definitions used in the following rules ***) - - apply_def "f ` t == case(f,bot,bot,%x y.bot,%u.u(t))" - bot_def "bot == (lam x.x`x)`(lam x.x`x)" - fix_def "fix(f) == (lam x.f(x`x))`(lam x.f(x`x))" - - (* The pre-order ([=) is defined as a simulation, and behavioural equivalence (=) *) - (* as a bisimulation. They can both be expressed as (bi)simulations up to *) - (* behavioural equivalence (ie the relations PO and EQ defined below). *) - - SIM_def - "SIM(t,t',R) == (t=true & t'=true) | (t=false & t'=false) | \ -\ (EX a a' b b'.t= & t'= & : R & : R) | \ -\ (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x. : R))" - - POgen_def "POgen(R) == {p. EX t t'. p= & (t = bot | SIM(t,t',R))}" - EQgen_def "EQgen(R) == {p. EX t t'. p= & (t = bot & t' = bot | SIM(t,t',R))}" - - PO_def "PO == gfp(POgen)" - EQ_def "EQ == gfp(EQgen)" - - (*** Rules ***) - - (** Partial Order **) - - po_refl "a [= a" - po_trans "[| a [= b; b [= c |] ==> a [= c" - po_cong "a [= b ==> f(a) [= f(b)" - - (* Extend definition of [= to program fragments of higher type *) - po_abstractn "(!!x. f(x) [= g(x)) ==> (%x.f(x)) [= (%x.g(x))" - - (** Equality - equivalence axioms inherited from FOL.thy **) - (** - congruence of "=" is axiomatised implicitly **) - - eq_iff "t = t' <-> t [= t' & t' [= t" - - (** Properties of canonical values given by greatest fixed point definitions **) - - PO_iff "t [= t' <-> : PO" - EQ_iff "t = t' <-> : EQ" - - (** Behaviour of non-canonical terms (ie case) given by the following beta-rules **) - - caseBtrue "case(true,d,e,f,g) = d" - caseBfalse "case(false,d,e,f,g) = e" - caseBpair "case(,d,e,f,g) = f(a,b)" - caseBlam "case(lam x.b(x),d,e,f,g) = g(b)" - caseBbot "case(bot,d,e,f,g) = bot" (* strictness *) - - (** The theory is non-trivial **) - distinctness "~ lam x.b(x) = bot" - - (*** Definitions of Termination and Divergence ***) - - Dvg_def "Dvg(t) == t = bot" - Trm_def "Trm(t) == ~ Dvg(t)" - -end - - -(* -Would be interesting to build a similar theory for a typed programming language: - ie. true :: bool, fix :: ('a=>'a)=>'a etc...... - -This is starting to look like LCF. -What are the advantages of this approach? - - less axiomatic - - wfd induction / coinduction and fixed point induction available - -*) diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/flag.ML --- a/src/CCL/ex/flag.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,46 +0,0 @@ -(* Title: CCL/ex/flag - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For flag.thy. -*) - -open Flag; - -(******) - -val flag_defs = [Colour_def,red_def,white_def,blue_def,ccase_def]; - -(******) - -val ColourXH = mk_XH_tac Flag.thy (simp_type_defs @flag_defs) [] - "a : Colour <-> (a=red | a=white | a=blue)"; - -val Colour_case = XH_to_E ColourXH; - -val redT = mk_canT_tac Flag.thy [ColourXH] "red : Colour"; -val whiteT = mk_canT_tac Flag.thy [ColourXH] "white : Colour"; -val blueT = mk_canT_tac Flag.thy [ColourXH] "blue : Colour"; - - -val ccaseT = mk_ncanT_tac Flag.thy flag_defs case_rls case_rls - "[| c:Colour; \ -\ c=red ==> r : C(red); c=white ==> w : C(white); c=blue ==> b : C(blue) |] ==> \ -\ ccase(c,r,w,b) : C(c)"; - -(***) - -val prems = goalw Flag.thy [flag_def] - "flag : List(Colour)->List(Colour)*List(Colour)*List(Colour)"; -by (typechk_tac [redT,whiteT,blueT,ccaseT] 1); -by clean_ccs_tac; -be (ListPRI RS (ListPR_wf RS wfI)) 1; -ba 1; -result(); - - -val prems = goalw Flag.thy [flag_def] - "flag : PROD l:List(Colour).{x:List(Colour)*List(Colour)*List(Colour).FLAG(x,l)}"; -by (gen_ccs_tac [redT,whiteT,blueT,ccaseT] 1); -by (REPEAT_SOME (ares_tac [ListPRI RS (ListPR_wf RS wfI)])); diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/flag.thy --- a/src/CCL/ex/flag.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,48 +0,0 @@ -(* Title: CCL/ex/flag.thy - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Dutch national flag program - except that the point of Dijkstra's example was to use -arrays and this uses lists. - -*) - -Flag = List + - -consts - - Colour :: "i set" - red, white, blue :: "i" - ccase :: "[i,i,i,i]=>i" - flag :: "i" - -rules - - Colour_def "Colour == Unit + Unit + Unit" - red_def "red == inl(one)" - white_def "white == inr(inl(one))" - blue_def "blue == inr(inr(one))" - - ccase_def "ccase(c,r,w,b) == when(c,%x.r,%wb.when(wb,%x.w,%x.b))" - - flag_def "flag == lam l.letrec \ -\ flagx l be lcase(l,<[],<[],[]>>, \ -\ %h t. split(flagx(t),%lr p.split(p,%lw lb. \ -\ ccase(h, >, \ -\ >, \ -\ >)))) \ -\ in flagx(l)" - - Flag_def - "Flag(l,x) == ALL lr:List(Colour).ALL lw:List(Colour).ALL lb:List(Colour). \ -\ x = > --> \ -\ (ALL c:Colour.(c mem lr = true --> c=red) & \ -\ (c mem lw = true --> c=white) & \ -\ (c mem lb = true --> c=blue)) & \ -\ Perm(l,lr @ lw @ lb)" - -end - - - diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/list.ML --- a/src/CCL/ex/list.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,106 +0,0 @@ -(* Title: CCL/ex/list - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For list.thy. -*) - -open List; - -val list_defs = [map_def,comp_def,append_def,filter_def,flat_def, - insert_def,isort_def,partition_def,qsort_def]; - -(****) - -val listBs = map (fn s=>prove_goalw List.thy list_defs s (fn _ => [simp_tac term_ss 1])) - ["(f o g) = (%a.f(g(a)))", - "(f o g)(a) = f(g(a))", - "map(f,[]) = []", - "map(f,x$xs) = f(x)$map(f,xs)", - "[] @ m = m", - "x$xs @ m = x$(xs @ m)", - "filter(f,[]) = []", - "filter(f,x$xs) = if f`x then x$filter(f,xs) else filter(f,xs)", - "flat([]) = []", - "flat(x$xs) = x @ flat(xs)", - "insert(f,a,[]) = a$[]", - "insert(f,a,x$xs) = if f`a`x then a$x$xs else x$insert(f,a,xs)"]; - -val list_ss = nat_ss addsimps listBs; - -(****) - -val [prem] = goal List.thy "n:Nat ==> map(f) ^ n ` [] = []"; -br (prem RS Nat_ind) 1; -by (ALLGOALS (asm_simp_tac list_ss)); -val nmapBnil = result(); - -val [prem] = goal List.thy "n:Nat ==> map(f)^n`(x$xs) = (f^n`x)$(map(f)^n`xs)"; -br (prem RS Nat_ind) 1; -by (ALLGOALS (asm_simp_tac list_ss)); -val nmapBcons = result(); - -(***) - -val prems = goalw List.thy [map_def] - "[| !!x.x:A==>f(x):B; l : List(A) |] ==> map(f,l) : List(B)"; -by (typechk_tac prems 1); -val mapT = result(); - -val prems = goalw List.thy [append_def] - "[| l : List(A); m : List(A) |] ==> l @ m : List(A)"; -by (typechk_tac prems 1); -val appendT = result(); - -val prems = goal List.thy - "[| l : {l:List(A). m : {m:List(A).P(l @ m)}} |] ==> l @ m : {x:List(A). P(x)}"; -by (cut_facts_tac prems 1); -by (fast_tac (set_cs addSIs [SubtypeI,appendT] addSEs [SubtypeE]) 1); -val appendTS = result(); - -val prems = goalw List.thy [filter_def] - "[| f:A->Bool; l : List(A) |] ==> filter(f,l) : List(A)"; -by (typechk_tac prems 1); -val filterT = result(); - -val prems = goalw List.thy [flat_def] - "l : List(List(A)) ==> flat(l) : List(A)"; -by (typechk_tac (appendT::prems) 1); -val flatT = result(); - -val prems = goalw List.thy [insert_def] - "[| f : A->A->Bool; a:A; l : List(A) |] ==> insert(f,a,l) : List(A)"; -by (typechk_tac prems 1); -val insertT = result(); - -val prems = goal List.thy - "[| f : {f:A->A->Bool. a : {a:A. l : {l:List(A).P(insert(f,a,l))}}} |] ==> \ -\ insert(f,a,l) : {x:List(A). P(x)}"; -by (cut_facts_tac prems 1); -by (fast_tac (set_cs addSIs [SubtypeI,insertT] addSEs [SubtypeE]) 1); -val insertTS = result(); - -val prems = goalw List.thy [partition_def] - "[| f:A->Bool; l : List(A) |] ==> partition(f,l) : List(A)*List(A)"; -by (typechk_tac prems 1); -by clean_ccs_tac; -br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 2; -br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 1; -by (REPEAT (atac 1)); -val partitionT = result(); - -(*** Correctness Conditions for Insertion Sort ***) - - -val prems = goalw List.thy [isort_def] - "f:A->A->Bool ==> isort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}"; -by (gen_ccs_tac ([insertTS,insertT]@prems) 1); - - -(*** Correctness Conditions for Quick Sort ***) - -val prems = goalw List.thy [qsort_def] - "f:A->A->Bool ==> qsort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}"; -by (gen_ccs_tac ([partitionT,appendTS,appendT]@prems) 1); - diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/list.thy --- a/src/CCL/ex/list.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,44 +0,0 @@ -(* Title: CCL/ex/list.thy - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Programs defined over lists. -*) - -List = Nat + - -consts - map :: "[i=>i,i]=>i" - "o" :: "[i=>i,i=>i]=>i=>i" (infixr 55) - "@" :: "[i,i]=>i" (infixr 55) - mem :: "[i,i]=>i" (infixr 55) - filter :: "[i,i]=>i" - flat :: "i=>i" - partition :: "[i,i]=>i" - insert :: "[i,i,i]=>i" - isort :: "i=>i" - qsort :: "i=>i" - -rules - - map_def "map(f,l) == lrec(l,[],%x xs g.f(x)$g)" - comp_def "f o g == (%x.f(g(x)))" - append_def "l @ m == lrec(l,m,%x xs g.x$g)" - mem_def "a mem l == lrec(l,false,%h t g.if eq(a,h) then true else g)" - filter_def "filter(f,l) == lrec(l,[],%x xs g.if f`x then x$g else g)" - flat_def "flat(l) == lrec(l,[],%h t g.h @ g)" - - insert_def "insert(f,a,l) == lrec(l,a$[],%h t g.if f`a`h then a$h$t else h$g)" - isort_def "isort(f) == lam l.lrec(l,[],%h t g.insert(f,h,g))" - - partition_def - "partition(f,l) == letrec part l a b be lcase(l,,%x xs.\ -\ if f`x then part(xs,x$a,b) else part(xs,a,x$b)) \ -\ in part(l,[],[])" - qsort_def "qsort(f) == lam l. letrec qsortx l be lcase(l,[],%h t. \ -\ let p be partition(f`h,t) \ -\ in split(p,%x y.qsortx(x) @ h$qsortx(y))) \ -\ in qsortx(l)" - -end diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/nat.ML --- a/src/CCL/ex/nat.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,72 +0,0 @@ -(* Title: CCL/ex/nat - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For nat.thy. -*) - -open Nat; - -val nat_defs = [not_def,add_def,mult_def,sub_def,le_def,lt_def,ack_def,napply_def]; - -val natBs = map (fn s=>prove_goalw Nat.thy nat_defs s (fn _ => [simp_tac term_ss 1])) - ["not(true) = false", - "not(false) = true", - "zero #+ n = n", - "succ(n) #+ m = succ(n #+ m)", - "zero #* n = zero", - "succ(n) #* m = m #+ (n #* m)", - "f^zero`a = a", - "f^succ(n)`a = f(f^n`a)"]; - -val nat_ss = term_ss addsimps natBs; - -(*** Lemma for napply ***) - -val [prem] = goal Nat.thy "n:Nat ==> f^n`f(a) = f^succ(n)`a"; -br (prem RS Nat_ind) 1; -by (ALLGOALS (asm_simp_tac nat_ss)); -val napply_f = result(); - -(****) - -val prems = goalw Nat.thy [add_def] "[| a:Nat; b:Nat |] ==> a #+ b : Nat"; -by (typechk_tac prems 1); -val addT = result(); - -val prems = goalw Nat.thy [mult_def] "[| a:Nat; b:Nat |] ==> a #* b : Nat"; -by (typechk_tac (addT::prems) 1); -val multT = result(); - -(* Defined to return zero if a a #- b : Nat"; -by (typechk_tac (prems) 1); -by clean_ccs_tac; -be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1; -val subT = result(); - -val prems = goalw Nat.thy [le_def] "[| a:Nat; b:Nat |] ==> a #<= b : Bool"; -by (typechk_tac (prems) 1); -by clean_ccs_tac; -be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1; -val leT = result(); - -val prems = goalw Nat.thy [not_def,lt_def] "[| a:Nat; b:Nat |] ==> a #< b : Bool"; -by (typechk_tac (prems@[leT]) 1); -val ltT = result(); - -(* Correctness conditions for subtractive division **) - -val prems = goalw Nat.thy [div_def] - "[| a:Nat; b:{x:Nat.~x=zero} |] ==> a ## b : {x:Nat. DIV(a,b,x)}"; -by (gen_ccs_tac (prems@[ltT,subT]) 1); - -(* Termination Conditions for Ackermann's Function *) - -val prems = goalw Nat.thy [ack_def] - "[| a:Nat; b:Nat |] ==> ackermann(a,b) : Nat"; -by (gen_ccs_tac prems 1); -val relI = NatPR_wf RS (NatPR_wf RS lex_wf RS wfI); -by (REPEAT (eresolve_tac [NatPRI RS (lexI1 RS relI),NatPRI RS (lexI2 RS relI)] 1)); -result(); diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/nat.thy --- a/src/CCL/ex/nat.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -(* Title: CCL/ex/nat.thy - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Programs defined over the natural numbers -*) - -Nat = Wfd + - -consts - - not :: "i=>i" - "#+","#*","#-", - "##","#<","#<=" :: "[i,i]=>i" (infixr 60) - ackermann :: "[i,i]=>i" - -rules - - not_def "not(b) == if b then false else true" - - add_def "a #+ b == nrec(a,b,%x g.succ(g))" - mult_def "a #* b == nrec(a,zero,%x g.b #+ g)" - sub_def "a #- b == letrec sub x y be ncase(y,x,%yy.ncase(x,zero,%xx.sub(xx,yy))) \ -\ in sub(a,b)" - le_def "a #<= b == letrec le x y be ncase(x,true,%xx.ncase(y,false,%yy.le(xx,yy))) \ -\ in le(a,b)" - lt_def "a #< b == not(b #<= a)" - - div_def "a ## b == letrec div x y be if x #< y then zero else succ(div(x#-y,y)) \ -\ in div(a,b)" - ack_def - "ackermann(a,b) == letrec ack n m be ncase(n,succ(m),%x. \ -\ ncase(m,ack(x,succ(zero)),%y.ack(x,ack(succ(x),y))))\ -\ in ack(a,b)" - -end - diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/stream.ML --- a/src/CCL/ex/stream.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ -(* Title: CCL/ex/stream - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For stream.thy. - -Proving properties about infinite lists using coinduction: - Lists(A) is the set of all finite and infinite lists of elements of A. - ILists(A) is the set of infinite lists of elements of A. -*) - -open Stream; - -(*** Map of composition is composition of maps ***) - -val prems = goal Stream.thy "l:Lists(A) ==> map(f o g,l) = map(f,map(g,l))"; -by (eq_coinduct3_tac - "{p. EX x y.p= & (EX l:Lists(A).x=map(f o g,l) & y=map(f,map(g,l)))}" 1); -by (fast_tac (ccl_cs addSIs prems) 1); -by (safe_tac type_cs); -be (XH_to_E ListsXH) 1; -by (EQgen_tac list_ss [] 1); -by (simp_tac list_ss 1); -by (fast_tac ccl_cs 1); -val map_comp = result(); - -(*** Mapping the identity function leaves a list unchanged ***) - -val prems = goal Stream.thy "l:Lists(A) ==> map(%x.x,l) = l"; -by (eq_coinduct3_tac - "{p. EX x y.p= & (EX l:Lists(A).x=map(%x.x,l) & y=l)}" 1); -by (fast_tac (ccl_cs addSIs prems) 1); -by (safe_tac type_cs); -be (XH_to_E ListsXH) 1; -by (EQgen_tac list_ss [] 1); -by (fast_tac ccl_cs 1); -val map_id = result(); - -(*** Mapping distributes over append ***) - -val prems = goal Stream.thy - "[| l:Lists(A); m:Lists(A) |] ==> map(f,l@m) = map(f,l) @ map(f,m)"; -by (eq_coinduct3_tac "{p. EX x y.p= & (EX l:Lists(A).EX m:Lists(A). \ -\ x=map(f,l@m) & y=map(f,l) @ map(f,m))}" 1); -by (fast_tac (ccl_cs addSIs prems) 1); -by (safe_tac type_cs); -be (XH_to_E ListsXH) 1; -by (EQgen_tac list_ss [] 1); -be (XH_to_E ListsXH) 1; -by (EQgen_tac list_ss [] 1); -by (fast_tac ccl_cs 1); -val map_append = result(); - -(*** Append is associative ***) - -val prems = goal Stream.thy - "[| k:Lists(A); l:Lists(A); m:Lists(A) |] ==> k @ l @ m = (k @ l) @ m"; -by (eq_coinduct3_tac "{p. EX x y.p= & (EX k:Lists(A).EX l:Lists(A).EX m:Lists(A). \ -\ x=k @ l @ m & y=(k @ l) @ m)}" 1); -by (fast_tac (ccl_cs addSIs prems) 1); -by (safe_tac type_cs); -be (XH_to_E ListsXH) 1; -by (EQgen_tac list_ss [] 1); -be (XH_to_E ListsXH) 1;back(); -by (EQgen_tac list_ss [] 1); -be (XH_to_E ListsXH) 1; -by (EQgen_tac list_ss [] 1); -by (fast_tac ccl_cs 1); -val append_assoc = result(); - -(*** Appending anything to an infinite list doesn't alter it ****) - -val prems = goal Stream.thy "l:ILists(A) ==> l @ m = l"; -by (eq_coinduct3_tac "{p. EX x y.p= & (EX l:ILists(A).EX m.x=l@m & y=l)}" 1); -by (fast_tac (ccl_cs addSIs prems) 1); -by (safe_tac set_cs); -be (XH_to_E IListsXH) 1; -by (EQgen_tac list_ss [] 1); -by (fast_tac ccl_cs 1); -val ilist_append = result(); - -(*** The equivalance of two versions of an iteration function ***) -(* *) -(* fun iter1(f,a) = a$iter1(f,f(a)) *) -(* fun iter2(f,a) = a$map(f,iter2(f,a)) *) - -goalw Stream.thy [iter1_def] "iter1(f,a) = a$iter1(f,f(a))"; -br (letrecB RS trans) 1; -by (simp_tac term_ss 1); -val iter1B = result(); - -goalw Stream.thy [iter2_def] "iter2(f,a) = a $ map(f,iter2(f,a))"; -br (letrecB RS trans) 1; -br refl 1; -val iter2B = result(); - -val [prem] =goal Stream.thy - "n:Nat ==> map(f) ^ n ` iter2(f,a) = (f ^ n ` a) $ (map(f) ^ n ` map(f,iter2(f,a)))"; -br (iter2B RS ssubst) 1;back();back(); -by (simp_tac (list_ss addsimps [prem RS nmapBcons]) 1); -val iter2Blemma = result(); - -goal Stream.thy "iter1(f,a) = iter2(f,a)"; -by (eq_coinduct3_tac - "{p. EX x y.p= & (EX n:Nat.x=iter1(f,f^n`a) & y=map(f)^n`iter2(f,a))}" - 1); -by (fast_tac (type_cs addSIs [napplyBzero RS sym, - napplyBzero RS sym RS arg_cong]) 1); -by (EQgen_tac list_ss [iter1B,iter2Blemma] 1); -by (rtac (napply_f RS ssubst) 1 THEN atac 1); -by (res_inst_tac [("f1","f")] (napplyBsucc RS subst) 1); -by (fast_tac type_cs 1); -val iter1_iter2_eq = result(); diff -r 19849d258890 -r 8018173a7979 src/CCL/ex/stream.thy --- a/src/CCL/ex/stream.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -(* Title: CCL/ex/stream.thy - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Programs defined over streams. -*) - -Stream = List + - -consts - - iter1,iter2 :: "[i=>i,i]=>i" - -rules - - iter1_def "iter1(f,a) == letrec iter x be x$iter(f(x)) in iter(a)" - iter2_def "iter2(f,a) == letrec iter x be x$map(f,iter(x)) in iter(a)" - -end diff -r 19849d258890 -r 8018173a7979 src/CCL/fix.ML --- a/src/CCL/fix.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,194 +0,0 @@ -(* Title: CCL/fix - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For fix.thy. -*) - -open Fix; - -(*** Fixed Point Induction ***) - -val [base,step,incl] = goalw Fix.thy [INCL_def] - "[| P(bot); !!x.P(x) ==> P(f(x)); INCL(P) |] ==> P(fix(f))"; -br (incl RS spec RS mp) 1; -by (rtac (Nat_ind RS ballI) 1 THEN atac 1); -by (ALLGOALS (simp_tac term_ss)); -by (REPEAT (ares_tac [base,step] 1)); -val fix_ind = result(); - -(*** Inclusive Predicates ***) - -val prems = goalw Fix.thy [INCL_def] - "INCL(P) <-> (ALL f. (ALL n:Nat. P(f ^ n ` bot)) --> P(fix(f)))"; -br iff_refl 1; -val inclXH = result(); - -val prems = goal Fix.thy - "[| !!f.ALL n:Nat.P(f^n`bot) ==> P(fix(f)) |] ==> INCL(%x.P(x))"; -by (fast_tac (term_cs addIs (prems @ [XH_to_I inclXH])) 1); -val inclI = result(); - -val incl::prems = goal Fix.thy - "[| INCL(P); !!n.n:Nat ==> P(f^n`bot) |] ==> P(fix(f))"; -by (fast_tac (term_cs addIs ([ballI RS (incl RS (XH_to_D inclXH) RS spec RS mp)] - @ prems)) 1); -val inclD = result(); - -val incl::prems = goal Fix.thy - "[| INCL(P); (ALL n:Nat.P(f^n`bot))-->P(fix(f)) ==> R |] ==> R"; -by (fast_tac (term_cs addIs ([incl RS inclD] @ prems)) 1); -val inclE = result(); - - -(*** Lemmas for Inclusive Predicates ***) - -goal Fix.thy "INCL(%x.~ a(x) [= t)"; -br inclI 1; -bd bspec 1; -br zeroT 1; -be contrapos 1; -br po_trans 1; -ba 2; -br (napplyBzero RS ssubst) 1; -by (rtac po_cong 1 THEN rtac po_bot 1); -val npo_INCL = result(); - -val prems = goal Fix.thy "[| INCL(P); INCL(Q) |] ==> INCL(%x.P(x) & Q(x))"; -by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);; -val conj_INCL = result(); - -val prems = goal Fix.thy "[| !!a.INCL(P(a)) |] ==> INCL(%x.ALL a.P(a,x))"; -by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);; -val all_INCL = result(); - -val prems = goal Fix.thy "[| !!a.a:A ==> INCL(P(a)) |] ==> INCL(%x.ALL a:A.P(a,x))"; -by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);; -val ball_INCL = result(); - -goal Fix.thy "INCL(%x.a(x) = b(x)::'a::prog)"; -by (simp_tac (term_ss addsimps [eq_iff]) 1); -by (REPEAT (resolve_tac [conj_INCL,po_INCL] 1)); -val eq_INCL = result(); - -(*** Derivation of Reachability Condition ***) - -(* Fixed points of idgen *) - -goal Fix.thy "idgen(fix(idgen)) = fix(idgen)"; -br (fixB RS sym) 1; -val fix_idgenfp = result(); - -goalw Fix.thy [idgen_def] "idgen(lam x.x) = lam x.x"; -by (simp_tac term_ss 1); -br (term_case RS allI) 1; -by (ALLGOALS (simp_tac term_ss)); -val id_idgenfp = result(); - -(* All fixed points are lam-expressions *) - -val [prem] = goal Fix.thy "idgen(d) = d ==> d = lam x.?f(x)"; -br (prem RS subst) 1; -bw idgen_def; -br refl 1; -val idgenfp_lam = result(); - -(* Lemmas for rewriting fixed points of idgen *) - -val prems = goalw Fix.thy [idgen_def] - "[| a = b; a ` t = u |] ==> b ` t = u"; -by (simp_tac (term_ss addsimps (prems RL [sym])) 1); -val l_lemma= result(); - -val idgen_lemmas = - let fun mk_thm s = prove_goalw Fix.thy [idgen_def] s - (fn [prem] => [rtac (prem RS l_lemma) 1,simp_tac term_ss 1]) - in map mk_thm - [ "idgen(d) = d ==> d ` bot = bot", - "idgen(d) = d ==> d ` true = true", - "idgen(d) = d ==> d ` false = false", - "idgen(d) = d ==> d ` = ", - "idgen(d) = d ==> d ` (lam x.f(x)) = lam x.d ` f(x)"] - end; - -(* Proof of Reachability law - show that fix and lam x.x both give LEAST fixed points - of idgen and hence are they same *) - -val [p1,p2,p3] = goal CCL.thy - "[| ALL x.t ` x [= u ` x; EX f.t=lam x.f(x); EX f.u=lam x.f(x) |] ==> t [= u"; -br (p2 RS cond_eta RS ssubst) 1; -br (p3 RS cond_eta RS ssubst) 1; -br (p1 RS (po_lam RS iffD2)) 1; -val po_eta = result(); - -val [prem] = goalw Fix.thy [idgen_def] "idgen(d) = d ==> d = lam x.?f(x)"; -br (prem RS subst) 1; -br refl 1; -val po_eta_lemma = result(); - -val [prem] = goal Fix.thy - "idgen(d) = d ==> \ -\ {p.EX a b.p= & (EX t.a=fix(idgen) ` t & b = d ` t)} <= \ -\ POgen({p.EX a b.p= & (EX t.a=fix(idgen) ` t & b = d ` t)})"; -by (REPEAT (step_tac term_cs 1)); -by (term_case_tac "t" 1); -by (ALLGOALS (simp_tac (term_ss addsimps (POgenXH::([prem,fix_idgenfp] RL idgen_lemmas))))); -by (ALLGOALS (fast_tac set_cs)); -val lemma1 = result(); - -val [prem] = goal Fix.thy - "idgen(d) = d ==> fix(idgen) [= d"; -br (allI RS po_eta) 1; -br (lemma1 RSN(2,po_coinduct)) 1; -by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp]))); -val fix_least_idgen = result(); - -val [prem] = goal Fix.thy - "idgen(d) = d ==> \ -\ {p.EX a b.p= & b = d ` a} <= POgen({p.EX a b.p= & b = d ` a})"; -by (REPEAT (step_tac term_cs 1)); -by (term_case_tac "a" 1); -by (ALLGOALS (simp_tac (term_ss addsimps (POgenXH::([prem] RL idgen_lemmas))))); -by (ALLGOALS (fast_tac set_cs)); -val lemma2 = result(); - -val [prem] = goal Fix.thy - "idgen(d) = d ==> lam x.x [= d"; -br (allI RS po_eta) 1; -br (lemma2 RSN(2,po_coinduct)) 1; -by (simp_tac term_ss 1); -by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp]))); -val id_least_idgen = result(); - -goal Fix.thy "fix(idgen) = lam x.x"; -by (fast_tac (term_cs addIs [eq_iff RS iffD2, - id_idgenfp RS fix_least_idgen, - fix_idgenfp RS id_least_idgen]) 1); -val reachability = result(); - -(********) - -val [prem] = goal Fix.thy "f = lam x.x ==> f`t = t"; -br (prem RS sym RS subst) 1; -br applyB 1; -val id_apply = result(); - -val prems = goal Fix.thy - "[| P(bot); P(true); P(false); \ -\ !!x y.[| P(x); P(y) |] ==> P(); \ -\ !!u.(!!x.P(u(x))) ==> P(lam x.u(x)); INCL(P) |] ==> \ -\ P(t)"; -br (reachability RS id_apply RS subst) 1; -by (res_inst_tac [("x","t")] spec 1); -br fix_ind 1; -bw idgen_def; -by (REPEAT_SOME (ares_tac [allI])); -br (applyBbot RS ssubst) 1; -brs prems 1; -br (applyB RS ssubst )1; -by (res_inst_tac [("t","xa")] term_case 1); -by (ALLGOALS (simp_tac term_ss)); -by (ALLGOALS (fast_tac (term_cs addIs ([all_INCL,INCL_subst] @ prems)))); -val term_ind = result(); - diff -r 19849d258890 -r 8018173a7979 src/CCL/fix.thy --- a/src/CCL/fix.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,26 +0,0 @@ -(* Title: CCL/Lazy/fix.thy - ID: $Id$ - Author: Martin Coen - Copyright 1993 University of Cambridge - -Tentative attempt at including fixed point induction. -Justified by Smith. -*) - -Fix = Type + - -consts - - idgen :: "[i]=>i" - INCL :: "[i=>o]=>o" - -rules - - idgen_def - "idgen(f) == lam t.case(t,true,false,%x y.,%u.lam x.f ` u(x))" - - INCL_def "INCL(%x.P(x)) == (ALL f.(ALL n:Nat.P(f^n`bot)) --> P(fix(f)))" - po_INCL "INCL(%x.a(x) [= b(x))" - INCL_subst "INCL(P) ==> INCL(%x.P((g::i=>i)(x)))" - -end diff -r 19849d258890 -r 8018173a7979 src/CCL/gfp.ML --- a/src/CCL/gfp.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,133 +0,0 @@ -(* Title: CCL/gfp - ID: $Id$ - -Modified version of - Title: HOL/gfp - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For gfp.thy. The Knaster-Tarski Theorem for greatest fixed points. -*) - -open Gfp; - -(*** Proof of Knaster-Tarski Theorem using gfp ***) - -(* gfp(f) is the least upper bound of {u. u <= f(u)} *) - -val prems = goalw Gfp.thy [gfp_def] "[| A <= f(A) |] ==> A <= gfp(f)"; -by (rtac (CollectI RS Union_upper) 1); -by (resolve_tac prems 1); -val gfp_upperbound = result(); - -val prems = goalw Gfp.thy [gfp_def] - "[| !!u. u <= f(u) ==> u<=A |] ==> gfp(f) <= A"; -by (REPEAT (ares_tac ([Union_least]@prems) 1)); -by (etac CollectD 1); -val gfp_least = result(); - -val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) <= f(gfp(f))"; -by (EVERY1 [rtac gfp_least, rtac subset_trans, atac, - rtac (mono RS monoD), rtac gfp_upperbound, atac]); -val gfp_lemma2 = result(); - -val [mono] = goal Gfp.thy "mono(f) ==> f(gfp(f)) <= gfp(f)"; -by (EVERY1 [rtac gfp_upperbound, rtac (mono RS monoD), - rtac gfp_lemma2, rtac mono]); -val gfp_lemma3 = result(); - -val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) = f(gfp(f))"; -by (REPEAT (resolve_tac [equalityI,gfp_lemma2,gfp_lemma3,mono] 1)); -val gfp_Tarski = result(); - -(*** Coinduction rules for greatest fixed points ***) - -(*weak version*) -val prems = goal Gfp.thy - "[| a: A; A <= f(A) |] ==> a : gfp(f)"; -by (rtac (gfp_upperbound RS subsetD) 1); -by (REPEAT (ares_tac prems 1)); -val coinduct = result(); - -val [prem,mono] = goal Gfp.thy - "[| A <= f(A) Un gfp(f); mono(f) |] ==> \ -\ A Un gfp(f) <= f(A Un gfp(f))"; -by (rtac subset_trans 1); -by (rtac (mono RS mono_Un) 2); -by (rtac (mono RS gfp_Tarski RS subst) 1); -by (rtac (prem RS Un_least) 1); -by (rtac Un_upper2 1); -val coinduct2_lemma = result(); - -(*strong version, thanks to Martin Coen*) -val prems = goal Gfp.thy - "[| a: A; A <= f(A) Un gfp(f); mono(f) |] ==> a : gfp(f)"; -by (rtac (coinduct2_lemma RSN (2,coinduct)) 1); -by (REPEAT (resolve_tac (prems@[UnI1]) 1)); -val coinduct2 = result(); - -(*** Even Stronger version of coinduct [by Martin Coen] - - instead of the condition A <= f(A) - consider A <= (f(A) Un f(f(A)) ...) Un gfp(A) ***) - -val [prem] = goal Gfp.thy "mono(f) ==> mono(%x.f(x) Un A Un B)"; -by (REPEAT (ares_tac [subset_refl, monoI, Un_mono, prem RS monoD] 1)); -val coinduct3_mono_lemma= result(); - -val [prem,mono] = goal Gfp.thy - "[| A <= f(lfp(%x.f(x) Un A Un gfp(f))); mono(f) |] ==> \ -\ lfp(%x.f(x) Un A Un gfp(f)) <= f(lfp(%x.f(x) Un A Un gfp(f)))"; -by (rtac subset_trans 1); -br (mono RS coinduct3_mono_lemma RS lfp_lemma3) 1; -by (rtac (Un_least RS Un_least) 1); -br subset_refl 1; -br prem 1; -br (mono RS gfp_Tarski RS equalityD1 RS subset_trans) 1; -by (rtac (mono RS monoD) 1); -by (rtac (mono RS coinduct3_mono_lemma RS lfp_Tarski RS ssubst) 1); -by (rtac Un_upper2 1); -val coinduct3_lemma = result(); - -val prems = goal Gfp.thy - "[| a:A; A <= f(lfp(%x.f(x) Un A Un gfp(f))); mono(f) |] ==> a : gfp(f)"; -by (rtac (coinduct3_lemma RSN (2,coinduct)) 1); -brs (prems RL [coinduct3_mono_lemma RS lfp_Tarski RS ssubst]) 1; -br (UnI2 RS UnI1) 1; -by (REPEAT (resolve_tac prems 1)); -val coinduct3 = result(); - - -(** Definition forms of gfp_Tarski, to control unfolding **) - -val [rew,mono] = goal Gfp.thy "[| h==gfp(f); mono(f) |] ==> h = f(h)"; -by (rewtac rew); -by (rtac (mono RS gfp_Tarski) 1); -val def_gfp_Tarski = result(); - -val rew::prems = goal Gfp.thy - "[| h==gfp(f); a:A; A <= f(A) |] ==> a: h"; -by (rewtac rew); -by (REPEAT (ares_tac (prems @ [coinduct]) 1)); -val def_coinduct = result(); - -val rew::prems = goal Gfp.thy - "[| h==gfp(f); a:A; A <= f(A) Un h; mono(f) |] ==> a: h"; -by (rewtac rew); -by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct2]) 1)); -val def_coinduct2 = result(); - -val rew::prems = goal Gfp.thy - "[| h==gfp(f); a:A; A <= f(lfp(%x.f(x) Un A Un h)); mono(f) |] ==> a: h"; -by (rewtac rew); -by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct3]) 1)); -val def_coinduct3 = result(); - -(*Monotonicity of gfp!*) -val prems = goal Gfp.thy - "[| mono(f); !!Z. f(Z)<=g(Z) |] ==> gfp(f) <= gfp(g)"; -by (rtac gfp_upperbound 1); -by (rtac subset_trans 1); -by (rtac gfp_lemma2 1); -by (resolve_tac prems 1); -by (resolve_tac prems 1); -val gfp_mono = result(); diff -r 19849d258890 -r 8018173a7979 src/CCL/gfp.thy --- a/src/CCL/gfp.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -(* Title: HOL/gfp.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -Greatest fixed points -*) - -Gfp = Lfp + -consts gfp :: "['a set=>'a set] => 'a set" -rules - (*greatest fixed point*) - gfp_def "gfp(f) == Union({u. u <= f(u)})" -end diff -r 19849d258890 -r 8018173a7979 src/CCL/hered.ML --- a/src/CCL/hered.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,194 +0,0 @@ -(* Title: CCL/hered - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For hered.thy. -*) - -open Hered; - -fun type_of_terms (Const("Trueprop",_) $ (Const("op =",(Type ("fun", [t,_])))$_$_)) = t; - -(*** Hereditary Termination ***) - -goalw Hered.thy [HTTgen_def] "mono(%X.HTTgen(X))"; -br monoI 1; -by (fast_tac set_cs 1); -val HTTgen_mono = result(); - -goalw Hered.thy [HTTgen_def] - "t : HTTgen(A) <-> t=true | t=false | (EX a b.t= & a : A & b : A) | \ -\ (EX f.t=lam x.f(x) & (ALL x.f(x) : A))"; -by (fast_tac set_cs 1); -val HTTgenXH = result(); - -goal Hered.thy - "t : HTT <-> t=true | t=false | (EX a b.t= & a : HTT & b : HTT) | \ -\ (EX f.t=lam x.f(x) & (ALL x.f(x) : HTT))"; -br (rewrite_rule [HTTgen_def] - (HTTgen_mono RS (HTT_def RS def_gfp_Tarski) RS XHlemma1)) 1; -by (fast_tac set_cs 1); -val HTTXH = result(); - -(*** Introduction Rules for HTT ***) - -goal Hered.thy "~ bot : HTT"; -by (fast_tac (term_cs addDs [XH_to_D HTTXH]) 1); -val HTT_bot = result(); - -goal Hered.thy "true : HTT"; -by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1); -val HTT_true = result(); - -goal Hered.thy "false : HTT"; -by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1); -val HTT_false = result(); - -goal Hered.thy " : HTT <-> a : HTT & b : HTT"; -br (HTTXH RS iff_trans) 1; -by (fast_tac term_cs 1); -val HTT_pair = result(); - -goal Hered.thy "lam x.f(x) : HTT <-> (ALL x. f(x) : HTT)"; -br (HTTXH RS iff_trans) 1; -by (simp_tac term_ss 1); -by (safe_tac term_cs); -by (asm_simp_tac term_ss 1); -by (fast_tac term_cs 1); -val HTT_lam = result(); - -local - val raw_HTTrews = [HTT_bot,HTT_true,HTT_false,HTT_pair,HTT_lam]; - fun mk_thm s = prove_goalw Hered.thy data_defs s (fn _ => - [simp_tac (term_ss addsimps raw_HTTrews) 1]); -in - val HTT_rews = raw_HTTrews @ - map mk_thm ["one : HTT", - "inl(a) : HTT <-> a : HTT", - "inr(b) : HTT <-> b : HTT", - "zero : HTT", - "succ(n) : HTT <-> n : HTT", - "[] : HTT", - "x$xs : HTT <-> x : HTT & xs : HTT"]; -end; - -val HTT_Is = HTT_rews @ (HTT_rews RL [iffD2]); - -(*** Coinduction for HTT ***) - -val prems = goal Hered.thy "[| t : R; R <= HTTgen(R) |] ==> t : HTT"; -br (HTT_def RS def_coinduct) 1; -by (REPEAT (ares_tac prems 1)); -val HTT_coinduct = result(); - -fun HTT_coinduct_tac s i = res_inst_tac [("R",s)] HTT_coinduct i; - -val prems = goal Hered.thy - "[| t : R; R <= HTTgen(lfp(%x. HTTgen(x) Un R Un HTT)) |] ==> t : HTT"; -br (HTTgen_mono RSN(3,HTT_def RS def_coinduct3)) 1; -by (REPEAT (ares_tac prems 1)); -val HTT_coinduct3 = result(); -val HTT_coinduct3_raw = rewrite_rule [HTTgen_def] HTT_coinduct3; - -fun HTT_coinduct3_tac s i = res_inst_tac [("R",s)] HTT_coinduct3 i; - -val HTTgenIs = map (mk_genIs Hered.thy data_defs HTTgenXH HTTgen_mono) - ["true : HTTgen(R)", - "false : HTTgen(R)", - "[| a : R; b : R |] ==> : HTTgen(R)", - "[| !!x. b(x) : R |] ==> lam x.b(x) : HTTgen(R)", - "one : HTTgen(R)", - "a : lfp(%x. HTTgen(x) Un R Un HTT) ==> \ -\ inl(a) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))", - "b : lfp(%x. HTTgen(x) Un R Un HTT) ==> \ -\ inr(b) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))", - "zero : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))", - "n : lfp(%x. HTTgen(x) Un R Un HTT) ==> \ -\ succ(n) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))", - "[] : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))", - "[| h : lfp(%x. HTTgen(x) Un R Un HTT); t : lfp(%x. HTTgen(x) Un R Un HTT) |] ==>\ -\ h$t : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))"]; - -(*** Formation Rules for Types ***) - -goal Hered.thy "Unit <= HTT"; -by (simp_tac (CCL_ss addsimps ([subsetXH,UnitXH] @ HTT_rews)) 1); -val UnitF = result(); - -goal Hered.thy "Bool <= HTT"; -by (simp_tac (CCL_ss addsimps ([subsetXH,BoolXH] @ HTT_rews)) 1); -by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1); -val BoolF = result(); - -val prems = goal Hered.thy "[| A <= HTT; B <= HTT |] ==> A + B <= HTT"; -by (simp_tac (CCL_ss addsimps ([subsetXH,PlusXH] @ HTT_rews)) 1); -by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1); -val PlusF = result(); - -val prems = goal Hered.thy - "[| A <= HTT; !!x.x:A ==> B(x) <= HTT |] ==> SUM x:A.B(x) <= HTT"; -by (simp_tac (CCL_ss addsimps ([subsetXH,SgXH] @ HTT_rews)) 1); -by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1); -val SigmaF = result(); - -(*** Formation Rules for Recursive types - using coinduction these only need ***) -(*** exhaution rule for type-former ***) - -(*Proof by induction - needs induction rule for type*) -goal Hered.thy "Nat <= HTT"; -by (simp_tac (term_ss addsimps [subsetXH]) 1); -by (safe_tac set_cs); -be Nat_ind 1; -by (ALLGOALS (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])))); -val NatF = result(); - -goal Hered.thy "Nat <= HTT"; -by (safe_tac set_cs); -be HTT_coinduct3 1; -by (fast_tac (set_cs addIs HTTgenIs - addSEs [HTTgen_mono RS ci3_RI] addEs [XH_to_E NatXH]) 1); -val NatF = result(); - -val [prem] = goal Hered.thy "A <= HTT ==> List(A) <= HTT"; -by (safe_tac set_cs); -be HTT_coinduct3 1; -by (fast_tac (set_cs addSIs HTTgenIs - addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] - addEs [XH_to_E ListXH]) 1); -val ListF = result(); - -val [prem] = goal Hered.thy "A <= HTT ==> Lists(A) <= HTT"; -by (safe_tac set_cs); -be HTT_coinduct3 1; -by (fast_tac (set_cs addSIs HTTgenIs - addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] - addEs [XH_to_E ListsXH]) 1); -val ListsF = result(); - -val [prem] = goal Hered.thy "A <= HTT ==> ILists(A) <= HTT"; -by (safe_tac set_cs); -be HTT_coinduct3 1; -by (fast_tac (set_cs addSIs HTTgenIs - addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] - addEs [XH_to_E IListsXH]) 1); -val IListsF = result(); - -(*** A possible use for this predicate is proving equality from pre-order ***) -(*** but it seems as easy (and more general) to do this directly by coinduction ***) -(* -val prems = goal Hered.thy "[| t : HTT; t [= u |] ==> u [= t"; -by (po_coinduct_tac "{p. EX a b.p= & b : HTT & b [= a}" 1); -by (fast_tac (ccl_cs addIs prems) 1); -by (safe_tac ccl_cs); -bd (poXH RS iffD1) 1; -by (safe_tac (set_cs addSEs [HTT_bot RS notE])); -by (REPEAT_SOME (rtac (POgenXH RS iffD2) ORELSE' etac rev_mp)); -by (ALLGOALS (simp_tac (term_ss addsimps HTT_rews))); -by (ALLGOALS (fast_tac ccl_cs)); -val HTT_po_op = result(); - -val prems = goal Hered.thy "[| t : HTT; t [= u |] ==> t = u"; -by (REPEAT (ares_tac (prems @ [conjI RS (eq_iff RS iffD2),HTT_po_op]) 1)); -val HTT_po_eq = result(); -*) diff -r 19849d258890 -r 8018173a7979 src/CCL/hered.thy --- a/src/CCL/hered.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -(* Title: CCL/hered.thy - ID: $Id$ - Author: Martin Coen - Copyright 1993 University of Cambridge - -Hereditary Termination - cf. Martin Lo\"f - -Note that this is based on an untyped equality and so lam x.b(x) is only -hereditarily terminating if ALL x.b(x) is. Not so useful for functions! - -*) - -Hered = Type + - -consts - (*** Predicates ***) - HTTgen :: "i set => i set" - HTT :: "i set" - - -rules - - (*** Definitions of Hereditary Termination ***) - - HTTgen_def - "HTTgen(R) == {t. t=true | t=false | (EX a b.t= & a : R & b : R) | \ -\ (EX f. t=lam x.f(x) & (ALL x.f(x) : R))}" - HTT_def "HTT == gfp(HTTgen)" - -end diff -r 19849d258890 -r 8018173a7979 src/CCL/lfp.ML --- a/src/CCL/lfp.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,82 +0,0 @@ -(* Title: CCL/lfp - ID: $Id$ - -Modified version of - Title: HOL/lfp.ML - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -For lfp.thy. The Knaster-Tarski Theorem -*) - -open Lfp; - -(*** Proof of Knaster-Tarski Theorem ***) - -(* lfp(f) is the greatest lower bound of {u. f(u) <= u} *) - -val prems = goalw Lfp.thy [lfp_def] "[| f(A) <= A |] ==> lfp(f) <= A"; -by (rtac (CollectI RS Inter_lower) 1); -by (resolve_tac prems 1); -val lfp_lowerbound = result(); - -val prems = goalw Lfp.thy [lfp_def] - "[| !!u. f(u) <= u ==> A<=u |] ==> A <= lfp(f)"; -by (REPEAT (ares_tac ([Inter_greatest]@prems) 1)); -by (etac CollectD 1); -val lfp_greatest = result(); - -val [mono] = goal Lfp.thy "mono(f) ==> f(lfp(f)) <= lfp(f)"; -by (EVERY1 [rtac lfp_greatest, rtac subset_trans, - rtac (mono RS monoD), rtac lfp_lowerbound, atac, atac]); -val lfp_lemma2 = result(); - -val [mono] = goal Lfp.thy "mono(f) ==> lfp(f) <= f(lfp(f))"; -by (EVERY1 [rtac lfp_lowerbound, rtac (mono RS monoD), - rtac lfp_lemma2, rtac mono]); -val lfp_lemma3 = result(); - -val [mono] = goal Lfp.thy "mono(f) ==> lfp(f) = f(lfp(f))"; -by (REPEAT (resolve_tac [equalityI,lfp_lemma2,lfp_lemma3,mono] 1)); -val lfp_Tarski = result(); - - -(*** General induction rule for least fixed points ***) - -val [lfp,mono,indhyp] = goal Lfp.thy - "[| a: lfp(f); mono(f); \ -\ !!x. [| x: f(lfp(f) Int {x.P(x)}) |] ==> P(x) \ -\ |] ==> P(a)"; -by (res_inst_tac [("a","a")] (Int_lower2 RS subsetD RS CollectD) 1); -by (rtac (lfp RSN (2, lfp_lowerbound RS subsetD)) 1); -by (EVERY1 [rtac Int_greatest, rtac subset_trans, - rtac (Int_lower1 RS (mono RS monoD)), - rtac (mono RS lfp_lemma2), - rtac (CollectI RS subsetI), rtac indhyp, atac]); -val induct = result(); - -(** Definition forms of lfp_Tarski and induct, to control unfolding **) - -val [rew,mono] = goal Lfp.thy "[| h==lfp(f); mono(f) |] ==> h = f(h)"; -by (rewtac rew); -by (rtac (mono RS lfp_Tarski) 1); -val def_lfp_Tarski = result(); - -val rew::prems = goal Lfp.thy - "[| A == lfp(f); a:A; mono(f); \ -\ !!x. [| x: f(A Int {x.P(x)}) |] ==> P(x) \ -\ |] ==> P(a)"; -by (EVERY1 [rtac induct, (*backtracking to force correct induction*) - REPEAT1 o (ares_tac (map (rewrite_rule [rew]) prems))]); -val def_induct = result(); - -(*Monotonicity of lfp!*) -val prems = goal Lfp.thy - "[| mono(g); !!Z. f(Z)<=g(Z) |] ==> lfp(f) <= lfp(g)"; -by (rtac lfp_lowerbound 1); -by (rtac subset_trans 1); -by (resolve_tac prems 1); -by (rtac lfp_lemma2 1); -by (resolve_tac prems 1); -val lfp_mono = result(); - diff -r 19849d258890 -r 8018173a7979 src/CCL/lfp.thy --- a/src/CCL/lfp.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -(* Title: HOL/lfp.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -The Knaster-Tarski Theorem -*) - -Lfp = Set + -consts lfp :: "['a set=>'a set] => 'a set" -rules - (*least fixed point*) - lfp_def "lfp(f) == Inter({u. f(u) <= u})" -end diff -r 19849d258890 -r 8018173a7979 src/CCL/set.ML --- a/src/CCL/set.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,350 +0,0 @@ -(* Title: set/set - ID: $Id$ - -For set.thy. - -Modified version of - Title: HOL/set - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -For set.thy. Set theory for higher-order logic. A set is simply a predicate. -*) - -open Set; - -val [prem] = goal Set.thy "[| P(a) |] ==> a : {x.P(x)}"; -by (rtac (mem_Collect_iff RS iffD2) 1); -by (rtac prem 1); -val CollectI = result(); - -val prems = goal Set.thy "[| a : {x.P(x)} |] ==> P(a)"; -by (resolve_tac (prems RL [mem_Collect_iff RS iffD1]) 1); -val CollectD = result(); - -val CollectE = make_elim CollectD; - -val [prem] = goal Set.thy "[| !!x. x:A <-> x:B |] ==> A = B"; -by (rtac (set_extension RS iffD2) 1); -by (rtac (prem RS allI) 1); -val set_ext = result(); - -(*** Bounded quantifiers ***) - -val prems = goalw Set.thy [Ball_def] - "[| !!x. x:A ==> P(x) |] ==> ALL x:A. P(x)"; -by (REPEAT (ares_tac (prems @ [allI,impI]) 1)); -val ballI = result(); - -val [major,minor] = goalw Set.thy [Ball_def] - "[| ALL x:A. P(x); x:A |] ==> P(x)"; -by (rtac (minor RS (major RS spec RS mp)) 1); -val bspec = result(); - -val major::prems = goalw Set.thy [Ball_def] - "[| ALL x:A. P(x); P(x) ==> Q; ~ x:A ==> Q |] ==> Q"; -by (rtac (major RS spec RS impCE) 1); -by (REPEAT (eresolve_tac prems 1)); -val ballE = result(); - -(*Takes assumptions ALL x:A.P(x) and a:A; creates assumption P(a)*) -fun ball_tac i = etac ballE i THEN contr_tac (i+1); - -val prems = goalw Set.thy [Bex_def] - "[| P(x); x:A |] ==> EX x:A. P(x)"; -by (REPEAT (ares_tac (prems @ [exI,conjI]) 1)); -val bexI = result(); - -val bexCI = prove_goal Set.thy - "[| EX x:A. ~P(x) ==> P(a); a:A |] ==> EX x:A.P(x)" - (fn prems=> - [ (rtac classical 1), - (REPEAT (ares_tac (prems@[bexI,ballI,notI,notE]) 1)) ]); - -val major::prems = goalw Set.thy [Bex_def] - "[| EX x:A. P(x); !!x. [| x:A; P(x) |] ==> Q |] ==> Q"; -by (rtac (major RS exE) 1); -by (REPEAT (eresolve_tac (prems @ [asm_rl,conjE]) 1)); -val bexE = result(); - -(*Trival rewrite rule; (! x:A.P)=P holds only if A is nonempty!*) -val prems = goal Set.thy - "(ALL x:A. True) <-> True"; -by (REPEAT (ares_tac [TrueI,ballI,iffI] 1)); -val ball_rew = result(); - -(** Congruence rules **) - -val prems = goal Set.thy - "[| A=A'; !!x. x:A' ==> P(x) <-> P'(x) |] ==> \ -\ (ALL x:A. P(x)) <-> (ALL x:A'. P'(x))"; -by (resolve_tac (prems RL [ssubst,iffD2]) 1); -by (REPEAT (ares_tac [ballI,iffI] 1 - ORELSE eresolve_tac ([make_elim bspec, mp] @ (prems RL [iffE])) 1)); -val ball_cong = result(); - -val prems = goal Set.thy - "[| A=A'; !!x. x:A' ==> P(x) <-> P'(x) |] ==> \ -\ (EX x:A. P(x)) <-> (EX x:A'. P'(x))"; -by (resolve_tac (prems RL [ssubst,iffD2]) 1); -by (REPEAT (etac bexE 1 - ORELSE ares_tac ([bexI,iffI] @ (prems RL [iffD1,iffD2])) 1)); -val bex_cong = result(); - -(*** Rules for subsets ***) - -val prems = goalw Set.thy [subset_def] "(!!x.x:A ==> x:B) ==> A <= B"; -by (REPEAT (ares_tac (prems @ [ballI]) 1)); -val subsetI = result(); - -(*Rule in Modus Ponens style*) -val major::prems = goalw Set.thy [subset_def] "[| A <= B; c:A |] ==> c:B"; -by (rtac (major RS bspec) 1); -by (resolve_tac prems 1); -val subsetD = result(); - -(*Classical elimination rule*) -val major::prems = goalw Set.thy [subset_def] - "[| A <= B; ~(c:A) ==> P; c:B ==> P |] ==> P"; -by (rtac (major RS ballE) 1); -by (REPEAT (eresolve_tac prems 1)); -val subsetCE = result(); - -(*Takes assumptions A<=B; c:A and creates the assumption c:B *) -fun set_mp_tac i = etac subsetCE i THEN mp_tac i; - -val subset_refl = prove_goal Set.thy "A <= A" - (fn _=> [ (REPEAT (ares_tac [subsetI] 1)) ]); - -goal Set.thy "!!A B C. [| A<=B; B<=C |] ==> A<=C"; -br subsetI 1; -by (REPEAT (eresolve_tac [asm_rl, subsetD] 1)); -val subset_trans = result(); - - -(*** Rules for equality ***) - -(*Anti-symmetry of the subset relation*) -val prems = goal Set.thy "[| A <= B; B <= A |] ==> A = B"; -by (rtac (iffI RS set_ext) 1); -by (REPEAT (ares_tac (prems RL [subsetD]) 1)); -val subset_antisym = result(); -val equalityI = subset_antisym; - -(* Equality rules from ZF set theory -- are they appropriate here? *) -val prems = goal Set.thy "A = B ==> A<=B"; -by (resolve_tac (prems RL [subst]) 1); -by (rtac subset_refl 1); -val equalityD1 = result(); - -val prems = goal Set.thy "A = B ==> B<=A"; -by (resolve_tac (prems RL [subst]) 1); -by (rtac subset_refl 1); -val equalityD2 = result(); - -val prems = goal Set.thy - "[| A = B; [| A<=B; B<=A |] ==> P |] ==> P"; -by (resolve_tac prems 1); -by (REPEAT (resolve_tac (prems RL [equalityD1,equalityD2]) 1)); -val equalityE = result(); - -val major::prems = goal Set.thy - "[| A = B; [| c:A; c:B |] ==> P; [| ~ c:A; ~ c:B |] ==> P |] ==> P"; -by (rtac (major RS equalityE) 1); -by (REPEAT (contr_tac 1 ORELSE eresolve_tac ([asm_rl,subsetCE]@prems) 1)); -val equalityCE = result(); - -(*Lemma for creating induction formulae -- for "pattern matching" on p - To make the induction hypotheses usable, apply "spec" or "bspec" to - put universal quantifiers over the free variables in p. *) -val prems = goal Set.thy - "[| p:A; !!z. z:A ==> p=z --> R |] ==> R"; -by (rtac mp 1); -by (REPEAT (resolve_tac (refl::prems) 1)); -val setup_induction = result(); - -goal Set.thy "{x.x:A} = A"; -by (REPEAT (ares_tac [equalityI,subsetI,CollectI] 1 ORELSE eresolve_tac [CollectD] 1)); -val trivial_set = result(); - -(*** Rules for binary union -- Un ***) - -val prems = goalw Set.thy [Un_def] "c:A ==> c : A Un B"; -by (REPEAT (resolve_tac (prems @ [CollectI,disjI1]) 1)); -val UnI1 = result(); - -val prems = goalw Set.thy [Un_def] "c:B ==> c : A Un B"; -by (REPEAT (resolve_tac (prems @ [CollectI,disjI2]) 1)); -val UnI2 = result(); - -(*Classical introduction rule: no commitment to A vs B*) -val UnCI = prove_goal Set.thy "(~c:B ==> c:A) ==> c : A Un B" - (fn prems=> - [ (rtac classical 1), - (REPEAT (ares_tac (prems@[UnI1,notI]) 1)), - (REPEAT (ares_tac (prems@[UnI2,notE]) 1)) ]); - -val major::prems = goalw Set.thy [Un_def] - "[| c : A Un B; c:A ==> P; c:B ==> P |] ==> P"; -by (rtac (major RS CollectD RS disjE) 1); -by (REPEAT (eresolve_tac prems 1)); -val UnE = result(); - - -(*** Rules for small intersection -- Int ***) - -val prems = goalw Set.thy [Int_def] - "[| c:A; c:B |] ==> c : A Int B"; -by (REPEAT (resolve_tac (prems @ [CollectI,conjI]) 1)); -val IntI = result(); - -val [major] = goalw Set.thy [Int_def] "c : A Int B ==> c:A"; -by (rtac (major RS CollectD RS conjunct1) 1); -val IntD1 = result(); - -val [major] = goalw Set.thy [Int_def] "c : A Int B ==> c:B"; -by (rtac (major RS CollectD RS conjunct2) 1); -val IntD2 = result(); - -val [major,minor] = goal Set.thy - "[| c : A Int B; [| c:A; c:B |] ==> P |] ==> P"; -by (rtac minor 1); -by (rtac (major RS IntD1) 1); -by (rtac (major RS IntD2) 1); -val IntE = result(); - - -(*** Rules for set complement -- Compl ***) - -val prems = goalw Set.thy [Compl_def] - "[| c:A ==> False |] ==> c : Compl(A)"; -by (REPEAT (ares_tac (prems @ [CollectI,notI]) 1)); -val ComplI = result(); - -(*This form, with negated conclusion, works well with the Classical prover. - Negated assumptions behave like formulae on the right side of the notional - turnstile...*) -val major::prems = goalw Set.thy [Compl_def] - "[| c : Compl(A) |] ==> ~c:A"; -by (rtac (major RS CollectD) 1); -val ComplD = result(); - -val ComplE = make_elim ComplD; - - -(*** Empty sets ***) - -goalw Set.thy [empty_def] "{x.False} = {}"; -br refl 1; -val empty_eq = result(); - -val [prem] = goalw Set.thy [empty_def] "a : {} ==> P"; -by (rtac (prem RS CollectD RS FalseE) 1); -val emptyD = result(); - -val emptyE = make_elim emptyD; - -val [prem] = goal Set.thy "~ A={} ==> (EX x.x:A)"; -br (prem RS swap) 1; -br equalityI 1; -by (ALLGOALS (fast_tac (FOL_cs addSIs [subsetI] addSEs [emptyD]))); -val not_emptyD = result(); - -(*** Singleton sets ***) - -goalw Set.thy [singleton_def] "a : {a}"; -by (rtac CollectI 1); -by (rtac refl 1); -val singletonI = result(); - -val [major] = goalw Set.thy [singleton_def] "b : {a} ==> b=a"; -by (rtac (major RS CollectD) 1); -val singletonD = result(); - -val singletonE = make_elim singletonD; - -(*** Unions of families ***) - -(*The order of the premises presupposes that A is rigid; b may be flexible*) -val prems = goalw Set.thy [UNION_def] - "[| a:A; b: B(a) |] ==> b: (UN x:A. B(x))"; -by (REPEAT (resolve_tac (prems @ [bexI,CollectI]) 1)); -val UN_I = result(); - -val major::prems = goalw Set.thy [UNION_def] - "[| b : (UN x:A. B(x)); !!x.[| x:A; b: B(x) |] ==> R |] ==> R"; -by (rtac (major RS CollectD RS bexE) 1); -by (REPEAT (ares_tac prems 1)); -val UN_E = result(); - -val prems = goal Set.thy - "[| A=B; !!x. x:B ==> C(x) = D(x) |] ==> \ -\ (UN x:A. C(x)) = (UN x:B. D(x))"; -by (REPEAT (etac UN_E 1 - ORELSE ares_tac ([UN_I,equalityI,subsetI] @ - (prems RL [equalityD1,equalityD2] RL [subsetD])) 1)); -val UN_cong = result(); - -(*** Intersections of families -- INTER x:A. B(x) is Inter(B)``A ) *) - -val prems = goalw Set.thy [INTER_def] - "(!!x. x:A ==> b: B(x)) ==> b : (INT x:A. B(x))"; -by (REPEAT (ares_tac ([CollectI,ballI] @ prems) 1)); -val INT_I = result(); - -val major::prems = goalw Set.thy [INTER_def] - "[| b : (INT x:A. B(x)); a:A |] ==> b: B(a)"; -by (rtac (major RS CollectD RS bspec) 1); -by (resolve_tac prems 1); -val INT_D = result(); - -(*"Classical" elimination rule -- does not require proving X:C *) -val major::prems = goalw Set.thy [INTER_def] - "[| b : (INT x:A. B(x)); b: B(a) ==> R; ~ a:A ==> R |] ==> R"; -by (rtac (major RS CollectD RS ballE) 1); -by (REPEAT (eresolve_tac prems 1)); -val INT_E = result(); - -val prems = goal Set.thy - "[| A=B; !!x. x:B ==> C(x) = D(x) |] ==> \ -\ (INT x:A. C(x)) = (INT x:B. D(x))"; -by (REPEAT_FIRST (resolve_tac [INT_I,equalityI,subsetI])); -by (REPEAT (dtac INT_D 1 - ORELSE ares_tac (prems RL [equalityD1,equalityD2] RL [subsetD]) 1)); -val INT_cong = result(); - -(*** Rules for Unions ***) - -(*The order of the premises presupposes that C is rigid; A may be flexible*) -val prems = goalw Set.thy [Union_def] - "[| X:C; A:X |] ==> A : Union(C)"; -by (REPEAT (resolve_tac (prems @ [UN_I]) 1)); -val UnionI = result(); - -val major::prems = goalw Set.thy [Union_def] - "[| A : Union(C); !!X.[| A:X; X:C |] ==> R |] ==> R"; -by (rtac (major RS UN_E) 1); -by (REPEAT (ares_tac prems 1)); -val UnionE = result(); - -(*** Rules for Inter ***) - -val prems = goalw Set.thy [Inter_def] - "[| !!X. X:C ==> A:X |] ==> A : Inter(C)"; -by (REPEAT (ares_tac ([INT_I] @ prems) 1)); -val InterI = result(); - -(*A "destruct" rule -- every X in C contains A as an element, but - A:X can hold when X:C does not! This rule is analogous to "spec". *) -val major::prems = goalw Set.thy [Inter_def] - "[| A : Inter(C); X:C |] ==> A:X"; -by (rtac (major RS INT_D) 1); -by (resolve_tac prems 1); -val InterD = result(); - -(*"Classical" elimination rule -- does not require proving X:C *) -val major::prems = goalw Set.thy [Inter_def] - "[| A : Inter(C); A:X ==> R; ~ X:C ==> R |] ==> R"; -by (rtac (major RS INT_E) 1); -by (REPEAT (eresolve_tac prems 1)); -val InterE = result(); diff -r 19849d258890 -r 8018173a7979 src/CCL/set.thy --- a/src/CCL/set.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -(* Title: CCL/set.thy - ID: $Id$ - -Modified version of HOL/set.thy that extends FOL - -*) - -Set = FOL + - -types - 'a set - -arities - set :: (term) term - -consts - Collect :: "['a => o] => 'a set" (*comprehension*) - Compl :: "('a set) => 'a set" (*complement*) - Int :: "['a set, 'a set] => 'a set" (infixl 70) - Un :: "['a set, 'a set] => 'a set" (infixl 65) - Union, Inter :: "(('a set)set) => 'a set" (*...of a set*) - UNION, INTER :: "['a set, 'a => 'b set] => 'b set" (*general*) - Ball, Bex :: "['a set, 'a => o] => o" (*bounded quants*) - mono :: "['a set => 'b set] => o" (*monotonicity*) - ":" :: "['a, 'a set] => o" (infixl 50) (*membership*) - "<=" :: "['a set, 'a set] => o" (infixl 50) - singleton :: "'a => 'a set" ("{_}") - empty :: "'a set" ("{}") - "oo" :: "['b => 'c, 'a => 'b, 'a] => 'c" (infixr 50) (*composition*) - - "@Coll" :: "[idt, o] => 'a set" ("(1{_./ _})") (*collection*) - - (* Big Intersection / Union *) - - "@INTER" :: "[idt, 'a set, 'b set] => 'b set" ("(INT _:_./ _)" [0, 0, 0] 10) - "@UNION" :: "[idt, 'a set, 'b set] => 'b set" ("(UN _:_./ _)" [0, 0, 0] 10) - - (* Bounded Quantifiers *) - - "@Ball" :: "[idt, 'a set, o] => o" ("(ALL _:_./ _)" [0, 0, 0] 10) - "@Bex" :: "[idt, 'a set, o] => o" ("(EX _:_./ _)" [0, 0, 0] 10) - - -translations - "{x. P}" == "Collect(%x. P)" - "INT x:A. B" == "INTER(A, %x. B)" - "UN x:A. B" == "UNION(A, %x. B)" - "ALL x:A. P" == "Ball(A, %x. P)" - "EX x:A. P" == "Bex(A, %x. P)" - - -rules - mem_Collect_iff "(a : {x.P(x)}) <-> P(a)" - set_extension "A=B <-> (ALL x.x:A <-> x:B)" - - Ball_def "Ball(A, P) == ALL x. x:A --> P(x)" - Bex_def "Bex(A, P) == EX x. x:A & P(x)" - mono_def "mono(f) == (ALL A B. A <= B --> f(A) <= f(B))" - subset_def "A <= B == ALL x:A. x:B" - singleton_def "{a} == {x.x=a}" - empty_def "{} == {x.False}" - Un_def "A Un B == {x.x:A | x:B}" - Int_def "A Int B == {x.x:A & x:B}" - Compl_def "Compl(A) == {x. ~x:A}" - INTER_def "INTER(A, B) == {y. ALL x:A. y: B(x)}" - UNION_def "UNION(A, B) == {y. EX x:A. y: B(x)}" - Inter_def "Inter(S) == (INT x:S. x)" - Union_def "Union(S) == (UN x:S. x)" - -end - diff -r 19849d258890 -r 8018173a7979 src/CCL/term.ML --- a/src/CCL/term.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,148 +0,0 @@ -(* Title: CCL/terms - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For terms.thy. -*) - -open Term; - -val simp_can_defs = [one_def,inl_def,inr_def]; -val simp_ncan_defs = [if_def,when_def,split_def,fst_def,snd_def,thd_def]; -val simp_defs = simp_can_defs @ simp_ncan_defs; - -val ind_can_defs = [zero_def,succ_def,nil_def,cons_def]; -val ind_ncan_defs = [ncase_def,nrec_def,lcase_def,lrec_def]; -val ind_defs = ind_can_defs @ ind_ncan_defs; - -val data_defs = simp_defs @ ind_defs @ [napply_def]; -val genrec_defs = [letrec_def,letrec2_def,letrec3_def]; - -(*** Beta Rules, including strictness ***) - -goalw Term.thy [let_def] "~ t=bot--> let x be t in f(x) = f(t)"; -by (res_inst_tac [("t","t")] term_case 1); -by (ALLGOALS(simp_tac(CCL_ss addsimps [caseBtrue,caseBfalse,caseBpair,caseBlam]))); -val letB = result() RS mp; - -goalw Term.thy [let_def] "let x be bot in f(x) = bot"; -br caseBbot 1; -val letBabot = result(); - -goalw Term.thy [let_def] "let x be t in bot = bot"; -brs ([caseBbot] RL [term_case]) 1; -by (ALLGOALS(simp_tac(CCL_ss addsimps [caseBtrue,caseBfalse,caseBpair,caseBlam]))); -val letBbbot = result(); - -goalw Term.thy [apply_def] "(lam x.b(x)) ` a = b(a)"; -by (ALLGOALS(simp_tac(CCL_ss addsimps [caseBtrue,caseBfalse,caseBpair,caseBlam]))); -val applyB = result(); - -goalw Term.thy [apply_def] "bot ` a = bot"; -br caseBbot 1; -val applyBbot = result(); - -goalw Term.thy [fix_def] "fix(f) = f(fix(f))"; -by (resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1); -val fixB = result(); - -goalw Term.thy [letrec_def] - "letrec g x be h(x,g) in g(a) = h(a,%y.letrec g x be h(x,g) in g(y))"; -by (resolve_tac [fixB RS ssubst] 1 THEN - resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1); -val letrecB = result(); - -val rawBs = caseBs @ [applyB,applyBbot]; - -fun raw_mk_beta_rl defs s = prove_goalw Term.thy defs s - (fn _ => [rtac (letrecB RS ssubst) 1, - simp_tac (CCL_ss addsimps rawBs) 1]); -fun mk_beta_rl s = raw_mk_beta_rl data_defs s; - -fun raw_mk_beta_rl defs s = prove_goalw Term.thy defs s - (fn _ => [simp_tac (CCL_ss addsimps rawBs - setloop (rtac (letrecB RS ssubst))) 1]); -fun mk_beta_rl s = raw_mk_beta_rl data_defs s; - -val ifBtrue = mk_beta_rl "if true then t else u = t"; -val ifBfalse = mk_beta_rl "if false then t else u = u"; -val ifBbot = mk_beta_rl "if bot then t else u = bot"; - -val whenBinl = mk_beta_rl "when(inl(a),t,u) = t(a)"; -val whenBinr = mk_beta_rl "when(inr(a),t,u) = u(a)"; -val whenBbot = mk_beta_rl "when(bot,t,u) = bot"; - -val splitB = mk_beta_rl "split(,h) = h(a,b)"; -val splitBbot = mk_beta_rl "split(bot,h) = bot"; -val fstB = mk_beta_rl "fst() = a"; -val fstBbot = mk_beta_rl "fst(bot) = bot"; -val sndB = mk_beta_rl "snd() = b"; -val sndBbot = mk_beta_rl "snd(bot) = bot"; -val thdB = mk_beta_rl "thd(>) = c"; -val thdBbot = mk_beta_rl "thd(bot) = bot"; - -val ncaseBzero = mk_beta_rl "ncase(zero,t,u) = t"; -val ncaseBsucc = mk_beta_rl "ncase(succ(n),t,u) = u(n)"; -val ncaseBbot = mk_beta_rl "ncase(bot,t,u) = bot"; -val nrecBzero = mk_beta_rl "nrec(zero,t,u) = t"; -val nrecBsucc = mk_beta_rl "nrec(succ(n),t,u) = u(n,nrec(n,t,u))"; -val nrecBbot = mk_beta_rl "nrec(bot,t,u) = bot"; - -val lcaseBnil = mk_beta_rl "lcase([],t,u) = t"; -val lcaseBcons = mk_beta_rl "lcase(x$xs,t,u) = u(x,xs)"; -val lcaseBbot = mk_beta_rl "lcase(bot,t,u) = bot"; -val lrecBnil = mk_beta_rl "lrec([],t,u) = t"; -val lrecBcons = mk_beta_rl "lrec(x$xs,t,u) = u(x,xs,lrec(xs,t,u))"; -val lrecBbot = mk_beta_rl "lrec(bot,t,u) = bot"; - -val letrec2B = raw_mk_beta_rl (data_defs @ [letrec2_def]) - "letrec g x y be h(x,y,g) in g(p,q) = \ -\ h(p,q,%u v.letrec g x y be h(x,y,g) in g(u,v))"; -val letrec3B = raw_mk_beta_rl (data_defs @ [letrec3_def]) - "letrec g x y z be h(x,y,z,g) in g(p,q,r) = \ -\ h(p,q,r,%u v w.letrec g x y z be h(x,y,z,g) in g(u,v,w))"; - -val napplyBzero = mk_beta_rl "f^zero`a = a"; -val napplyBsucc = mk_beta_rl "f^succ(n)`a = f(f^n`a)"; - -val termBs = [letB,applyB,applyBbot,splitB,splitBbot, - fstB,fstBbot,sndB,sndBbot,thdB,thdBbot, - ifBtrue,ifBfalse,ifBbot,whenBinl,whenBinr,whenBbot, - ncaseBzero,ncaseBsucc,ncaseBbot,nrecBzero,nrecBsucc,nrecBbot, - lcaseBnil,lcaseBcons,lcaseBbot,lrecBnil,lrecBcons,lrecBbot, - napplyBzero,napplyBsucc]; - -(*** Constructors are injective ***) - -val term_injs = map (mk_inj_rl Term.thy - [applyB,splitB,whenBinl,whenBinr,ncaseBsucc,lcaseBcons]) - ["(inl(a) = inl(a')) <-> (a=a')", - "(inr(a) = inr(a')) <-> (a=a')", - "(succ(a) = succ(a')) <-> (a=a')", - "(a$b = a'$b') <-> (a=a' & b=b')"]; - -(*** Constructors are distinct ***) - -val term_dstncts = mkall_dstnct_thms Term.thy data_defs (ccl_injs @ term_injs) - [["bot","inl","inr"],["bot","zero","succ"],["bot","nil","op $"]]; - -(*** Rules for pre-order [= ***) - -local - fun mk_thm s = prove_goalw Term.thy data_defs s (fn _ => - [simp_tac (ccl_ss addsimps (ccl_porews)) 1]); -in - val term_porews = map mk_thm ["inl(a) [= inl(a') <-> a [= a'", - "inr(b) [= inr(b') <-> b [= b'", - "succ(n) [= succ(n') <-> n [= n'", - "x$xs [= x'$xs' <-> x [= x' & xs [= xs'"]; -end; - -(*** Rewriting and Proving ***) - -val term_rews = termBs @ term_injs @ term_dstncts @ ccl_porews @ term_porews; -val term_ss = ccl_ss addsimps term_rews; - -val term_cs = ccl_cs addSEs (term_dstncts RL [notE]) - addSDs (XH_to_Ds term_injs); diff -r 19849d258890 -r 8018173a7979 src/CCL/term.thy --- a/src/CCL/term.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,131 +0,0 @@ -(* Title: CCL/terms.thy - ID: $Id$ - Author: Martin Coen - Copyright 1993 University of Cambridge - -Definitions of usual program constructs in CCL. - -*) - -Term = CCL + - -consts - - one :: "i" - - if :: "[i,i,i]=>i" ("(3if _/ then _/ else _)" [] 60) - - inl,inr :: "i=>i" - when :: "[i,i=>i,i=>i]=>i" - - split :: "[i,[i,i]=>i]=>i" - fst,snd, - thd :: "i=>i" - - zero :: "i" - succ :: "i=>i" - ncase :: "[i,i,i=>i]=>i" - nrec :: "[i,i,[i,i]=>i]=>i" - - nil :: "i" ("([])") - "$" :: "[i,i]=>i" (infixr 80) - lcase :: "[i,i,[i,i]=>i]=>i" - lrec :: "[i,i,[i,i,i]=>i]=>i" - - let :: "[i,i=>i]=>i" - letrec :: "[[i,i=>i]=>i,(i=>i)=>i]=>i" - letrec2 :: "[[i,i,i=>i=>i]=>i,(i=>i=>i)=>i]=>i" - letrec3 :: "[[i,i,i,i=>i=>i=>i]=>i,(i=>i=>i=>i)=>i]=>i" - - "@let" :: "[id,i,i]=>i" ("(3let _ be _/ in _)" [] 60) - "@letrec" :: "[id,id,i,i]=>i" ("(3letrec _ _ be _/ in _)" [] 60) - "@letrec2" :: "[id,id,id,i,i]=>i" ("(3letrec _ _ _ be _/ in _)" [] 60) - "@letrec3" :: "[id,id,id,id,i,i]=>i" ("(3letrec _ _ _ _ be _/ in _)" [] 60) - - napply :: "[i=>i,i,i]=>i" ("(_ ^ _ ` _)") - -rules - - one_def "one == true" - if_def "if b then t else u == case(b,t,u,% x y.bot,%v.bot)" - inl_def "inl(a) == " - inr_def "inr(b) == " - when_def "when(t,f,g) == split(t,%b x.if b then f(x) else g(x))" - split_def "split(t,f) == case(t,bot,bot,f,%u.bot)" - fst_def "fst(t) == split(t,%x y.x)" - snd_def "snd(t) == split(t,%x y.y)" - thd_def "thd(t) == split(t,%x p.split(p,%y z.z))" - zero_def "zero == inl(one)" - succ_def "succ(n) == inr(n)" - ncase_def "ncase(n,b,c) == when(n,%x.b,%y.c(y))" - nrec_def " nrec(n,b,c) == letrec g x be ncase(x,b,%y.c(y,g(y))) in g(n)" - nil_def "[] == inl(one)" - cons_def "h$t == inr()" - lcase_def "lcase(l,b,c) == when(l,%x.b,%y.split(y,c))" - lrec_def "lrec(l,b,c) == letrec g x be lcase(x,b,%h t.c(h,t,g(t))) in g(l)" - - let_def "let x be t in f(x) == case(t,f(true),f(false),%x y.f(),%u.f(lam x.u(x)))" - letrec_def - "letrec g x be h(x,g) in b(g) == b(%x.fix(%f.lam x.h(x,%y.f`y))`x)" - - letrec2_def "letrec g x y be h(x,y,g) in f(g)== \ -\ letrec g' p be split(p,%x y.h(x,y,%u v.g'())) \ -\ in f(%x y.g'())" - - letrec3_def "letrec g x y z be h(x,y,z,g) in f(g) == \ -\ letrec g' p be split(p,%x xs.split(xs,%y z.h(x,y,z,%u v w.g'(>)))) \ -\ in f(%x y z.g'(>))" - - napply_def "f ^n` a == nrec(n,a,%x g.f(g))" - -end - -ML - -(** Quantifier translations: variable binding **) - -fun let_tr [Free(id,T),a,b] = Const("let",dummyT) $ a $ absfree(id,T,b); -fun let_tr' [a,Abs(id,T,b)] = - let val (id',b') = variant_abs(id,T,b) - in Const("@let",dummyT) $ Free(id',T) $ a $ b' end; - -fun letrec_tr [Free(f,S),Free(x,T),a,b] = - Const("letrec",dummyT) $ absfree(x,T,absfree(f,S,a)) $ absfree(f,S,b); -fun letrec2_tr [Free(f,S),Free(x,T),Free(y,U),a,b] = - Const("letrec2",dummyT) $ absfree(x,T,absfree(y,U,absfree(f,S,a))) $ absfree(f,S,b); -fun letrec3_tr [Free(f,S),Free(x,T),Free(y,U),Free(z,V),a,b] = - Const("letrec3",dummyT) $ absfree(x,T,absfree(y,U,absfree(z,U,absfree(f,S,a)))) $ absfree(f,S,b); - -fun letrec_tr' [Abs(x,T,Abs(f,S,a)),Abs(ff,SS,b)] = - let val (f',b') = variant_abs(ff,SS,b) - val (_,a'') = variant_abs(f,S,a) - val (x',a') = variant_abs(x,T,a'') - in Const("@letrec",dummyT) $ Free(f',SS) $ Free(x',T) $ a' $ b' end; -fun letrec2_tr' [Abs(x,T,Abs(y,U,Abs(f,S,a))),Abs(ff,SS,b)] = - let val (f',b') = variant_abs(ff,SS,b) - val ( _,a1) = variant_abs(f,S,a) - val (y',a2) = variant_abs(y,U,a1) - val (x',a') = variant_abs(x,T,a2) - in Const("@letrec2",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ a' $ b' - end; -fun letrec3_tr' [Abs(x,T,Abs(y,U,Abs(z,V,Abs(f,S,a)))),Abs(ff,SS,b)] = - let val (f',b') = variant_abs(ff,SS,b) - val ( _,a1) = variant_abs(f,S,a) - val (z',a2) = variant_abs(z,V,a1) - val (y',a3) = variant_abs(y,U,a2) - val (x',a') = variant_abs(x,T,a3) - in Const("@letrec3",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ Free(z',V) $ a' $ b' - end; - -val parse_translation= - [("@let", let_tr), - ("@letrec", letrec_tr), - ("@letrec2", letrec2_tr), - ("@letrec3", letrec3_tr) - ]; -val print_translation= - [("let", let_tr'), - ("letrec", letrec_tr'), - ("letrec2", letrec2_tr'), - ("letrec3", letrec3_tr') - ]; diff -r 19849d258890 -r 8018173a7979 src/CCL/terms.ML --- a/src/CCL/terms.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,148 +0,0 @@ -(* Title: CCL/terms - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -For terms.thy. -*) - -open Term; - -val simp_can_defs = [one_def,inl_def,inr_def]; -val simp_ncan_defs = [if_def,when_def,split_def,fst_def,snd_def,thd_def]; -val simp_defs = simp_can_defs @ simp_ncan_defs; - -val ind_can_defs = [zero_def,succ_def,nil_def,cons_def]; -val ind_ncan_defs = [ncase_def,nrec_def,lcase_def,lrec_def]; -val ind_defs = ind_can_defs @ ind_ncan_defs; - -val data_defs = simp_defs @ ind_defs @ [napply_def]; -val genrec_defs = [letrec_def,letrec2_def,letrec3_def]; - -(*** Beta Rules, including strictness ***) - -goalw Term.thy [let_def] "~ t=bot--> let x be t in f(x) = f(t)"; -by (res_inst_tac [("t","t")] term_case 1); -by (ALLGOALS(simp_tac(CCL_ss addsimps [caseBtrue,caseBfalse,caseBpair,caseBlam]))); -val letB = result() RS mp; - -goalw Term.thy [let_def] "let x be bot in f(x) = bot"; -br caseBbot 1; -val letBabot = result(); - -goalw Term.thy [let_def] "let x be t in bot = bot"; -brs ([caseBbot] RL [term_case]) 1; -by (ALLGOALS(simp_tac(CCL_ss addsimps [caseBtrue,caseBfalse,caseBpair,caseBlam]))); -val letBbbot = result(); - -goalw Term.thy [apply_def] "(lam x.b(x)) ` a = b(a)"; -by (ALLGOALS(simp_tac(CCL_ss addsimps [caseBtrue,caseBfalse,caseBpair,caseBlam]))); -val applyB = result(); - -goalw Term.thy [apply_def] "bot ` a = bot"; -br caseBbot 1; -val applyBbot = result(); - -goalw Term.thy [fix_def] "fix(f) = f(fix(f))"; -by (resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1); -val fixB = result(); - -goalw Term.thy [letrec_def] - "letrec g x be h(x,g) in g(a) = h(a,%y.letrec g x be h(x,g) in g(y))"; -by (resolve_tac [fixB RS ssubst] 1 THEN - resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1); -val letrecB = result(); - -val rawBs = caseBs @ [applyB,applyBbot]; - -fun raw_mk_beta_rl defs s = prove_goalw Term.thy defs s - (fn _ => [rtac (letrecB RS ssubst) 1, - simp_tac (CCL_ss addsimps rawBs) 1]); -fun mk_beta_rl s = raw_mk_beta_rl data_defs s; - -fun raw_mk_beta_rl defs s = prove_goalw Term.thy defs s - (fn _ => [simp_tac (CCL_ss addsimps rawBs - setloop (rtac (letrecB RS ssubst))) 1]); -fun mk_beta_rl s = raw_mk_beta_rl data_defs s; - -val ifBtrue = mk_beta_rl "if true then t else u = t"; -val ifBfalse = mk_beta_rl "if false then t else u = u"; -val ifBbot = mk_beta_rl "if bot then t else u = bot"; - -val whenBinl = mk_beta_rl "when(inl(a),t,u) = t(a)"; -val whenBinr = mk_beta_rl "when(inr(a),t,u) = u(a)"; -val whenBbot = mk_beta_rl "when(bot,t,u) = bot"; - -val splitB = mk_beta_rl "split(,h) = h(a,b)"; -val splitBbot = mk_beta_rl "split(bot,h) = bot"; -val fstB = mk_beta_rl "fst() = a"; -val fstBbot = mk_beta_rl "fst(bot) = bot"; -val sndB = mk_beta_rl "snd() = b"; -val sndBbot = mk_beta_rl "snd(bot) = bot"; -val thdB = mk_beta_rl "thd(>) = c"; -val thdBbot = mk_beta_rl "thd(bot) = bot"; - -val ncaseBzero = mk_beta_rl "ncase(zero,t,u) = t"; -val ncaseBsucc = mk_beta_rl "ncase(succ(n),t,u) = u(n)"; -val ncaseBbot = mk_beta_rl "ncase(bot,t,u) = bot"; -val nrecBzero = mk_beta_rl "nrec(zero,t,u) = t"; -val nrecBsucc = mk_beta_rl "nrec(succ(n),t,u) = u(n,nrec(n,t,u))"; -val nrecBbot = mk_beta_rl "nrec(bot,t,u) = bot"; - -val lcaseBnil = mk_beta_rl "lcase([],t,u) = t"; -val lcaseBcons = mk_beta_rl "lcase(x.xs,t,u) = u(x,xs)"; -val lcaseBbot = mk_beta_rl "lcase(bot,t,u) = bot"; -val lrecBnil = mk_beta_rl "lrec([],t,u) = t"; -val lrecBcons = mk_beta_rl "lrec(x.xs,t,u) = u(x,xs,lrec(xs,t,u))"; -val lrecBbot = mk_beta_rl "lrec(bot,t,u) = bot"; - -val letrec2B = raw_mk_beta_rl (data_defs @ [letrec2_def]) - "letrec g x y be h(x,y,g) in g(p,q) = \ -\ h(p,q,%u v.letrec g x y be h(x,y,g) in g(u,v))"; -val letrec3B = raw_mk_beta_rl (data_defs @ [letrec3_def]) - "letrec g x y z be h(x,y,z,g) in g(p,q,r) = \ -\ h(p,q,r,%u v w.letrec g x y z be h(x,y,z,g) in g(u,v,w))"; - -val napplyBzero = mk_beta_rl "f^zero`a = a"; -val napplyBsucc = mk_beta_rl "f^succ(n)`a = f(f^n`a)"; - -val termBs = [letB,applyB,applyBbot,splitB,splitBbot, - fstB,fstBbot,sndB,sndBbot,thdB,thdBbot, - ifBtrue,ifBfalse,ifBbot,whenBinl,whenBinr,whenBbot, - ncaseBzero,ncaseBsucc,ncaseBbot,nrecBzero,nrecBsucc,nrecBbot, - lcaseBnil,lcaseBcons,lcaseBbot,lrecBnil,lrecBcons,lrecBbot, - napplyBzero,napplyBsucc]; - -(*** Constructors are injective ***) - -val term_injs = map (mk_inj_rl Term.thy - [applyB,splitB,whenBinl,whenBinr,ncaseBsucc,lcaseBcons]) - ["(inl(a) = inl(a')) <-> (a=a')", - "(inr(a) = inr(a')) <-> (a=a')", - "(succ(a) = succ(a')) <-> (a=a')", - "(a.b = a'.b') <-> (a=a' & b=b')"]; - -(*** Constructors are distinct ***) - -val term_dstncts = mkall_dstnct_thms Term.thy data_defs (ccl_injs @ term_injs) - [["bot","inl","inr"],["bot","zero","succ"],["bot","nil","op ."]]; - -(*** Rules for pre-order [= ***) - -local - fun mk_thm s = prove_goalw Term.thy data_defs s (fn _ => - [simp_tac (ccl_ss addsimps (ccl_porews)) 1]); -in - val term_porews = map mk_thm ["inl(a) [= inl(a') <-> a [= a'", - "inr(b) [= inr(b') <-> b [= b'", - "succ(n) [= succ(n') <-> n [= n'", - "x.xs [= x'.xs' <-> x [= x' & xs [= xs'"]; -end; - -(*** Rewriting and Proving ***) - -val term_rews = termBs @ term_injs @ term_dstncts @ ccl_porews @ term_porews; -val term_ss = ccl_ss addsimps term_rews; - -val term_cs = ccl_cs addSEs (term_dstncts RL [notE]) - addSDs (XH_to_Ds term_injs); diff -r 19849d258890 -r 8018173a7979 src/CCL/terms.thy --- a/src/CCL/terms.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,131 +0,0 @@ -(* Title: CCL/terms.thy - ID: $Id$ - Author: Martin Coen - Copyright 1993 University of Cambridge - -Definitions of usual program constructs in CCL. - -*) - -Term = CCL + - -consts - - one :: "i" - - if :: "[i,i,i]=>i" ("(3if _/ then _/ else _)" [] 60) - - inl,inr :: "i=>i" - when :: "[i,i=>i,i=>i]=>i" - - split :: "[i,[i,i]=>i]=>i" - fst,snd, - thd :: "i=>i" - - zero :: "i" - succ :: "i=>i" - ncase :: "[i,i,i=>i]=>i" - nrec :: "[i,i,[i,i]=>i]=>i" - - nil :: "i" ("([])") - "." :: "[i,i]=>i" (infixr 80) - lcase :: "[i,i,[i,i]=>i]=>i" - lrec :: "[i,i,[i,i,i]=>i]=>i" - - let :: "[i,i=>i]=>i" - letrec :: "[[i,i=>i]=>i,(i=>i)=>i]=>i" - letrec2 :: "[[i,i,i=>i=>i]=>i,(i=>i=>i)=>i]=>i" - letrec3 :: "[[i,i,i,i=>i=>i=>i]=>i,(i=>i=>i=>i)=>i]=>i" - - "@let" :: "[id,i,i]=>i" ("(3let _ be _/ in _)" [] 60) - "@letrec" :: "[id,id,i,i]=>i" ("(3letrec _ _ be _/ in _)" [] 60) - "@letrec2" :: "[id,id,id,i,i]=>i" ("(3letrec _ _ _ be _/ in _)" [] 60) - "@letrec3" :: "[id,id,id,id,i,i]=>i" ("(3letrec _ _ _ _ be _/ in _)" [] 60) - - napply :: "[i=>i,i,i]=>i" ("(_ ^ _ ` _)") - -rules - - one_def "one == true" - if_def "if b then t else u == case(b,t,u,% x y.bot,%v.bot)" - inl_def "inl(a) == " - inr_def "inr(b) == " - when_def "when(t,f,g) == split(t,%b x.if b then f(x) else g(x))" - split_def "split(t,f) == case(t,bot,bot,f,%u.bot)" - fst_def "fst(t) == split(t,%x y.x)" - snd_def "snd(t) == split(t,%x y.y)" - thd_def "thd(t) == split(t,%x p.split(p,%y z.z))" - zero_def "zero == inl(one)" - succ_def "succ(n) == inr(n)" - ncase_def "ncase(n,b,c) == when(n,%x.b,%y.c(y))" - nrec_def " nrec(n,b,c) == letrec g x be ncase(x,b,%y.c(y,g(y))) in g(n)" - nil_def "[] == inl(one)" - cons_def "h.t == inr()" - lcase_def "lcase(l,b,c) == when(l,%x.b,%y.split(y,c))" - lrec_def "lrec(l,b,c) == letrec g x be lcase(x,b,%h t.c(h,t,g(t))) in g(l)" - - let_def "let x be t in f(x) == case(t,f(true),f(false),%x y.f(),%u.f(lam x.u(x)))" - letrec_def - "letrec g x be h(x,g) in b(g) == b(%x.fix(%f.lam x.h(x,%y.f`y))`x)" - - letrec2_def "letrec g x y be h(x,y,g) in f(g)== \ -\ letrec g' p be split(p,%x y.h(x,y,%u v.g'())) \ -\ in f(%x y.g'())" - - letrec3_def "letrec g x y z be h(x,y,z,g) in f(g) == \ -\ letrec g' p be split(p,%x xs.split(xs,%y z.h(x,y,z,%u v w.g'(>)))) \ -\ in f(%x y z.g'(>))" - - napply_def "f ^n` a == nrec(n,a,%x g.f(g))" - -end - -ML - -(** Quantifier translations: variable binding **) - -fun let_tr [Free(id,T),a,b] = Const("let",dummyT) $ a $ absfree(id,T,b); -fun let_tr' [a,Abs(id,T,b)] = - let val (id',b') = variant_abs(id,T,b) - in Const("@let",dummyT) $ Free(id',T) $ a $ b' end; - -fun letrec_tr [Free(f,S),Free(x,T),a,b] = - Const("letrec",dummyT) $ absfree(x,T,absfree(f,S,a)) $ absfree(f,S,b); -fun letrec2_tr [Free(f,S),Free(x,T),Free(y,U),a,b] = - Const("letrec2",dummyT) $ absfree(x,T,absfree(y,U,absfree(f,S,a))) $ absfree(f,S,b); -fun letrec3_tr [Free(f,S),Free(x,T),Free(y,U),Free(z,V),a,b] = - Const("letrec3",dummyT) $ absfree(x,T,absfree(y,U,absfree(z,U,absfree(f,S,a)))) $ absfree(f,S,b); - -fun letrec_tr' [Abs(x,T,Abs(f,S,a)),Abs(ff,SS,b)] = - let val (f',b') = variant_abs(ff,SS,b) - val (_,a'') = variant_abs(f,S,a) - val (x',a') = variant_abs(x,T,a'') - in Const("@letrec",dummyT) $ Free(f',SS) $ Free(x',T) $ a' $ b' end; -fun letrec2_tr' [Abs(x,T,Abs(y,U,Abs(f,S,a))),Abs(ff,SS,b)] = - let val (f',b') = variant_abs(ff,SS,b) - val ( _,a1) = variant_abs(f,S,a) - val (y',a2) = variant_abs(y,U,a1) - val (x',a') = variant_abs(x,T,a2) - in Const("@letrec2",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ a' $ b' - end; -fun letrec3_tr' [Abs(x,T,Abs(y,U,Abs(z,V,Abs(f,S,a)))),Abs(ff,SS,b)] = - let val (f',b') = variant_abs(ff,SS,b) - val ( _,a1) = variant_abs(f,S,a) - val (z',a2) = variant_abs(z,V,a1) - val (y',a3) = variant_abs(y,U,a2) - val (x',a') = variant_abs(x,T,a3) - in Const("@letrec3",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ Free(z',V) $ a' $ b' - end; - -val parse_translation= - [("@let", let_tr), - ("@letrec", letrec_tr), - ("@letrec2", letrec2_tr), - ("@letrec3", letrec3_tr) - ]; -val print_translation= - [("let", let_tr'), - ("letrec", letrec_tr'), - ("letrec2", letrec2_tr'), - ("letrec3", letrec3_tr') - ]; diff -r 19849d258890 -r 8018173a7979 src/CCL/trancl.ML --- a/src/CCL/trancl.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,215 +0,0 @@ -(* Title: CCL/trancl - ID: $Id$ - -For trancl.thy. - -Modified version of - Title: HOL/trancl.ML - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -*) - -open Trancl; - -(** Natural deduction for trans(r) **) - -val prems = goalw Trancl.thy [trans_def] - "(!! x y z. [| :r; :r |] ==> :r) ==> trans(r)"; -by (REPEAT (ares_tac (prems@[allI,impI]) 1)); -val transI = result(); - -val major::prems = goalw Trancl.thy [trans_def] - "[| trans(r); :r; :r |] ==> :r"; -by (cut_facts_tac [major] 1); -by (fast_tac (FOL_cs addIs prems) 1); -val transD = result(); - -(** Identity relation **) - -goalw Trancl.thy [id_def] " : id"; -by (rtac CollectI 1); -by (rtac exI 1); -by (rtac refl 1); -val idI = result(); - -val major::prems = goalw Trancl.thy [id_def] - "[| p: id; !!x.[| p = |] ==> P \ -\ |] ==> P"; -by (rtac (major RS CollectE) 1); -by (etac exE 1); -by (eresolve_tac prems 1); -val idE = result(); - -(** Composition of two relations **) - -val prems = goalw Trancl.thy [comp_def] - "[| :s; :r |] ==> : r O s"; -by (fast_tac (set_cs addIs prems) 1); -val compI = result(); - -(*proof requires higher-level assumptions or a delaying of hyp_subst_tac*) -val prems = goalw Trancl.thy [comp_def] - "[| xz : r O s; \ -\ !!x y z. [| xz = ; :s; :r |] ==> P \ -\ |] ==> P"; -by (cut_facts_tac prems 1); -by (REPEAT (eresolve_tac [CollectE, exE, conjE] 1 ORELSE ares_tac prems 1)); -val compE = result(); - -val prems = goal Trancl.thy - "[| : r O s; \ -\ !!y. [| :s; :r |] ==> P \ -\ |] ==> P"; -by (rtac compE 1); -by (REPEAT (ares_tac prems 1 ORELSE eresolve_tac [pair_inject,ssubst] 1)); -val compEpair = result(); - -val comp_cs = set_cs addIs [compI,idI] - addEs [compE,idE] - addSEs [pair_inject]; - -val prems = goal Trancl.thy - "[| r'<=r; s'<=s |] ==> (r' O s') <= (r O s)"; -by (cut_facts_tac prems 1); -by (fast_tac comp_cs 1); -val comp_mono = result(); - -(** The relation rtrancl **) - -goal Trancl.thy "mono(%s. id Un (r O s))"; -by (rtac monoI 1); -by (REPEAT (ares_tac [monoI, subset_refl, comp_mono, Un_mono] 1)); -val rtrancl_fun_mono = result(); - -val rtrancl_unfold = rtrancl_fun_mono RS (rtrancl_def RS def_lfp_Tarski); - -(*Reflexivity of rtrancl*) -goal Trancl.thy " : r^*"; -br (rtrancl_unfold RS ssubst) 1; -by (fast_tac comp_cs 1); -val rtrancl_refl = result(); - -(*Closure under composition with r*) -val prems = goal Trancl.thy - "[| : r^*; : r |] ==> : r^*"; -br (rtrancl_unfold RS ssubst) 1; -by (fast_tac (comp_cs addIs prems) 1); -val rtrancl_into_rtrancl = result(); - -(*rtrancl of r contains r*) -val [prem] = goal Trancl.thy "[| : r |] ==> : r^*"; -by (rtac (rtrancl_refl RS rtrancl_into_rtrancl) 1); -by (rtac prem 1); -val r_into_rtrancl = result(); - - -(** standard induction rule **) - -val major::prems = goal Trancl.thy - "[| : r^*; \ -\ !!x. P(); \ -\ !!x y z.[| P(); : r^*; : r |] ==> P() |] \ -\ ==> P()"; -by (rtac (major RS (rtrancl_def RS def_induct)) 1); -by (rtac rtrancl_fun_mono 1); -by (fast_tac (comp_cs addIs prems) 1); -val rtrancl_full_induct = result(); - -(*nice induction rule*) -val major::prems = goal Trancl.thy - "[| : r^*; \ -\ P(a); \ -\ !!y z.[| : r^*; : r; P(y) |] ==> P(z) |] \ -\ ==> P(b)"; -(*by induction on this formula*) -by (subgoal_tac "ALL y. = --> P(y)" 1); -(*now solve first subgoal: this formula is sufficient*) -by (fast_tac FOL_cs 1); -(*now do the induction*) -by (resolve_tac [major RS rtrancl_full_induct] 1); -by (fast_tac (comp_cs addIs prems) 1); -by (fast_tac (comp_cs addIs prems) 1); -val rtrancl_induct = result(); - -(*transitivity of transitive closure!! -- by induction.*) -goal Trancl.thy "trans(r^*)"; -by (rtac transI 1); -by (res_inst_tac [("b","z")] rtrancl_induct 1); -by (DEPTH_SOLVE (eresolve_tac [asm_rl, rtrancl_into_rtrancl] 1)); -val trans_rtrancl = result(); - -(*elimination of rtrancl -- by induction on a special formula*) -val major::prems = goal Trancl.thy - "[| : r^*; (a = b) ==> P; \ -\ !!y.[| : r^*; : r |] ==> P |] \ -\ ==> P"; -by (subgoal_tac "a = b | (EX y. : r^* & : r)" 1); -by (rtac (major RS rtrancl_induct) 2); -by (fast_tac (set_cs addIs prems) 2); -by (fast_tac (set_cs addIs prems) 2); -by (REPEAT (eresolve_tac ([asm_rl,exE,disjE,conjE]@prems) 1)); -val rtranclE = result(); - - -(**** The relation trancl ****) - -(** Conversions between trancl and rtrancl **) - -val [major] = goalw Trancl.thy [trancl_def] - "[| : r^+ |] ==> : r^*"; -by (resolve_tac [major RS compEpair] 1); -by (REPEAT (ares_tac [rtrancl_into_rtrancl] 1)); -val trancl_into_rtrancl = result(); - -(*r^+ contains r*) -val [prem] = goalw Trancl.thy [trancl_def] - "[| : r |] ==> : r^+"; -by (REPEAT (ares_tac [prem,compI,rtrancl_refl] 1)); -val r_into_trancl = result(); - -(*intro rule by definition: from rtrancl and r*) -val prems = goalw Trancl.thy [trancl_def] - "[| : r^*; : r |] ==> : r^+"; -by (REPEAT (resolve_tac ([compI]@prems) 1)); -val rtrancl_into_trancl1 = result(); - -(*intro rule from r and rtrancl*) -val prems = goal Trancl.thy - "[| : r; : r^* |] ==> : r^+"; -by (resolve_tac (prems RL [rtranclE]) 1); -by (etac subst 1); -by (resolve_tac (prems RL [r_into_trancl]) 1); -by (rtac (trans_rtrancl RS transD RS rtrancl_into_trancl1) 1); -by (REPEAT (ares_tac (prems@[r_into_rtrancl]) 1)); -val rtrancl_into_trancl2 = result(); - -(*elimination of r^+ -- NOT an induction rule*) -val major::prems = goal Trancl.thy - "[| : r^+; \ -\ : r ==> P; \ -\ !!y.[| : r^+; : r |] ==> P \ -\ |] ==> P"; -by (subgoal_tac " : r | (EX y. : r^+ & : r)" 1); -by (REPEAT (eresolve_tac ([asm_rl,disjE,exE,conjE]@prems) 1)); -by (rtac (rewrite_rule [trancl_def] major RS compEpair) 1); -by (etac rtranclE 1); -by (fast_tac comp_cs 1); -by (fast_tac (comp_cs addSIs [rtrancl_into_trancl1]) 1); -val tranclE = result(); - -(*Transitivity of r^+. - Proved by unfolding since it uses transitivity of rtrancl. *) -goalw Trancl.thy [trancl_def] "trans(r^+)"; -by (rtac transI 1); -by (REPEAT (etac compEpair 1)); -by (rtac (rtrancl_into_rtrancl RS (trans_rtrancl RS transD RS compI)) 1); -by (REPEAT (assume_tac 1)); -val trans_trancl = result(); - -val prems = goal Trancl.thy - "[| : r; : r^+ |] ==> : r^+"; -by (rtac (r_into_trancl RS (trans_trancl RS transD)) 1); -by (resolve_tac prems 1); -by (resolve_tac prems 1); -val trancl_into_trancl2 = result(); diff -r 19849d258890 -r 8018173a7979 src/CCL/trancl.thy --- a/src/CCL/trancl.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,28 +0,0 @@ -(* Title: CCL/trancl.thy - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Transitive closure of a relation -*) - -Trancl = CCL + - -consts - trans :: "i set => o" (*transitivity predicate*) - id :: "i set" - rtrancl :: "i set => i set" ("(_^*)" [100] 100) - trancl :: "i set => i set" ("(_^+)" [100] 100) - O :: "[i set,i set] => i set" (infixr 60) - -rules - -trans_def "trans(r) == (ALL x y z. :r --> :r --> :r)" -comp_def (*composition of relations*) - "r O s == {xz. EX x y z. xz = & :s & :r}" -id_def (*the identity relation*) - "id == {p. EX x. p = }" -rtrancl_def "r^* == lfp(%s. id Un (r O s))" -trancl_def "r^+ == r O rtrancl(r)" - -end diff -r 19849d258890 -r 8018173a7979 src/CCL/type.ML --- a/src/CCL/type.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,308 +0,0 @@ -(* Title: CCL/types - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -For types.thy. -*) - -open Type; - -val simp_type_defs = [Subtype_def,Unit_def,Bool_def,Plus_def,Sigma_def,Pi_def, - Lift_def,Tall_def,Tex_def]; -val ind_type_defs = [Nat_def,List_def]; - -val simp_data_defs = [one_def,inl_def,inr_def]; -val ind_data_defs = [zero_def,succ_def,nil_def,cons_def]; - -goal Set.thy "A <= B <-> (ALL x.x:A --> x:B)"; -by (fast_tac set_cs 1); -val subsetXH = result(); - -(*** Exhaustion Rules ***) - -fun mk_XH_tac thy defs rls s = prove_goalw thy defs s (fn _ => [cfast_tac rls 1]); -val XH_tac = mk_XH_tac Type.thy simp_type_defs []; - -val EmptyXH = XH_tac "a : {} <-> False"; -val SubtypeXH = XH_tac "a : {x:A.P(x)} <-> (a:A & P(a))"; -val UnitXH = XH_tac "a : Unit <-> a=one"; -val BoolXH = XH_tac "a : Bool <-> a=true | a=false"; -val PlusXH = XH_tac "a : A+B <-> (EX x:A.a=inl(x)) | (EX x:B.a=inr(x))"; -val PiXH = XH_tac "a : PROD x:A.B(x) <-> (EX b.a=lam x.b(x) & (ALL x:A.b(x):B(x)))"; -val SgXH = XH_tac "a : SUM x:A.B(x) <-> (EX x:A.EX y:B(x).a=)"; - -val XHs = [EmptyXH,SubtypeXH,UnitXH,BoolXH,PlusXH,PiXH,SgXH]; - -val LiftXH = XH_tac "a : [A] <-> (a=bot | a:A)"; -val TallXH = XH_tac "a : TALL X.B(X) <-> (ALL X. a:B(X))"; -val TexXH = XH_tac "a : TEX X.B(X) <-> (EX X. a:B(X))"; - -val case_rls = XH_to_Es XHs; - -(*** Canonical Type Rules ***) - -fun mk_canT_tac thy xhs s = prove_goal thy s - (fn prems => [fast_tac (set_cs addIs (prems @ (xhs RL [iffD2]))) 1]); -val canT_tac = mk_canT_tac Type.thy XHs; - -val oneT = canT_tac "one : Unit"; -val trueT = canT_tac "true : Bool"; -val falseT = canT_tac "false : Bool"; -val lamT = canT_tac "[| !!x.x:A ==> b(x):B(x) |] ==> lam x.b(x) : Pi(A,B)"; -val pairT = canT_tac "[| a:A; b:B(a) |] ==> :Sigma(A,B)"; -val inlT = canT_tac "a:A ==> inl(a) : A+B"; -val inrT = canT_tac "b:B ==> inr(b) : A+B"; - -val canTs = [oneT,trueT,falseT,pairT,lamT,inlT,inrT]; - -(*** Non-Canonical Type Rules ***) - -local -val lemma = prove_goal Type.thy "[| a:B(u); u=v |] ==> a : B(v)" - (fn prems => [cfast_tac prems 1]); -in -fun mk_ncanT_tac thy defs top_crls crls s = prove_goalw thy defs s - (fn major::prems => [(resolve_tac ([major] RL top_crls) 1), - (REPEAT_SOME (eresolve_tac (crls @ [exE,bexE,conjE,disjE]))), - (ALLGOALS (asm_simp_tac term_ss)), - (ALLGOALS (ares_tac (prems RL [lemma]) ORELSE' - eresolve_tac [bspec])), - (safe_tac (ccl_cs addSIs prems))]); -end; - -val ncanT_tac = mk_ncanT_tac Type.thy [] case_rls case_rls; - -val ifT = ncanT_tac - "[| b:Bool; b=true ==> t:A(true); b=false ==> u:A(false) |] ==> \ -\ if b then t else u : A(b)"; - -val applyT = ncanT_tac - "[| f : Pi(A,B); a:A |] ==> f ` a : B(a)"; - -val splitT = ncanT_tac - "[| p:Sigma(A,B); !!x y. [| x:A; y:B(x); p= |] ==> c(x,y):C() |] ==> \ -\ split(p,c):C(p)"; - -val whenT = ncanT_tac - "[| p:A+B; !!x.[| x:A; p=inl(x) |] ==> a(x):C(inl(x)); \ -\ !!y.[| y:B; p=inr(y) |] ==> b(y):C(inr(y)) |] ==> \ -\ when(p,a,b) : C(p)"; - -val ncanTs = [ifT,applyT,splitT,whenT]; - -(*** Subtypes ***) - -val SubtypeD1 = standard ((SubtypeXH RS iffD1) RS conjunct1); -val SubtypeD2 = standard ((SubtypeXH RS iffD1) RS conjunct2); - -val prems = goal Type.thy - "[| a:A; P(a) |] ==> a : {x:A. P(x)}"; -by (REPEAT (resolve_tac (prems@[SubtypeXH RS iffD2,conjI]) 1)); -val SubtypeI = result(); - -val prems = goal Type.thy - "[| a : {x:A. P(x)}; [| a:A; P(a) |] ==> Q |] ==> Q"; -by (REPEAT (resolve_tac (prems@[SubtypeD1,SubtypeD2]) 1)); -val SubtypeE = result(); - -(*** Monotonicity ***) - -goal Type.thy "mono (%X.X)"; -by (REPEAT (ares_tac [monoI] 1)); -val idM = result(); - -goal Type.thy "mono(%X.A)"; -by (REPEAT (ares_tac [monoI,subset_refl] 1)); -val constM = result(); - -val major::prems = goal Type.thy - "mono(%X.A(X)) ==> mono(%X.[A(X)])"; -br (subsetI RS monoI) 1; -bd (LiftXH RS iffD1) 1; -be disjE 1; -be (disjI1 RS (LiftXH RS iffD2)) 1; -br (disjI2 RS (LiftXH RS iffD2)) 1; -be (major RS monoD RS subsetD) 1; -ba 1; -val LiftM = result(); - -val prems = goal Type.thy - "[| mono(%X.A(X)); !!x X. x:A(X) ==> mono(%X.B(X,x)) |] ==> \ -\ mono(%X.Sigma(A(X),B(X)))"; -by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE - eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE - (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE - hyp_subst_tac 1)); -val SgM = result(); - -val prems = goal Type.thy - "[| !!x. x:A ==> mono(%X.B(X,x)) |] ==> mono(%X.Pi(A,B(X)))"; -by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE - eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE - (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE - hyp_subst_tac 1)); -val PiM = result(); - -val prems = goal Type.thy - "[| mono(%X.A(X)); mono(%X.B(X)) |] ==> mono(%X.A(X)+B(X))"; -by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE - eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE - (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE - hyp_subst_tac 1)); -val PlusM = result(); - -(**************** RECURSIVE TYPES ******************) - -(*** Conversion Rules for Fixed Points via monotonicity and Tarski ***) - -goal Type.thy "mono(%X.Unit+X)"; -by (REPEAT (ares_tac [PlusM,constM,idM] 1)); -val NatM = result(); -val def_NatB = result() RS (Nat_def RS def_lfp_Tarski); - -goal Type.thy "mono(%X.(Unit+Sigma(A,%y.X)))"; -by (REPEAT (ares_tac [PlusM,SgM,constM,idM] 1)); -val ListM = result(); -val def_ListB = result() RS (List_def RS def_lfp_Tarski); -val def_ListsB = result() RS (Lists_def RS def_gfp_Tarski); - -goal Type.thy "mono(%X.({} + Sigma(A,%y.X)))"; -by (REPEAT (ares_tac [PlusM,SgM,constM,idM] 1)); -val IListsM = result(); -val def_IListsB = result() RS (ILists_def RS def_gfp_Tarski); - -val ind_type_eqs = [def_NatB,def_ListB,def_ListsB,def_IListsB]; - -(*** Exhaustion Rules ***) - -fun mk_iXH_tac teqs ddefs rls s = prove_goalw Type.thy ddefs s - (fn _ => [resolve_tac (teqs RL [XHlemma1]) 1, - fast_tac (set_cs addSIs canTs addSEs case_rls) 1]); - -val iXH_tac = mk_iXH_tac ind_type_eqs ind_data_defs []; - -val NatXH = iXH_tac "a : Nat <-> (a=zero | (EX x:Nat.a=succ(x)))"; -val ListXH = iXH_tac "a : List(A) <-> (a=[] | (EX x:A.EX xs:List(A).a=x$xs))"; -val ListsXH = iXH_tac "a : Lists(A) <-> (a=[] | (EX x:A.EX xs:Lists(A).a=x$xs))"; -val IListsXH = iXH_tac "a : ILists(A) <-> (EX x:A.EX xs:ILists(A).a=x$xs)"; - -val iXHs = [NatXH,ListXH]; -val icase_rls = XH_to_Es iXHs; - -(*** Type Rules ***) - -val icanT_tac = mk_canT_tac Type.thy iXHs; -val incanT_tac = mk_ncanT_tac Type.thy [] icase_rls case_rls; - -val zeroT = icanT_tac "zero : Nat"; -val succT = icanT_tac "n:Nat ==> succ(n) : Nat"; -val nilT = icanT_tac "[] : List(A)"; -val consT = icanT_tac "[| h:A; t:List(A) |] ==> h$t : List(A)"; - -val icanTs = [zeroT,succT,nilT,consT]; - -val ncaseT = incanT_tac - "[| n:Nat; n=zero ==> b:C(zero); \ -\ !!x.[| x:Nat; n=succ(x) |] ==> c(x):C(succ(x)) |] ==> \ -\ ncase(n,b,c) : C(n)"; - -val lcaseT = incanT_tac - "[| l:List(A); l=[] ==> b:C([]); \ -\ !!h t.[| h:A; t:List(A); l=h$t |] ==> c(h,t):C(h$t) |] ==> \ -\ lcase(l,b,c) : C(l)"; - -val incanTs = [ncaseT,lcaseT]; - -(*** Induction Rules ***) - -val ind_Ms = [NatM,ListM]; - -fun mk_ind_tac ddefs tdefs Ms canTs case_rls s = prove_goalw Type.thy ddefs s - (fn major::prems => [resolve_tac (Ms RL ([major] RL (tdefs RL [def_induct]))) 1, - fast_tac (set_cs addSIs (prems @ canTs) addSEs case_rls) 1]); - -val ind_tac = mk_ind_tac ind_data_defs ind_type_defs ind_Ms canTs case_rls; - -val Nat_ind = ind_tac - "[| n:Nat; P(zero); !!x.[| x:Nat; P(x) |] ==> P(succ(x)) |] ==> \ -\ P(n)"; - -val List_ind = ind_tac - "[| l:List(A); P([]); \ -\ !!x xs.[| x:A; xs:List(A); P(xs) |] ==> P(x$xs) |] ==> \ -\ P(l)"; - -val inds = [Nat_ind,List_ind]; - -(*** Primitive Recursive Rules ***) - -fun mk_prec_tac inds s = prove_goal Type.thy s - (fn major::prems => [resolve_tac ([major] RL inds) 1, - ALLGOALS (simp_tac term_ss THEN' - fast_tac (set_cs addSIs prems))]); -val prec_tac = mk_prec_tac inds; - -val nrecT = prec_tac - "[| n:Nat; b:C(zero); \ -\ !!x g.[| x:Nat; g:C(x) |] ==> c(x,g):C(succ(x)) |] ==> \ -\ nrec(n,b,c) : C(n)"; - -val lrecT = prec_tac - "[| l:List(A); b:C([]); \ -\ !!x xs g.[| x:A; xs:List(A); g:C(xs) |] ==> c(x,xs,g):C(x$xs) |] ==> \ -\ lrec(l,b,c) : C(l)"; - -val precTs = [nrecT,lrecT]; - - -(*** Theorem proving ***) - -val [major,minor] = goal Type.thy - "[| : Sigma(A,B); [| a:A; b:B(a) |] ==> P \ -\ |] ==> P"; -br (major RS (XH_to_E SgXH)) 1; -br minor 1; -by (ALLGOALS (fast_tac term_cs)); -val SgE2 = result(); - -(* General theorem proving ignores non-canonical term-formers, *) -(* - intro rules are type rules for canonical terms *) -(* - elim rules are case rules (no non-canonical terms appear) *) - -val type_cs = term_cs addSIs (SubtypeI::(canTs @ icanTs)) - addSEs (SubtypeE::(XH_to_Es XHs)); - - -(*** Infinite Data Types ***) - -val [mono] = goal Type.thy "mono(f) ==> lfp(f) <= gfp(f)"; -br (lfp_lowerbound RS subset_trans) 1; -br (mono RS gfp_lemma3) 1; -br subset_refl 1; -val lfp_subset_gfp = result(); - -val prems = goal Type.thy - "[| a:A; !!x X.[| x:A; ALL y:A.t(y):X |] ==> t(x) : B(X) |] ==> \ -\ t(a) : gfp(B)"; -br coinduct 1; -by (res_inst_tac [("P","%x.EX y:A.x=t(y)")] CollectI 1); -by (ALLGOALS (fast_tac (ccl_cs addSIs prems))); -val gfpI = result(); - -val rew::prem::prems = goal Type.thy - "[| C==gfp(B); a:A; !!x X.[| x:A; ALL y:A.t(y):X |] ==> t(x) : B(X) |] ==> \ -\ t(a) : C"; -by (rewtac rew); -by (REPEAT (ares_tac ((prem RS gfpI)::prems) 1)); -val def_gfpI = result(); - -(* EG *) - -val prems = goal Type.thy - "letrec g x be zero$g(x) in g(bot) : Lists(Nat)"; -by (rtac (refl RS (XH_to_I UnitXH) RS (Lists_def RS def_gfpI)) 1); -br (letrecB RS ssubst) 1; -bw cons_def; -by (fast_tac type_cs 1); -result(); diff -r 19849d258890 -r 8018173a7979 src/CCL/type.thy --- a/src/CCL/type.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -(* Title: CCL/types.thy - ID: $Id$ - Author: Martin Coen - Copyright 1993 University of Cambridge - -Types in CCL are defined as sets of terms. - -*) - -Type = Term + - -consts - - Subtype :: "['a set, 'a => o] => 'a set" - Bool :: "i set" - Unit :: "i set" - "+" :: "[i set, i set] => i set" (infixr 55) - Pi :: "[i set, i => i set] => i set" - Sigma :: "[i set, i => i set] => i set" - Nat :: "i set" - List :: "i set => i set" - Lists :: "i set => i set" - ILists :: "i set => i set" - TAll :: "(i set => i set) => i set" (binder "TALL " 55) - TEx :: "(i set => i set) => i set" (binder "TEX " 55) - Lift :: "i set => i set" ("(3[_])") - - SPLIT :: "[i, [i, i] => i set] => i set" - - "@Pi" :: "[idt, i set, i set] => i set" ("(3PROD _:_./ _)" [] 60) - "@Sigma" :: "[idt, i set, i set] => i set" ("(3SUM _:_./ _)" [] 60) - "@->" :: "[i set, i set] => i set" ("(_ ->/ _)" [54, 53] 53) - "@*" :: "[i set, i set] => i set" ("(_ */ _)" [56, 55] 55) - "@Subtype" :: "[idt, 'a set, o] => 'a set" ("(1{_: _ ./ _})") - -translations - "PROD x:A. B" => "Pi(A, %x. B)" - "A -> B" => "Pi(A, _K(B))" - "SUM x:A. B" => "Sigma(A, %x. B)" - "A * B" => "Sigma(A, _K(B))" - "{x: A. B}" == "Subtype(A, %x. B)" - -rules - - Subtype_def "{x:A.P(x)} == {x.x:A & P(x)}" - Unit_def "Unit == {x.x=one}" - Bool_def "Bool == {x.x=true | x=false}" - Plus_def "A+B == {x. (EX a:A.x=inl(a)) | (EX b:B.x=inr(b))}" - Pi_def "Pi(A,B) == {x.EX b.x=lam x.b(x) & (ALL x:A.b(x):B(x))}" - Sigma_def "Sigma(A,B) == {x.EX a:A.EX b:B(a).x=}" - Nat_def "Nat == lfp(% X.Unit + X)" - List_def "List(A) == lfp(% X.Unit + A*X)" - - Lists_def "Lists(A) == gfp(% X.Unit + A*X)" - ILists_def "ILists(A) == gfp(% X.{} + A*X)" - - Tall_def "TALL X.B(X) == Inter({X.EX Y.X=B(Y)})" - Tex_def "TEX X.B(X) == Union({X.EX Y.X=B(Y)})" - Lift_def "[A] == A Un {bot}" - - SPLIT_def "SPLIT(p,B) == Union({A.EX x y.p= & A=B(x,y)})" - -end - - -ML - -val print_translation = - [("Pi", dependent_tr' ("@Pi", "@->")), - ("Sigma", dependent_tr' ("@Sigma", "@*"))]; - diff -r 19849d258890 -r 8018173a7979 src/CCL/wfd.ML --- a/src/CCL/wfd.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,204 +0,0 @@ -(* Title: CCL/wfd.ML - ID: $Id$ - -For wfd.thy. - -Based on - Titles: ZF/wf.ML and HOL/ex/lex-prod - Authors: Lawrence C Paulson and Tobias Nipkow - Copyright 1992 University of Cambridge - -*) - -open Wfd; - -(***********) - -val [major,prem] = goalw Wfd.thy [Wfd_def] - "[| Wfd(R); \ -\ !!x.[| ALL y. : R --> P(y) |] ==> P(x) |] ==> \ -\ P(a)"; -by (rtac (major RS spec RS mp RS spec RS CollectD) 1); -by (fast_tac (set_cs addSIs [prem RS CollectI]) 1); -val wfd_induct = result(); - -val [p1,p2,p3] = goal Wfd.thy - "[| !!x y. : R ==> Q(x); \ -\ ALL x. (ALL y. : R --> y : P) --> x : P; \ -\ !!x.Q(x) ==> x:P |] ==> a:P"; -br (p2 RS spec RS mp) 1; -by (fast_tac (set_cs addSIs [p1 RS p3]) 1); -val wfd_strengthen_lemma = result(); - -fun wfd_strengthen_tac s i = res_inst_tac [("Q",s)] wfd_strengthen_lemma i THEN - assume_tac (i+1); - -val wfd::prems = goal Wfd.thy "[| Wfd(r); :r; :r |] ==> P"; -by (subgoal_tac "ALL x. :r --> :r --> P" 1); -by (fast_tac (FOL_cs addIs prems) 1); -br (wfd RS wfd_induct) 1; -by (ALLGOALS (fast_tac (ccl_cs addSIs prems))); -val wf_anti_sym = result(); - -val prems = goal Wfd.thy "[| Wfd(r); : r |] ==> P"; -by (rtac wf_anti_sym 1); -by (REPEAT (resolve_tac prems 1)); -val wf_anti_refl = result(); - -(*** Irreflexive transitive closure ***) - -val [prem] = goal Wfd.thy "Wfd(R) ==> Wfd(R^+)"; -by (rewtac Wfd_def); -by (REPEAT (ares_tac [allI,ballI,impI] 1)); -(*must retain the universal formula for later use!*) -by (rtac allE 1 THEN assume_tac 1); -by (etac mp 1); -br (prem RS wfd_induct) 1; -by (rtac (impI RS allI) 1); -by (etac tranclE 1); -by (fast_tac ccl_cs 1); -be (spec RS mp RS spec RS mp) 1; -by (REPEAT (atac 1)); -val trancl_wf = result(); - -(*** Lexicographic Ordering ***) - -goalw Wfd.thy [lex_def] - "p : ra**rb <-> (EX a a' b b'.p = <,> & ( : ra | a=a' & : rb))"; -by (fast_tac ccl_cs 1); -val lexXH = result(); - -val prems = goal Wfd.thy - " : ra ==> <,> : ra**rb"; -by (fast_tac (ccl_cs addSIs (prems @ [lexXH RS iffD2])) 1); -val lexI1 = result(); - -val prems = goal Wfd.thy - " : rb ==> <,> : ra**rb"; -by (fast_tac (ccl_cs addSIs (prems @ [lexXH RS iffD2])) 1); -val lexI2 = result(); - -val major::prems = goal Wfd.thy - "[| p : ra**rb; \ -\ !!a a' b b'.[| : ra; p=<,> |] ==> R; \ -\ !!a b b'.[| : rb; p = <,> |] ==> R |] ==> \ -\ R"; -br (major RS (lexXH RS iffD1) RS exE) 1; -by (REPEAT_SOME (eresolve_tac ([exE,conjE,disjE]@prems))); -by (ALLGOALS (fast_tac ccl_cs)); -val lexE = result(); - -val [major,minor] = goal Wfd.thy - "[| p : r**s; !!a a' b b'. p = <,> ==> P |] ==>P"; -br (major RS lexE) 1; -by (ALLGOALS (fast_tac (set_cs addSEs [minor]))); -val lex_pair = result(); - -val [wfa,wfb] = goal Wfd.thy - "[| Wfd(R); Wfd(S) |] ==> Wfd(R**S)"; -bw Wfd_def; -by (safe_tac ccl_cs); -by (wfd_strengthen_tac "%x.EX a b.x=" 1); -by (fast_tac (term_cs addSEs [lex_pair]) 1); -by (subgoal_tac "ALL a b.:P" 1); -by (fast_tac ccl_cs 1); -br (wfa RS wfd_induct RS allI) 1; -br (wfb RS wfd_induct RS allI) 1;back(); -by (fast_tac (type_cs addSEs [lexE]) 1); -val lex_wf = result(); - -(*** Mapping ***) - -goalw Wfd.thy [wmap_def] - "p : wmap(f,r) <-> (EX x y. p= & : r)"; -by (fast_tac ccl_cs 1); -val wmapXH = result(); - -val prems = goal Wfd.thy - " : r ==> : wmap(f,r)"; -by (fast_tac (ccl_cs addSIs (prems @ [wmapXH RS iffD2])) 1); -val wmapI = result(); - -val major::prems = goal Wfd.thy - "[| p : wmap(f,r); !!a b.[| : r; p= |] ==> R |] ==> R"; -br (major RS (wmapXH RS iffD1) RS exE) 1; -by (REPEAT_SOME (eresolve_tac ([exE,conjE,disjE]@prems))); -by (ALLGOALS (fast_tac ccl_cs)); -val wmapE = result(); - -val [wf] = goal Wfd.thy - "Wfd(r) ==> Wfd(wmap(f,r))"; -bw Wfd_def; -by (safe_tac ccl_cs); -by (subgoal_tac "ALL b.ALL a.f(a)=b-->a:P" 1); -by (fast_tac ccl_cs 1); -br (wf RS wfd_induct RS allI) 1; -by (safe_tac ccl_cs); -be (spec RS mp) 1; -by (safe_tac (ccl_cs addSEs [wmapE])); -be (spec RS mp RS spec RS mp) 1; -ba 1; -br refl 1; -val wmap_wf = result(); - -(* Projections *) - -val prems = goal Wfd.thy " : r ==> <,> : wmap(fst,r)"; -br wmapI 1; -by (simp_tac (term_ss addsimps prems) 1); -val wfstI = result(); - -val prems = goal Wfd.thy " : r ==> <,> : wmap(snd,r)"; -br wmapI 1; -by (simp_tac (term_ss addsimps prems) 1); -val wsndI = result(); - -val prems = goal Wfd.thy " : r ==> <>,>> : wmap(thd,r)"; -br wmapI 1; -by (simp_tac (term_ss addsimps prems) 1); -val wthdI = result(); - -(*** Ground well-founded relations ***) - -val prems = goalw Wfd.thy [wf_def] - "[| Wfd(r); a : r |] ==> a : wf(r)"; -by (fast_tac (set_cs addSIs prems) 1); -val wfI = result(); - -val prems = goalw Wfd.thy [Wfd_def] "Wfd({})"; -by (fast_tac (set_cs addEs [EmptyXH RS iffD1 RS FalseE]) 1); -val Empty_wf = result(); - -val prems = goalw Wfd.thy [wf_def] "Wfd(wf(R))"; -by (res_inst_tac [("Q","Wfd(R)")] (excluded_middle RS disjE) 1); -by (ALLGOALS (asm_simp_tac CCL_ss)); -br Empty_wf 1; -val wf_wf = result(); - -goalw Wfd.thy [NatPR_def] "p : NatPR <-> (EX x:Nat.p=)"; -by (fast_tac set_cs 1); -val NatPRXH = result(); - -goalw Wfd.thy [ListPR_def] "p : ListPR(A) <-> (EX h:A.EX t:List(A).p=)"; -by (fast_tac set_cs 1); -val ListPRXH = result(); - -val NatPRI = refl RS (bexI RS (NatPRXH RS iffD2)); -val ListPRI = refl RS (bexI RS (bexI RS (ListPRXH RS iffD2))); - -goalw Wfd.thy [Wfd_def] "Wfd(NatPR)"; -by (safe_tac set_cs); -by (wfd_strengthen_tac "%x.x:Nat" 1); -by (fast_tac (type_cs addSEs [XH_to_E NatPRXH]) 1); -be Nat_ind 1; -by (ALLGOALS (fast_tac (type_cs addEs [XH_to_E NatPRXH]))); -val NatPR_wf = result(); - -goalw Wfd.thy [Wfd_def] "Wfd(ListPR(A))"; -by (safe_tac set_cs); -by (wfd_strengthen_tac "%x.x:List(A)" 1); -by (fast_tac (type_cs addSEs [XH_to_E ListPRXH]) 1); -be List_ind 1; -by (ALLGOALS (fast_tac (type_cs addEs [XH_to_E ListPRXH]))); -val ListPR_wf = result(); - diff -r 19849d258890 -r 8018173a7979 src/CCL/wfd.thy --- a/src/CCL/wfd.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -(* Title: CCL/wfd.thy - ID: $Id$ - Author: Martin Coen, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Well-founded relations in CCL. -*) - -Wfd = Trancl + Type + - -consts - (*** Predicates ***) - Wfd :: "[i set] => o" - (*** Relations ***) - wf :: "[i set] => i set" - wmap :: "[i=>i,i set] => i set" - "**" :: "[i set,i set] => i set" (infixl 70) - NatPR :: "i set" - ListPR :: "i set => i set" - -rules - - Wfd_def - "Wfd(R) == ALL P.(ALL x.(ALL y. : R --> y:P) --> x:P) --> (ALL a.a:P)" - - wf_def "wf(R) == {x.x:R & Wfd(R)}" - - wmap_def "wmap(f,R) == {p. EX x y. p= & : R}" - lex_def - "ra**rb == {p. EX a a' b b'.p = <,> & ( : ra | (a=a' & : rb))}" - - NatPR_def "NatPR == {p.EX x:Nat. p=}" - ListPR_def "ListPR(A) == {p.EX h:A.EX t:List(A). p=}" -end diff -r 19849d258890 -r 8018173a7979 src/CTT/arith.ML --- a/src/CTT/arith.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,497 +0,0 @@ -(* Title: CTT/arith - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -Theorems for arith.thy (Arithmetic operators) - -Proofs about elementary arithmetic: addition, multiplication, etc. -Tests definitions and simplifier. -*) - -open Arith; -val arith_defs = [add_def, diff_def, absdiff_def, mult_def, mod_def, div_def]; - - -(** Addition *) - -(*typing of add: short and long versions*) - -val add_typing = prove_goal Arith.thy - "[| a:N; b:N |] ==> a #+ b : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (typechk_tac prems) ]); - -val add_typingL = prove_goal Arith.thy - "[| a=c:N; b=d:N |] ==> a #+ b = c #+ d : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (equal_tac prems) ]); - - -(*computation for add: 0 and successor cases*) - -val addC0 = prove_goal Arith.thy - "b:N ==> 0 #+ b = b : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (rew_tac prems) ]); - -val addC_succ = prove_goal Arith.thy - "[| a:N; b:N |] ==> succ(a) #+ b = succ(a #+ b) : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (rew_tac prems) ]); - - -(** Multiplication *) - -(*typing of mult: short and long versions*) - -val mult_typing = prove_goal Arith.thy - "[| a:N; b:N |] ==> a #* b : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (typechk_tac([add_typing]@prems)) ]); - -val mult_typingL = prove_goal Arith.thy - "[| a=c:N; b=d:N |] ==> a #* b = c #* d : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (equal_tac (prems@[add_typingL])) ]); - -(*computation for mult: 0 and successor cases*) - -val multC0 = prove_goal Arith.thy - "b:N ==> 0 #* b = 0 : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (rew_tac prems) ]); - -val multC_succ = prove_goal Arith.thy - "[| a:N; b:N |] ==> succ(a) #* b = b #+ (a #* b) : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (rew_tac prems) ]); - - -(** Difference *) - -(*typing of difference*) - -val diff_typing = prove_goal Arith.thy - "[| a:N; b:N |] ==> a - b : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (typechk_tac prems) ]); - -val diff_typingL = prove_goal Arith.thy - "[| a=c:N; b=d:N |] ==> a - b = c - d : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (equal_tac prems) ]); - - - -(*computation for difference: 0 and successor cases*) - -val diffC0 = prove_goal Arith.thy - "a:N ==> a - 0 = a : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (rew_tac prems) ]); - -(*Note: rec(a, 0, %z w.z) is pred(a). *) - -val diff_0_eq_0 = prove_goal Arith.thy - "b:N ==> 0 - b = 0 : N" - (fn prems=> - [ (NE_tac "b" 1), - (rewrite_goals_tac arith_defs), - (hyp_rew_tac prems) ]); - - -(*Essential to simplify FIRST!! (Else we get a critical pair) - succ(a) - succ(b) rewrites to pred(succ(a) - b) *) -val diff_succ_succ = prove_goal Arith.thy - "[| a:N; b:N |] ==> succ(a) - succ(b) = a - b : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (hyp_rew_tac prems), - (NE_tac "b" 1), - (hyp_rew_tac prems) ]); - - - -(*** Simplification *) - -val arith_typing_rls = - [add_typing, mult_typing, diff_typing]; - -val arith_congr_rls = - [add_typingL, mult_typingL, diff_typingL]; - -val congr_rls = arith_congr_rls@standard_congr_rls; - -val arithC_rls = - [addC0, addC_succ, - multC0, multC_succ, - diffC0, diff_0_eq_0, diff_succ_succ]; - - -structure Arith_simp_data: TSIMP_DATA = - struct - val refl = refl_elem - val sym = sym_elem - val trans = trans_elem - val refl_red = refl_red - val trans_red = trans_red - val red_if_equal = red_if_equal - val default_rls = arithC_rls @ comp_rls - val routine_tac = routine_tac (arith_typing_rls @ routine_rls) - end; - -structure Arith_simp = TSimpFun (Arith_simp_data); - -fun arith_rew_tac prems = make_rew_tac - (Arith_simp.norm_tac(congr_rls, prems)); - -fun hyp_arith_rew_tac prems = make_rew_tac - (Arith_simp.cond_norm_tac(prove_cond_tac, congr_rls, prems)); - - -(********** - Addition - **********) - -(*Associative law for addition*) -val add_assoc = prove_goal Arith.thy - "[| a:N; b:N; c:N |] ==> (a #+ b) #+ c = a #+ (b #+ c) : N" - (fn prems=> - [ (NE_tac "a" 1), - (hyp_arith_rew_tac prems) ]); - - -(*Commutative law for addition. Can be proved using three inductions. - Must simplify after first induction! Orientation of rewrites is delicate*) -val add_commute = prove_goal Arith.thy - "[| a:N; b:N |] ==> a #+ b = b #+ a : N" - (fn prems=> - [ (NE_tac "a" 1), - (hyp_arith_rew_tac prems), - (NE_tac "b" 2), - (resolve_tac [sym_elem] 1), - (NE_tac "b" 1), - (hyp_arith_rew_tac prems) ]); - - -(**************** - Multiplication - ****************) - -(*Commutative law for multiplication -val mult_commute = prove_goal Arith.thy - "[| a:N; b:N |] ==> a #* b = b #* a : N" - (fn prems=> - [ (NE_tac "a" 1), - (hyp_arith_rew_tac prems), - (NE_tac "b" 2), - (resolve_tac [sym_elem] 1), - (NE_tac "b" 1), - (hyp_arith_rew_tac prems) ]); NEEDS COMMUTATIVE MATCHING -***************) - -(*right annihilation in product*) -val mult_0_right = prove_goal Arith.thy - "a:N ==> a #* 0 = 0 : N" - (fn prems=> - [ (NE_tac "a" 1), - (hyp_arith_rew_tac prems) ]); - -(*right successor law for multiplication*) -val mult_succ_right = prove_goal Arith.thy - "[| a:N; b:N |] ==> a #* succ(b) = a #+ (a #* b) : N" - (fn prems=> - [ (NE_tac "a" 1), -(*swap round the associative law of addition*) - (hyp_arith_rew_tac (prems @ [add_assoc RS sym_elem])), -(*leaves a goal involving a commutative law*) - (REPEAT (assume_tac 1 ORELSE - resolve_tac - (prems@[add_commute,mult_typingL,add_typingL]@ - intrL_rls@[refl_elem]) 1)) ]); - -(*Commutative law for multiplication*) -val mult_commute = prove_goal Arith.thy - "[| a:N; b:N |] ==> a #* b = b #* a : N" - (fn prems=> - [ (NE_tac "a" 1), - (hyp_arith_rew_tac (prems @ [mult_0_right, mult_succ_right])) ]); - -(*addition distributes over multiplication*) -val add_mult_distrib = prove_goal Arith.thy - "[| a:N; b:N; c:N |] ==> (a #+ b) #* c = (a #* c) #+ (b #* c) : N" - (fn prems=> - [ (NE_tac "a" 1), -(*swap round the associative law of addition*) - (hyp_arith_rew_tac (prems @ [add_assoc RS sym_elem])) ]); - - -(*Associative law for multiplication*) -val mult_assoc = prove_goal Arith.thy - "[| a:N; b:N; c:N |] ==> (a #* b) #* c = a #* (b #* c) : N" - (fn prems=> - [ (NE_tac "a" 1), - (hyp_arith_rew_tac (prems @ [add_mult_distrib])) ]); - - -(************ - Difference - ************ - -Difference on natural numbers, without negative numbers - a - b = 0 iff a<=b a - b = succ(c) iff a>b *) - -val diff_self_eq_0 = prove_goal Arith.thy - "a:N ==> a - a = 0 : N" - (fn prems=> - [ (NE_tac "a" 1), - (hyp_arith_rew_tac prems) ]); - - -(* [| c : N; 0 : N; c : N |] ==> c #+ 0 = c : N *) -val add_0_right = addC0 RSN (3, add_commute RS trans_elem); - -(*Addition is the inverse of subtraction: if b<=x then b#+(x-b) = x. - An example of induction over a quantified formula (a product). - Uses rewriting with a quantified, implicative inductive hypothesis.*) -val prems = -goal Arith.thy - "b:N ==> ?a : PROD x:N. Eq(N, b-x, 0) --> Eq(N, b #+ (x-b), x)"; -by (NE_tac "b" 1); -(*strip one "universal quantifier" but not the "implication"*) -by (resolve_tac intr_rls 3); -(*case analysis on x in - (succ(u) <= x) --> (succ(u)#+(x-succ(u)) = x) *) -by (NE_tac "x" 4 THEN assume_tac 4); -(*Prepare for simplification of types -- the antecedent succ(u)<=x *) -by (resolve_tac [replace_type] 5); -by (resolve_tac [replace_type] 4); -by (arith_rew_tac prems); -(*Solves first 0 goal, simplifies others. Two sugbgoals remain. - Both follow by rewriting, (2) using quantified induction hyp*) -by (intr_tac[]); (*strips remaining PRODs*) -by (hyp_arith_rew_tac (prems@[add_0_right])); -by (assume_tac 1); -val add_diff_inverse_lemma = result(); - - -(*Version of above with premise b-a=0 i.e. a >= b. - Using ProdE does not work -- for ?B(?a) is ambiguous. - Instead, add_diff_inverse_lemma states the desired induction scheme; - the use of RS below instantiates Vars in ProdE automatically. *) -val prems = -goal Arith.thy "[| a:N; b:N; b-a = 0 : N |] ==> b #+ (a-b) = a : N"; -by (resolve_tac [EqE] 1); -by (resolve_tac [ add_diff_inverse_lemma RS ProdE RS ProdE ] 1); -by (REPEAT (resolve_tac (prems@[EqI]) 1)); -val add_diff_inverse = result(); - - -(******************** - Absolute difference - ********************) - -(*typing of absolute difference: short and long versions*) - -val absdiff_typing = prove_goal Arith.thy - "[| a:N; b:N |] ==> a |-| b : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (typechk_tac prems) ]); - -val absdiff_typingL = prove_goal Arith.thy - "[| a=c:N; b=d:N |] ==> a |-| b = c |-| d : N" - (fn prems=> - [ (rewrite_goals_tac arith_defs), - (equal_tac prems) ]); - -val absdiff_self_eq_0 = prove_goal Arith.thy - "a:N ==> a |-| a = 0 : N" - (fn prems=> - [ (rewrite_goals_tac [absdiff_def]), - (arith_rew_tac (prems@[diff_self_eq_0])) ]); - -val absdiffC0 = prove_goal Arith.thy - "a:N ==> 0 |-| a = a : N" - (fn prems=> - [ (rewrite_goals_tac [absdiff_def]), - (hyp_arith_rew_tac prems) ]); - - -val absdiff_succ_succ = prove_goal Arith.thy - "[| a:N; b:N |] ==> succ(a) |-| succ(b) = a |-| b : N" - (fn prems=> - [ (rewrite_goals_tac [absdiff_def]), - (hyp_arith_rew_tac prems) ]); - -(*Note how easy using commutative laws can be? ...not always... *) -val prems = goal Arith.thy "[| a:N; b:N |] ==> a |-| b = b |-| a : N"; -by (rewrite_goals_tac [absdiff_def]); -by (resolve_tac [add_commute] 1); -by (typechk_tac ([diff_typing]@prems)); -val absdiff_commute = result(); - -(*If a+b=0 then a=0. Surprisingly tedious*) -val prems = -goal Arith.thy "[| a:N; b:N |] ==> ?c : PROD u: Eq(N,a#+b,0) . Eq(N,a,0)"; -by (NE_tac "a" 1); -by (resolve_tac [replace_type] 3); -by (arith_rew_tac prems); -by (intr_tac[]); (*strips remaining PRODs*) -by (resolve_tac [ zero_ne_succ RS FE ] 2); -by (etac (EqE RS sym_elem) 3); -by (typechk_tac ([add_typing] @prems)); -val add_eq0_lemma = result(); - -(*Version of above with the premise a+b=0. - Again, resolution instantiates variables in ProdE *) -val prems = -goal Arith.thy "[| a:N; b:N; a #+ b = 0 : N |] ==> a = 0 : N"; -by (resolve_tac [EqE] 1); -by (resolve_tac [add_eq0_lemma RS ProdE] 1); -by (resolve_tac [EqI] 3); -by (ALLGOALS (resolve_tac prems)); -val add_eq0 = result(); - -(*Here is a lemma to infer a-b=0 and b-a=0 from a|-|b=0, below. *) -val prems = goal Arith.thy - "[| a:N; b:N; a |-| b = 0 : N |] ==> \ -\ ?a : SUM v: Eq(N, a-b, 0) . Eq(N, b-a, 0)"; -by (intr_tac[]); -by eqintr_tac; -by (resolve_tac [add_eq0] 2); -by (resolve_tac [add_eq0] 1); -by (resolve_tac [add_commute RS trans_elem] 6); -by (typechk_tac (diff_typing:: map (rewrite_rule [absdiff_def]) prems)); -val absdiff_eq0_lem = result(); - -(*if a |-| b = 0 then a = b - proof: a-b=0 and b-a=0, so b = a+(b-a) = a+0 = a*) -val prems = -goal Arith.thy "[| a |-| b = 0 : N; a:N; b:N |] ==> a = b : N"; -by (resolve_tac [EqE] 1); -by (resolve_tac [absdiff_eq0_lem RS SumE] 1); -by (TRYALL (resolve_tac prems)); -by eqintr_tac; -by (resolve_tac [add_diff_inverse RS sym_elem RS trans_elem] 1); -by (resolve_tac [EqE] 3 THEN assume_tac 3); -by (hyp_arith_rew_tac (prems@[add_0_right])); -val absdiff_eq0 = result(); - -(*********************** - Remainder and Quotient - ***********************) - -(*typing of remainder: short and long versions*) - -val mod_typing = prove_goal Arith.thy - "[| a:N; b:N |] ==> a mod b : N" - (fn prems=> - [ (rewrite_goals_tac [mod_def]), - (typechk_tac (absdiff_typing::prems)) ]); - -val mod_typingL = prove_goal Arith.thy - "[| a=c:N; b=d:N |] ==> a mod b = c mod d : N" - (fn prems=> - [ (rewrite_goals_tac [mod_def]), - (equal_tac (prems@[absdiff_typingL])) ]); - - -(*computation for mod : 0 and successor cases*) - -val modC0 = prove_goal Arith.thy "b:N ==> 0 mod b = 0 : N" - (fn prems=> - [ (rewrite_goals_tac [mod_def]), - (rew_tac(absdiff_typing::prems)) ]); - -val modC_succ = prove_goal Arith.thy -"[| a:N; b:N |] ==> succ(a) mod b = rec(succ(a mod b) |-| b, 0, %x y.succ(a mod b)) : N" - (fn prems=> - [ (rewrite_goals_tac [mod_def]), - (rew_tac(absdiff_typing::prems)) ]); - - -(*typing of quotient: short and long versions*) - -val div_typing = prove_goal Arith.thy "[| a:N; b:N |] ==> a div b : N" - (fn prems=> - [ (rewrite_goals_tac [div_def]), - (typechk_tac ([absdiff_typing,mod_typing]@prems)) ]); - -val div_typingL = prove_goal Arith.thy - "[| a=c:N; b=d:N |] ==> a div b = c div d : N" - (fn prems=> - [ (rewrite_goals_tac [div_def]), - (equal_tac (prems @ [absdiff_typingL, mod_typingL])) ]); - -val div_typing_rls = [mod_typing, div_typing, absdiff_typing]; - - -(*computation for quotient: 0 and successor cases*) - -val divC0 = prove_goal Arith.thy "b:N ==> 0 div b = 0 : N" - (fn prems=> - [ (rewrite_goals_tac [div_def]), - (rew_tac([mod_typing, absdiff_typing] @ prems)) ]); - -val divC_succ = -prove_goal Arith.thy "[| a:N; b:N |] ==> succ(a) div b = \ -\ rec(succ(a) mod b, succ(a div b), %x y. a div b) : N" - (fn prems=> - [ (rewrite_goals_tac [div_def]), - (rew_tac([mod_typing]@prems)) ]); - - -(*Version of above with same condition as the mod one*) -val divC_succ2 = prove_goal Arith.thy - "[| a:N; b:N |] ==> \ -\ succ(a) div b =rec(succ(a mod b) |-| b, succ(a div b), %x y. a div b) : N" - (fn prems=> - [ (resolve_tac [ divC_succ RS trans_elem ] 1), - (rew_tac(div_typing_rls @ prems @ [modC_succ])), - (NE_tac "succ(a mod b)|-|b" 1), - (rew_tac ([mod_typing, div_typing, absdiff_typing] @prems)) ]); - -(*for case analysis on whether a number is 0 or a successor*) -val iszero_decidable = prove_goal Arith.thy - "a:N ==> rec(a, inl(eq), %ka kb.inr()) : \ -\ Eq(N,a,0) + (SUM x:N. Eq(N,a, succ(x)))" - (fn prems=> - [ (NE_tac "a" 1), - (resolve_tac [PlusI_inr] 3), - (resolve_tac [PlusI_inl] 2), - eqintr_tac, - (equal_tac prems) ]); - -(*Main Result. Holds when b is 0 since a mod 0 = a and a div 0 = 0 *) -val prems = -goal Arith.thy "[| a:N; b:N |] ==> a mod b #+ (a div b) #* b = a : N"; -by (NE_tac "a" 1); -by (arith_rew_tac (div_typing_rls@prems@[modC0,modC_succ,divC0,divC_succ2])); -by (resolve_tac [EqE] 1); -(*case analysis on succ(u mod b)|-|b *) -by (res_inst_tac [("a1", "succ(u mod b) |-| b")] - (iszero_decidable RS PlusE) 1); -by (etac SumE 3); -by (hyp_arith_rew_tac (prems @ div_typing_rls @ - [modC0,modC_succ, divC0, divC_succ2])); -(*Replace one occurence of b by succ(u mod b). Clumsy!*) -by (resolve_tac [ add_typingL RS trans_elem ] 1); -by (eresolve_tac [EqE RS absdiff_eq0 RS sym_elem] 1); -by (resolve_tac [refl_elem] 3); -by (hyp_arith_rew_tac (prems @ div_typing_rls)); -val mod_div_equality = result(); - -writeln"Reached end of file."; diff -r 19849d258890 -r 8018173a7979 src/CTT/arith.thy --- a/src/CTT/arith.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -(* Title: CTT/arith - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -Arithmetic operators and their definitions - -Proves about elementary arithmetic: addition, multiplication, etc. -Tests definitions and simplifier. -*) - -Arith = CTT + - -consts "#+","-","|-|" :: "[i,i]=>i" (infixr 65) - "#*",div,mod :: "[i,i]=>i" (infixr 70) - -rules - add_def "a#+b == rec(a, b, %u v.succ(v))" - diff_def "a-b == rec(b, a, %u v.rec(v, 0, %x y.x))" - absdiff_def "a|-|b == (a-b) #+ (b-a)" - mult_def "a#*b == rec(a, 0, %u v. b #+ v)" - mod_def "a mod b == rec(a, 0, %u v. rec(succ(v) |-| b, 0, %x y.succ(v)))" - div_def "a div b == rec(a, 0, %u v. rec(succ(u) mod b, succ(v), %x y.v))" -end diff -r 19849d258890 -r 8018173a7979 src/CTT/bool.ML --- a/src/CTT/bool.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -(* Title: CTT/bool - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -Theorems for bool.thy (booleans and conditionals) -*) - -open Bool; - -val bool_defs = [Bool_def,true_def,false_def,cond_def]; - -(*Derivation of rules for the type Bool*) - -(*formation rule*) -val boolF = prove_goal Bool.thy - "Bool type" - (fn prems=> - [ (rewrite_goals_tac bool_defs), - (typechk_tac[]) ]); - - -(*introduction rules for true, false*) - -val boolI_true = prove_goal Bool.thy - "true : Bool" - (fn prems=> - [ (rewrite_goals_tac bool_defs), - (typechk_tac[]) ]); - -val boolI_false = prove_goal Bool.thy - "false : Bool" - (fn prems=> - [ (rewrite_goals_tac bool_defs), - (typechk_tac[]) ]); - -(*elimination rule: typing of cond*) -val boolE = prove_goal Bool.thy - "[| p:Bool; a : C(true); b : C(false) |] ==> cond(p,a,b) : C(p)" - (fn prems=> - [ (cut_facts_tac prems 1), - (rewrite_goals_tac bool_defs), - (typechk_tac prems), - (ALLGOALS (etac TE)), - (typechk_tac prems) ]); - -val boolEL = prove_goal Bool.thy - "[| p = q : Bool; a = c : C(true); b = d : C(false) |] ==> \ -\ cond(p,a,b) = cond(q,c,d) : C(p)" - (fn prems=> - [ (cut_facts_tac prems 1), - (rewrite_goals_tac bool_defs), - (resolve_tac [PlusEL] 1), - (REPEAT (eresolve_tac [asm_rl, refl_elem RS TEL] 1)) ]); - -(*computation rules for true, false*) - -val boolC_true = prove_goal Bool.thy - "[| a : C(true); b : C(false) |] ==> cond(true,a,b) = a : C(true)" - (fn prems=> - [ (cut_facts_tac prems 1), - (rewrite_goals_tac bool_defs), - (resolve_tac comp_rls 1), - (typechk_tac[]), - (ALLGOALS (etac TE)), - (typechk_tac prems) ]); - -val boolC_false = prove_goal Bool.thy - "[| a : C(true); b : C(false) |] ==> cond(false,a,b) = b : C(false)" - (fn prems=> - [ (cut_facts_tac prems 1), - (rewrite_goals_tac bool_defs), - (resolve_tac comp_rls 1), - (typechk_tac[]), - (ALLGOALS (etac TE)), - (typechk_tac prems) ]); - -writeln"Reached end of file."; - diff -r 19849d258890 -r 8018173a7979 src/CTT/bool.thy --- a/src/CTT/bool.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -(* Title: CTT/bool - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -The two-element type (booleans and conditionals) -*) - -Bool = CTT + - -consts Bool :: "t" - true,false :: "i" - cond :: "[i,i,i]=>i" -rules - Bool_def "Bool == T+T" - true_def "true == inl(tt)" - false_def "false == inr(tt)" - cond_def "cond(a,b,c) == when(a, %u.b, %u.c)" -end diff -r 19849d258890 -r 8018173a7979 src/CTT/ctt.ML --- a/src/CTT/ctt.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,249 +0,0 @@ -(* Title: CTT/ctt.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -Tactics and lemmas for ctt.thy (Constructive Type Theory) -*) - -open CTT; - -signature CTT_RESOLVE = - sig - val add_mp_tac: int -> tactic - val ASSUME: (int -> tactic) -> int -> tactic - val basic_defs: thm list - val comp_rls: thm list - val element_rls: thm list - val elimL_rls: thm list - val elim_rls: thm list - val eqintr_tac: tactic - val equal_tac: thm list -> tactic - val formL_rls: thm list - val form_rls: thm list - val form_tac: tactic - val intrL2_rls: thm list - val intrL_rls: thm list - val intr_rls: thm list - val intr_tac: thm list -> tactic - val mp_tac: int -> tactic - val NE_tac: string -> int -> tactic - val pc_tac: thm list -> int -> tactic - val PlusE_tac: string -> int -> tactic - val reduction_rls: thm list - val replace_type: thm - val routine_rls: thm list - val routine_tac: thm list -> thm list -> int -> tactic - val safe_brls: (bool * thm) list - val safestep_tac: thm list -> int -> tactic - val safe_tac: thm list -> int -> tactic - val step_tac: thm list -> int -> tactic - val subst_eqtyparg: thm - val subst_prodE: thm - val SumE_fst: thm - val SumE_snd: thm - val SumE_tac: string -> int -> tactic - val SumIL2: thm - val test_assume_tac: int -> tactic - val typechk_tac: thm list -> tactic - val unsafe_brls: (bool * thm) list - end; - - -structure CTT_Resolve : CTT_RESOLVE = -struct - -(*Formation rules*) -val form_rls = [NF, ProdF, SumF, PlusF, EqF, FF, TF] -and formL_rls = [ProdFL, SumFL, PlusFL, EqFL]; - - -(*Introduction rules - OMITTED: EqI, because its premise is an eqelem, not an elem*) -val intr_rls = [NI0, NI_succ, ProdI, SumI, PlusI_inl, PlusI_inr, TI] -and intrL_rls = [NI_succL, ProdIL, SumIL, PlusI_inlL, PlusI_inrL]; - - -(*Elimination rules - OMITTED: EqE, because its conclusion is an eqelem, not an elem - TE, because it does not involve a constructor *) -val elim_rls = [NE, ProdE, SumE, PlusE, FE] -and elimL_rls = [NEL, ProdEL, SumEL, PlusEL, FEL]; - -(*OMITTED: eqC are TC because they make rewriting loop: p = un = un = ... *) -val comp_rls = [NC0, NC_succ, ProdC, SumC, PlusC_inl, PlusC_inr]; - -(*rules with conclusion a:A, an elem judgement*) -val element_rls = intr_rls @ elim_rls; - -(*Definitions are (meta)equality axioms*) -val basic_defs = [fst_def,snd_def]; - -(*Compare with standard version: B is applied to UNSIMPLIFIED expression! *) -val SumIL2 = prove_goal CTT.thy - "[| c=a : A; d=b : B(a) |] ==> = : Sum(A,B)" - (fn prems=> - [ (resolve_tac [sym_elem] 1), - (resolve_tac [SumIL] 1), - (ALLGOALS (resolve_tac [sym_elem])), - (ALLGOALS (resolve_tac prems)) ]); - -val intrL2_rls = [NI_succL, ProdIL, SumIL2, PlusI_inlL, PlusI_inrL]; - -(*Exploit p:Prod(A,B) to create the assumption z:B(a). - A more natural form of product elimination. *) -val subst_prodE = prove_goal CTT.thy - "[| p: Prod(A,B); a: A; !!z. z: B(a) ==> c(z): C(z) \ -\ |] ==> c(p`a): C(p`a)" - (fn prems=> - [ (REPEAT (resolve_tac (prems@[ProdE]) 1)) ]); - -(** Tactics for type checking **) - -fun is_rigid_elem (Const("Elem",_) $ a $ _) = not (is_Var (head_of a)) - | is_rigid_elem _ = false; - -(*Try solving a:A by assumption provided a is rigid!*) -val test_assume_tac = SUBGOAL(fn (prem,i) => - if is_rigid_elem (Logic.strip_assums_concl prem) - then assume_tac i else no_tac); - -fun ASSUME tf i = test_assume_tac i ORELSE tf i; - - -(*For simplification: type formation and checking, - but no equalities between terms*) -val routine_rls = form_rls @ formL_rls @ [refl_type] @ element_rls; - -fun routine_tac rls prems = ASSUME (filt_resolve_tac (prems @ rls) 4); - - -(*Solve all subgoals "A type" using formation rules. *) -val form_tac = REPEAT_FIRST (filt_resolve_tac(form_rls) 1); - - -(*Type checking: solve a:A (a rigid, A flexible) by intro and elim rules. *) -fun typechk_tac thms = - let val tac = filt_resolve_tac (thms @ form_rls @ element_rls) 3 - in REPEAT_FIRST (ASSUME tac) end; - - -(*Solve a:A (a flexible, A rigid) by introduction rules. - Cannot use stringtrees (filt_resolve_tac) since - goals like ?a:SUM(A,B) have a trivial head-string *) -fun intr_tac thms = - let val tac = filt_resolve_tac(thms@form_rls@intr_rls) 1 - in REPEAT_FIRST (ASSUME tac) end; - - -(*Equality proving: solve a=b:A (where a is rigid) by long rules. *) -fun equal_tac thms = - let val rls = thms @ form_rls @ element_rls @ intrL_rls @ - elimL_rls @ [refl_elem] - in REPEAT_FIRST (ASSUME (filt_resolve_tac rls 3)) end; - -(*** Simplification ***) - -(*To simplify the type in a goal*) -val replace_type = prove_goal CTT.thy - "[| B = A; a : A |] ==> a : B" - (fn prems=> - [ (resolve_tac [equal_types] 1), - (resolve_tac [sym_type] 2), - (ALLGOALS (resolve_tac prems)) ]); - -(*Simplify the parameter of a unary type operator.*) -val subst_eqtyparg = prove_goal CTT.thy - "a=c : A ==> (!!z.z:A ==> B(z) type) ==> B(a)=B(c)" - (fn prems=> - [ (resolve_tac [subst_typeL] 1), - (resolve_tac [refl_type] 2), - (ALLGOALS (resolve_tac prems)), - (assume_tac 1) ]); - -(*Make a reduction rule for simplification. - A goal a=c becomes b=c, by virtue of a=b *) -fun resolve_trans rl = rl RS trans_elem; - -(*Simplification rules for Constructive Type Theory*) -val reduction_rls = map resolve_trans comp_rls; - -(*Converts each goal "e : Eq(A,a,b)" into "a=b:A" for simplification. - Uses other intro rules to avoid changing flexible goals.*) -val eqintr_tac = REPEAT_FIRST (ASSUME (filt_resolve_tac(EqI::intr_rls) 1)); - -(** Tactics that instantiate CTT-rules. - Vars in the given terms will be incremented! - The (resolve_tac [EqE] i) lets them apply to equality judgements. **) - -fun NE_tac (sp: string) i = - TRY (resolve_tac [EqE] i) THEN res_inst_tac [ ("p",sp) ] NE i; - -fun SumE_tac (sp: string) i = - TRY (resolve_tac [EqE] i) THEN res_inst_tac [ ("p",sp) ] SumE i; - -fun PlusE_tac (sp: string) i = - TRY (resolve_tac [EqE] i) THEN res_inst_tac [ ("p",sp) ] PlusE i; - -(** Predicate logic reasoning, WITH THINNING!! Procedures adapted from NJ. **) - -(*Finds f:Prod(A,B) and a:A in the assumptions, concludes there is z:B(a) *) -fun add_mp_tac i = - resolve_tac [subst_prodE] i THEN assume_tac i THEN assume_tac i; - -(*Finds P-->Q and P in the assumptions, replaces implication by Q *) -fun mp_tac i = eresolve_tac [subst_prodE] i THEN assume_tac i; - -(*"safe" when regarded as predicate calculus rules*) -val safe_brls = sort lessb - [ (true,FE), (true,asm_rl), - (false,ProdI), (true,SumE), (true,PlusE) ]; - -val unsafe_brls = - [ (false,PlusI_inl), (false,PlusI_inr), (false,SumI), - (true,subst_prodE) ]; - -(*0 subgoals vs 1 or more*) -val (safe0_brls, safep_brls) = - partition (apl(0,op=) o subgoals_of_brl) safe_brls; - -fun safestep_tac thms i = - form_tac ORELSE - resolve_tac thms i ORELSE - biresolve_tac safe0_brls i ORELSE mp_tac i ORELSE - DETERM (biresolve_tac safep_brls i); - -fun safe_tac thms i = DEPTH_SOLVE_1 (safestep_tac thms i); - -fun step_tac thms = safestep_tac thms ORELSE' biresolve_tac unsafe_brls; - -(*Fails unless it solves the goal!*) -fun pc_tac thms = DEPTH_SOLVE_1 o (step_tac thms); - -(** The elimination rules for fst/snd **) - -val SumE_fst = prove_goal CTT.thy - "p : Sum(A,B) ==> fst(p) : A" - (fn prems=> - [ (rewrite_goals_tac basic_defs), - (resolve_tac elim_rls 1), - (REPEAT (pc_tac prems 1)), - (fold_tac basic_defs) ]); - -(*The first premise must be p:Sum(A,B) !!*) -val SumE_snd = prove_goal CTT.thy - "[| p: Sum(A,B); A type; !!x. x:A ==> B(x) type \ -\ |] ==> snd(p) : B(fst(p))" - (fn prems=> - [ (rewrite_goals_tac basic_defs), - (resolve_tac elim_rls 1), - (resolve_tac prems 1), - (resolve_tac [replace_type] 1), - (resolve_tac [subst_eqtyparg] 1), (*like B(x) equality formation?*) - (resolve_tac comp_rls 1), - (typechk_tac prems), - (fold_tac basic_defs) ]); - -end; - -open CTT_Resolve; diff -r 19849d258890 -r 8018173a7979 src/CTT/ctt.thy --- a/src/CTT/ctt.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,256 +0,0 @@ -(* Title: CTT/ctt.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Constructive Type Theory -*) - -CTT = Pure + - -types - i - t - o - -arities - i,t,o :: logic - -consts - (*Types*) - F,T :: "t" (*F is empty, T contains one element*) - contr :: "i=>i" - tt :: "i" - (*Natural numbers*) - N :: "t" - succ :: "i=>i" - rec :: "[i, i, [i,i]=>i] => i" - (*Unions*) - inl,inr :: "i=>i" - when :: "[i, i=>i, i=>i]=>i" - (*General Sum and Binary Product*) - Sum :: "[t, i=>t]=>t" - fst,snd :: "i=>i" - split :: "[i, [i,i]=>i] =>i" - (*General Product and Function Space*) - Prod :: "[t, i=>t]=>t" - (*Equality type*) - Eq :: "[t,i,i]=>t" - eq :: "i" - (*Judgements*) - Type :: "t => prop" ("(_ type)" [10] 5) - Eqtype :: "[t,t]=>prop" ("(3_ =/ _)" [10,10] 5) - Elem :: "[i, t]=>prop" ("(_ /: _)" [10,10] 5) - Eqelem :: "[i,i,t]=>prop" ("(3_ =/ _ :/ _)" [10,10,10] 5) - Reduce :: "[i,i]=>prop" ("Reduce[_,_]") - (*Types*) - "@PROD" :: "[idt,t,t]=>t" ("(3PROD _:_./ _)" 10) - "@SUM" :: "[idt,t,t]=>t" ("(3SUM _:_./ _)" 10) - "+" :: "[t,t]=>t" (infixr 40) - (*Invisible infixes!*) - "@-->" :: "[t,t]=>t" ("(_ -->/ _)" [31,30] 30) - "@*" :: "[t,t]=>t" ("(_ */ _)" [51,50] 50) - (*Functions*) - lambda :: "(i => i) => i" (binder "lam " 10) - "`" :: "[i,i]=>i" (infixl 60) - (*Natural numbers*) - "0" :: "i" ("0") - (*Pairing*) - pair :: "[i,i]=>i" ("(1<_,/_>)") - -translations - "PROD x:A. B" => "Prod(A, %x. B)" - "A --> B" => "Prod(A, _K(B))" - "SUM x:A. B" => "Sum(A, %x. B)" - "A * B" => "Sum(A, _K(B))" - -rules - - (*Reduction: a weaker notion than equality; a hack for simplification. - Reduce[a,b] means either that a=b:A for some A or else that "a" and "b" - are textually identical.*) - - (*does not verify a:A! Sound because only trans_red uses a Reduce premise - No new theorems can be proved about the standard judgements.*) - refl_red "Reduce[a,a]" - red_if_equal "a = b : A ==> Reduce[a,b]" - trans_red "[| a = b : A; Reduce[b,c] |] ==> a = c : A" - - (*Reflexivity*) - - refl_type "A type ==> A = A" - refl_elem "a : A ==> a = a : A" - - (*Symmetry*) - - sym_type "A = B ==> B = A" - sym_elem "a = b : A ==> b = a : A" - - (*Transitivity*) - - trans_type "[| A = B; B = C |] ==> A = C" - trans_elem "[| a = b : A; b = c : A |] ==> a = c : A" - - equal_types "[| a : A; A = B |] ==> a : B" - equal_typesL "[| a = b : A; A = B |] ==> a = b : B" - - (*Substitution*) - - subst_type "[| a : A; !!z. z:A ==> B(z) type |] ==> B(a) type" - subst_typeL "[| a = c : A; !!z. z:A ==> B(z) = D(z) |] ==> B(a) = D(c)" - - subst_elem "[| a : A; !!z. z:A ==> b(z):B(z) |] ==> b(a):B(a)" - subst_elemL - "[| a=c : A; !!z. z:A ==> b(z)=d(z) : B(z) |] ==> b(a)=d(c) : B(a)" - - - (*The type N -- natural numbers*) - - NF "N type" - NI0 "0 : N" - NI_succ "a : N ==> succ(a) : N" - NI_succL "a = b : N ==> succ(a) = succ(b) : N" - - NE - "[| p: N; a: C(0); !!u v. [| u: N; v: C(u) |] ==> b(u,v): C(succ(u)) |] \ -\ ==> rec(p, a, %u v.b(u,v)) : C(p)" - - NEL - "[| p = q : N; a = c : C(0); \ -\ !!u v. [| u: N; v: C(u) |] ==> b(u,v) = d(u,v): C(succ(u)) |] \ -\ ==> rec(p, a, %u v.b(u,v)) = rec(q,c,d) : C(p)" - - NC0 - "[| a: C(0); !!u v. [| u: N; v: C(u) |] ==> b(u,v): C(succ(u)) |] \ -\ ==> rec(0, a, %u v.b(u,v)) = a : C(0)" - - NC_succ - "[| p: N; a: C(0); \ -\ !!u v. [| u: N; v: C(u) |] ==> b(u,v): C(succ(u)) |] ==> \ -\ rec(succ(p), a, %u v.b(u,v)) = b(p, rec(p, a, %u v.b(u,v))) : C(succ(p))" - - (*The fourth Peano axiom. See page 91 of Martin-Lof's book*) - zero_ne_succ - "[| a: N; 0 = succ(a) : N |] ==> 0: F" - - - (*The Product of a family of types*) - - ProdF "[| A type; !!x. x:A ==> B(x) type |] ==> PROD x:A.B(x) type" - - ProdFL - "[| A = C; !!x. x:A ==> B(x) = D(x) |] ==> \ -\ PROD x:A.B(x) = PROD x:C.D(x)" - - ProdI - "[| A type; !!x. x:A ==> b(x):B(x)|] ==> lam x.b(x) : PROD x:A.B(x)" - - ProdIL - "[| A type; !!x. x:A ==> b(x) = c(x) : B(x)|] ==> \ -\ lam x.b(x) = lam x.c(x) : PROD x:A.B(x)" - - ProdE "[| p : PROD x:A.B(x); a : A |] ==> p`a : B(a)" - ProdEL "[| p=q: PROD x:A.B(x); a=b : A |] ==> p`a = q`b : B(a)" - - ProdC - "[| a : A; !!x. x:A ==> b(x) : B(x)|] ==> \ -\ (lam x.b(x)) ` a = b(a) : B(a)" - - ProdC2 - "p : PROD x:A.B(x) ==> (lam x. p`x) = p : PROD x:A.B(x)" - - - (*The Sum of a family of types*) - - SumF "[| A type; !!x. x:A ==> B(x) type |] ==> SUM x:A.B(x) type" - SumFL - "[| A = C; !!x. x:A ==> B(x) = D(x) |] ==> SUM x:A.B(x) = SUM x:C.D(x)" - - SumI "[| a : A; b : B(a) |] ==> : SUM x:A.B(x)" - SumIL "[| a=c:A; b=d:B(a) |] ==> = : SUM x:A.B(x)" - - SumE - "[| p: SUM x:A.B(x); !!x y. [| x:A; y:B(x) |] ==> c(x,y): C() |] \ -\ ==> split(p, %x y.c(x,y)) : C(p)" - - SumEL - "[| p=q : SUM x:A.B(x); \ -\ !!x y. [| x:A; y:B(x) |] ==> c(x,y)=d(x,y): C()|] \ -\ ==> split(p, %x y.c(x,y)) = split(q, % x y.d(x,y)) : C(p)" - - SumC - "[| a: A; b: B(a); !!x y. [| x:A; y:B(x) |] ==> c(x,y): C() |] \ -\ ==> split(, %x y.c(x,y)) = c(a,b) : C()" - - fst_def "fst(a) == split(a, %x y.x)" - snd_def "snd(a) == split(a, %x y.y)" - - - (*The sum of two types*) - - PlusF "[| A type; B type |] ==> A+B type" - PlusFL "[| A = C; B = D |] ==> A+B = C+D" - - PlusI_inl "[| a : A; B type |] ==> inl(a) : A+B" - PlusI_inlL "[| a = c : A; B type |] ==> inl(a) = inl(c) : A+B" - - PlusI_inr "[| A type; b : B |] ==> inr(b) : A+B" - PlusI_inrL "[| A type; b = d : B |] ==> inr(b) = inr(d) : A+B" - - PlusE - "[| p: A+B; !!x. x:A ==> c(x): C(inl(x)); \ -\ !!y. y:B ==> d(y): C(inr(y)) |] \ -\ ==> when(p, %x.c(x), %y.d(y)) : C(p)" - - PlusEL - "[| p = q : A+B; !!x. x: A ==> c(x) = e(x) : C(inl(x)); \ -\ !!y. y: B ==> d(y) = f(y) : C(inr(y)) |] \ -\ ==> when(p, %x.c(x), %y.d(y)) = when(q, %x.e(x), %y.f(y)) : C(p)" - - PlusC_inl - "[| a: A; !!x. x:A ==> c(x): C(inl(x)); \ -\ !!y. y:B ==> d(y): C(inr(y)) |] \ -\ ==> when(inl(a), %x.c(x), %y.d(y)) = c(a) : C(inl(a))" - - PlusC_inr - "[| b: B; !!x. x:A ==> c(x): C(inl(x)); \ -\ !!y. y:B ==> d(y): C(inr(y)) |] \ -\ ==> when(inr(b), %x.c(x), %y.d(y)) = d(b) : C(inr(b))" - - - (*The type Eq*) - - EqF "[| A type; a : A; b : A |] ==> Eq(A,a,b) type" - EqFL "[| A=B; a=c: A; b=d : A |] ==> Eq(A,a,b) = Eq(B,c,d)" - EqI "a = b : A ==> eq : Eq(A,a,b)" - EqE "p : Eq(A,a,b) ==> a = b : A" - - (*By equality of types, can prove C(p) from C(eq), an elimination rule*) - EqC "p : Eq(A,a,b) ==> p = eq : Eq(A,a,b)" - - (*The type F*) - - FF "F type" - FE "[| p: F; C type |] ==> contr(p) : C" - FEL "[| p = q : F; C type |] ==> contr(p) = contr(q) : C" - - (*The type T - Martin-Lof's book (page 68) discusses elimination and computation. - Elimination can be derived by computation and equality of types, - but with an extra premise C(x) type x:T. - Also computation can be derived from elimination. *) - - TF "T type" - TI "tt : T" - TE "[| p : T; c : C(tt) |] ==> c : C(p)" - TEL "[| p = q : T; c = d : C(tt) |] ==> c = d : C(p)" - TC "p : T ==> p = tt : T" -end - - -ML - -val print_translation = - [("Prod", dependent_tr' ("@PROD", "@-->")), - ("Sum", dependent_tr' ("@SUM", "@*"))]; - diff -r 19849d258890 -r 8018173a7979 src/Cube/cube.ML --- a/src/Cube/cube.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,60 +0,0 @@ -(* Title: Cube/cube - ID: $Id$ - Author: Tobias Nipkow - Copyright 1990 University of Cambridge - -For cube.thy. The systems of the Lambda-cube that extend simple types -*) - -open Cube; - -val simple = [s_b,strip_s,strip_b,app,lam_ss,pi_ss]; - -val L2_thy = extend_theory Cube.thy "L2" ([],[],[],[],[],[],None) -[ - ("pi_bs", "[| A:[]; !!x. x:A ==> B(x):* |] ==> Prod(A,B):*"), - - ("lam_bs", "[| A:[]; !!x. x:A ==> f(x):B(x); !!x. x:A ==> B(x):* |] \ -\ ==> Abs(A,f) : Prod(A,B)") -]; - -val lam_bs = get_axiom L2_thy "lam_bs"; -val pi_bs = get_axiom L2_thy "pi_bs"; - -val L2 = simple @ [lam_bs,pi_bs]; - -val Lomega_thy = extend_theory Cube.thy "Lomega" ([],[],[],[],[],[],None) -[ - ("pi_bb", "[| A:[]; !!x. x:A ==> B(x):[] |] ==> Prod(A,B):[]"), - - ("lam_bb", "[| A:[]; !!x. x:A ==> f(x):B(x); !!x. x:A ==> B(x):[] |] \ -\ ==> Abs(A,f) : Prod(A,B)") -]; - -val lam_bb = get_axiom Lomega_thy "lam_bb"; -val pi_bb = get_axiom Lomega_thy "pi_bb"; -val Lomega = simple @ [lam_bb,pi_bb]; - -val LOmega_thy = merge_theories(L2_thy,Lomega_thy); -val LOmega = simple @ [lam_bs,pi_bs,lam_bb,pi_bb]; - -val LP_thy = extend_theory Cube.thy "LP" ([],[],[],[],[],[],None) -[ - ("pi_sb", "[| A:*; !!x. x:A ==> B(x):[] |] ==> Prod(A,B):[]"), - - ("lam_sb", "[| A:*; !!x. x:A ==> f(x):B(x); !!x. x:A ==> B(x):[] |] \ -\ ==> Abs(A,f) : Prod(A,B)") -]; - -val lam_sb = get_axiom LP_thy "lam_sb"; -val pi_sb = get_axiom LP_thy "pi_sb"; -val LP = simple @ [lam_sb,pi_sb]; - -val LP2_thy = merge_theories(L2_thy,LP_thy); -val LP2 = simple @ [lam_bs,pi_bs,lam_sb,pi_sb]; - -val LPomega_thy = merge_theories(LP_thy,Lomega_thy); -val LPomega = simple @ [lam_bb,pi_bb,lam_sb,pi_sb]; - -val CC_thy = merge_theories(L2_thy,LPomega_thy); -val CC = simple @ [lam_bs,pi_bs,lam_bb,pi_bb,lam_sb,pi_sb]; diff -r 19849d258890 -r 8018173a7979 src/Cube/cube.thy --- a/src/Cube/cube.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,60 +0,0 @@ -(* Title: Cube/cube.thy - ID: $Id$ - Author: Tobias Nipkow - Copyright 1993 University of Cambridge - -Barendregt's Lambda-Cube -*) - -Cube = Pure + - -types - term, context, typing 0 - -arities - term :: logic - -consts - Abs, Prod :: "[term, term => term] => term" - Trueprop :: "[context, typing] => prop" ("(_/ |- _)") - Trueprop1 :: "typing => prop" ("(_)") - MT_context :: "context" ("") - "" :: "id => context" ("_ ") - "" :: "var => context" ("_ ") - Context :: "[typing, context] => context" ("_ _") - star :: "term" ("*") - box :: "term" ("[]") - "^" :: "[term, term] => term" (infixl 20) - Lam :: "[idt, term, term] => term" ("(3Lam _:_./ _)" [0, 0, 0] 10) - Pi :: "[idt, term, term] => term" ("(3Pi _:_./ _)" [0, 0] 10) - "->" :: "[term, term] => term" (infixr 10) - Has_type :: "[term, term] => typing" ("(_:/ _)" [0, 0] 5) - -translations - (prop) "x:X" == (prop) "|- x:X" - "Lam x:A. B" == "Abs(A, %x. B)" - "Pi x:A. B" => "Prod(A, %x. B)" - "A -> B" => "Prod(A, _K(B))" - -rules - s_b "*: []" - - strip_s "[| A:*; a:A ==> G |- x:X |] ==> a:A G |- x:X" - strip_b "[| A:[]; a:A ==> G |- x:X |] ==> a:A G |- x:X" - - app "[| F:Prod(A, B); C:A |] ==> F^C: B(C)" - - pi_ss "[| A:*; !!x. x:A ==> B(x):* |] ==> Prod(A, B):*" - - lam_ss "[| A:*; !!x. x:A ==> f(x):B(x); !!x. x:A ==> B(x):* |] \ -\ ==> Abs(A, f) : Prod(A, B)" - - beta "Abs(A, f)^a == f(a)" - -end - - -ML - -val print_translation = [("Prod", dependent_tr' ("Pi", "op ->"))]; - diff -r 19849d258890 -r 8018173a7979 src/FOL/.fol.thy.ML --- a/src/FOL/.fol.thy.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -structure FOL = -struct - -local - val parse_ast_translation = [] - val parse_preproc = None - val parse_postproc = None - val parse_translation = [] - val print_translation = [] - val print_preproc = None - val print_postproc = None - val print_ast_translation = [] -in - -(**** begin of user section ****) - -(**** end of user section ****) - -val thy = extend_theory (IFOL.thy) - "FOL" - ([], - [], - [], - [], - [], - None) - [("classical", "(~P ==> P) ==> P")] - -val ax = get_axiom thy - -val classical = ax "classical" - - -end -end diff -r 19849d258890 -r 8018173a7979 src/FOL/.ifol.thy.ML --- a/src/FOL/.ifol.thy.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -structure IFOL = -struct - -local - val parse_ast_translation = [] - val parse_preproc = None - val parse_postproc = None - val parse_translation = [] - val print_translation = [] - val print_preproc = None - val print_postproc = None - val print_ast_translation = [] -in - -(**** begin of user section ****) - -(**** end of user section ****) - -val thy = extend_theory (Pure.thy) - "IFOL" - ([("term", ["logic"])], - ["term"], - [(["o"], 0)], - [(["o"], ([], "logic"))], - [(["True", "False"], "o")], - Some (NewSext { - mixfix = - [Mixfix("(_)", "o => prop", "Trueprop", [0], 5), - Infixl("=", "['a,'a] => o", 50), - Mixfix("~ _", "o => o", "Not", [40], 40), - Infixr("&", "[o,o] => o", 35), - Infixr("|", "[o,o] => o", 30), - Infixr("-->", "[o,o] => o", 25), - Infixr("<->", "[o,o] => o", 25), - Binder("ALL ", "('a => o) => o", "All", 0, 10), - Binder("EX ", "('a => o) => o", "Ex", 0, 10), - Binder("EX! ", "('a => o) => o", "Ex1", 0, 10)], - xrules = - [], - parse_ast_translation = parse_ast_translation, - parse_preproc = parse_preproc, - parse_postproc = parse_postproc, - parse_translation = parse_translation, - print_translation = print_translation, - print_preproc = print_preproc, - print_postproc = print_postproc, - print_ast_translation = print_ast_translation})) - [("refl", "a=a"), - ("subst", "[| a=b; P(a) |] ==> P(b)"), - ("conjI", "[| P; Q |] ==> P&Q"), - ("conjunct1", "P&Q ==> P"), - ("conjunct2", "P&Q ==> Q"), - ("disjI1", "P ==> P|Q"), - ("disjI2", "Q ==> P|Q"), - ("disjE", "[| P|Q; P ==> R; Q ==> R |] ==> R"), - ("impI", "(P ==> Q) ==> P-->Q"), - ("mp", "[| P-->Q; P |] ==> Q"), - ("FalseE", "False ==> P"), - ("True_def", "True == False-->False"), - ("not_def", "~P == P-->False"), - ("iff_def", "P<->Q == (P-->Q) & (Q-->P)"), - ("ex1_def", "EX! x. P(x) == EX x. P(x) & (ALL y. P(y) --> y=x)"), - ("allI", "(!!x. P(x)) ==> (ALL x.P(x))"), - ("spec", "(ALL x.P(x)) ==> P(x)"), - ("exI", "P(x) ==> (EX x.P(x))"), - ("exE", "[| EX x.P(x); !!x. P(x) ==> R |] ==> R"), - ("eq_reflection", "(x=y) ==> (x==y)"), - ("iff_reflection", "(P<->Q) ==> (P==Q)")] - -val ax = get_axiom thy - -val refl = ax "refl" -val subst = ax "subst" -val conjI = ax "conjI" -val conjunct1 = ax "conjunct1" -val conjunct2 = ax "conjunct2" -val disjI1 = ax "disjI1" -val disjI2 = ax "disjI2" -val disjE = ax "disjE" -val impI = ax "impI" -val mp = ax "mp" -val FalseE = ax "FalseE" -val True_def = ax "True_def" -val not_def = ax "not_def" -val iff_def = ax "iff_def" -val ex1_def = ax "ex1_def" -val allI = ax "allI" -val spec = ax "spec" -val exI = ax "exI" -val exE = ax "exE" -val eq_reflection = ax "eq_reflection" -val iff_reflection = ax "iff_reflection" - - -end -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/.if.thy.ML --- a/src/FOL/ex/.if.thy.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -structure If = -struct - -local - val parse_ast_translation = [] - val parse_preproc = None - val parse_postproc = None - val parse_translation = [] - val print_translation = [] - val print_preproc = None - val print_postproc = None - val print_ast_translation = [] -in - -(**** begin of user section ****) - -(**** end of user section ****) - -val thy = extend_theory (FOL.thy) - "If" - ([], - [], - [], - [], - [(["if"], "[o,o,o]=>o")], - None) - [("if_def", "if(P,Q,R) == P&Q | ~P&R")] - -val ax = get_axiom thy - -val if_def = ax "if_def" - - -end -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/.list.thy.ML --- a/src/FOL/ex/.list.thy.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,81 +0,0 @@ -structure List = -struct - -local - val parse_ast_translation = [] - val parse_preproc = None - val parse_postproc = None - val parse_translation = [] - val print_translation = [] - val print_preproc = None - val print_postproc = None - val print_ast_translation = [] -in - -(**** begin of user section ****) - -(**** end of user section ****) - -val thy = extend_theory (Nat2.thy) - "List" - ([], - [], - [(["list"], 1)], - [(["list"], ([["term"]], "term"))], - [(["hd"], "'a list => 'a"), - (["tl"], "'a list => 'a list"), - (["forall"], "['a list, 'a => o] => o"), - (["len"], "'a list => nat"), - (["at"], "['a list, nat] => 'a")], - Some (NewSext { - mixfix = - [Delimfix("[]", "'a list", "[]"), - Infixr(".", "['a, 'a list] => 'a list", 80), - Infixr("++", "['a list, 'a list] => 'a list", 70)], - xrules = - [], - parse_ast_translation = parse_ast_translation, - parse_preproc = parse_preproc, - parse_postproc = parse_postproc, - parse_translation = parse_translation, - print_translation = print_translation, - print_preproc = print_preproc, - print_postproc = print_postproc, - print_ast_translation = print_ast_translation})) - [("list_ind", "[| P([]); ALL x l. P(l)-->P(x.l) |] ==> All(P)"), - ("forall_cong", "[| l = l'; !!x. P(x)<->P'(x) |] ==> forall(l,P) <-> forall(l',P')"), - ("list_distinct1", "~[] = x.l"), - ("list_distinct2", "~x.l = []"), - ("list_free", "x.l = x'.l' <-> x=x' & l=l'"), - ("app_nil", "[]++l = l"), - ("app_cons", "(x.l)++l' = x.(l++l')"), - ("tl_eq", "tl(m.q) = q"), - ("hd_eq", "hd(m.q) = m"), - ("forall_nil", "forall([],P)"), - ("forall_cons", "forall(x.l,P) <-> P(x) & forall(l,P)"), - ("len_nil", "len([]) = 0"), - ("len_cons", "len(m.q) = succ(len(q))"), - ("at_0", "at(m.q,0) = m"), - ("at_succ", "at(m.q,succ(n)) = at(q,n)")] - -val ax = get_axiom thy - -val list_ind = ax "list_ind" -val forall_cong = ax "forall_cong" -val list_distinct1 = ax "list_distinct1" -val list_distinct2 = ax "list_distinct2" -val list_free = ax "list_free" -val app_nil = ax "app_nil" -val app_cons = ax "app_cons" -val tl_eq = ax "tl_eq" -val hd_eq = ax "hd_eq" -val forall_nil = ax "forall_nil" -val forall_cons = ax "forall_cons" -val len_nil = ax "len_nil" -val len_cons = ax "len_cons" -val at_0 = ax "at_0" -val at_succ = ax "at_succ" - - -end -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/.nat.thy.ML --- a/src/FOL/ex/.nat.thy.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,59 +0,0 @@ -structure Nat = -struct - -local - val parse_ast_translation = [] - val parse_preproc = None - val parse_postproc = None - val parse_translation = [] - val print_translation = [] - val print_preproc = None - val print_postproc = None - val print_ast_translation = [] -in - -(**** begin of user section ****) - -(**** end of user section ****) - -val thy = extend_theory (FOL.thy) - "Nat" - ([], - [], - [(["nat"], 0)], - [(["nat"], ([], "term"))], - [(["Suc"], "nat=>nat"), - (["rec"], "[nat, 'a, [nat,'a]=>'a] => 'a")], - Some (NewSext { - mixfix = - [Delimfix("0", "nat", "0"), - Infixl("+", "[nat, nat] => nat", 60)], - xrules = - [], - parse_ast_translation = parse_ast_translation, - parse_preproc = parse_preproc, - parse_postproc = parse_postproc, - parse_translation = parse_translation, - print_translation = print_translation, - print_preproc = print_preproc, - print_postproc = print_postproc, - print_ast_translation = print_ast_translation})) - [("induct", "[| P(0); !!x. P(x) ==> P(Suc(x)) |] ==> P(n)"), - ("Suc_inject", "Suc(m)=Suc(n) ==> m=n"), - ("Suc_neq_0", "Suc(m)=0 ==> R"), - ("rec_0", "rec(0,a,f) = a"), - ("rec_Suc", "rec(Suc(m), a, f) = f(m, rec(m,a,f))"), - ("add_def", "m+n == rec(m, n, %x y. Suc(y))")] - -val ax = get_axiom thy - -val induct = ax "induct" -val Suc_inject = ax "Suc_inject" -val Suc_neq_0 = ax "Suc_neq_0" -val rec_0 = ax "rec_0" -val rec_Suc = ax "rec_Suc" -val add_def = ax "add_def" - - -end -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/.nat2.thy.ML --- a/src/FOL/ex/.nat2.thy.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,76 +0,0 @@ -structure Nat2 = -struct - -local - val parse_ast_translation = [] - val parse_preproc = None - val parse_postproc = None - val parse_translation = [] - val print_translation = [] - val print_preproc = None - val print_postproc = None - val print_ast_translation = [] -in - -(**** begin of user section ****) - -(**** end of user section ****) - -val thy = extend_theory (FOL.thy) - "Nat2" - ([], - [], - [(["nat"], 0)], - [(["nat"], ([], "term"))], - [(["succ", "pred"], "nat => nat")], - Some (NewSext { - mixfix = - [Delimfix("0", "nat", "0"), - Infixr("+", "[nat,nat] => nat", 90), - Infixr("<", "[nat,nat] => o", 70), - Infixr("<=", "[nat,nat] => o", 70)], - xrules = - [], - parse_ast_translation = parse_ast_translation, - parse_preproc = parse_preproc, - parse_postproc = parse_postproc, - parse_translation = parse_translation, - print_translation = print_translation, - print_preproc = print_preproc, - print_postproc = print_postproc, - print_ast_translation = print_ast_translation})) - [("pred_0", "pred(0) = 0"), - ("pred_succ", "pred(succ(m)) = m"), - ("plus_0", "0+n = n"), - ("plus_succ", "succ(m)+n = succ(m+n)"), - ("nat_distinct1", "~ 0=succ(n)"), - ("nat_distinct2", "~ succ(m)=0"), - ("succ_inject", "succ(m)=succ(n) <-> m=n"), - ("leq_0", "0 <= n"), - ("leq_succ_succ", "succ(m)<=succ(n) <-> m<=n"), - ("leq_succ_0", "~ succ(m) <= 0"), - ("lt_0_succ", "0 < succ(n)"), - ("lt_succ_succ", "succ(m) mP(succ(n)) |] ==> All(P)")] - -val ax = get_axiom thy - -val pred_0 = ax "pred_0" -val pred_succ = ax "pred_succ" -val plus_0 = ax "plus_0" -val plus_succ = ax "plus_succ" -val nat_distinct1 = ax "nat_distinct1" -val nat_distinct2 = ax "nat_distinct2" -val succ_inject = ax "succ_inject" -val leq_0 = ax "leq_0" -val leq_succ_succ = ax "leq_succ_succ" -val leq_succ_0 = ax "leq_succ_0" -val lt_0_succ = ax "lt_0_succ" -val lt_succ_succ = ax "lt_succ_succ" -val lt_0 = ax "lt_0" -val nat_ind = ax "nat_ind" - - -end -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/.prolog.thy.ML --- a/src/FOL/ex/.prolog.thy.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -structure Prolog = -struct - -local - val parse_ast_translation = [] - val parse_preproc = None - val parse_postproc = None - val parse_translation = [] - val print_translation = [] - val print_preproc = None - val print_postproc = None - val print_ast_translation = [] -in - -(**** begin of user section ****) - -(**** end of user section ****) - -val thy = extend_theory (FOL.thy) - "Prolog" - ([], - [], - [(["list"], 1)], - [(["list"], ([["term"]], "term"))], - [(["Nil"], "'a list"), - (["app"], "['a list, 'a list, 'a list] => o"), - (["rev"], "['a list, 'a list] => o")], - Some (NewSext { - mixfix = - [Infixr(":", "['a, 'a list]=> 'a list", 60)], - xrules = - [], - parse_ast_translation = parse_ast_translation, - parse_preproc = parse_preproc, - parse_postproc = parse_postproc, - parse_translation = parse_translation, - print_translation = print_translation, - print_preproc = print_preproc, - print_postproc = print_postproc, - print_ast_translation = print_ast_translation})) - [("appNil", "app(Nil,ys,ys)"), - ("appCons", "app(xs,ys,zs) ==> app(x:xs, ys, x:zs)"), - ("revNil", "rev(Nil,Nil)"), - ("revCons", "[| rev(xs,ys); app(ys, x:Nil, zs) |] ==> rev(x:xs, zs)")] - -val ax = get_axiom thy - -val appNil = ax "appNil" -val appCons = ax "appCons" -val revNil = ax "revNil" -val revCons = ax "revCons" - - -end -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/if.ML --- a/src/FOL/ex/if.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -(* Title: FOL/ex/if - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -For ex/if.thy. First-Order Logic: the 'if' example -*) - -open If; -open Cla; (*in case structure Int is open!*) - -val prems = goalw If.thy [if_def] - "[| P ==> Q; ~P ==> R |] ==> if(P,Q,R)"; -by (fast_tac (FOL_cs addIs prems) 1); -val ifI = result(); - -val major::prems = goalw If.thy [if_def] - "[| if(P,Q,R); [| P; Q |] ==> S; [| ~P; R |] ==> S |] ==> S"; -by (cut_facts_tac [major] 1); -by (fast_tac (FOL_cs addIs prems) 1); -val ifE = result(); - - -goal If.thy - "if(P, if(Q,A,B), if(Q,C,D)) <-> if(Q, if(P,A,C), if(P,B,D))"; -by (resolve_tac [iffI] 1); -by (eresolve_tac [ifE] 1); -by (eresolve_tac [ifE] 1); -by (resolve_tac [ifI] 1); -by (resolve_tac [ifI] 1); - -choplev 0; -val if_cs = FOL_cs addSIs [ifI] addSEs[ifE]; -by (fast_tac if_cs 1); -val if_commute = result(); - - -goal If.thy "if(if(P,Q,R), A, B) <-> if(P, if(Q,A,B), if(R,A,B))"; -by (fast_tac if_cs 1); -val nested_ifs = result(); - -choplev 0; -by (rewrite_goals_tac [if_def]); -by (fast_tac FOL_cs 1); -result(); - - -(*An invalid formula. High-level rules permit a simpler diagnosis*) -goal If.thy "if(if(P,Q,R), A, B) <-> if(P, if(Q,A,B), if(R,B,A))"; -by (fast_tac if_cs 1) handle ERROR => writeln"Failed, as expected"; -(*Check that subgoals remain: proof failed.*) -getgoal 1; -by (REPEAT (step_tac if_cs 1)); - -choplev 0; -by (rewrite_goals_tac [if_def]); -by (fast_tac FOL_cs 1) handle ERROR => writeln"Failed, as expected"; -(*Check that subgoals remain: proof failed.*) -getgoal 1; -by (REPEAT (step_tac FOL_cs 1)); - - - -writeln"Reached end of file."; diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/if.thy --- a/src/FOL/ex/if.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -If = FOL + -consts if :: "[o,o,o]=>o" -rules - if_def "if(P,Q,R) == P&Q | ~P&R" -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/list.ML --- a/src/FOL/ex/list.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -(* Title: FOL/ex/list - ID: $Id$ - Author: Tobias Nipkow - Copyright 1991 University of Cambridge - -For ex/list.thy. Examples of simplification and induction on lists -*) - -open List; - -val prems = goal List.thy "[| P([]); !!x l. P(x.l) |] ==> All(P)"; -by (rtac list_ind 1); -by (REPEAT (resolve_tac (prems@[allI,impI]) 1)); -val list_exh = result(); - -val list_rew_thms = [list_distinct1,list_distinct2,app_nil,app_cons, - hd_eq,tl_eq,forall_nil,forall_cons,list_free, - len_nil,len_cons,at_0,at_succ]; - -val list_ss = nat_ss addsimps list_rew_thms; - -goal List.thy "~l=[] --> hd(l).tl(l) = l"; -by(IND_TAC list_exh (simp_tac list_ss) "l" 1); -result(); - -goal List.thy "(l1++l2)++l3 = l1++(l2++l3)"; -by(IND_TAC list_ind (simp_tac list_ss) "l1" 1); -val append_assoc = result(); - -goal List.thy "l++[] = l"; -by(IND_TAC list_ind (simp_tac list_ss) "l" 1); -val app_nil_right = result(); - -goal List.thy "l1++l2=[] <-> l1=[] & l2=[]"; -by(IND_TAC list_exh (simp_tac list_ss) "l1" 1); -val app_eq_nil_iff = result(); - -goal List.thy "forall(l++l',P) <-> forall(l,P) & forall(l',P)"; -by(IND_TAC list_ind (simp_tac list_ss) "l" 1); -val forall_app = result(); - -goal List.thy "forall(l,%x.P(x)&Q(x)) <-> forall(l,P) & forall(l,Q)"; -by(IND_TAC list_ind (simp_tac list_ss) "l" 1); -by(fast_tac FOL_cs 1); -val forall_conj = result(); - -goal List.thy "~l=[] --> forall(l,P) <-> P(hd(l)) & forall(tl(l),P)"; -by(IND_TAC list_ind (simp_tac list_ss) "l" 1); -val forall_ne = result(); - -(*** Lists with natural numbers ***) - -goal List.thy "len(l1++l2) = len(l1)+len(l2)"; -by (IND_TAC list_ind (simp_tac list_ss) "l1" 1); -val len_app = result(); - -goal List.thy "i at(l1++l2,i) = at(l1,i)"; -by (IND_TAC list_ind (simp_tac list_ss) "l1" 1); -by (REPEAT (rtac allI 1)); -by (rtac impI 1); -by (ALL_IND_TAC nat_exh (asm_simp_tac list_ss) 1); -val at_app1 = result(); - -goal List.thy "at(l1++(x.l2), len(l1)) = x"; -by (IND_TAC list_ind (simp_tac list_ss) "l1" 1); -val at_app_hd2 = result(); - diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/list.thy --- a/src/FOL/ex/list.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -(* Title: FOL/ex/list - ID: $Id$ - Author: Tobias Nipkow - Copyright 1991 University of Cambridge - -Examples of simplification and induction on lists -*) - -List = Nat2 + - -types list 1 -arities list :: (term)term - -consts - hd :: "'a list => 'a" - tl :: "'a list => 'a list" - forall :: "['a list, 'a => o] => o" - len :: "'a list => nat" - at :: "['a list, nat] => 'a" - "[]" :: "'a list" ("[]") - "." :: "['a, 'a list] => 'a list" (infixr 80) - "++" :: "['a list, 'a list] => 'a list" (infixr 70) - -rules - list_ind "[| P([]); ALL x l. P(l)-->P(x.l) |] ==> All(P)" - - forall_cong - "[| l = l'; !!x. P(x)<->P'(x) |] ==> forall(l,P) <-> forall(l',P')" - - list_distinct1 "~[] = x.l" - list_distinct2 "~x.l = []" - - list_free "x.l = x'.l' <-> x=x' & l=l'" - - app_nil "[]++l = l" - app_cons "(x.l)++l' = x.(l++l')" - tl_eq "tl(m.q) = q" - hd_eq "hd(m.q) = m" - - forall_nil "forall([],P)" - forall_cons "forall(x.l,P) <-> P(x) & forall(l,P)" - - len_nil "len([]) = 0" - len_cons "len(m.q) = succ(len(q))" - - at_0 "at(m.q,0) = m" - at_succ "at(m.q,succ(n)) = at(q,n)" - -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/nat.ML --- a/src/FOL/ex/nat.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ -(* Title: FOL/ex/nat.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -Examples for the manual "Introduction to Isabelle" - -Proofs about the natural numbers - -INCOMPATIBLE with nat2.ML, Nipkow's examples - -To generate similar output to manual, execute these commands: - Pretty.setmargin 72; print_depth 0; -*) - -open Nat; - -goal Nat.thy "Suc(k) ~= k"; -by (res_inst_tac [("n","k")] induct 1); -by (resolve_tac [notI] 1); -by (eresolve_tac [Suc_neq_0] 1); -by (resolve_tac [notI] 1); -by (eresolve_tac [notE] 1); -by (eresolve_tac [Suc_inject] 1); -val Suc_n_not_n = result(); - - -goal Nat.thy "(k+m)+n = k+(m+n)"; -prths ([induct] RL [topthm()]); (*prints all 14 next states!*) -by (resolve_tac [induct] 1); -back(); -back(); -back(); -back(); -back(); -back(); - -goalw Nat.thy [add_def] "0+n = n"; -by (resolve_tac [rec_0] 1); -val add_0 = result(); - -goalw Nat.thy [add_def] "Suc(m)+n = Suc(m+n)"; -by (resolve_tac [rec_Suc] 1); -val add_Suc = result(); - -val add_ss = FOL_ss addsimps [add_0, add_Suc]; - -goal Nat.thy "(k+m)+n = k+(m+n)"; -by (res_inst_tac [("n","k")] induct 1); -by (simp_tac add_ss 1); -by (asm_simp_tac add_ss 1); -val add_assoc = result(); - -goal Nat.thy "m+0 = m"; -by (res_inst_tac [("n","m")] induct 1); -by (simp_tac add_ss 1); -by (asm_simp_tac add_ss 1); -val add_0_right = result(); - -goal Nat.thy "m+Suc(n) = Suc(m+n)"; -by (res_inst_tac [("n","m")] induct 1); -by (ALLGOALS (asm_simp_tac add_ss)); -val add_Suc_right = result(); - -val [prem] = goal Nat.thy "(!!n. f(Suc(n)) = Suc(f(n))) ==> f(i+j) = i+f(j)"; -by (res_inst_tac [("n","i")] induct 1); -by (simp_tac add_ss 1); -by (asm_simp_tac (add_ss addsimps [prem]) 1); -result(); diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/nat.thy --- a/src/FOL/ex/nat.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,26 +0,0 @@ -(* Title: FOL/ex/nat.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -Examples for the manual "Introduction to Isabelle" - -Theory of the natural numbers: Peano's axioms, primitive recursion - -INCOMPATIBLE with nat2.thy, Nipkow's example -*) - -Nat = FOL + -types nat 0 -arities nat :: term -consts "0" :: "nat" ("0") - Suc :: "nat=>nat" - rec :: "[nat, 'a, [nat,'a]=>'a] => 'a" - "+" :: "[nat, nat] => nat" (infixl 60) -rules induct "[| P(0); !!x. P(x) ==> P(Suc(x)) |] ==> P(n)" - Suc_inject "Suc(m)=Suc(n) ==> m=n" - Suc_neq_0 "Suc(m)=0 ==> R" - rec_0 "rec(0,a,f) = a" - rec_Suc "rec(Suc(m), a, f) = f(m, rec(m,a,f))" - add_def "m+n == rec(m, n, %x y. Suc(y))" -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/nat2.ML --- a/src/FOL/ex/nat2.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,163 +0,0 @@ -(* Title: FOL/ex/nat2.ML - ID: $Id$ - Author: Tobias Nipkow - Copyright 1991 University of Cambridge - -For ex/nat.thy. -Examples of simplification and induction on the natural numbers -*) - -open Nat2; - -val nat_rews = [pred_0, pred_succ, plus_0, plus_succ, - nat_distinct1, nat_distinct2, succ_inject, - leq_0,leq_succ_succ,leq_succ_0, - lt_0_succ,lt_succ_succ,lt_0]; - -val nat_ss = FOL_ss addsimps nat_rews; - -val prems = goal Nat2.thy - "[| P(0); !!x. P(succ(x)) |] ==> All(P)"; -by (rtac nat_ind 1); -by (REPEAT (resolve_tac (prems@[allI,impI]) 1)); -val nat_exh = result(); - -goal Nat2.thy "~ n=succ(n)"; -by (IND_TAC nat_ind (simp_tac nat_ss) "n" 1); -result(); - -goal Nat2.thy "~ succ(n)=n"; -by (IND_TAC nat_ind (simp_tac nat_ss) "n" 1); -result(); - -goal Nat2.thy "~ succ(succ(n))=n"; -by (IND_TAC nat_ind (simp_tac nat_ss) "n" 1); -result(); - -goal Nat2.thy "~ n=succ(succ(n))"; -by (IND_TAC nat_ind (simp_tac nat_ss) "n" 1); -result(); - -goal Nat2.thy "m+0 = m"; -by (IND_TAC nat_ind (simp_tac nat_ss) "m" 1); -val plus_0_right = result(); - -goal Nat2.thy "m+succ(n) = succ(m+n)"; -by (IND_TAC nat_ind (simp_tac nat_ss) "m" 1); -val plus_succ_right = result(); - -goal Nat2.thy "~n=0 --> m+pred(n) = pred(m+n)"; -by (IND_TAC nat_ind (simp_tac (nat_ss addsimps [plus_succ_right])) "n" 1); -result(); - -goal Nat2.thy "~n=0 --> succ(pred(n))=n"; -by (IND_TAC nat_ind (simp_tac nat_ss) "n" 1); -result(); - -goal Nat2.thy "m+n=0 <-> m=0 & n=0"; -by (IND_TAC nat_ind (simp_tac nat_ss) "m" 1); -result(); - -goal Nat2.thy "m <= n --> m <= succ(n)"; -by (IND_TAC nat_ind (simp_tac nat_ss) "m" 1); -by (rtac (impI RS allI) 1); -by (ALL_IND_TAC nat_ind (simp_tac nat_ss) 1); -by (fast_tac FOL_cs 1); -val le_imp_le_succ = result() RS mp; - -goal Nat2.thy "n m < succ(n)"; -by (IND_TAC nat_ind (simp_tac nat_ss) "m" 1); -by (rtac (impI RS allI) 1); -by (ALL_IND_TAC nat_ind (simp_tac nat_ss) 1); -by (fast_tac FOL_cs 1); -result(); - -goal Nat2.thy "m <= n --> m <= n+k"; -by (IND_TAC nat_ind - (simp_tac (nat_ss addsimps [plus_0_right, plus_succ_right, le_imp_le_succ])) - "k" 1); -val le_plus = result(); - -goal Nat2.thy "succ(m) <= n --> m <= n"; -by (res_inst_tac [("x","n")]spec 1); -by (ALL_IND_TAC nat_exh (simp_tac (nat_ss addsimps [le_imp_le_succ])) 1); -val succ_le = result(); - -goal Nat2.thy "~m n<=m"; -by (IND_TAC nat_ind (simp_tac nat_ss) "n" 1); -by (rtac (impI RS allI) 1); -by (ALL_IND_TAC nat_ind (asm_simp_tac nat_ss) 1); -val not_less = result(); - -goal Nat2.thy "n<=m --> ~m ~n<=m"; -by (cut_facts_tac [not_less] 1 THEN fast_tac FOL_cs 1); -val not_le = result(); - -goal Nat2.thy "m+k<=n --> m<=n"; -by (IND_TAC nat_ind (K all_tac) "k" 1); -by (simp_tac (nat_ss addsimps [plus_0_right]) 1); -by (rtac (impI RS allI) 1); -by (simp_tac (nat_ss addsimps [plus_succ_right]) 1); -by (REPEAT (resolve_tac [allI,impI] 1)); -by (cut_facts_tac [succ_le] 1); -by (fast_tac FOL_cs 1); -val plus_le = result(); - -val prems = goal Nat2.thy "[| ~m=0; m <= n |] ==> ~n=0"; -by (cut_facts_tac prems 1); -by (REPEAT (etac rev_mp 1)); -by (IND_TAC nat_exh (simp_tac nat_ss) "m" 1); -by (ALL_IND_TAC nat_exh (simp_tac nat_ss) 1); -val not0 = result(); - -goal Nat2.thy "a<=a' & b<=b' --> a+b<=a'+b'"; -by (IND_TAC nat_ind (simp_tac (nat_ss addsimps [plus_0_right,le_plus])) "b" 1); -by (resolve_tac [impI RS allI] 1); -by (resolve_tac [allI RS allI] 1); -by (ALL_IND_TAC nat_exh (asm_simp_tac (nat_ss addsimps [plus_succ_right])) 1); -val plus_le_plus = result(); - -goal Nat2.thy "i<=j --> j<=k --> i<=k"; -by (IND_TAC nat_ind (K all_tac) "i" 1); -by (simp_tac nat_ss 1); -by (resolve_tac [impI RS allI] 1); -by (ALL_IND_TAC nat_exh (simp_tac nat_ss) 1); -by (ALL_IND_TAC nat_exh (simp_tac nat_ss) 1); -by (fast_tac FOL_cs 1); -val le_trans = result(); - -goal Nat2.thy "i < j --> j <=k --> i < k"; -by (IND_TAC nat_ind (K all_tac) "j" 1); -by (simp_tac nat_ss 1); -by (resolve_tac [impI RS allI] 1); -by (ALL_IND_TAC nat_exh (simp_tac nat_ss) 1); -by (ALL_IND_TAC nat_exh (simp_tac nat_ss) 1); -by (ALL_IND_TAC nat_exh (simp_tac nat_ss) 1); -by (fast_tac FOL_cs 1); -val less_le_trans = result(); - -goal Nat2.thy "succ(i) <= j <-> i < j"; -by (IND_TAC nat_ind (simp_tac nat_ss) "j" 1); -by (resolve_tac [impI RS allI] 1); -by (ALL_IND_TAC nat_exh (asm_simp_tac nat_ss) 1); -val succ_le = result(); - -goal Nat2.thy "i i=j | i nat" - "0" :: "nat" ("0") - "+" :: "[nat,nat] => nat" (infixr 90) - "<","<=" :: "[nat,nat] => o" (infixr 70) - -rules - pred_0 "pred(0) = 0" - pred_succ "pred(succ(m)) = m" - - plus_0 "0+n = n" - plus_succ "succ(m)+n = succ(m+n)" - - nat_distinct1 "~ 0=succ(n)" - nat_distinct2 "~ succ(m)=0" - succ_inject "succ(m)=succ(n) <-> m=n" - - leq_0 "0 <= n" - leq_succ_succ "succ(m)<=succ(n) <-> m<=n" - leq_succ_0 "~ succ(m) <= 0" - - lt_0_succ "0 < succ(n)" - lt_succ_succ "succ(m) mP(succ(n)) |] ==> All(P)" -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/prolog.ML --- a/src/FOL/ex/prolog.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,74 +0,0 @@ -(* Title: FOL/ex/prolog.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -For ex/prolog.thy. First-Order Logic: PROLOG examples -*) - -open Prolog; - -goal Prolog.thy "app(a:b:c:Nil, d:e:Nil, ?x)"; -by (resolve_tac [appNil,appCons] 1); -by (resolve_tac [appNil,appCons] 1); -by (resolve_tac [appNil,appCons] 1); -by (resolve_tac [appNil,appCons] 1); -prth (result()); - -goal Prolog.thy "app(?x, c:d:Nil, a:b:c:d:Nil)"; -by (REPEAT (resolve_tac [appNil,appCons] 1)); -result(); - - -goal Prolog.thy "app(?x, ?y, a:b:c:d:Nil)"; -by (REPEAT (resolve_tac [appNil,appCons] 1)); -back(); -back(); -back(); -back(); -result(); - - -(*app([x1,...,xn], y, ?z) requires (n+1) inferences*) -(*rev([x1,...,xn], ?y) requires (n+1)(n+2)/2 inferences*) - -goal Prolog.thy "rev(a:b:c:d:Nil, ?x)"; -val rules = [appNil,appCons,revNil,revCons]; -by (REPEAT (resolve_tac rules 1)); -result(); - -goal Prolog.thy "rev(a:b:c:d:e:f:g:h:i:j:k:l:m:n:Nil, ?w)"; -by (REPEAT (resolve_tac rules 1)); -result(); - -goal Prolog.thy "rev(?x, a:b:c:Nil)"; -by (REPEAT (resolve_tac rules 1)); (*does not solve it directly!*) -back(); -back(); - -(*backtracking version*) -val prolog_tac = DEPTH_FIRST (has_fewer_prems 1) (resolve_tac rules 1); - -choplev 0; -by prolog_tac; -result(); - -goal Prolog.thy "rev(a:?x:c:?y:Nil, d:?z:b:?u)"; -by prolog_tac; -result(); - -(*rev([a..p], ?w) requires 153 inferences *) -goal Prolog.thy "rev(a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:Nil, ?w)"; -by (DEPTH_SOLVE (resolve_tac ([refl,conjI]@rules) 1)); -(*Poly/ML: 4 secs >> 38 lips*) -result(); - -(*?x has 16, ?y has 32; rev(?y,?w) requires 561 (rather large) inferences; - total inferences = 2 + 1 + 17 + 561 = 581*) -goal Prolog.thy - "a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:Nil = ?x & app(?x,?x,?y) & rev(?y,?w)"; -by (DEPTH_SOLVE (resolve_tac ([refl,conjI]@rules) 1)); -(*Poly/ML: 29 secs >> 20 lips*) -result(); - -writeln"Reached end of file."; diff -r 19849d258890 -r 8018173a7979 src/FOL/ex/prolog.thy --- a/src/FOL/ex/prolog.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -(* Title: FOL/ex/prolog.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -First-Order Logic: PROLOG examples - -Inherits from FOL the class term, the type o, and the coercion Trueprop -*) - -Prolog = FOL + -types list 1 -arities list :: (term)term -consts Nil :: "'a list" - ":" :: "['a, 'a list]=> 'a list" (infixr 60) - app :: "['a list, 'a list, 'a list] => o" - rev :: "['a list, 'a list] => o" -rules appNil "app(Nil,ys,ys)" - appCons "app(xs,ys,zs) ==> app(x:xs, ys, x:zs)" - revNil "rev(Nil,Nil)" - revCons "[| rev(xs,ys); app(ys, x:Nil, zs) |] ==> rev(x:xs, zs)" -end diff -r 19849d258890 -r 8018173a7979 src/FOL/fol.ML --- a/src/FOL/fol.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,94 +0,0 @@ -(* Title: FOL/fol.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -Tactics and lemmas for fol.thy (classical First-Order Logic) -*) - -open FOL; - -signature FOL_LEMMAS = - sig - val disjCI : thm - val excluded_middle : thm - val exCI : thm - val ex_classical : thm - val iffCE : thm - val impCE : thm - val notnotD : thm - val swap : thm - end; - - -structure FOL_Lemmas : FOL_LEMMAS = -struct - -(*** Classical introduction rules for | and EX ***) - -val disjCI = prove_goal FOL.thy - "(~Q ==> P) ==> P|Q" - (fn prems=> - [ (resolve_tac [classical] 1), - (REPEAT (ares_tac (prems@[disjI1,notI]) 1)), - (REPEAT (ares_tac (prems@[disjI2,notE]) 1)) ]); - -(*introduction rule involving only EX*) -val ex_classical = prove_goal FOL.thy - "( ~(EX x. P(x)) ==> P(a)) ==> EX x.P(x)" - (fn prems=> - [ (resolve_tac [classical] 1), - (eresolve_tac (prems RL [exI]) 1) ]); - -(*version of above, simplifying ~EX to ALL~ *) -val exCI = prove_goal FOL.thy - "(ALL x. ~P(x) ==> P(a)) ==> EX x.P(x)" - (fn [prem]=> - [ (resolve_tac [ex_classical] 1), - (resolve_tac [notI RS allI RS prem] 1), - (eresolve_tac [notE] 1), - (eresolve_tac [exI] 1) ]); - -val excluded_middle = prove_goal FOL.thy "~P | P" - (fn _=> [ rtac disjCI 1, assume_tac 1 ]); - - -(*** Special elimination rules *) - - -(*Classical implies (-->) elimination. *) -val impCE = prove_goal FOL.thy - "[| P-->Q; ~P ==> R; Q ==> R |] ==> R" - (fn major::prems=> - [ (resolve_tac [excluded_middle RS disjE] 1), - (DEPTH_SOLVE (ares_tac (prems@[major RS mp]) 1)) ]); - -(*Double negation law*) -val notnotD = prove_goal FOL.thy "~~P ==> P" - (fn [major]=> - [ (resolve_tac [classical] 1), (eresolve_tac [major RS notE] 1) ]); - - -(*** Tactics for implication and contradiction ***) - -(*Classical <-> elimination. Proof substitutes P=Q in - ~P ==> ~Q and P ==> Q *) -val iffCE = prove_goalw FOL.thy [iff_def] - "[| P<->Q; [| P; Q |] ==> R; [| ~P; ~Q |] ==> R |] ==> R" - (fn prems => - [ (resolve_tac [conjE] 1), - (REPEAT (DEPTH_SOLVE_1 - (etac impCE 1 ORELSE mp_tac 1 ORELSE ares_tac prems 1))) ]); - - -(*Should be used as swap since ~P becomes redundant*) -val swap = prove_goal FOL.thy - "~P ==> (~Q ==> P) ==> Q" - (fn major::prems=> - [ (resolve_tac [classical] 1), - (rtac (major RS notE) 1), - (REPEAT (ares_tac prems 1)) ]); - -end; - -open FOL_Lemmas; diff -r 19849d258890 -r 8018173a7979 src/FOL/fol.thy --- a/src/FOL/fol.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -FOL = IFOL + -rules -classical "(~P ==> P) ==> P" -end diff -r 19849d258890 -r 8018173a7979 src/FOL/ifol.ML --- a/src/FOL/ifol.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,415 +0,0 @@ -(* Title: FOL/ifol.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -Tactics and lemmas for ifol.thy (intuitionistic first-order logic) -*) - -open IFOL; - -signature IFOL_LEMMAS = - sig - val allE: thm - val all_cong: thm - val all_dupE: thm - val all_impE: thm - val box_equals: thm - val conjE: thm - val conj_cong: thm - val conj_impE: thm - val contrapos: thm - val disj_cong: thm - val disj_impE: thm - val eq_cong: thm - val eq_mp_tac: int -> tactic - val ex1I: thm - val ex_ex1I: thm - val ex1E: thm - val ex1_equalsE: thm - val ex1_cong: thm - val ex_cong: thm - val ex_impE: thm - val iffD1: thm - val iffD2: thm - val iffE: thm - val iffI: thm - val iff_cong: thm - val iff_impE: thm - val iff_refl: thm - val iff_sym: thm - val iff_trans: thm - val impE: thm - val imp_cong: thm - val imp_impE: thm - val mp_tac: int -> tactic - val notE: thm - val notI: thm - val not_cong: thm - val not_impE: thm - val not_sym: thm - val not_to_imp: thm - val pred1_cong: thm - val pred2_cong: thm - val pred3_cong: thm - val pred_congs: thm list - val rev_mp: thm - val simp_equals: thm - val ssubst: thm - val subst_context: thm - val subst_context2: thm - val subst_context3: thm - val sym: thm - val trans: thm - val TrueI: thm - end; - - -structure IFOL_Lemmas : IFOL_LEMMAS = -struct - -val TrueI = prove_goalw IFOL.thy [True_def] "True" - (fn _ => [ (REPEAT (ares_tac [impI] 1)) ]); - -(*** Sequent-style elimination rules for & --> and ALL ***) - -val conjE = prove_goal IFOL.thy - "[| P&Q; [| P; Q |] ==> R |] ==> R" - (fn prems=> - [ (REPEAT (resolve_tac prems 1 - ORELSE (resolve_tac [conjunct1, conjunct2] 1 THEN - resolve_tac prems 1))) ]); - -val impE = prove_goal IFOL.thy - "[| P-->Q; P; Q ==> R |] ==> R" - (fn prems=> [ (REPEAT (resolve_tac (prems@[mp]) 1)) ]); - -val allE = prove_goal IFOL.thy - "[| ALL x.P(x); P(x) ==> R |] ==> R" - (fn prems=> [ (REPEAT (resolve_tac (prems@[spec]) 1)) ]); - -(*Duplicates the quantifier; for use with eresolve_tac*) -val all_dupE = prove_goal IFOL.thy - "[| ALL x.P(x); [| P(x); ALL x.P(x) |] ==> R \ -\ |] ==> R" - (fn prems=> [ (REPEAT (resolve_tac (prems@[spec]) 1)) ]); - - -(*** Negation rules, which translate between ~P and P-->False ***) - -val notI = prove_goalw IFOL.thy [not_def] "(P ==> False) ==> ~P" - (fn prems=> [ (REPEAT (ares_tac (prems@[impI]) 1)) ]); - -val notE = prove_goalw IFOL.thy [not_def] "[| ~P; P |] ==> R" - (fn prems=> - [ (resolve_tac [mp RS FalseE] 1), - (REPEAT (resolve_tac prems 1)) ]); - -(*This is useful with the special implication rules for each kind of P. *) -val not_to_imp = prove_goal IFOL.thy - "[| ~P; (P-->False) ==> Q |] ==> Q" - (fn prems=> [ (REPEAT (ares_tac (prems@[impI,notE]) 1)) ]); - - -(* For substitution int an assumption P, reduce Q to P-->Q, substitute into - this implication, then apply impI to move P back into the assumptions. - To specify P use something like - eres_inst_tac [ ("P","ALL y. ?S(x,y)") ] rev_mp 1 *) -val rev_mp = prove_goal IFOL.thy "[| P; P --> Q |] ==> Q" - (fn prems=> [ (REPEAT (resolve_tac (prems@[mp]) 1)) ]); - - -(*Contrapositive of an inference rule*) -val contrapos = prove_goal IFOL.thy "[| ~Q; P==>Q |] ==> ~P" - (fn [major,minor]=> - [ (rtac (major RS notE RS notI) 1), - (etac minor 1) ]); - - -(*** Modus Ponens Tactics ***) - -(*Finds P-->Q and P in the assumptions, replaces implication by Q *) -fun mp_tac i = eresolve_tac [notE,impE] i THEN assume_tac i; - -(*Like mp_tac but instantiates no variables*) -fun eq_mp_tac i = eresolve_tac [notE,impE] i THEN eq_assume_tac i; - - -(*** If-and-only-if ***) - -val iffI = prove_goalw IFOL.thy [iff_def] - "[| P ==> Q; Q ==> P |] ==> P<->Q" - (fn prems=> [ (REPEAT (ares_tac (prems@[conjI, impI]) 1)) ]); - - -(*Observe use of rewrite_rule to unfold "<->" in meta-assumptions (prems) *) -val iffE = prove_goalw IFOL.thy [iff_def] - "[| P <-> Q; [| P-->Q; Q-->P |] ==> R |] ==> R" - (fn prems => [ (resolve_tac [conjE] 1), (REPEAT (ares_tac prems 1)) ]); - -(* Destruct rules for <-> similar to Modus Ponens *) - -val iffD1 = prove_goalw IFOL.thy [iff_def] "[| P <-> Q; P |] ==> Q" - (fn prems => [ (rtac (conjunct1 RS mp) 1), (REPEAT (ares_tac prems 1)) ]); - -val iffD2 = prove_goalw IFOL.thy [iff_def] "[| P <-> Q; Q |] ==> P" - (fn prems => [ (rtac (conjunct2 RS mp) 1), (REPEAT (ares_tac prems 1)) ]); - -val iff_refl = prove_goal IFOL.thy "P <-> P" - (fn _ => [ (REPEAT (ares_tac [iffI] 1)) ]); - -val iff_sym = prove_goal IFOL.thy "Q <-> P ==> P <-> Q" - (fn [major] => - [ (rtac (major RS iffE) 1), - (rtac iffI 1), - (REPEAT (eresolve_tac [asm_rl,mp] 1)) ]); - -val iff_trans = prove_goal IFOL.thy - "!!P Q R. [| P <-> Q; Q<-> R |] ==> P <-> R" - (fn _ => - [ (rtac iffI 1), - (REPEAT (eresolve_tac [asm_rl,iffE] 1 ORELSE mp_tac 1)) ]); - - -(*** Unique existence. NOTE THAT the following 2 quantifications - EX!x such that [EX!y such that P(x,y)] (sequential) - EX!x,y such that P(x,y) (simultaneous) - do NOT mean the same thing. The parser treats EX!x y.P(x,y) as sequential. -***) - -val ex1I = prove_goalw IFOL.thy [ex1_def] - "[| P(a); !!x. P(x) ==> x=a |] ==> EX! x. P(x)" - (fn prems => [ (REPEAT (ares_tac (prems@[exI,conjI,allI,impI]) 1)) ]); - -(*Sometimes easier to use: the premises have no shared variables*) -val ex_ex1I = prove_goal IFOL.thy - "[| EX x.P(x); !!x y. [| P(x); P(y) |] ==> x=y |] ==> EX! x. P(x)" - (fn [ex,eq] => [ (rtac (ex RS exE) 1), - (REPEAT (ares_tac [ex1I,eq] 1)) ]); - -val ex1E = prove_goalw IFOL.thy [ex1_def] - "[| EX! x.P(x); !!x. [| P(x); ALL y. P(y) --> y=x |] ==> R |] ==> R" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (eresolve_tac [exE,conjE] 1 ORELSE ares_tac prems 1)) ]); - - -(*** <-> congruence rules for simplification ***) - -(*Use iffE on a premise. For conj_cong, imp_cong, all_cong, ex_cong*) -fun iff_tac prems i = - resolve_tac (prems RL [iffE]) i THEN - REPEAT1 (eresolve_tac [asm_rl,mp] i); - -val conj_cong = prove_goal IFOL.thy - "[| P <-> P'; P' ==> Q <-> Q' |] ==> (P&Q) <-> (P'&Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (ares_tac [iffI,conjI] 1 - ORELSE eresolve_tac [iffE,conjE,mp] 1 - ORELSE iff_tac prems 1)) ]); - -val disj_cong = prove_goal IFOL.thy - "[| P <-> P'; Q <-> Q' |] ==> (P|Q) <-> (P'|Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (eresolve_tac [iffE,disjE,disjI1,disjI2] 1 - ORELSE ares_tac [iffI] 1 - ORELSE mp_tac 1)) ]); - -val imp_cong = prove_goal IFOL.thy - "[| P <-> P'; P' ==> Q <-> Q' |] ==> (P-->Q) <-> (P'-->Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (ares_tac [iffI,impI] 1 - ORELSE eresolve_tac [iffE] 1 - ORELSE mp_tac 1 ORELSE iff_tac prems 1)) ]); - -val iff_cong = prove_goal IFOL.thy - "[| P <-> P'; Q <-> Q' |] ==> (P<->Q) <-> (P'<->Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (eresolve_tac [iffE] 1 - ORELSE ares_tac [iffI] 1 - ORELSE mp_tac 1)) ]); - -val not_cong = prove_goal IFOL.thy - "P <-> P' ==> ~P <-> ~P'" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (ares_tac [iffI,notI] 1 - ORELSE mp_tac 1 - ORELSE eresolve_tac [iffE,notE] 1)) ]); - -val all_cong = prove_goal IFOL.thy - "(!!x.P(x) <-> Q(x)) ==> (ALL x.P(x)) <-> (ALL x.Q(x))" - (fn prems => - [ (REPEAT (ares_tac [iffI,allI] 1 - ORELSE mp_tac 1 - ORELSE eresolve_tac [allE] 1 ORELSE iff_tac prems 1)) ]); - -val ex_cong = prove_goal IFOL.thy - "(!!x.P(x) <-> Q(x)) ==> (EX x.P(x)) <-> (EX x.Q(x))" - (fn prems => - [ (REPEAT (eresolve_tac [exE] 1 ORELSE ares_tac [iffI,exI] 1 - ORELSE mp_tac 1 - ORELSE iff_tac prems 1)) ]); - -val ex1_cong = prove_goal IFOL.thy - "(!!x.P(x) <-> Q(x)) ==> (EX! x.P(x)) <-> (EX! x.Q(x))" - (fn prems => - [ (REPEAT (eresolve_tac [ex1E, spec RS mp] 1 ORELSE ares_tac [iffI,ex1I] 1 - ORELSE mp_tac 1 - ORELSE iff_tac prems 1)) ]); - -(*** Equality rules ***) - -val sym = prove_goal IFOL.thy "a=b ==> b=a" - (fn [major] => [ (rtac (major RS subst) 1), (rtac refl 1) ]); - -val trans = prove_goal IFOL.thy "[| a=b; b=c |] ==> a=c" - (fn [prem1,prem2] => [ (rtac (prem2 RS subst) 1), (rtac prem1 1) ]); - -(** ~ b=a ==> ~ a=b **) -val [not_sym] = compose(sym,2,contrapos); - -(*calling "standard" reduces maxidx to 0*) -val ssubst = standard (sym RS subst); - -(*A special case of ex1E that would otherwise need quantifier expansion*) -val ex1_equalsE = prove_goal IFOL.thy - "[| EX! x.P(x); P(a); P(b) |] ==> a=b" - (fn prems => - [ (cut_facts_tac prems 1), - (etac ex1E 1), - (rtac trans 1), - (rtac sym 2), - (REPEAT (eresolve_tac [asm_rl, spec RS mp] 1)) ]); - -(** Polymorphic congruence rules **) - -val subst_context = prove_goal IFOL.thy - "[| a=b |] ==> t(a)=t(b)" - (fn prems=> - [ (resolve_tac (prems RL [ssubst]) 1), - (resolve_tac [refl] 1) ]); - -val subst_context2 = prove_goal IFOL.thy - "[| a=b; c=d |] ==> t(a,c)=t(b,d)" - (fn prems=> - [ (EVERY1 (map rtac ((prems RL [ssubst]) @ [refl]))) ]); - -val subst_context3 = prove_goal IFOL.thy - "[| a=b; c=d; e=f |] ==> t(a,c,e)=t(b,d,f)" - (fn prems=> - [ (EVERY1 (map rtac ((prems RL [ssubst]) @ [refl]))) ]); - -(*Useful with eresolve_tac for proving equalties from known equalities. - a = b - | | - c = d *) -val box_equals = prove_goal IFOL.thy - "[| a=b; a=c; b=d |] ==> c=d" - (fn prems=> - [ (resolve_tac [trans] 1), - (resolve_tac [trans] 1), - (resolve_tac [sym] 1), - (REPEAT (resolve_tac prems 1)) ]); - -(*Dual of box_equals: for proving equalities backwards*) -val simp_equals = prove_goal IFOL.thy - "[| a=c; b=d; c=d |] ==> a=b" - (fn prems=> - [ (resolve_tac [trans] 1), - (resolve_tac [trans] 1), - (REPEAT (resolve_tac (prems @ (prems RL [sym])) 1)) ]); - -(** Congruence rules for predicate letters **) - -val pred1_cong = prove_goal IFOL.thy - "a=a' ==> P(a) <-> P(a')" - (fn prems => - [ (cut_facts_tac prems 1), - (rtac iffI 1), - (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ]); - -val pred2_cong = prove_goal IFOL.thy - "[| a=a'; b=b' |] ==> P(a,b) <-> P(a',b')" - (fn prems => - [ (cut_facts_tac prems 1), - (rtac iffI 1), - (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ]); - -val pred3_cong = prove_goal IFOL.thy - "[| a=a'; b=b'; c=c' |] ==> P(a,b,c) <-> P(a',b',c')" - (fn prems => - [ (cut_facts_tac prems 1), - (rtac iffI 1), - (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ]); - -(*special cases for free variables P, Q, R, S -- up to 3 arguments*) - -val pred_congs = - flat (map (fn c => - map (fn th => read_instantiate [("P",c)] th) - [pred1_cong,pred2_cong,pred3_cong]) - (explode"PQRS")); - -(*special case for the equality predicate!*) -val eq_cong = read_instantiate [("P","op =")] pred2_cong; - - -(*** Simplifications of assumed implications. - Roy Dyckhoff has proved that conj_impE, disj_impE, and imp_impE - used with mp_tac (restricted to atomic formulae) is COMPLETE for - intuitionistic propositional logic. See - R. Dyckhoff, Contraction-free sequent calculi for intuitionistic logic - (preprint, University of St Andrews, 1991) ***) - -val conj_impE = prove_goal IFOL.thy - "[| (P&Q)-->S; P-->(Q-->S) ==> R |] ==> R" - (fn major::prems=> - [ (REPEAT (ares_tac ([conjI, impI, major RS mp]@prems) 1)) ]); - -val disj_impE = prove_goal IFOL.thy - "[| (P|Q)-->S; [| P-->S; Q-->S |] ==> R |] ==> R" - (fn major::prems=> - [ (DEPTH_SOLVE (ares_tac ([disjI1, disjI2, impI, major RS mp]@prems) 1)) ]); - -(*Simplifies the implication. Classical version is stronger. - Still UNSAFE since Q must be provable -- backtracking needed. *) -val imp_impE = prove_goal IFOL.thy - "[| (P-->Q)-->S; [| P; Q-->S |] ==> Q; S ==> R |] ==> R" - (fn major::prems=> - [ (REPEAT (ares_tac ([impI, major RS mp]@prems) 1)) ]); - -(*Simplifies the implication. Classical version is stronger. - Still UNSAFE since ~P must be provable -- backtracking needed. *) -val not_impE = prove_goal IFOL.thy - "[| ~P --> S; P ==> False; S ==> R |] ==> R" - (fn major::prems=> - [ (REPEAT (ares_tac ([notI, impI, major RS mp]@prems) 1)) ]); - -(*Simplifies the implication. UNSAFE. *) -val iff_impE = prove_goal IFOL.thy - "[| (P<->Q)-->S; [| P; Q-->S |] ==> Q; [| Q; P-->S |] ==> P; \ -\ S ==> R |] ==> R" - (fn major::prems=> - [ (REPEAT (ares_tac ([iffI, impI, major RS mp]@prems) 1)) ]); - -(*What if (ALL x.~~P(x)) --> ~~(ALL x.P(x)) is an assumption? UNSAFE*) -val all_impE = prove_goal IFOL.thy - "[| (ALL x.P(x))-->S; !!x.P(x); S ==> R |] ==> R" - (fn major::prems=> - [ (REPEAT (ares_tac ([allI, impI, major RS mp]@prems) 1)) ]); - -(*Unsafe: (EX x.P(x))-->S is equivalent to ALL x.P(x)-->S. *) -val ex_impE = prove_goal IFOL.thy - "[| (EX x.P(x))-->S; P(x)-->S ==> R |] ==> R" - (fn major::prems=> - [ (REPEAT (ares_tac ([exI, impI, major RS mp]@prems) 1)) ]); - -end; - -open IFOL_Lemmas; - diff -r 19849d258890 -r 8018173a7979 src/FOL/ifol.thy --- a/src/FOL/ifol.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,97 +0,0 @@ -(* Title: FOL/ifol.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1993 University of Cambridge - -Intuitionistic first-order logic -*) - -IFOL = Pure + - -classes - term < logic - -default - term - -types - o - -arities - o :: logic - - -consts - - Trueprop :: "o => prop" ("(_)" 5) - True, False :: "o" - - (* Connectives *) - - "=" :: "['a, 'a] => o" (infixl 50) - "~=" :: "['a, 'a] => o" ("(_ ~=/ _)" [50, 51] 50) - - Not :: "o => o" ("~ _" [40] 40) - "&" :: "[o, o] => o" (infixr 35) - "|" :: "[o, o] => o" (infixr 30) - "-->" :: "[o, o] => o" (infixr 25) - "<->" :: "[o, o] => o" (infixr 25) - - (* Quantifiers *) - - All :: "('a => o) => o" (binder "ALL " 10) - Ex :: "('a => o) => o" (binder "EX " 10) - Ex1 :: "('a => o) => o" (binder "EX! " 10) - - -translations - "x ~= y" == "~ (x = y)" - - -rules - - (* Equality *) - - refl "a=a" - subst "[| a=b; P(a) |] ==> P(b)" - - (* Propositional logic *) - - conjI "[| P; Q |] ==> P&Q" - conjunct1 "P&Q ==> P" - conjunct2 "P&Q ==> Q" - - disjI1 "P ==> P|Q" - disjI2 "Q ==> P|Q" - disjE "[| P|Q; P ==> R; Q ==> R |] ==> R" - - impI "(P ==> Q) ==> P-->Q" - mp "[| P-->Q; P |] ==> Q" - - FalseE "False ==> P" - - (* Definitions *) - - True_def "True == False-->False" - not_def "~P == P-->False" - iff_def "P<->Q == (P-->Q) & (Q-->P)" - - (* Unique existence *) - - ex1_def "EX! x. P(x) == EX x. P(x) & (ALL y. P(y) --> y=x)" - - (* Quantifiers *) - - allI "(!!x. P(x)) ==> (ALL x.P(x))" - spec "(ALL x.P(x)) ==> P(x)" - - exI "P(x) ==> (EX x.P(x))" - exE "[| EX x.P(x); !!x. P(x) ==> R |] ==> R" - - (* Reflection *) - - eq_reflection "(x=y) ==> (x==y)" - iff_reflection "(P<->Q) ==> (P==Q)" - -end - diff -r 19849d258890 -r 8018173a7979 src/FOL/int-prover.ML --- a/src/FOL/int-prover.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,81 +0,0 @@ -(* Title: FOL/int-prover - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -A naive prover for intuitionistic logic - -BEWARE OF NAME CLASHES WITH CLASSICAL TACTICS -- use Int.fast_tac ... - -Completeness (for propositional logic) is proved in - -Roy Dyckhoff. -Contraction-Free Sequent Calculi for Intuitionistic Logic. -J. Symbolic Logic (in press) -*) - -signature INT_PROVER = - sig - val best_tac: int -> tactic - val fast_tac: int -> tactic - val inst_step_tac: int -> tactic - val safe_step_tac: int -> tactic - val safe_brls: (bool * thm) list - val safe_tac: tactic - val step_tac: int -> tactic - val haz_brls: (bool * thm) list - end; - - -structure Int : INT_PROVER = -struct - -(*Negation is treated as a primitive symbol, with rules notI (introduction), - not_to_imp (converts the assumption ~P to P-->False), and not_impE - (handles double negations). Could instead rewrite by not_def as the first - step of an intuitionistic proof. -*) -val safe_brls = sort lessb - [ (true,FalseE), (false,TrueI), (false,refl), - (false,impI), (false,notI), (false,allI), - (true,conjE), (true,exE), - (false,conjI), (true,conj_impE), - (true,disj_impE), (true,ex_impE), - (true,disjE), (false,iffI), (true,iffE), (true,not_to_imp) ]; - -val haz_brls = - [ (false,disjI1), (false,disjI2), (false,exI), - (true,allE), (true,not_impE), (true,imp_impE), (true,iff_impE), - (true,all_impE), (true,impE) ]; - -(*0 subgoals vs 1 or more: the p in safep is for positive*) -val (safe0_brls, safep_brls) = - partition (apl(0,op=) o subgoals_of_brl) safe_brls; - -(*Attack subgoals using safe inferences -- matching, not resolution*) -val safe_step_tac = FIRST' [eq_assume_tac, - eq_mp_tac, - bimatch_tac safe0_brls, - hyp_subst_tac, - bimatch_tac safep_brls] ; - -(*Repeatedly attack subgoals using safe inferences -- it's deterministic!*) -val safe_tac = DETERM (REPEAT_FIRST safe_step_tac); - -(*These steps could instantiate variables and are therefore unsafe.*) -val inst_step_tac = - assume_tac APPEND' mp_tac APPEND' - biresolve_tac (safe0_brls @ safep_brls); - -(*One safe or unsafe step. *) -fun step_tac i = FIRST [safe_tac, inst_step_tac i, biresolve_tac haz_brls i]; - -(*Dumb but fast*) -val fast_tac = SELECT_GOAL (DEPTH_SOLVE (step_tac 1)); - -(*Slower but smarter than fast_tac*) -val best_tac = - SELECT_GOAL (BEST_FIRST (has_fewer_prems 1, size_of_thm) (step_tac 1)); - -end; - diff -r 19849d258890 -r 8018173a7979 src/FOLP/change --- a/src/FOLP/change Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -#! /bin/sh -# -# Usage: -# expandshort FILE1 ... FILEn -# -# leaves previous versions as XXX~~ -# -for f in $* -do -echo Expanding shorthands in $f. \ Backup file is $f~~ -mv $f $f~~; sed -e ' -s/PFOL/FOLP/g -s/PIFOL/IFOLP/g -s/pfol/folp/g -s/pifol/ifolp/g -' $f~~ > $f -done -echo Finished. diff -r 19849d258890 -r 8018173a7979 src/FOLP/ex/if.ML --- a/src/FOLP/ex/if.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,43 +0,0 @@ -(* Title: FOLP/ex/if - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -For ex/if.thy. First-Order Logic: the 'if' example -*) - -open If; -open Cla; (*in case structure Int is open!*) - -val prems = goalw If.thy [if_def] - "[| !!x.x:P ==> f(x):Q; !!x.x:~P ==> g(x):R |] ==> ?p:if(P,Q,R)"; -by (fast_tac (FOLP_cs addIs prems) 1); -val ifI = result(); - -val major::prems = goalw If.thy [if_def] - "[| p:if(P,Q,R); !!x y.[| x:P; y:Q |] ==> f(x,y):S; \ -\ !!x y.[| x:~P; y:R |] ==> g(x,y):S |] ==> ?p:S"; -by (cut_facts_tac [major] 1); -by (fast_tac (FOLP_cs addIs prems) 1); -val ifE = result(); - - -goal If.thy - "?p : if(P, if(Q,A,B), if(Q,C,D)) <-> if(Q, if(P,A,C), if(P,B,D))"; -by (resolve_tac [iffI] 1); -by (eresolve_tac [ifE] 1); -by (eresolve_tac [ifE] 1); -by (resolve_tac [ifI] 1); -by (resolve_tac [ifI] 1); - -choplev 0; -val if_cs = FOLP_cs addSIs [ifI] addSEs[ifE]; -by (fast_tac if_cs 1); -val if_commute = result(); - - -goal If.thy "?p : if(if(P,Q,R), A, B) <-> if(P, if(Q,A,B), if(R,A,B))"; -by (fast_tac if_cs 1); -val nested_ifs = result(); - -writeln"Reached end of file."; diff -r 19849d258890 -r 8018173a7979 src/FOLP/ex/if.thy --- a/src/FOLP/ex/if.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -If = FOLP + -consts if :: "[o,o,o]=>o" -rules - if_def "if(P,Q,R) == P&Q | ~P&R" -end diff -r 19849d258890 -r 8018173a7979 src/FOLP/ex/nat.ML --- a/src/FOLP/ex/nat.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,82 +0,0 @@ -(* Title: FOLP/ex/nat.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -Examples for the manual "Introduction to Isabelle" - -Proofs about the natural numbers - -To generate similar output to manual, execute these commands: - Pretty.setmargin 72; print_depth 0; -*) - -open Nat; - -goal Nat.thy "?p : ~ (Suc(k) = k)"; -by (res_inst_tac [("n","k")] induct 1); -by (rtac notI 1); -by (etac Suc_neq_0 1); -by (rtac notI 1); -by (etac notE 1); -by (etac Suc_inject 1); -val Suc_n_not_n = result(); - - -goal Nat.thy "?p : (k+m)+n = k+(m+n)"; -prths ([induct] RL [topthm()]); (*prints all 14 next states!*) -by (rtac induct 1); -back(); -back(); -back(); -back(); -back(); -back(); - -goalw Nat.thy [add_def] "?p : 0+n = n"; -by (rtac rec_0 1); -val add_0 = result(); - -goalw Nat.thy [add_def] "?p : Suc(m)+n = Suc(m+n)"; -by (rtac rec_Suc 1); -val add_Suc = result(); - -(* -val nat_congs = mk_congs Nat.thy ["Suc", "op +"]; -prths nat_congs; -*) -val prems = goal Nat.thy "p: x=y ==> ?p : Suc(x) = Suc(y)"; -by (resolve_tac (prems RL [subst]) 1); -by (rtac refl 1); -val Suc_cong = result(); - -val prems = goal Nat.thy "[| p : a=x; q: b=y |] ==> ?p : a+b=x+y"; -by (resolve_tac (prems RL [subst]) 1 THEN resolve_tac (prems RL [subst]) 1 THEN - rtac refl 1); -val Plus_cong = result(); - -val nat_congs = [Suc_cong,Plus_cong]; - - -val add_ss = FOLP_ss addcongs nat_congs - addrews [add_0, add_Suc]; - -goal Nat.thy "?p : (k+m)+n = k+(m+n)"; -by (res_inst_tac [("n","k")] induct 1); -by (SIMP_TAC add_ss 1); -by (ASM_SIMP_TAC add_ss 1); -val add_assoc = result(); - -goal Nat.thy "?p : m+0 = m"; -by (res_inst_tac [("n","m")] induct 1); -by (SIMP_TAC add_ss 1); -by (ASM_SIMP_TAC add_ss 1); -val add_0_right = result(); - -goal Nat.thy "?p : m+Suc(n) = Suc(m+n)"; -by (res_inst_tac [("n","m")] induct 1); -by (ALLGOALS (ASM_SIMP_TAC add_ss)); -val add_Suc_right = result(); - -(*mk_typed_congs appears not to work with FOLP's version of subst*) - diff -r 19849d258890 -r 8018173a7979 src/FOLP/ex/nat.thy --- a/src/FOLP/ex/nat.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -(* Title: FOLP/ex/nat.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -Examples for the manual "Introduction to Isabelle" - -Theory of the natural numbers: Peano's axioms, primitive recursion -*) - -Nat = IFOLP + -types nat 0 -arities nat :: term -consts "0" :: "nat" ("0") - Suc :: "nat=>nat" - rec :: "[nat, 'a, [nat,'a]=>'a] => 'a" - "+" :: "[nat, nat] => nat" (infixl 60) - - (*Proof terms*) - nrec :: "[nat,p,[nat,p]=>p]=>p" - ninj,nneq :: "p=>p" - rec0, recSuc :: "p" - -rules - induct "[| b:P(0); !!x u. u:P(x) ==> c(x,u):P(Suc(x)) \ -\ |] ==> nrec(n,b,c):P(n)" - - Suc_inject "p:Suc(m)=Suc(n) ==> ninj(p) : m=n" - Suc_neq_0 "p:Suc(m)=0 ==> nneq(p) : R" - rec_0 "rec0 : rec(0,a,f) = a" - rec_Suc "recSuc : rec(Suc(m), a, f) = f(m, rec(m,a,f))" - add_def "m+n == rec(m, n, %x y. Suc(y))" - - nrecB0 "b: A ==> nrec(0,b,c) = b : A" - nrecBSuc "c(n,nrec(n,b,c)) : A ==> nrec(Suc(n),b,c) = c(n,nrec(n,b,c)) : A" -end diff -r 19849d258890 -r 8018173a7979 src/FOLP/ex/prolog.ML --- a/src/FOLP/ex/prolog.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,74 +0,0 @@ -(* Title: FOL/ex/prolog.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -For ex/prolog.thy. First-Order Logic: PROLOG examples -*) - -open Prolog; - -goal Prolog.thy "app(a:b:c:Nil, d:e:Nil, ?x)"; -by (resolve_tac [appNil,appCons] 1); -by (resolve_tac [appNil,appCons] 1); -by (resolve_tac [appNil,appCons] 1); -by (resolve_tac [appNil,appCons] 1); -prth (result()); - -goal Prolog.thy "app(?x, c:d:Nil, a:b:c:d:Nil)"; -by (REPEAT (resolve_tac [appNil,appCons] 1)); -result(); - - -goal Prolog.thy "app(?x, ?y, a:b:c:d:Nil)"; -by (REPEAT (resolve_tac [appNil,appCons] 1)); -back(); -back(); -back(); -back(); -result(); - - -(*app([x1,...,xn], y, ?z) requires (n+1) inferences*) -(*rev([x1,...,xn], ?y) requires (n+1)(n+2)/2 inferences*) - -goal Prolog.thy "rev(a:b:c:d:Nil, ?x)"; -val rules = [appNil,appCons,revNil,revCons]; -by (REPEAT (resolve_tac rules 1)); -result(); - -goal Prolog.thy "rev(a:b:c:d:e:f:g:h:i:j:k:l:m:n:Nil, ?w)"; -by (REPEAT (resolve_tac rules 1)); -result(); - -goal Prolog.thy "rev(?x, a:b:c:Nil)"; -by (REPEAT (resolve_tac rules 1)); (*does not solve it directly!*) -back(); -back(); - -(*backtracking version*) -val prolog_tac = DEPTH_FIRST (has_fewer_prems 1) (resolve_tac rules 1); - -choplev 0; -by prolog_tac; -result(); - -goal Prolog.thy "rev(a:?x:c:?y:Nil, d:?z:b:?u)"; -by prolog_tac; -result(); - -(*rev([a..p], ?w) requires 153 inferences *) -goal Prolog.thy "rev(a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:Nil, ?w)"; -by (DEPTH_SOLVE (resolve_tac ([refl,conjI]@rules) 1)); -(*Poly/ML: 4 secs >> 38 lips*) -result(); - -(*?x has 16, ?y has 32; rev(?y,?w) requires 561 (rather large) inferences; - total inferences = 2 + 1 + 17 + 561 = 581*) -goal Prolog.thy - "a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:Nil = ?x & app(?x,?x,?y) & rev(?y,?w)"; -by (DEPTH_SOLVE (resolve_tac ([refl,conjI]@rules) 1)); -(*Poly/ML: 29 secs >> 20 lips*) -result(); - -writeln"Reached end of file."; diff -r 19849d258890 -r 8018173a7979 src/FOLP/ex/prolog.thy --- a/src/FOLP/ex/prolog.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -(* Title: FOL/ex/prolog.thy - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -First-Order Logic: PROLOG examples - -Inherits from FOL the class term, the type o, and the coercion Trueprop -*) - -Prolog = FOL + -types list 1 -arities list :: (term)term -consts Nil :: "'a list" - ":" :: "['a, 'a list]=> 'a list" (infixr 60) - app :: "['a list, 'a list, 'a list] => o" - rev :: "['a list, 'a list] => o" -rules appNil "app(Nil,ys,ys)" - appCons "app(xs,ys,zs) ==> app(x:xs, ys, x:zs)" - revNil "rev(Nil,Nil)" - revCons "[| rev(xs,ys); app(ys, x:Nil, zs) |] ==> rev(x:xs, zs)" -end diff -r 19849d258890 -r 8018173a7979 src/FOLP/folp.ML --- a/src/FOLP/folp.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -(* Title: FOL/fol.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1991 University of Cambridge - -Tactics and lemmas for fol.thy (classical First-Order Logic) -*) - -open FOLP; - -signature FOLP_LEMMAS = - sig - val disjCI : thm - val excluded_middle : thm - val exCI : thm - val ex_classical : thm - val iffCE : thm - val impCE : thm - val notnotD : thm - val swap : thm - end; - - -structure FOLP_Lemmas : FOLP_LEMMAS = -struct - -(*** Classical introduction rules for | and EX ***) - -val disjCI = prove_goal FOLP.thy - "(!!x.x:~Q ==> f(x):P) ==> ?p : P|Q" - (fn prems=> - [ (resolve_tac [classical] 1), - (REPEAT (ares_tac (prems@[disjI1,notI]) 1)), - (REPEAT (ares_tac (prems@[disjI2,notE]) 1)) ]); - -(*introduction rule involving only EX*) -val ex_classical = prove_goal FOLP.thy - "( !!u.u:~(EX x. P(x)) ==> f(u):P(a)) ==> ?p : EX x.P(x)" - (fn prems=> - [ (resolve_tac [classical] 1), - (eresolve_tac (prems RL [exI]) 1) ]); - -(*version of above, simplifying ~EX to ALL~ *) -val exCI = prove_goal FOLP.thy - "(!!u.u:ALL x. ~P(x) ==> f(u):P(a)) ==> ?p : EX x.P(x)" - (fn [prem]=> - [ (resolve_tac [ex_classical] 1), - (resolve_tac [notI RS allI RS prem] 1), - (eresolve_tac [notE] 1), - (eresolve_tac [exI] 1) ]); - -val excluded_middle = prove_goal FOLP.thy "?p : ~P | P" - (fn _=> [ rtac disjCI 1, assume_tac 1 ]); - - -(*** Special elimination rules *) - - -(*Classical implies (-->) elimination. *) -val impCE = prove_goal FOLP.thy - "[| p:P-->Q; !!x.x:~P ==> f(x):R; !!y.y:Q ==> g(y):R |] ==> ?p : R" - (fn major::prems=> - [ (resolve_tac [excluded_middle RS disjE] 1), - (DEPTH_SOLVE (ares_tac (prems@[major RS mp]) 1)) ]); - -(*Double negation law*) -val notnotD = prove_goal FOLP.thy "p:~~P ==> ?p : P" - (fn [major]=> - [ (resolve_tac [classical] 1), (eresolve_tac [major RS notE] 1) ]); - - -(*** Tactics for implication and contradiction ***) - -(*Classical <-> elimination. Proof substitutes P=Q in - ~P ==> ~Q and P ==> Q *) -val iffCE = prove_goalw FOLP.thy [iff_def] - "[| p:P<->Q; !!x y.[| x:P; y:Q |] ==> f(x,y):R; \ -\ !!x y.[| x:~P; y:~Q |] ==> g(x,y):R |] ==> ?p : R" - (fn prems => - [ (resolve_tac [conjE] 1), - (REPEAT (DEPTH_SOLVE_1 - (etac impCE 1 ORELSE mp_tac 1 ORELSE ares_tac prems 1))) ]); - - -(*Should be used as swap since ~P becomes redundant*) -val swap = prove_goal FOLP.thy - "p:~P ==> (!!x.x:~Q ==> f(x):P) ==> ?p : Q" - (fn major::prems=> - [ (resolve_tac [classical] 1), - (rtac (major RS notE) 1), - (REPEAT (ares_tac prems 1)) ]); - -end; - -open FOLP_Lemmas; diff -r 19849d258890 -r 8018173a7979 src/FOLP/folp.thy --- a/src/FOLP/folp.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -FOLP = IFOLP + -consts - cla :: "[p=>p]=>p" -rules - classical "(!!x.x:~P ==> f(x):P) ==> cla(f):P" -end diff -r 19849d258890 -r 8018173a7979 src/FOLP/ifolp.ML --- a/src/FOLP/ifolp.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,444 +0,0 @@ -(* Title: FOLP/ifol.ML - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -Tactics and lemmas for ifol.thy (intuitionistic first-order logic) -*) - -open IFOLP; - -signature IFOLP_LEMMAS = - sig - val allE: thm - val all_cong: thm - val all_dupE: thm - val all_impE: thm - val box_equals: thm - val conjE: thm - val conj_cong: thm - val conj_impE: thm - val contrapos: thm - val disj_cong: thm - val disj_impE: thm - val eq_cong: thm - val ex1I: thm - val ex1E: thm - val ex1_equalsE: thm -(* val ex1_cong: thm****) - val ex_cong: thm - val ex_impE: thm - val iffD1: thm - val iffD2: thm - val iffE: thm - val iffI: thm - val iff_cong: thm - val iff_impE: thm - val iff_refl: thm - val iff_sym: thm - val iff_trans: thm - val impE: thm - val imp_cong: thm - val imp_impE: thm - val mp_tac: int -> tactic - val notE: thm - val notI: thm - val not_cong: thm - val not_impE: thm - val not_sym: thm - val not_to_imp: thm - val pred1_cong: thm - val pred2_cong: thm - val pred3_cong: thm - val pred_congs: thm list - val refl: thm - val rev_mp: thm - val simp_equals: thm - val subst: thm - val ssubst: thm - val subst_context: thm - val subst_context2: thm - val subst_context3: thm - val sym: thm - val trans: thm - val TrueI: thm - val uniq_assume_tac: int -> tactic - val uniq_mp_tac: int -> tactic - end; - - -structure IFOLP_Lemmas : IFOLP_LEMMAS = -struct - -val TrueI = TrueI; - -(*** Sequent-style elimination rules for & --> and ALL ***) - -val conjE = prove_goal IFOLP.thy - "[| p:P&Q; !!x y.[| x:P; y:Q |] ==> f(x,y):R |] ==> ?a:R" - (fn prems=> - [ (REPEAT (resolve_tac prems 1 - ORELSE (resolve_tac [conjunct1, conjunct2] 1 THEN - resolve_tac prems 1))) ]); - -val impE = prove_goal IFOLP.thy - "[| p:P-->Q; q:P; !!x.x:Q ==> r(x):R |] ==> ?p:R" - (fn prems=> [ (REPEAT (resolve_tac (prems@[mp]) 1)) ]); - -val allE = prove_goal IFOLP.thy - "[| p:ALL x.P(x); !!y.y:P(x) ==> q(y):R |] ==> ?p:R" - (fn prems=> [ (REPEAT (resolve_tac (prems@[spec]) 1)) ]); - -(*Duplicates the quantifier; for use with eresolve_tac*) -val all_dupE = prove_goal IFOLP.thy - "[| p:ALL x.P(x); !!y z.[| y:P(x); z:ALL x.P(x) |] ==> q(y,z):R \ -\ |] ==> ?p:R" - (fn prems=> [ (REPEAT (resolve_tac (prems@[spec]) 1)) ]); - - -(*** Negation rules, which translate between ~P and P-->False ***) - -val notI = prove_goalw IFOLP.thy [not_def] "(!!x.x:P ==> q(x):False) ==> ?p:~P" - (fn prems=> [ (REPEAT (ares_tac (prems@[impI]) 1)) ]); - -val notE = prove_goalw IFOLP.thy [not_def] "[| p:~P; q:P |] ==> ?p:R" - (fn prems=> - [ (resolve_tac [mp RS FalseE] 1), - (REPEAT (resolve_tac prems 1)) ]); - -(*This is useful with the special implication rules for each kind of P. *) -val not_to_imp = prove_goal IFOLP.thy - "[| p:~P; !!x.x:(P-->False) ==> q(x):Q |] ==> ?p:Q" - (fn prems=> [ (REPEAT (ares_tac (prems@[impI,notE]) 1)) ]); - - -(* For substitution int an assumption P, reduce Q to P-->Q, substitute into - this implication, then apply impI to move P back into the assumptions. - To specify P use something like - eres_inst_tac [ ("P","ALL y. ?S(x,y)") ] rev_mp 1 *) -val rev_mp = prove_goal IFOLP.thy "[| p:P; q:P --> Q |] ==> ?p:Q" - (fn prems=> [ (REPEAT (resolve_tac (prems@[mp]) 1)) ]); - - -(*Contrapositive of an inference rule*) -val contrapos = prove_goal IFOLP.thy "[| p:~Q; !!y.y:P==>q(y):Q |] ==> ?a:~P" - (fn [major,minor]=> - [ (rtac (major RS notE RS notI) 1), - (etac minor 1) ]); - -(** Unique assumption tactic. - Ignores proof objects. - Fails unless one assumption is equal and exactly one is unifiable -**) - -local - fun discard_proof (Const("Proof",_) $ P $ _) = P; -in -val uniq_assume_tac = - SUBGOAL - (fn (prem,i) => - let val hyps = map discard_proof (Logic.strip_assums_hyp prem) - and concl = discard_proof (Logic.strip_assums_concl prem) - in - if exists (fn hyp => hyp aconv concl) hyps - then case distinct (filter (fn hyp=> could_unify(hyp,concl)) hyps) of - [_] => assume_tac i - | _ => no_tac - else no_tac - end); -end; - - -(*** Modus Ponens Tactics ***) - -(*Finds P-->Q and P in the assumptions, replaces implication by Q *) -fun mp_tac i = eresolve_tac [notE,make_elim mp] i THEN assume_tac i; - -(*Like mp_tac but instantiates no variables*) -fun uniq_mp_tac i = eresolve_tac [notE,impE] i THEN uniq_assume_tac i; - - -(*** If-and-only-if ***) - -val iffI = prove_goalw IFOLP.thy [iff_def] - "[| !!x.x:P ==> q(x):Q; !!x.x:Q ==> r(x):P |] ==> ?p:P<->Q" - (fn prems=> [ (REPEAT (ares_tac (prems@[conjI, impI]) 1)) ]); - - -(*Observe use of rewrite_rule to unfold "<->" in meta-assumptions (prems) *) -val iffE = prove_goalw IFOLP.thy [iff_def] - "[| p:P <-> Q; !!x y.[| x:P-->Q; y:Q-->P |] ==> q(x,y):R |] ==> ?p:R" - (fn prems => [ (resolve_tac [conjE] 1), (REPEAT (ares_tac prems 1)) ]); - -(* Destruct rules for <-> similar to Modus Ponens *) - -val iffD1 = prove_goalw IFOLP.thy [iff_def] "[| p:P <-> Q; q:P |] ==> ?p:Q" - (fn prems => [ (rtac (conjunct1 RS mp) 1), (REPEAT (ares_tac prems 1)) ]); - -val iffD2 = prove_goalw IFOLP.thy [iff_def] "[| p:P <-> Q; q:Q |] ==> ?p:P" - (fn prems => [ (rtac (conjunct2 RS mp) 1), (REPEAT (ares_tac prems 1)) ]); - -val iff_refl = prove_goal IFOLP.thy "?p:P <-> P" - (fn _ => [ (REPEAT (ares_tac [iffI] 1)) ]); - -val iff_sym = prove_goal IFOLP.thy "p:Q <-> P ==> ?p:P <-> Q" - (fn [major] => - [ (rtac (major RS iffE) 1), - (rtac iffI 1), - (REPEAT (eresolve_tac [asm_rl,mp] 1)) ]); - -val iff_trans = prove_goal IFOLP.thy "[| p:P <-> Q; q:Q<-> R |] ==> ?p:P <-> R" - (fn prems => - [ (cut_facts_tac prems 1), - (rtac iffI 1), - (REPEAT (eresolve_tac [asm_rl,iffE] 1 ORELSE mp_tac 1)) ]); - - -(*** Unique existence. NOTE THAT the following 2 quantifications - EX!x such that [EX!y such that P(x,y)] (sequential) - EX!x,y such that P(x,y) (simultaneous) - do NOT mean the same thing. The parser treats EX!x y.P(x,y) as sequential. -***) - -val ex1I = prove_goalw IFOLP.thy [ex1_def] - "[| p:P(a); !!x u.u:P(x) ==> f(u) : x=a |] ==> ?p:EX! x. P(x)" - (fn prems => [ (REPEAT (ares_tac (prems@[exI,conjI,allI,impI]) 1)) ]); - -val ex1E = prove_goalw IFOLP.thy [ex1_def] - "[| p:EX! x.P(x); \ -\ !!x u v. [| u:P(x); v:ALL y. P(y) --> y=x |] ==> f(x,u,v):R |] ==>\ -\ ?a : R" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (eresolve_tac [exE,conjE] 1 ORELSE ares_tac prems 1)) ]); - - -(*** <-> congruence rules for simplification ***) - -(*Use iffE on a premise. For conj_cong, imp_cong, all_cong, ex_cong*) -fun iff_tac prems i = - resolve_tac (prems RL [iffE]) i THEN - REPEAT1 (eresolve_tac [asm_rl,mp] i); - -val conj_cong = prove_goal IFOLP.thy - "[| p:P <-> P'; !!x.x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P&Q) <-> (P'&Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (ares_tac [iffI,conjI] 1 - ORELSE eresolve_tac [iffE,conjE,mp] 1 - ORELSE iff_tac prems 1)) ]); - -val disj_cong = prove_goal IFOLP.thy - "[| p:P <-> P'; q:Q <-> Q' |] ==> ?p:(P|Q) <-> (P'|Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (eresolve_tac [iffE,disjE,disjI1,disjI2] 1 - ORELSE ares_tac [iffI] 1 - ORELSE mp_tac 1)) ]); - -val imp_cong = prove_goal IFOLP.thy - "[| p:P <-> P'; !!x.x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P-->Q) <-> (P'-->Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (ares_tac [iffI,impI] 1 - ORELSE eresolve_tac [iffE] 1 - ORELSE mp_tac 1 ORELSE iff_tac prems 1)) ]); - -val iff_cong = prove_goal IFOLP.thy - "[| p:P <-> P'; q:Q <-> Q' |] ==> ?p:(P<->Q) <-> (P'<->Q')" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (eresolve_tac [iffE] 1 - ORELSE ares_tac [iffI] 1 - ORELSE mp_tac 1)) ]); - -val not_cong = prove_goal IFOLP.thy - "p:P <-> P' ==> ?p:~P <-> ~P'" - (fn prems => - [ (cut_facts_tac prems 1), - (REPEAT (ares_tac [iffI,notI] 1 - ORELSE mp_tac 1 - ORELSE eresolve_tac [iffE,notE] 1)) ]); - -val all_cong = prove_goal IFOLP.thy - "(!!x.f(x):P(x) <-> Q(x)) ==> ?p:(ALL x.P(x)) <-> (ALL x.Q(x))" - (fn prems => - [ (REPEAT (ares_tac [iffI,allI] 1 - ORELSE mp_tac 1 - ORELSE eresolve_tac [allE] 1 ORELSE iff_tac prems 1)) ]); - -val ex_cong = prove_goal IFOLP.thy - "(!!x.f(x):P(x) <-> Q(x)) ==> ?p:(EX x.P(x)) <-> (EX x.Q(x))" - (fn prems => - [ (REPEAT (eresolve_tac [exE] 1 ORELSE ares_tac [iffI,exI] 1 - ORELSE mp_tac 1 - ORELSE iff_tac prems 1)) ]); - -(*NOT PROVED -val ex1_cong = prove_goal IFOLP.thy - "(!!x.f(x):P(x) <-> Q(x)) ==> ?p:(EX! x.P(x)) <-> (EX! x.Q(x))" - (fn prems => - [ (REPEAT (eresolve_tac [ex1E, spec RS mp] 1 ORELSE ares_tac [iffI,ex1I] 1 - ORELSE mp_tac 1 - ORELSE iff_tac prems 1)) ]); -*) - -(*** Equality rules ***) - -val refl = ieqI; - -val subst = prove_goal IFOLP.thy "[| p:a=b; q:P(a) |] ==> ?p : P(b)" - (fn [prem1,prem2] => [ rtac (prem2 RS rev_mp) 1, (rtac (prem1 RS ieqE) 1), - rtac impI 1, atac 1 ]); - -val sym = prove_goal IFOLP.thy "q:a=b ==> ?c:b=a" - (fn [major] => [ (rtac (major RS subst) 1), (rtac refl 1) ]); - -val trans = prove_goal IFOLP.thy "[| p:a=b; q:b=c |] ==> ?d:a=c" - (fn [prem1,prem2] => [ (rtac (prem2 RS subst) 1), (rtac prem1 1) ]); - -(** ~ b=a ==> ~ a=b **) -val not_sym = prove_goal IFOLP.thy "p:~ b=a ==> ?q:~ a=b" - (fn [prem] => [ (rtac (prem RS contrapos) 1), (etac sym 1) ]); - -(*calling "standard" reduces maxidx to 0*) -val ssubst = standard (sym RS subst); - -(*A special case of ex1E that would otherwise need quantifier expansion*) -val ex1_equalsE = prove_goal IFOLP.thy - "[| p:EX! x.P(x); q:P(a); r:P(b) |] ==> ?d:a=b" - (fn prems => - [ (cut_facts_tac prems 1), - (etac ex1E 1), - (rtac trans 1), - (rtac sym 2), - (REPEAT (eresolve_tac [asm_rl, spec RS mp] 1)) ]); - -(** Polymorphic congruence rules **) - -val subst_context = prove_goal IFOLP.thy - "[| p:a=b |] ==> ?d:t(a)=t(b)" - (fn prems=> - [ (resolve_tac (prems RL [ssubst]) 1), - (resolve_tac [refl] 1) ]); - -val subst_context2 = prove_goal IFOLP.thy - "[| p:a=b; q:c=d |] ==> ?p:t(a,c)=t(b,d)" - (fn prems=> - [ (EVERY1 (map rtac ((prems RL [ssubst]) @ [refl]))) ]); - -val subst_context3 = prove_goal IFOLP.thy - "[| p:a=b; q:c=d; r:e=f |] ==> ?p:t(a,c,e)=t(b,d,f)" - (fn prems=> - [ (EVERY1 (map rtac ((prems RL [ssubst]) @ [refl]))) ]); - -(*Useful with eresolve_tac for proving equalties from known equalities. - a = b - | | - c = d *) -val box_equals = prove_goal IFOLP.thy - "[| p:a=b; q:a=c; r:b=d |] ==> ?p:c=d" - (fn prems=> - [ (resolve_tac [trans] 1), - (resolve_tac [trans] 1), - (resolve_tac [sym] 1), - (REPEAT (resolve_tac prems 1)) ]); - -(*Dual of box_equals: for proving equalities backwards*) -val simp_equals = prove_goal IFOLP.thy - "[| p:a=c; q:b=d; r:c=d |] ==> ?p:a=b" - (fn prems=> - [ (resolve_tac [trans] 1), - (resolve_tac [trans] 1), - (REPEAT (resolve_tac (prems @ (prems RL [sym])) 1)) ]); - -(** Congruence rules for predicate letters **) - -val pred1_cong = prove_goal IFOLP.thy - "p:a=a' ==> ?p:P(a) <-> P(a')" - (fn prems => - [ (cut_facts_tac prems 1), - (rtac iffI 1), - (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ]); - -val pred2_cong = prove_goal IFOLP.thy - "[| p:a=a'; q:b=b' |] ==> ?p:P(a,b) <-> P(a',b')" - (fn prems => - [ (cut_facts_tac prems 1), - (rtac iffI 1), - (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ]); - -val pred3_cong = prove_goal IFOLP.thy - "[| p:a=a'; q:b=b'; r:c=c' |] ==> ?p:P(a,b,c) <-> P(a',b',c')" - (fn prems => - [ (cut_facts_tac prems 1), - (rtac iffI 1), - (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ]); - -(*special cases for free variables P, Q, R, S -- up to 3 arguments*) - -val pred_congs = - flat (map (fn c => - map (fn th => read_instantiate [("P",c)] th) - [pred1_cong,pred2_cong,pred3_cong]) - (explode"PQRS")); - -(*special case for the equality predicate!*) -val eq_cong = read_instantiate [("P","op =")] pred2_cong; - - -(*** Simplifications of assumed implications. - Roy Dyckhoff has proved that conj_impE, disj_impE, and imp_impE - used with mp_tac (restricted to atomic formulae) is COMPLETE for - intuitionistic propositional logic. See - R. Dyckhoff, Contraction-free sequent calculi for intuitionistic logic - (preprint, University of St Andrews, 1991) ***) - -val conj_impE = prove_goal IFOLP.thy - "[| p:(P&Q)-->S; !!x.x:P-->(Q-->S) ==> q(x):R |] ==> ?p:R" - (fn major::prems=> - [ (REPEAT (ares_tac ([conjI, impI, major RS mp]@prems) 1)) ]); - -val disj_impE = prove_goal IFOLP.thy - "[| p:(P|Q)-->S; !!x y.[| x:P-->S; y:Q-->S |] ==> q(x,y):R |] ==> ?p:R" - (fn major::prems=> - [ (DEPTH_SOLVE (ares_tac ([disjI1, disjI2, impI, major RS mp]@prems) 1)) ]); - -(*Simplifies the implication. Classical version is stronger. - Still UNSAFE since Q must be provable -- backtracking needed. *) -val imp_impE = prove_goal IFOLP.thy - "[| p:(P-->Q)-->S; !!x y.[| x:P; y:Q-->S |] ==> q(x,y):Q; !!x.x:S ==> r(x):R |] ==> \ -\ ?p:R" - (fn major::prems=> - [ (REPEAT (ares_tac ([impI, major RS mp]@prems) 1)) ]); - -(*Simplifies the implication. Classical version is stronger. - Still UNSAFE since ~P must be provable -- backtracking needed. *) -val not_impE = prove_goal IFOLP.thy - "[| p:~P --> S; !!y.y:P ==> q(y):False; !!y.y:S ==> r(y):R |] ==> ?p:R" - (fn major::prems=> - [ (REPEAT (ares_tac ([notI, impI, major RS mp]@prems) 1)) ]); - -(*Simplifies the implication. UNSAFE. *) -val iff_impE = prove_goal IFOLP.thy - "[| p:(P<->Q)-->S; !!x y.[| x:P; y:Q-->S |] ==> q(x,y):Q; \ -\ !!x y.[| x:Q; y:P-->S |] ==> r(x,y):P; !!x.x:S ==> s(x):R |] ==> ?p:R" - (fn major::prems=> - [ (REPEAT (ares_tac ([iffI, impI, major RS mp]@prems) 1)) ]); - -(*What if (ALL x.~~P(x)) --> ~~(ALL x.P(x)) is an assumption? UNSAFE*) -val all_impE = prove_goal IFOLP.thy - "[| p:(ALL x.P(x))-->S; !!x.q:P(x); !!y.y:S ==> r(y):R |] ==> ?p:R" - (fn major::prems=> - [ (REPEAT (ares_tac ([allI, impI, major RS mp]@prems) 1)) ]); - -(*Unsafe: (EX x.P(x))-->S is equivalent to ALL x.P(x)-->S. *) -val ex_impE = prove_goal IFOLP.thy - "[| p:(EX x.P(x))-->S; !!y.y:P(a)-->S ==> q(y):R |] ==> ?p:R" - (fn major::prems=> - [ (REPEAT (ares_tac ([exI, impI, major RS mp]@prems) 1)) ]); - -end; - -open IFOLP_Lemmas; - diff -r 19849d258890 -r 8018173a7979 src/FOLP/ifolp.thy --- a/src/FOLP/ifolp.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,144 +0,0 @@ -IFOLP = Pure + - -classes term < logic - -default term - -types - p - o - -arities - p,o :: logic - -consts - (*** Judgements ***) - "@Proof" :: "[p,o]=>prop" ("(_ /: _)" [10,10] 5) - Proof :: "[o,p]=>prop" - EqProof :: "[p,p,o]=>prop" ("(3_ /= _ :/ _)" [10,10,10] 5) - - (*** Logical Connectives -- Type Formers ***) - "=" :: "['a,'a] => o" (infixl 50) - True,False :: "o" - "Not" :: "o => o" ("~ _" [40] 40) - "&" :: "[o,o] => o" (infixr 35) - "|" :: "[o,o] => o" (infixr 30) - "-->" :: "[o,o] => o" (infixr 25) - "<->" :: "[o,o] => o" (infixr 25) - (*Quantifiers*) - All :: "('a => o) => o" (binder "ALL " 10) - Ex :: "('a => o) => o" (binder "EX " 10) - Ex1 :: "('a => o) => o" (binder "EX! " 10) - (*Rewriting gadgets*) - NORM :: "o => o" - norm :: "'a => 'a" - - (*** Proof Term Formers ***) - tt :: "p" - contr :: "p=>p" - fst,snd :: "p=>p" - pair :: "[p,p]=>p" ("(1<_,/_>)") - split :: "[p, [p,p]=>p] =>p" - inl,inr :: "p=>p" - when :: "[p, p=>p, p=>p]=>p" - lambda :: "(p => p) => p" (binder "lam " 20) - "`" :: "[p,p]=>p" (infixl 60) - alll :: "['a=>p]=>p" (binder "all " 15) - "^" :: "[p,'a]=>p" (infixl 50) - exists :: "['a,p]=>p" ("(1[_,/_])") - xsplit :: "[p,['a,p]=>p]=>p" - ideq :: "'a=>p" - idpeel :: "[p,'a=>p]=>p" - nrm, NRM :: "p" - -rules - -(**** Propositional logic ****) - -(*Equality*) -(* Like Intensional Equality in MLTT - but proofs distinct from terms *) - -ieqI "ideq(a) : a=a" -ieqE "[| p : a=b; !!x.f(x) : P(x,x) |] ==> idpeel(p,f) : P(a,b)" - -(* Truth and Falsity *) - -TrueI "tt : True" -FalseE "a:False ==> contr(a):P" - -(* Conjunction *) - -conjI "[| a:P; b:Q |] ==> : P&Q" -conjunct1 "p:P&Q ==> fst(p):P" -conjunct2 "p:P&Q ==> snd(p):Q" - -(* Disjunction *) - -disjI1 "a:P ==> inl(a):P|Q" -disjI2 "b:Q ==> inr(b):P|Q" -disjE "[| a:P|Q; !!x.x:P ==> f(x):R; !!x.x:Q ==> g(x):R \ -\ |] ==> when(a,f,g):R" - -(* Implication *) - -impI "(!!x.x:P ==> f(x):Q) ==> lam x.f(x):P-->Q" -mp "[| f:P-->Q; a:P |] ==> f`a:Q" - -(*Quantifiers*) - -allI "(!!x. f(x) : P(x)) ==> all x.f(x) : ALL x.P(x)" -spec "(f:ALL x.P(x)) ==> f^x : P(x)" - -exI "p : P(x) ==> [x,p] : EX x.P(x)" -exE "[| p: EX x.P(x); !!x u. u:P(x) ==> f(x,u) : R |] ==> xsplit(p,f):R" - -(**** Equality between proofs ****) - -prefl "a : P ==> a = a : P" -psym "a = b : P ==> b = a : P" -ptrans "[| a = b : P; b = c : P |] ==> a = c : P" - -idpeelB "[| !!x.f(x) : P(x,x) |] ==> idpeel(ideq(a),f) = f(a) : P(a,a)" - -fstB "a:P ==> fst() = a : P" -sndB "b:Q ==> snd() = b : Q" -pairEC "p:P&Q ==> p = : P&Q" - -whenBinl "[| a:P; !!x.x:P ==> f(x) : Q |] ==> when(inl(a),f,g) = f(a) : Q" -whenBinr "[| b:P; !!x.x:P ==> g(x) : Q |] ==> when(inr(b),f,g) = g(b) : Q" -plusEC "a:P|Q ==> when(a,%x.inl(x),%y.inr(y)) = p : P|Q" - -applyB "[| a:P; !!x.x:P ==> b(x) : Q |] ==> (lam x.b(x)) ` a = b(a) : Q" -funEC "f:P ==> f = lam x.f`x : P" - -specB "[| !!x.f(x) : P(x) |] ==> (all x.f(x)) ^ a = f(a) : P(a)" - - -(**** Definitions ****) - -not_def "~P == P-->False" -iff_def "P<->Q == (P-->Q) & (Q-->P)" - -(*Unique existence*) -ex1_def "EX! x. P(x) == EX x. P(x) & (ALL y. P(y) --> y=x)" - -(*Rewriting -- special constants to flag normalized terms and formulae*) -norm_eq "nrm : norm(x) = x" -NORM_iff "NRM : NORM(P) <-> P" - -end - -ML - -(*show_proofs:=true displays the proof terms -- they are ENORMOUS*) -val show_proofs = ref false; - -fun proof_tr [p,P] = Const("Proof",dummyT) $ P $ p; - -fun proof_tr' [P,p] = - if !show_proofs then Const("@Proof",dummyT) $ p $ P - else P (*this case discards the proof term*); - -val parse_translation = [("@Proof", proof_tr)]; -val print_translation = [("Proof", proof_tr')]; - diff -r 19849d258890 -r 8018173a7979 src/FOLP/int-prover.ML --- a/src/FOLP/int-prover.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -(* Title: FOL/int-prover - ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1992 University of Cambridge - -A naive prover for intuitionistic logic - -BEWARE OF NAME CLASHES WITH CLASSICAL TACTICS -- use Int.fast_tac ... - -Completeness (for propositional logic) is proved in - -Roy Dyckhoff. -Contraction-Free Sequent Calculi for Intuitionistic Logic. -J. Symbolic Logic (in press) -*) - -signature INT_PROVER = - sig - val best_tac: int -> tactic - val fast_tac: int -> tactic - val inst_step_tac: int -> tactic - val safe_step_tac: int -> tactic - val safe_brls: (bool * thm) list - val safe_tac: tactic - val step_tac: int -> tactic - val haz_brls: (bool * thm) list - end; - - -structure Int : INT_PROVER = -struct - -(*Negation is treated as a primitive symbol, with rules notI (introduction), - not_to_imp (converts the assumption ~P to P-->False), and not_impE - (handles double negations). Could instead rewrite by not_def as the first - step of an intuitionistic proof. -*) -val safe_brls = sort lessb - [ (true,FalseE), (false,TrueI), (false,refl), - (false,impI), (false,notI), (false,allI), - (true,conjE), (true,exE), - (false,conjI), (true,conj_impE), - (true,disj_impE), (true,ex_impE), - (true,disjE), (false,iffI), (true,iffE), (true,not_to_imp) ]; - -val haz_brls = - [ (false,disjI1), (false,disjI2), (false,exI), - (true,allE), (true,not_impE), (true,imp_impE), (true,iff_impE), - (true,all_impE), (true,impE) ]; - -(*0 subgoals vs 1 or more: the p in safep is for positive*) -val (safe0_brls, safep_brls) = - partition (apl(0,op=) o subgoals_of_brl) safe_brls; - -(*Attack subgoals using safe inferences*) -val safe_step_tac = FIRST' [uniq_assume_tac, - IFOLP_Lemmas.uniq_mp_tac, - biresolve_tac safe0_brls, - hyp_subst_tac, - biresolve_tac safep_brls] ; - -(*Repeatedly attack subgoals using safe inferences*) -val safe_tac = DETERM (REPEAT_FIRST safe_step_tac); - -(*These steps could instantiate variables and are therefore unsafe.*) -val inst_step_tac = assume_tac APPEND' mp_tac; - -(*One safe or unsafe step. *) -fun step_tac i = FIRST [safe_tac, inst_step_tac i, biresolve_tac haz_brls i]; - -(*Dumb but fast*) -val fast_tac = SELECT_GOAL (DEPTH_SOLVE (step_tac 1)); - -(*Slower but smarter than fast_tac*) -val best_tac = - SELECT_GOAL (BEST_FIRST (has_fewer_prems 1, size_of_thm) (step_tac 1)); - -end; - diff -r 19849d258890 -r 8018173a7979 src/HOL/Integ/Relation.ML --- a/src/HOL/Integ/Relation.ML Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,98 +0,0 @@ -(* Title: Relation.ML - ID: $Id$ - Authors: Riccardo Mattolini, Dip. Sistemi e Informatica - Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1994 Universita' di Firenze - Copyright 1993 University of Cambridge - -Functions represented as relations in HOL Set Theory -*) - -val RSLIST = curry (op MRS); - -open Relation; - -goalw Relation.thy [converse_def] "!!a b r. (a,b):r ==> (b,a):converse(r)"; -by (simp_tac prod_ss 1); -by (fast_tac set_cs 1); -qed "converseI"; - -goalw Relation.thy [converse_def] "!!a b r. (a,b) : converse(r) ==> (b,a) : r"; -by (fast_tac comp_cs 1); -qed "converseD"; - -qed_goalw "converseE" Relation.thy [converse_def] - "[| yx : converse(r); \ -\ !!x y. [| yx=(y,x); (x,y):r |] ==> P \ -\ |] ==> P" - (fn [major,minor]=> - [ (rtac (major RS CollectE) 1), - (REPEAT (eresolve_tac [bexE,exE, conjE, minor] 1)), - (hyp_subst_tac 1), - (assume_tac 1) ]); - -val converse_cs = comp_cs addSIs [converseI] - addSEs [converseD,converseE]; - -qed_goalw "Domain_iff" Relation.thy [Domain_def] - "a: Domain(r) = (EX y. (a,y): r)" - (fn _=> [ (fast_tac comp_cs 1) ]); - -qed_goal "DomainI" Relation.thy "!!a b r. (a,b): r ==> a: Domain(r)" - (fn _ => [ (etac (exI RS (Domain_iff RS iffD2)) 1) ]); - -qed_goal "DomainE" Relation.thy - "[| a : Domain(r); !!y. (a,y): r ==> P |] ==> P" - (fn prems=> - [ (rtac (Domain_iff RS iffD1 RS exE) 1), - (REPEAT (ares_tac prems 1)) ]); - -qed_goalw "RangeI" Relation.thy [Range_def] "!!a b r.(a,b): r ==> b : Range(r)" - (fn _ => [ (etac (converseI RS DomainI) 1) ]); - -qed_goalw "RangeE" Relation.thy [Range_def] - "[| b : Range(r); !!x. (x,b): r ==> P |] ==> P" - (fn major::prems=> - [ (rtac (major RS DomainE) 1), - (resolve_tac prems 1), - (etac converseD 1) ]); - -(*** Image of a set under a function/relation ***) - -qed_goalw "Image_iff" Relation.thy [Image_def] - "b : r^^A = (? x:A. (x,b):r)" - (fn _ => [ fast_tac (comp_cs addIs [RangeI]) 1 ]); - -qed_goal "Image_singleton_iff" Relation.thy - "(b : r^^{a}) = ((a,b):r)" - (fn _ => [ rtac (Image_iff RS trans) 1, - fast_tac comp_cs 1 ]); - -qed_goalw "ImageI" Relation.thy [Image_def] - "!!a b r. [| (a,b): r; a:A |] ==> b : r^^A" - (fn _ => [ (REPEAT (ares_tac [CollectI,RangeI,bexI] 1)), - (resolve_tac [conjI ] 1), - (resolve_tac [RangeI] 1), - (REPEAT (fast_tac set_cs 1))]); - -qed_goalw "ImageE" Relation.thy [Image_def] - "[| b: r^^A; !!x.[| (x,b): r; x:A |] ==> P |] ==> P" - (fn major::prems=> - [ (rtac (major RS CollectE) 1), - (safe_tac set_cs), - (etac RangeE 1), - (rtac (hd prems) 1), - (REPEAT (etac bexE 1 ORELSE ares_tac prems 1)) ]); - -qed_goal "Image_subset" Relation.thy - "!!A B r. r <= Sigma A (%x.B) ==> r^^C <= B" - (fn _ => - [ (rtac subsetI 1), - (REPEAT (eresolve_tac [asm_rl, ImageE, subsetD RS SigmaD2] 1)) ]); - -val rel_cs = converse_cs addSIs [converseI] - addIs [ImageI, DomainI, RangeI] - addSEs [ImageE, DomainE, RangeE]; - -val rel_eq_cs = rel_cs addSIs [equalityI]; - diff -r 19849d258890 -r 8018173a7979 src/HOL/Integ/Relation.thy --- a/src/HOL/Integ/Relation.thy Sat Apr 05 16:00:00 2003 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -(* Title: Relation.thy - ID: $Id$ - Author: Riccardo Mattolini, Dip. Sistemi e Informatica - and Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1994 Universita' di Firenze - Copyright 1993 University of Cambridge - -Functions represented as relations in Higher-Order Set Theory -*) - -Relation = Trancl + -consts - converse :: "('a*'a) set => ('a*'a) set" - "^^" :: "[('a*'a) set,'a set] => 'a set" (infixl 90) - Domain :: "('a*'a) set => 'a set" - Range :: "('a*'a) set => 'a set" - -defs - converse_def "converse(r) == {z. (? w:r. ? x y. w=(x,y) & z=(y,x))}" - Domain_def "Domain(r) == {z. ! x. (z=x --> (? y. (x,y):r))}" - Range_def "Range(r) == Domain(converse(r))" - Image_def "r ^^ s == {y. y:Range(r) & (? x:s. (x,y):r)}" - -end