(* Title:      Containers/Containers_Userguide.thy
   Author:     Andreas Lochbihler, ETH Zurich *)
(*<*)
theory Containers_Userguide imports
  Card_Datatype
  List_Proper_Interval
  Containers
begin
(*>*)
chapter \<open>User guide\<close>
text_raw \<open>\label{chapter:Userguide}\<close>

text \<open>
  This user guide shows how to use and extend the lightweight containers framework (LC).
  For a more theoretical discussion, see \<^cite>\<open>"Lochbihler2013ITP"\<close>.
  This user guide assumes that you are familiar with refinement in the code generator \<^cite>\<open>"HaftmannBulwahn2013codetut" and "HaftmannKrausKuncarNipkow2013ITP"\<close>.
  The theory \<open>Containers_Userguide\<close> generates it; so if you want to experiment with the examples, you can find their source code there.
  Further examples can be found in the @{dir \<open>Examples\<close>} folder.
\<close>

section \<open>Characteristics\<close>

text_raw \<open>
  \isastyletext
  \begin{itemize}
\<close>
text_raw \<open>
  \isastyletext
  \item \textbf{Separate type classes for code generation}
    \\
    LC follows the ideal that type classes for code generation should be separate from the standard type classes in Isabelle.
    LC's type classes are designed such that every type can become an instance, so well-sortedness errors during code generation can always be remedied.
\<close>
text_raw \<open>
  \isastyletext
  \item \textbf{Multiple implementations}
    \\
    LC supports multiple simultaneous implementations of the same container type.
    For example, the following implements at the same time
    (i)~the set of @{typ bool} as a distinct list of the elements,
    (ii)~@{typ "int set"} as a RBT of the elements or as the RBT of the complement, and
    (iii)~sets of functions as monad-style lists:
    \par
\<close>
value "({True}, {1 :: int}, - {2 :: int, 3}, {\<lambda>x :: int. x * x, \<lambda>y. y + 1})"
text_raw \<open>
    \isastyletext
    \par
    The LC type classes are the key to simultaneously supporting different implementations.

  \item \textbf{Extensibility}
    \\
    The LC framework is designed for being extensible.
    You can add new containers, implementations and element types any time.
  \end{itemize}
\<close>

section \<open>Getting started\<close>
text_raw \<open>\label{section:getting:started}\<close>

text \<open>
  Add the entry theory @{theory Containers.Containers} for LC to the end of your imports.
  This will reconfigure the code generator such that it implements the types @{typ "'a set"} for sets and @{typ "('a, 'b) mapping"} for maps with one of the data structures supported.
  As with all the theories that adapt the code generator setup, it is important that @{theory Containers.Containers} comes at the end of the imports.

  \textbf{Note:} LC should not be used together with the theory @{text "HOL-Library.Code_Cardinality"}.

  Run the following command, e.g., to check that LC works correctly and implements sets of @{typ int}s as red-black trees (RBT):
\<close>

value [code] "{1 :: int}"

text \<open>
  This should produce @{value [names_short] "{1 :: int}"}.
  Without LC, sets are represented as (complements of) a list of elements, i.e., @{term "set [1 :: int]"} in the example.
\<close>

text \<open>
  If your exported code does not use your own types as elements of sets or maps and you have not declared any code equation for these containers, then your \isacommand{export{\isacharunderscore}code} command will use LC to implement @{typ "'a set"} and @{typ "('a, 'b) mapping"}.

  Our running example will be arithmetic expressions.
  The function @{term "vars e"} computes the variables that occur in the expression @{term e}
\<close>

type_synonym vname = string
datatype expr = Var vname | Lit int | Add expr expr
fun vars :: "expr \<Rightarrow> vname set" where
  "vars (Var v) = {v}"
| "vars (Lit i) = {}"
| "vars (Add e\<^sub>1 e\<^sub>2) = vars e\<^sub>1 \<union> vars e\<^sub>2"

value "vars (Var ''x'')"

text \<open>
  To illustrate how to deal with type variables, we will use the following variant where variable names are polymorphic:
\<close>

datatype 'a expr' = Var' 'a | Lit' int | Add' "'a expr'" "'a expr'"
fun vars' ::  "'a expr' \<Rightarrow> 'a set" where
  "vars' (Var' v) = {v}"
| "vars' (Lit' i) = {}"
| "vars' (Add' e\<^sub>1 e\<^sub>2) = vars' e\<^sub>1 \<union> vars' e\<^sub>2"

value "vars' (Var' (1 :: int))"

section \<open>New types as elements\<close>

text \<open>
  This section explains LC's type classes and shows how to instantiate them.
  If you want to use your own types as the elements of sets or the keys of maps, you must instantiate up to eight type classes: @{class ceq} (\S\ref{subsection:ceq}), @{class ccompare} (\S\ref{subsection:ccompare}), @{class set_impl} (\S\ref{subsection:set_impl}), @{class mapping_impl} (\S\ref{subsection:mapping_impl}), @{class cenum} (\S\ref{subsection:cenum}), @{class finite_UNIV} (\S\ref{subsection:finite_UNIV}), @{class card_UNIV} (\S\ref{subsection:card_UNIV}), and @{class cproper_interval} (\S\ref{subsection:cproper_interval}).
  Otherwise, well-sortedness errors like the following will occur:
\begin{verbatim}
*** Wellsortedness error:
*** Type expr not of sort {ceq,ccompare}
*** No type arity expr :: ceq
*** At command "value"
\end{verbatim}

  In detail, the sort requirements on the element type @{typ "'a"} are:
  \begin{itemize}
  \item @{class ceq} (\S\ref{subsection:ceq}), @{class ccompare} (\S\ref{subsection:ccompare}), and @{class set_impl} (\S\ref{subsection:set_impl}) for @{typ "'a set"} in general
  \item @{class cenum} (\S\ref{subsection:cenum}) for set comprehensions @{term "{x. P x}"},
  \item @{class card_UNIV}, @{class cproper_interval} for @{typ "'a set set"} and any deeper nesting of sets (\S\ref{subsection:card_UNIV}),%
   \footnote{%
     These type classes are only required for set complements (see \S\ref{subsection:well:sortedness}).
   }
    and
  \item @{class equal},%
    \footnote{%
      We deviate here from the strict separation of type classes, because it does not make sense to store types in a map on which we do not have equality, because the most basic operation @{term "Mapping.lookup"} inherently requires equality.
    }
    @{class ccompare} (\S\ref{subsection:ccompare}) and @{class mapping_impl} (\S\ref{subsection:mapping_impl}) for @{typ "('a, 'b) mapping"}.
  \end{itemize}
\<close>

subsection \<open>Equality testing\<close>
text_raw \<open>\label{subsection:ceq}\<close>

(*<*)context fixes dummy :: "'a :: {cenum, ceq, ccompare, set_impl, mapping_impl}" begin(*>*)
text \<open>
  The type class @{class ceq} defines the operation @{term [source] "CEQ('a) :: ('a \<Rightarrow> 'a \<Rightarrow> bool) option" } for testing whether two elements are equal.%
  \footnote{%
    Technically, the type class @{class ceq} defines the operation @{term [source] ceq}.
    As usage often does not fully determine @{term [source] ceq}'s type, we use the notation @{term "CEQ('a)"} that explicitly mentions the type.
    In detail, @{term "CEQ('a)"} is translated to @{term [source] "CEQ('a) :: ('a \<Rightarrow> 'a \<Rightarrow> bool) option" } including the type constraint.
    We do the same for the other type class operators:
    @{term "CCOMPARE('a)"} constrains the operation @{term [source] ccompare} (\S\ref{subsection:ccompare}),
    @{term [source] "SET_IMPL('a)"} constrains the operation @{term [source] set_impl}, (\S\ref{subsection:set_impl}),
    @{term [source] "MAPPING_IMPL('a)"} (constrains the operation @{term [source] mapping_impl}, (\S\ref{subsection:mapping_impl}), and
    @{term "CENUM('a)"} constrains the operation @{term [source] cenum}, \S\ref{subsection:cenum}.
  }
  The test is embedded in an \<open>option\<close> value to allow for types that do not support executable equality test such as @{typ "'a \<Rightarrow> 'b"}.
  Whenever possible, @{term "CEQ('a)"} should provide an executable equality operator.
  Otherwise, membership tests on such sets will raise an exception at run-time.

  For data types, the \<open>derive\<close> command can automatically instantiates of @{class ceq},
  we only have to tell it whether an equality operation should be provided or not (parameter \<open>no\<close>).
\<close>
(*<*)end(*>*)

derive (eq) ceq expr

datatype example = Example
derive (no) ceq example

text \<open>
  In the remainder of this subsection, we look at how to manually instantiate a type for @{class ceq}.
  First, the simple case of a type constructor \<open>simple_tycon\<close> without parameters that already is an instance of @{class equal}:
\<close>
typedecl simple_tycon
axiomatization where simple_tycon_equal: "OFCLASS(simple_tycon, equal_class)"
instance simple_tycon :: equal by (rule simple_tycon_equal)

instantiation simple_tycon :: ceq begin
definition "CEQ(simple_tycon) = Some (=)"
instance by(intro_classes)(simp add: ceq_simple_tycon_def)
end

text \<open>
  For polymorphic types, this is a bit more involved, as the next example with @{typ "'a expr'"} illustrates (note that we could have delegated all this to \<open>derive\<close>).
  First, we need an operation that implements equality tests with respect to a given equality operation on the polymorphic type.
  For data types, we can use the relator which the transfer package (method \<open>transfer\<close>) requires and the BNF package generates automatically.
  As we have used the old datatype package for @{typ "'a expr'"}, we must define it manually:
\<close>

context fixes R :: "'a \<Rightarrow> 'b \<Rightarrow> bool" begin
fun expr'_rel :: "'a expr' \<Rightarrow> 'b expr' \<Rightarrow> bool"
where
  "expr'_rel (Var' v)      (Var' v')        \<longleftrightarrow> R v v'"
| "expr'_rel (Lit' i)        (Lit' i')         \<longleftrightarrow> i = i'"
| "expr'_rel (Add' e\<^sub>1 e\<^sub>2) (Add' e\<^sub>1' e\<^sub>2') \<longleftrightarrow> expr'_rel e\<^sub>1 e\<^sub>1' \<and> expr'_rel e\<^sub>2 e\<^sub>2'"
| "expr'_rel _                 _                \<longleftrightarrow> False"
end

text \<open>If we give HOL equality as parameter, the relator is equality:\<close>

lemma expr'_rel_eq: "expr'_rel (=) e\<^sub>1 e\<^sub>2 \<longleftrightarrow> e\<^sub>1 = e\<^sub>2"
by(induct e\<^sub>1 e\<^sub>2 rule: expr'_rel.induct) simp_all
text \<open>
  Then, the instantiation is again canonical:
\<close>
instantiation expr' :: (ceq) ceq begin
definition
  "CEQ('a expr') =
  (case ID CEQ('a) of None \<Rightarrow> None | Some eq \<Rightarrow> Some (expr'_rel eq))"
instance
  by(intro_classes)
    (auto simp add: ceq_expr'_def expr'_rel_eq[abs_def]
          dest: Collection_Eq.ID_ceq
          split: option.split_asm)
end
(*<*)context fixes dummy :: "'a :: ceq" begin(*>*)
text \<open>
  Note the following two points:
  First, the instantiation should avoid to use @{term "(=)"} on terms of the polymorphic type.
  This keeps the LC framework separate from the type class @{class equal}, i.e., every choice of @{typ "'a"}
  in @{typ "'a expr'"} can be of sort @{class "ceq"}.
  The easiest way to achieve this is to obtain the equality test from @{term "CEQ('a)"}.
  Second, we use @{term "ID CEQ('a)"} instead of @{term "CEQ('a)"}.
  In proofs, we want that the simplifier uses assumptions like \<open>CEQ('a) = Some \<dots>\<close> for rewriting.
  However, @{term "CEQ('a)"} is a nullary constant, so the simplifier reverses such an equation, i.e., it only rewrites \<open>Some \<dots>\<close> to @{term "CEQ('a :: ceq)"}.
  Applying the identity function @{term "ID"} to @{term "CEQ('a :: ceq)"} avoids this, and the code generator eliminates all occurrences of @{term "ID"}.
  Although @{thm ID_def} by definition, do not use the conventional @{term "id"} instead of @{term ID}, because @{term "id CEQ('a :: ceq)"} immediately simplifies to @{term "CEQ('a :: ceq)"}.
\<close>
(*<*)end(*>*)

subsection \<open>Ordering\<close>
text_raw \<open>\label{subsection:ccompare}\<close>

(*<*)context fixes dummy :: "'a :: {ccompare, ceq}" begin(*>*)
text \<open>
  LC takes the order for storing elements in search trees from the type class @{class ccompare} rather than @{class compare}, because we cannot instantiate @{class compare} for some types (e.g., @{typ "'a set"} as @{term "(\<subseteq>)"} is not linear).
  Similar to @{term "CEQ('a)"} in class @{term ceq}, the class @{class ccompare} specifies an optional comparator @{term [source] "CCOMPARE('a) :: (('a \<Rightarrow> 'a \<Rightarrow> order)) option" }.
  If you cannot or do not want to implement a comparator on your type, you can default to @{term "None"}.
  In that case, you will not be able to use your type as elements of sets or as keys in maps implemented by search trees.

  If the type is a data type or instantiates @{class compare} and we wish to use that comparator also for the search tree, instantiation is again canonical:
  For our data type @{typ expr}, derive does everything!
\<close>
(*<*)end(*>*)
(*<*)(*>*)
derive ccompare expr
(*<*)(*>*)

text \<open>
  In general, the pattern for type constructors without parameters looks as follows:
\<close>
axiomatization where simple_tycon_compare: "OFCLASS(simple_tycon, compare_class)"
instance simple_tycon :: compare by (rule simple_tycon_compare)

derive (compare) ccompare simple_tycon

text \<open>
  For polymorphic types like @{typ "'a expr'"}, we should not do everything manually:
  First, we must define a comparator that takes the comparator on the type variable @{typ "'a"} as a parameter.
  This is necessary to maintain the separation between Isabelle/HOL's type classes (like @{class compare}) and LC's.
  Such a comparator is again easily defined by derive.
\<close>

derive ccompare expr'

thm ccompare_expr'_def comparator_expr'_simps

subsection \<open>Heuristics for picking an implementation\<close>
text_raw \<open>\label{subsection:set_impl} \label{subsection:mapping_impl}\<close>
(*<*)context fixes dummy :: "'a :: {ceq, ccompare, set_impl, mapping_impl}" begin(*>*)
text \<open>
  Now, we have defined the necessary operations on @{typ expr} and @{typ "'a expr'"} to store them in a set
  or use them as the keys in a map.
  But before we can actually do so, we also have to say which data structure to use.
  The type classes @{class set_impl} and @{class mapping_impl} are used for this.

  They define the overloaded operations @{term [source] "SET_IMPL('a) :: ('a, set_impl) phantom" } and @{term [source] "MAPPING_IMPL('a) :: ('a, mapping_impl) phantom"}, respectively.
  The phantom type @{typ "('a, 'b) phantom"} from theory @{theory "HOL-Library.Phantom_Type"} is isomorphic to @{typ "'b"}, but formally depends on @{typ "'a"}.
  This way, the type class operations meet the requirement that their type contains exactly one type variable.
  The Haskell and ML compiler will get rid of the extra type constructor again.

  For sets, you can choose between @{term set_Collect} (characteristic function @{term P} like in @{term "{x. P x}"}), @{term set_DList} (distinct list), @{term set_RBT} (red-black tree), and @{term set_Monad} (list with duplicates).
  Additionally, you can define @{term "set_impl"} as @{term "set_Choose"} which picks the implementation based on the available operations (RBT if @{term "CCOMPARE('a)"} provides a linear order, else distinct lists if @{term "CEQ('a)"} provides equality testing, and lists with duplicates otherwise).
  @{term "set_Choose"} is the safest choice because it picks only a data structure when the required operations are actually available.
  If @{term set_impl} picks a specific implementation, Isabelle does not ensure that all required operations are indeed available.

  For maps, the choices are @{term "mapping_Assoc_List"} (associative list without duplicates), @{term "mapping_RBT"} (red-black tree), and @{term "mapping_Mapping"} (closures with function update).
  Again, there is also the @{term "mapping_Choose"} heuristics.

  For simple cases, \<open>derive\<close> can be used again (even if the type is not a data type).
  Consider, e.g., the following instantiations:
  @{typ "expr set"} uses RBTs, @{typ "(expr, _) mapping"} and @{typ "'a expr' set"} use the heuristics, and @{typ "('a expr', _) mapping"} uses the same implementation as @{typ "('a, _) mapping"}.
\<close>
(*<*)end(*>*)

derive (rbt) set_impl expr
derive (choose) mapping_impl expr
derive (choose) set_impl expr'

text \<open>
  More complex cases such as taking the implementation preference of a type parameter must be done manually.
\<close>

instantiation expr' :: (mapping_impl) mapping_impl begin
definition
  "MAPPING_IMPL('a expr') =
   Phantom('a expr') (of_phantom MAPPING_IMPL('a))"
instance ..
end

(*<*)
locale mynamespace begin
definition empty where "empty = Mapping.empty"
declare (in -) mynamespace.empty_def [code]
(*>*)
text \<open>
  To see the effect of the different configurations, consider the following examples where @{term [names_short] "empty"} refers to @{term "Mapping.empty"}.
  For that, we must disable pretty printing for sets as follows:
\<close>
declare (*<*)(in -) (*>*)pretty_sets[code_post del]
text \<open>
  \begin{center}
    \small
    \begin{tabular}{ll}
      \toprule
      \isamarkuptrue\isacommand{value}\isamarkupfalse\ {\isacharbrackleft}code{\isacharbrackright}
      &
      \textbf{result}
      \\
      \midrule
      @{term [source] "{} :: expr set"}
      &
      @{value [names_short] "{} :: expr set"}
      \\
      @{term [source] "empty :: (expr, unit) mapping"}
      &
      @{value [names_short] "empty :: (expr, unit) mapping"}
      \\
      \midrule
      @{term [source] "{} :: string expr' set"}
     &
      @{value [names_short] "{} :: string expr' set"}
      \\
      @{term [source] "{} :: (nat \<Rightarrow> nat) expr' set"}
      &
      @{value [names_short] "{} :: (nat \<Rightarrow> nat) expr' set"}
      \\
      @{term [source] "{} :: bool expr' set"}
      &
      @{value [names_short] "{} :: bool expr' set"}
      \\
      @{term [source] "empty :: (bool expr', unit) mapping"}
      &
      @{value [names_short] "empty :: (bool expr', unit) mapping"}
      \\
      \bottomrule
    \end{tabular}
  \end{center}

  For @{typ expr}, @{term mapping_Choose} picks RBTs, because @{term "CCOMPARE(expr)"} provides a comparison operation for @{typ "expr"}.
  For @{typ "'a expr'"}, the effect of @{term set_Choose} is more pronounced:
  @{term "CCOMPARE(string)"} is not @{term "None"}, so neither is @{term "CCOMPARE(string expr')"}, and @{term set_Choose} picks RBTs.
  As @{typ "nat \<Rightarrow> nat"} neither provides equality tests (@{class ceq}) nor comparisons (@{class ccompare}), neither does @{typ "(nat \<Rightarrow> nat) expr'"}, so we use lists with duplicates.
  The last two examples show the difference between inheriting a choice and choosing freshly:
  By default, @{typ bool} prefers distinct (associative) lists over RBTs, because there are just two elements.
  As @{typ "bool expr'"} enherits the choice for maps from @{typ bool}, an associative list implements @{term [source] "empty :: (bool expr', unit) mapping"}.
  For sets, in contrast, @{term "SET_IMPL('a expr')"} discards @{typ 'a}'s preferences and picks RBTs, because there is a comparison operation.

  Finally, let's enable pretty-printing for sets again:
\<close>
declare (*<*)(in -) (*>*)pretty_sets [code_post]
(*<*)
  (* The following value commands ensure that the code generator executes @{value ...} above,
     I could not find a way to specify [code] to @{value}. *)
  value [code] "{} :: expr set"
  value [code] "empty :: (expr, unit) mapping"
  value [code] "{} :: string expr' set"
  value [code] "{} :: (nat \<Rightarrow> nat) expr' set"
  value [code] "{} :: bool expr' set"
  value [code] "empty :: (bool expr', unit) mapping"
(*>*)
(*<*)end(*>*)

subsection \<open>Set comprehensions\<close>
text_raw \<open>\label{subsection:cenum}\<close>

(*<*)context fixes dummy :: "'a :: cenum" begin(*>*)
text \<open>
  If you use the default code generator setup that comes with Isabelle, set comprehensions @{term [source] "{x. P x} :: 'a set"} are only executable if the type @{typ 'a} has sort @{class enum}.
  Internally, Isabelle's code generator transforms set comprehensions into an explicit list of elements which it obtains from the list @{term enum} of all of @{typ "'a"}'s elements.
  Thus, the type must be an instance of @{class enum}, i.e., finite in particular.
  For example, @{term "{c. CHR ''A'' \<le> c \<and> c \<le> CHR ''D''}"} evaluates to @{term "set ''ABCD''"}, the set of the characters A, B, C, and D.

  For compatibility, LC also implements such an enumeration strategy, but avoids the finiteness restriction.
  The type class @{class cenum} mimicks @{class enum}, but its single parameter @{term [source] "cEnum :: ('a list \<times> (('a \<Rightarrow> bool) \<Rightarrow> bool) \<times> (('a \<Rightarrow> bool) \<Rightarrow> bool)) option"} combines all of @{class enum}'s parameters, namely a list of all elements, a universal and an existential quantifier.
  \<open>option\<close> ensures that every type can be an instance as @{term "CENUM('a)"} can always default to @{term None}.

  For types that define @{term "CENUM('a)"}, set comprehensions evaluate to a list of their elements.
  Otherwise, set comprehensions are represented as a closure.
  This means that if the generated code contains at least one set comprehension, all element types of a set must instantiate @{class cenum}.
  Infinite types default to @{term None}, and enumerations for finite types are canoncial, see @{theory Containers.Collection_Enum} for examples.
\<close>
(*<*)end(*>*)

instantiation expr :: cenum begin
definition "CENUM(expr) = None"
instance by(intro_classes)(simp_all add: cEnum_expr_def)
end

derive (no) cenum expr'
derive compare_order expr

text_raw \<open>\par\medskip \isastyletext For example,\<close>
value "({b. b = True}, {x. compare x (Lit 0) = Lt})"
text_raw \<open>
  \isastyletext{}
  yields @{value "({b. b = True}, {x. compare x (Lit 0) = Lt})"}
\<close>

text \<open>
  LC keeps complements of such enumerated set comprehensions, i.e., @{term "- {b. b = True}"} evaluates to @{value "- {b. b = True}"}.
  If you want that the complement operation actually computes the elements of the complements, you have to replace the code equations for @{term uminus} as follows:
\<close>
declare Set_uminus_code[code del] Set_uminus_cenum[code]
(*<*)value "- {b. b = True}"(*>*)
text \<open>
  Then, @{term "- {b. b = True}"} becomes @{value "- {b. b = True}"}, but this applies to all complement invocations.
  For example, @{term [source] "UNIV :: bool set"} becomes @{value "UNIV :: bool set"}.
\<close>
(*<*)declare Set_uminus_cenum[code del] Set_uminus_code[code](*>*)

subsection \<open>Nested sets\<close>
text_raw \<open>\label{subsection:finite_UNIV} \label{subsection:card_UNIV} \label{subsection:cproper_interval}\<close>

(*<*)context fixes dummy :: "'a :: {card_UNIV, cproper_interval}" begin(*>*)
text \<open>
  To deal with nested sets such as @{typ "expr set set"}, the element type must provide three operations from three type classes:
  \begin{itemize}
  \item @{class finite_UNIV} from theory @{theory "HOL-Library.Cardinality"} defines the constant @{term [source] "finite_UNIV :: ('a, bool) phantom"} which designates whether the type is finite.
  \item @{class card_UNIV} from theory @{theory "HOL-Library.Cardinality"} defines the constant @{term [source] "card_UNIV :: ('a, nat) phantom"} which returns @{term "CARD('a)"}, i.e., the number of values in @{typ 'a}.
    If @{typ "'a"} is infinite, @{term "CARD('a) = 0"}.
  \item @{class cproper_interval} from theory @{theory Containers.Collection_Order} defines the function @{term [source] "cproper_interval :: 'a option \<Rightarrow> 'a option \<Rightarrow> bool"}.
    If the type @{typ "'a"} is finite and @{term "CCOMPARE('a)"} yields a linear order on @{typ "'a"}, then @{term "cproper_interval x y"} returns whether the open interval between @{term "x"} and @{term "y"} is non-empty.
    The bound @{term "None"} denotes unboundedness.
  \end{itemize}

  Note that the type class @{class finite_UNIV} must not be confused with the type class @{class finite}.
  @{class finite_UNIV} allows the generated code to examine whether a type is finite whereas @{class finite} requires that the type in fact is finite.
\<close>
(*<*)end(*>*)

text \<open>
  For datatypes, the theory @{theory Containers.Card_Datatype} defines some machinery to assist in proving that the type is (in)finite and has a given number of elements -- see @{file \<open>Examples/Card_Datatype_Ex.thy\<close>} for examples.
  With this, it is easy to instantiate @{class card_UNIV} for our running examples:
\<close>

lemma inj_expr [simp]: "inj Lit" "inj Var" "inj Add" "inj (Add e)"
by(simp_all add: fun_eq_iff inj_on_def)

lemma infinite_UNIV_expr: "\<not> finite (UNIV :: expr set)"
  including card_datatype
proof -
  have "rangeIt (Lit 0) (Add (Lit 0)) \<subseteq> UNIV" by simp
  from finite_subset[OF this] show ?thesis by auto
qed

instantiation expr :: card_UNIV begin
definition "finite_UNIV = Phantom(expr) False"
definition "card_UNIV = Phantom(expr) 0"
instance
  by intro_classes
     (simp_all add: finite_UNIV_expr_def card_UNIV_expr_def infinite_UNIV_expr)
end

lemma inj_expr' [simp]: "inj Lit'" "inj Var'" "inj Add'" "inj (Add' e)"
by(simp_all add: fun_eq_iff inj_on_def)

lemma infinite_UNIV_expr': "\<not> finite (UNIV :: 'a expr' set)"
  including card_datatype
proof -
  have "rangeIt (Lit' 0) (Add' (Lit' 0)) \<subseteq> UNIV" by simp
  from finite_subset[OF this] show ?thesis by auto
qed

instantiation expr' :: (type) card_UNIV begin
definition "finite_UNIV = Phantom('a expr') False"
definition "card_UNIV = Phantom('a expr') 0"
instance
  by intro_classes
     (simp_all add: finite_UNIV_expr'_def card_UNIV_expr'_def infinite_UNIV_expr')
end

text \<open>
  As @{typ expr} and @{typ "'a expr'"} are infinite, instantiating @{class cproper_interval} is trivial,
  because @{class cproper_interval} only makes assumptions about its parameters for finite types.
  Nevertheless, it is important to actually define @{term cproper_interval}, because the
  code generator requires a code equation.
\<close>

instantiation expr :: cproper_interval begin
definition cproper_interval_expr :: "expr proper_interval"
  where "cproper_interval_expr _ _ = undefined"
instance by(intro_classes)(simp add: infinite_UNIV_expr)
end

instantiation expr' :: (ccompare) cproper_interval begin
definition cproper_interval_expr' :: "'a expr' proper_interval"
  where "cproper_interval_expr' _ _ = undefined"
instance by(intro_classes)(simp add: infinite_UNIV_expr')
end

subsubsection \<open>Instantiation of @{class proper_interval}\<close>

text \<open>
  To illustrate what to do with finite types, we instantiate @{class proper_interval} for @{typ expr}.
  Like @{class ccompare} relates to @{class compare}, the class @{class cproper_interval} has a counterpart @{class proper_interval} without the finiteness assumption.
  Here, we first have to gather the simplification rules of the comparator from the derive
  invocation, especially, how the strict order of the comparator, @{term lt_of_comp}, can be defined.

  Since the order on lists is not yet shown to be consistent with the comparators that are used
  for lists, this part of the userguide is currently not available.

\<close>
(*
instantiation expr :: proper_interval begin

lemma less_expr_conv: "(<) = lt_of_comp comparator_expr" "(\<le>) = le_of_comp comparator_expr"
  using less_expr_def less_eq_expr_def unfolding compare_expr_def by auto

lemma lt_of_comp_expr: "lt_of_comp comparator_expr e1 e2 = (
  case e1 of
    Var x1 \<Rightarrow>
      (case e2 of
        Var x2 \<Rightarrow> lt_of_comp (comparator_list comparator_of) x1 x2
      | Lit _ \<Rightarrow> True
      | Add _ _ \<Rightarrow> True)
  | Lit i1 \<Rightarrow>
      (case e2 of
        Var _ \<Rightarrow> False
      | Lit i2 \<Rightarrow> lt_of_comp comparator_of i1 i2
      | Add _ _ \<Rightarrow> True)
  | Add a1 b1 \<Rightarrow>
      (case e2 of
        Var _ \<Rightarrow> False
      | Lit _ \<Rightarrow> False
      | Add a2 b2 \<Rightarrow> lt_of_comp comparator_expr a1 a2
          \<or> le_of_comp comparator_expr a1 a2 \<and> lt_of_comp comparator_expr b1 b2)
    )"
  by (simp add: lt_of_comp_def le_of_comp_def comp_lex_code split: expr.split order.split)

fun proper_interval_expr :: "expr option \<Rightarrow> expr option \<Rightarrow> bool"
where
  "proper_interval_expr None (Some (Var x)) \<longleftrightarrow> proper_interval None (Some x)"
| "proper_interval_expr (Some (Var x)) (Some (Var y)) \<longleftrightarrow> proper_interval (Some x) (Some y)"
| "proper_interval_expr (Some (Lit i)) (Some (Lit j)) \<longleftrightarrow> proper_interval (Some i) (Some j)"
| "proper_interval_expr (Some (Lit i)) (Some (Var x)) \<longleftrightarrow> False"
| "proper_interval_expr (Some (Add e1 e2)) (Some (Lit i)) \<longleftrightarrow> False"
| "proper_interval_expr (Some (Add e1 e2)) (Some (Var x)) \<longleftrightarrow> False"
| "proper_interval_expr (Some (Add e1 e2)) (Some (Add e1' e2')) \<longleftrightarrow>
    (case compare e1 e1' of Lt \<Rightarrow> True | Eq \<Rightarrow> proper_interval_expr (Some e2) (Some e2') | Gt \<Rightarrow> False)"
| "proper_interval_expr _ _ \<longleftrightarrow> True"

instance
proof(intro_classes)
  fix x y :: expr
  show "proper_interval None (Some y) = (\<exists>z. z < y)"
    unfolding less_expr_conv
    by (cases y)(auto simp add: lt_of_comp_expr  intro: exI[where x="''''"])

  { fix x y have "x < Add x y" unfolding less_expr_conv
      by(induct x arbitrary: y)(simp_all add: lt_of_comp_expr) }
  note le_Add = this
  thus "proper_interval (Some x) None = (\<exists>z. x < z)"
    by(simp add: less_expr_def exI[where x="Add x y"])

  note [simp] = less_expr_conv lt_of_comp_expr

  show "proper_interval (Some x) (Some y) = (\<exists>z. x < z \<and> z < y)"
  proof(induct "Some x" "Some y" arbitrary: x y rule: proper_interval_expr.induct)
    case 2
    show ?case by(auto simp add: proper_interval_list_aux_correct)
  next
    case (3 i j)
    show ?case by(auto intro: exI[where x="Lit (i + 1)"])
  next
    case (7 e1 e2 e1' e2')
    thus ?case by(auto intro: le_Add simp add: le_less)
  next
    case ("8_2" i e1 e2)
    show ?case by(auto intro: exI[where x="Lit (i + 1)"])
  next
    case ("8_5" x i) show ?case
      by(auto intro: exI[where x="Var (x @ [undefined])"] simp add: less_append_same_iff)
  next
    case ("8_6" x e1 e2) show ?case
      by(auto intro: exI[where x="Lit 0"])
  next
    case ("8_7" i e1 e2) show ?case
      by(auto intro: exI[where x="Lit (i + 1)"])
  next
    case ("8_10" x i) show ?case
      by(auto intro: exI[where x="Lit (i - 1)"])
  next
    case ("8_12" x e1 e2) show ?case
      by(auto intro: exI[where x="Lit 0"])
  next
    case ("8_13" i e1 e2) show ?case
      by(auto intro: exI[where x="Lit (i + 1)"])
  qed auto
qed simp
end
*)
(*<*)
value "{{Lit 1}}"
value "{{{Lit 1}}}"
value "{{{{Lit 1}}}}"
(*>*)

section \<open>New implementations for containers\<close>
text_raw \<open>\label{section:new:implementation}\<close>

(*<*)
typedecl 'v trie_raw
(*>*)

text \<open>
  This section explains how to add a new implementation for a container type.
  If you do so, please consider to add your implementation to this AFP entry.
\<close>

subsection \<open>Model and verify the data structure\<close>
text_raw \<open>\label{subsection:implement:data:structure}\<close>
text \<open>
  First, you of course have to define the data structure and verify that it has the required properties.
  As our running example, we use a trie to implement @{typ "('a, 'b) mapping"}.
  A trie is a binary tree whose the nodes store the values, the keys are the paths from the root to the given node.
  We use lists of @{typ bool}ans for the keys where the @{typ bool}ean indicates whether we should go to the left or right child.

  For brevity, we skip this step and rather assume that the type @{typ "'v trie_raw"} of tries has following operations and properties:
\<close>
type_synonym trie_key = "bool list"
axiomatization
  trie_empty :: "'v trie_raw" and
  trie_update :: "trie_key \<Rightarrow> 'v \<Rightarrow> 'v trie_raw \<Rightarrow> 'v trie_raw" and
  trie_lookup :: "'v trie_raw \<Rightarrow> trie_key \<Rightarrow> 'v option" and
  trie_keys :: "'v trie_raw \<Rightarrow> trie_key set"
where trie_lookup_empty: "trie_lookup trie_empty = Map.empty"
  and trie_lookup_update:
    "trie_lookup (trie_update k v t) = (trie_lookup t)(k \<mapsto> v)"
  and trie_keys_dom_lookup: "trie_keys t = dom (trie_lookup t)"

text \<open>
  This is only a minimal example.
  A full-fledged implementation has to provide more operations and -- for efficiency -- should use more than just @{typ bool}eans for the keys.
\<close>

(*<*) (* Implement trie by free term algebra *)
code_datatype trie_empty trie_update
lemmas [code] = trie_lookup_empty trie_lookup_update

lemma trie_keys_empty [code]: "trie_keys trie_empty = {}"
by(simp add: trie_keys_dom_lookup trie_lookup_empty)

lemma trie_keys_update [code]:
  "trie_keys (trie_update k v t) = insert k (trie_keys t)"
by(simp add: trie_keys_dom_lookup trie_lookup_update)
(*>*)

subsection \<open>Generalise the data structure\<close>
text_raw \<open>\label{subsection:introduce:type:class}\<close>
text \<open>
  As @{typ "('k, 'v) mapping"} store keys of arbitrary type @{typ "'k"}, not just @{typ "trie_key"}, we cannot use @{typ "'v trie_raw"} directly.
  Instead, we must first convert arbitrary types @{typ "'k"} into @{typ "trie_key"}.
  Of course, this is not always possbile, but we only have to make sure that we pick tries as implementation only if the types do.
  This is similar to red-black trees which require an order.
  Hence, we introduce a type class to convert arbitrary keys into trie keys.
  We make the conversions optional such that every type can instantiate the type class, just as LC does for @{class ceq} and @{class ccompare}.
\<close>
type_synonym 'a cbl = "(('a \<Rightarrow> bool list) \<times> (bool list \<Rightarrow> 'a)) option"
class cbl =
  fixes cbl :: "'a cbl"
  assumes inj_to_bl: "ID cbl = Some (to_bl, from_bl) \<Longrightarrow> inj to_bl"
  and to_bl_inverse: "ID cbl = Some (to_bl, from_bl) \<Longrightarrow> from_bl (to_bl a) = a"
begin
abbreviation from_bl where "from_bl \<equiv> snd (the (ID cbl))"
abbreviation to_bl where "to_bl \<equiv> fst (the (ID cbl))"
end

text \<open>
  It is best to immediately provide the instances for as many types as possible.
  Here, we only present two examples: @{typ unit} provides conversion functions, @{typ "'a \<Rightarrow> 'b"} does not.
\<close>
instantiation unit :: cbl begin
definition "cbl = Some (\<lambda>_. [], \<lambda>_. ())"
instance by(intro_classes)(auto simp add: cbl_unit_def ID_Some intro: injI)
end

instantiation "fun" :: (type, type) cbl begin
definition "cbl = (None :: ('a \<Rightarrow> 'b) cbl)"
instance by intro_classes(simp_all add: cbl_fun_def ID_None)
end

subsection \<open>Hide the invariants of the data structure\<close>
text_raw \<open>\label{subsection:hide:invariants}\<close>
text \<open>
  Many data structures have invariants on which the operations rely.
  You must hide such invariants in a \isamarkuptrue\isacommand{typedef}\isamarkupfalse{} before connecting to the container, because the code generator cannot handle explicit invariants.
  The type must be inhabited even if the types of the elements do not provide the required operations.
  The easiest way is often to ignore all invariants in that case.

  In our example, we require that all keys in the trie represent encoded values.
\<close>
typedef (overloaded) ('k :: cbl, 'v) trie =
  "{t :: 'v trie_raw.
    trie_keys t \<subseteq> range (to_bl :: 'k \<Rightarrow> trie_key) \<or> ID (cbl :: 'k cbl) = None}"
proof
  show "trie_empty \<in> ?trie"
    by(simp add: trie_keys_dom_lookup trie_lookup_empty)
qed

text \<open>
  Next, transfer the operations to the new type.
  The transfer package does a good job here.
\<close>

setup_lifting type_definition_trie \<comment> \<open>also sets up code generation\<close>

lift_definition empty :: "('k :: cbl, 'v) trie"
  is trie_empty
  by(simp add: trie_keys_empty)

lift_definition lookup :: "('k :: cbl, 'v) trie \<Rightarrow> 'k \<Rightarrow> 'v option"
  is "\<lambda>t. trie_lookup t \<circ> to_bl" .

lift_definition update :: "'k \<Rightarrow> 'v \<Rightarrow> ('k :: cbl, 'v) trie \<Rightarrow> ('k, 'v) trie"
  is "trie_update \<circ> to_bl"
  by(auto simp add: trie_keys_dom_lookup trie_lookup_update)

lift_definition keys :: "('k :: cbl, 'v) trie \<Rightarrow> 'k set"
  is "\<lambda>t. from_bl ` trie_keys t" .

text \<open>
  And now we go for the properties.
  Note that some properties hold only if the type class operations are actually provided, i.e., @{term "cbl \<noteq> None"} in our example.
\<close>

lemma lookup_empty: "lookup empty = Map.empty"
by transfer(simp add: trie_lookup_empty fun_eq_iff)

context
  fixes t :: "('k :: cbl, 'v) trie"
  assumes ID_cbl: "ID (cbl :: 'k cbl) \<noteq> None"
begin

lemma lookup_update: "lookup (update k v t) = (lookup t)(k \<mapsto> v)"
using ID_cbl
by transfer(auto simp add: trie_lookup_update fun_eq_iff dest: inj_to_bl[THEN injD])

lemma keys_conv_dom_lookup: "keys t = dom (lookup t)"
using ID_cbl
by transfer(force simp add: trie_keys_dom_lookup to_bl_inverse intro: rev_image_eqI)

end

subsection \<open>Connecting to the container\<close>
text_raw \<open>\label{subsection:connect:container}\<close>
text \<open>
  Connecting to the container (@{typ "('a, 'b) mapping"} in our example) takes three steps:
  \begin{enumerate}
  \item Define a new pseudo-constructor
  \item Implement the container operations for the new type
  \item Configure the heuristics to automatically pick an implementation
  \item Test thoroughly
  \end{enumerate}
  Thorough testing is particularly important, because Isabelle does not check whether you have implemented all your operations, whether you have configured your heuristics sensibly, nor whether your implementation always terminates.
\<close>

subsubsection \<open>Define a new pseudo-constructor\<close>

text \<open>
  Define a function that returns the abstract container view for a data structure value, and declare it as a datatype constructor for code generation with \isamarkuptrue\isacommand{code{\isacharunderscore}datatype}\isamarkupfalse.
  Unfortunately, you have to repeat all existing pseudo-constructors, because there is no way to extract the current set of pseudo-constructors from the code generator.
  We call them pseudo-constructors, because they do not behave like datatype constructors in the logic.
  For example, ours are neither injective nor disjoint.
\<close>

definition Trie_Mapping :: "('k :: cbl, 'v) trie \<Rightarrow> ('k, 'v) mapping"
where [simp, code del]: "Trie_Mapping t = Mapping.Mapping (lookup t)"

code_datatype Assoc_List_Mapping RBT_Mapping Mapping Trie_Mapping

subsubsection \<open>Implement the operations\<close>

text \<open>
  Next, you have to prove and declare code equations that implement the container operations for the new implementation.
  Typically, these just dispatch to the operations on the type from \S\ref{subsection:hide:invariants}.
  Some operations depend on the type class operations from \S\ref{subsection:introduce:type:class} being defined; then, the code equation must check that the operations are indeed defined.
  If not, there is usually no way to implement the operation, so the code should raise an exception.
  Logically, we use the function @{term "Code.abort"} of type @{typ "String.literal \<Rightarrow> (unit \<Rightarrow> 'a) \<Rightarrow> 'a"} with definition @{term "\<lambda>_ f. f ()"}, but the generated code raises an exception \texttt{Fail} with the given message (the unit closure avoids non-termination in strict languages).
  This function gets the exception message and the unit-closure of the equation's left-hand side as argument, because it is then trivial to prove equality.

  Again, we only show a small set of operations; a realistic implementation should cover as many as possible.
\<close>
context fixes t :: "('k :: cbl, 'v) trie" begin

lemma lookup_Trie_Mapping [code]:
  "Mapping.lookup (Trie_Mapping t) = lookup t"
  \<comment> \<open>Lookup does not need the check on @{term cbl},
        because we have defined the pseudo-constructor @{term Trie_Mapping} in terms of @{term "lookup"}\<close>
by simp(transfer, simp)

lemma update_Trie_Mapping [code]:
  "Mapping.update k v (Trie_Mapping t) =
  (case ID cbl :: 'k cbl of
     None \<Rightarrow> Code.abort (STR ''update Trie_Mapping: cbl = None'') (\<lambda>_. Mapping.update k v (Trie_Mapping t))
   | Some _ \<Rightarrow> Trie_Mapping (update k v t))"
by(simp split: option.split add: lookup_update Mapping.update.abs_eq)

lemma keys_Trie_Mapping [code]:
  "Mapping.keys (Trie_Mapping t) =
  (case ID cbl :: 'k cbl of
     None \<Rightarrow> Code.abort (STR ''keys Trie_Mapping: cbl = None'') (\<lambda>_. Mapping.keys (Trie_Mapping t))
   | Some _ \<Rightarrow> keys t)"
by(simp add: Mapping.keys.abs_eq keys_conv_dom_lookup split: option.split)

end

text \<open>
  These equations do not replace the existing equations for the other constructors, but they do take precedence over them.
  If there is already a generic implementation for an operation @{term "foo"}, say @{term "foo A = gen_foo A"}, and you prove a specialised equation @{term "foo (Trie_Mapping t) = trie_foo t"}, then when you call @{term "foo"} on some @{term "Trie_Mapping t"}, your equation will kick in.
  LC exploits this sequentiality especially for binary operators on sets like @{term "(\<inter>)"}, where there are generic implementations and faster specialised ones.
\<close>

subsubsection \<open>Configure the heuristics\<close>

text \<open>
  Finally, you should setup the heuristics that automatically picks a container implementation based on the types of the elements (\S\ref{subsection:set_impl}).

  The heuristics uses a type with a single value, e.g., @{typ mapping_impl} with value @{term Mapping_IMPL}, but there is one pseudo-constructor for each container implementation in the generated code.
  All these pseudo-constructors are the same in the logic, but they are different in the generated code.
  Hence, the generated code can distinguish them, but we do not have to commit to anything in the logic.
  This allows to reconfigure and extend the heuristic at any time.

  First, define and declare a new pseudo-constructor for the heuristics.
  Again, be sure to redeclare all previous pseudo-constructors.
\<close>
definition mapping_Trie :: mapping_impl
where [simp]: "mapping_Trie = Mapping_IMPL"

code_datatype
  mapping_Choose mapping_Assoc_List mapping_RBT mapping_Mapping mapping_Trie

text \<open>
  Then, adjust the implementation of the automatic choice.
  For every initial value of the container (such as the empty map or the empty set), there is one new constant (e.g., @{term mapping_empty_choose} and @{term set_empty_choose}) equivalent to it.
  Its code equation, however, checks the available operations from the type classes and picks an appropriate implementation.

  For example, the following prefers red-black trees over tries, but tries over associative lists:
\<close>

lemma mapping_empty_choose_code [code]:
  "(mapping_empty_choose :: ('a :: {ccompare, cbl}, 'b) mapping) =
   (case ID CCOMPARE('a) of Some _  \<Rightarrow> RBT_Mapping RBT_Mapping2.empty
    | None \<Rightarrow>
      case ID (cbl :: 'a cbl) of Some _ \<Rightarrow> Trie_Mapping empty
      | None \<Rightarrow> Assoc_List_Mapping DAList.empty)"
by(auto split: option.split simp add: DAList.lookup_empty[abs_def] Mapping.empty_def lookup_empty)

text \<open>
  There is also a second function for every such initial value that dispatches on the pseudo-constructors for @{typ mapping_impl}.
  This function is used to pick the right implementation for types that specify a preference.
\<close>
lemma mapping_empty_code [code]:
  "mapping_empty mapping_Trie = Trie_Mapping empty"
by(simp add: lookup_empty Mapping.empty_def)

text \<open>
  For @{typ "('k, 'v) mapping"}, LC also has a function @{term "mapping_impl_choose2"} which is given two preferences and returns one (for @{typ "'a set"}, it is called @{term "set_impl_choose2"}).
  Polymorphic type constructors like @{typ "'a + 'b"} use it to pick an implementation based on the preferences of @{typ "'a"} and @{typ "'b"}.
  By default, it returns @{term mapping_Choose}, i.e., ignore the preferences.
  You should add a code equation like the following that overrides this choice if both preferences are your new data structure:
\<close>

lemma mapping_impl_choose2_Trie [code]:
  "mapping_impl_choose2 mapping_Trie mapping_Trie = mapping_Trie"
by(simp add: mapping_Trie_def)

text \<open>
  If your new data structure is better than the existing ones for some element type, you should reconfigure the type's preferene.
  As all preferences are logically equal, you can prove (and declare) the appropriate code equation.
  For example, the following prefers tries for keys of type @{typ "unit"}:
\<close>

lemma mapping_impl_unit_Trie [code]:
  "MAPPING_IMPL(unit) = Phantom(unit) mapping_Trie"
by(simp add: mapping_impl_unit_def)

value "Mapping.empty :: (unit, int) mapping"

text \<open>
  You can also use your new pseudo-constructor with \<open>derive\<close> in instantiations, just give its name as option:
\<close>
derive (mapping_Trie) mapping_impl simple_tycon

section \<open>Changing the configuration\<close>

text \<open>
  As containers are connected to data structures only by refinement in the code generator, this can always be adapted later on.
  You can add new data structures as explained in \S\ref{section:new:implementation}.
  If you want to drop one, you redeclare the remaining pseudo-constructors with \isamarkuptrue\isacommand{code{\isacharunderscore}datatype}\isamarkupfalse{} and delete all code equations that pattern-match on the obsolete pseudo-constructors.
  The command \isamarkuptrue\isacommand{code{\isacharunderscore}thms}\isamarkupfalse{} will tell you which constants have such code equations.
  You can also freely adapt the heuristics for picking implementations as described in \S\ref{subsection:connect:container}.

  One thing, however, you cannot change afterwards, namely the decision whether an element type supports an operation and if so how it does, because this decision is visible in the logic.
\<close>

section \<open>New containers types\<close>

text \<open>
  We hope that the above explanations and the examples with sets and maps suffice to show what you need to do if you add a new container type, e.g., priority queues.
  There are three steps:
  \begin{enumerate}
  \item \textbf{Introduce a type constructor for the container.}
    \\
    Your new container type must not be a composite type, like @{typ "'a \<Rightarrow> 'b option"} for maps, because refinement for code generation only works with a single type constructor.
    Neither should you reuse a type constructor that is used already in other contexts, e.g., do not use @{typ "'a list"} to model queues.

    Introduce a new type constructor if necessary (e.g., @{typ "('a, 'b) mapping"} for maps) -- if your container type already has its own type constructor, everything is fine.

  \item \textbf{Implement the data structures}
    \\
    and connect them to the container type as described in \S\ref{section:new:implementation}.

  \item \textbf{Define a heuristics for picking an implementation.}
    \\
    See \<^cite>\<open>"Lochbihler2013ITP"\<close> for an explanation.
  \end{enumerate}
\<close>

section \<open>Troubleshooting\<close>

text \<open>
  This section describes some difficulties in using LC that we have come across, provides some background for them, and discusses how to overcome them.
  If you experience other difficulties, please contact the author.
\<close>

subsection \<open>Nesting of mappings\<close>

text \<open>
  Mappings can be arbitrarily nested on the value side, e.g., @{typ "('a, ('b, 'c) mapping) mapping"}.
  However, @{typ "('a, 'b) mapping"} cannot currently be the key of a mapping, i.e., code generation fails for @{typ "(('a, 'b) mapping, 'c) mapping"}.
  Simiarly, you cannot have a set of mappings like @{typ "('a, 'b) mapping set"} at the moment.
  There are no issues to make this work, we have just not seen the need for it.
  If you need to generate code for such types, please get in touch with the author.
\<close>

subsection \<open>Wellsortedness errors\<close>
text_raw \<open>\label{subsection:well:sortedness}\<close>

text \<open>
  LC uses its own hierarchy of type classes which is distinct from Isabelle/HOL's.
  This ensures that every type can be made an instance of LC's type classes.
  Consequently, you must instantiate these classes for your own types.
  The following lists where you can find information about the classes and examples how to instantiate them:
  \begin{center}
    \begin{tabular}{lll}
      \textbf{type class} & \textbf{user guide} & \textbf{theory}
      \\
      @{class card_UNIV} & \S\ref{subsection:card_UNIV} & @{theory "HOL-Library.Cardinality"}
      %@{term "Cardinality.card_UNIV_class"}
      \\
      @{class cenum} & \S\ref{subsection:cenum} & @{theory Containers.Collection_Enum}
      %@{term "Collection_Enum.cenum_class"}
      \\
      @{class ceq} & \S\ref{subsection:ceq} & @{theory Containers.Collection_Eq}
      %@{term "Collection_Eq.ceq_class"}
      \\
      @{class ccompare} & \S\ref{subsection:ccompare} & @{theory Containers.Collection_Order}
      %@{term "Collection_Order.ccompare_class"}
      \\
      @{class cproper_interval} & \S\ref{subsection:cproper_interval} & @{theory Containers.Collection_Order}
      %@{term "Collection_Order.cproper_interval_class"}
      \\
      @{class finite_UNIV} & \S\ref{subsection:finite_UNIV} & @{theory "HOL-Library.Cardinality"}
      %@{term "Cardinality.finite_UNIV_class"}
      \\
      @{class mapping_impl} & \S\ref{subsection:mapping_impl} & @{theory Containers.Mapping_Impl}
      %@{term "Mapping_Impl.mapping_impl_class"}
      \\
      @{class set_impl} & \S\ref{subsection:set_impl} & @{theory Containers.Set_Impl}
      %@{term "Set_Impl.set_impl_class"}
      \\
    \end{tabular}
  \end{center}

  The type classes @{class card_UNIV} and @{class cproper_interval} are only required to implement the operations on set complements.
  If your code does not need complements, you can manually delete the code equations involving @{const "Complement"}, the theorem list @{thm [source] set_complement_code} collects them.
  It is also recommended that you remove the pseudo-constructor @{const Complement} from the code generator.
  Note that some set operations like @{term "A - B"} and @{const UNIV} have no code equations any more.
\<close>
declare set_complement_code[code del]
code_datatype Collect_set DList_set RBT_set Set_Monad
(*<*)
datatype minimal_sorts = Minimal_Sorts bool
derive (eq) ceq minimal_sorts
derive (no) ccompare minimal_sorts
derive (monad) set_impl minimal_sorts
derive (no) cenum minimal_sorts
value "{Minimal_Sorts True} \<union> {} \<inter> Minimal_Sorts ` {True, False}"
(*>*)

subsection \<open>Exception raised at run-time\<close>
text_raw \<open>\label{subsection:set_impl_unsupported_operation}\<close>

text \<open>
  Not all combinations of data and container implementation are possible.
  For example, you cannot implement a set of functions with a RBT, because there is no order on @{typ "'a \<Rightarrow> 'b"}.
  If you try, the code will raise an exception \texttt{Fail} (with an exception message) or \texttt{Match}.
  They can occur in three cases:

  \begin{enumerate}
  \item
    You have misconfigured the heuristics that picks implementations (\S\ref{subsection:set_impl}), or you have manually picked an implementation that requires an operation that the element type does not provide.
    Printing a stack trace for the exception may help you in locating the error.

  \item You are trying to invoke an operation on a set complement which cannot be implemented on a complement representation, e.g., @{term "(`)"}.
    If the element type is enumerable, provide an instance of @{class cenum} and choose to represent complements of sets of enumerable types by the elements rather than the elements of the complement (see \S\ref{subsection:cenum} for how to do this).

  \item You use set comprehensions on types which do not provide an enumeration (i.e., they are represented as closures) or you chose to represent a map as a closure.

    A lot of operations are not implementable for closures, in particular those that return some element of the container

    Inspect the code equations with \isacommand{code{\isacharunderscore}thms} and look for calls to @{term "Collect_set"} and @{term "Mapping"} which are LC's constructor for sets and maps as closures.

    Note that the code generator preprocesses set comprehensions like @{term "{i < 4|i :: int. i > 2}"} to @{term "(\<lambda>i :: int. i < 4) ` {i. i > 2}"}, so this is a set comprehension over @{typ int} rather than @{typ bool}.
  \end{enumerate}
\<close>

(*<*)
definition test_set_impl_unsupported_operation1 :: "unit \<Rightarrow> (int \<Rightarrow> int) set"
where "test_set_impl_unsupported_operation1 _ = RBT_set RBT_Set2.empty \<union> {}"

definition test_set_impl_unsupported_operation2 :: "unit \<Rightarrow> bool set"
where "test_set_impl_unsupported_operation2 _ = {i < 4 | i :: int. i > 2}"

definition test_mapping_impl_unsupported_operation :: "unit \<Rightarrow> bool"
where
  "test_mapping_impl_unsupported_operation _ =
   Mapping.is_empty (RBT_Mapping (RBT_Mapping2.empty) :: (Enum.finite_4, unit) mapping)"

ML_val \<open>
fun test_fail s f =
  let
    fun error s' = Fail ("exception Fail \"" ^ s ^ "\" expected, but got " ^ s')
  in
    (f (); raise (error "no exception") )
    handle
      Fail s' => if s = s' then () else raise (error s')
  end;

test_fail "union RBT_set Set_Monad: ccompare = None" @{code test_set_impl_unsupported_operation1};
test_fail "image Collect_set" @{code test_set_impl_unsupported_operation2};
test_fail "is_empty RBT_Mapping: ccompare = None" @{code test_mapping_impl_unsupported_operation};
\<close>
(*>*)

subsection \<open>LC slows down my code\<close>

text \<open>
  Normally, this will not happen, because LC's data structures are more efficient than Isabelle's list-based implementations.
  However, in some rare cases, you can experience a slowdown:
\<close>
(*<*)
definition tiny_set :: "nat set"
where tiny_set_code: "tiny_set = {1, 2}"
(*>*)
text_raw \<open>
  \isastyletext
  \begin{enumerate}
  \item \textbf{Your containers contain just a few elements.}
    \\
    In that case, the overhead of the heuristics to pick an implementation outweighs the benefits of efficient implementations.
    You should identify the tiny containers and disable the heuristics locally.
    You do so by replacing the initial value like @{term "{}"} and @{term "Mapping.empty"} with low-overhead constructors like @{term "Set_Monad"} and @{term "Mapping"}.
    For example, if @{thm [source] tiny_set_code}: @{thm tiny_set_code} is your code equation with a tiny set,
    the following changes the code equation to directly use the list-based representation, i.e., disables the heuristics:
    \par
\<close>
lemma empty_Set_Monad: "{} = Set_Monad []" by simp
declare tiny_set_code[code del, unfolded empty_Set_Monad, code]
text_raw \<open>
    \isastyletext
    \par
     If you want to globally disable the heuristics, you can also declare an equation like @{thm [source] empty_Set_Monad} as [code].

  \item \textbf{The element type contains many type constructors and some type variables.}
    \\
    LC heavily relies on type classes, and type classes are implemented as dictionaries if the compiler cannot statically resolve them, i.e., if there are type variables.
    For type constructors with type variables (like @{typ "'a * 'b"}), LC's definitions of the type class parameters recursively calls itself on the type variables, i.e., @{typ "'a"} and @{typ "'b"}.
    If the element type is polymorphic, the compiler cannot precompute these recursive calls and therefore they have to be constructed repeatedly at run time.
    If you wrap your complicated type in a new type constructor, you can define optimised equations for the type class parameters.
  \end{enumerate}
\<close>

(*<*)
end
(*>*)


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

(*<*)
theory Chapter1_MinMax
imports "AutoCorres.AutoCorres"
begin

external_file "minmax.c"
(*>*)

section \<open>Introduction\<close>

text \<open>

  AutoCorres is a tool that attempts to simplify the formal verification of C
  programs in the Isabelle/HOL theorem prover. It allows C code
  to be automatically abstracted to produce a higher-level functional
  specification.

  AutoCorres relies on the C-Parser~\cite{CParser_download} developed by Michael Norrish
  at NICTA. This tool takes raw C code as input and produces a translation in
  SIMPL~\cite{Simpl-AFP}, an imperative language written by Norbert Schirmer on top
  of Isabelle. AutoCorres takes this SIMPL code to produce a "monadic"
  specification, which is intended to be simpler to reason about in Isabelle.
  The composition of these two tools (AutoCorres applied after the C-Parser) can
  then be used to reason about C programs.

  This guide is written for users of Isabelle/HOL, with some knowledge of C, to
  get started proving properties of C programs. Using AutoCorres in conjunction
  with the verification condition generator (VCG) \texttt{wp}, one
  should be able to do this without an understanding of SIMPL nor of the monadic
  representation produced by AutoCorres. We will see how this is possible in the
  next chapter.

\<close>

section  \<open>A First Proof with AutoCorres\<close>

text \<open>

  We will now show how to use these tools to prove correctness of some very
  simple C functions.

\<close>

subsection \<open>Two simple functions: \texttt{min} and \texttt{max}\<close>

text \<open>

  Consider the following two functions, defined in a file \texttt{minmax.c},
  which (we expect) return the minimum and maximum respectively of two unsigned
  integers.

  \lstinputlisting[language=C, firstline=13]{minmax.c}

  It is easy to see that \texttt{min} is correct, but perhaps less obvious why
  \texttt{max} is correct. AutoCorres will hopefully allow us to prove these
  claims without too much effort.

\<close>

subsection \<open>Invoking the C-parser\<close>

text \<open>

  As mentioned earlier, AutoCorres does not handle C code directly. The first
  step is to apply the
  C-Parser\footnote{\url{https://trustworthy.systems/software/TS/c-parser}} to
  obtain a SIMPL translation. We do this using the \texttt{install-C-file}
  command in Isabelle, as shown.

\<close>

install_C_file "minmax.c"

(* FIXME: Be consistent with \texttt and \emph *)
text \<open>

  For every function in the C source file, the C-Parser generates a
  corresponding Isabelle definition. These definitions are placed in an Isabelle
  "locale", whose name matches the input filename. For our file \emph{minmax.c},
  the C-Parser will place definitions in the locale \emph{minmax}.\footnote{The
  C-parser uses locales to avoid having to make certain assumptions about the
  behaviour of the linker, such as the concrete addresses of symbols in your
  program.}

  For our purposes, we just have to remember to enter the appropriate locale
  before writing our proofs. This is done using the \texttt{context} keyword in
  Isabelle.

  Let's look at the C-Parser's outputs for \texttt{min} and \texttt{max}, which
  are contained in the theorems \texttt{min\_body\_def} and \texttt{max\_body\_def}.
  These are simply definitions of the generated names \emph{min\_body} and
  \emph{max\_body}. We can also see here how our work is wrapped within the
  \emph{minmax} context.

\<close>

context minmax begin

  thm min_body_def
  text \<open>@{thm [display] min_body_def}\<close>
  thm max_body_def
  text \<open>@{thm [display] max_body_def}\<close>

end

text \<open>

  The definitions above show us the SIMPL generated for each of the
  functions; we can see that C-parser has translated \texttt{min} and
  \texttt{max} very literally and no detail of the C language has been
  omitted. For example:

  \begin{itemize}
    \item  C \texttt{return} statements have been translated into
           exceptions which are caught at the outside of the
           function's body;

    \item  \emph{Guard} statements are used to ensure that behaviour
           deemed `undefined' by the C standard does not occur. In the
           above functions, we see that a guard statement is emitted
           that ensures that program execution does not hit the end
           of the function, ensuring that we always return a value
           (as is required by all non-\texttt{void} functions).

    \item  Function parameters are modelled as local variables, which
           are setup prior to a function being called. Return variables
           are also modelled as local variables, which are then
           read by the caller.
  \end{itemize}

  While a literal translation of C helps to improve confidence that the
  translation is sound, it does tend to make formal reasoning an arduous
  task.

\<close>

subsection \<open>Invoking AutoCorres\<close>

text \<open>

  Now let's use AutoCorres to simplify our functions. This is done using
  the \texttt{autocorres} command, in a similar manner to the
  \texttt{install\_C\_file} command:

\<close>

autocorres "minmax.c"

text \<open>

  AutoCorres produces a definition in the \texttt{minmax} locale
  for each function body produced by the C parser. For example,
  our \texttt{min} function is defined as follows:

\<close>
context minmax begin
thm min'_def
text \<open>@{thm [display] min'_def}\<close>

text \<open>

  Each function's definition is named identically to its name in
  C, but with a prime mark (\texttt{'}) appended. For example,
  our functions \texttt{min} above was named @{term min'}, while
  the function \texttt{foo\_Bar} would be named @{term foo_Bar'}.

  AutoCorres does not require you to trust its translation is sound,
  but also emits a \emph{correspondence} or \emph{refinement} proof,
  as follows:

\<close>

(* FIXME *)
(* thm min_autocorres *)

text \<open>

  Informally, this theorem states that, assuming the abstract function
  @{term min'} can be proven to not fail for a partciular input, then
  for the associated input, the concrete C SIMPL program also will not
  fault, will always terminate, and will have a corresponding end state
  to the generated abstract program.

  For more technical details, see~\cite{Greenaway_AK_12} and~\cite{Greenaway_LAK_14}.

\<close>

subsection \<open>Verifying \texttt{min}\<close>

text \<open>

  In the abstracted version of @{term min'}, we can see that AutoCorres
  has simplified away the local variable reads and writes in the
  C-parser translation of \texttt{min}, simplified away the exception
  throwing and handling code, and also simplified away the unreachable
  guard statement at the end of the function. In fact, @{term min'} has
  been simplified to the point that it exactly matches Isabelle's
  built-in function @{term min}:

\<close>
thm min_def
text \<open>@{thm [display] min_def}\<close>

text \<open>
  So, verifying @{term min'} (and by extension, the C function
  \texttt{min}) should be easy:
\<close>
lemma min'_is_min: "min' a b = min a b"
  unfolding min_def min'_def
  by (rule refl)

subsection \<open>Verifying \texttt{max}\<close>

text \<open>

  Now we also wish to verify that @{term max'} implements the built-in
  function @{term max}. @{term min'} was nearly too simple to bother
  verifying, but @{term max'} is a bit more complicated. Let's look at
  AutoCorres' output for \texttt{max}:

\<close>
thm max'_def
text \<open>@{thm [display] max'_def}\<close>

text \<open>

  At this point, you might still doubt that @{term max'} is indeed
  correct, so perhaps a proof is in order. The basic idea is that
  subtracting from \texttt{UINT\_MAX} flips the ordering of unsigned
  ints. We can then use @{term min'} on the flipped numbers to compute
  the maximum.

  The next lemma proves that subtracting from \texttt{UINT\_MAX} flips
  the ordering. To prove it, we convert all words to @{typ int}'s, which
  does not change the meaning of the statement.

\<close>

  lemma n1_minus_flips_ord:
    "((a :: word32) \<le> b) = ((-1 - a) \<ge> (-1 - b))"
    apply (subst word_le_def)+
    apply (subst word_n1_ge [simplified uint_minus_simple_alt])+
    txt \<open>Now that our statement uses @{typ int}, we can apply Isabelle's built-in \texttt{arith} method.\<close>
    apply arith
    done

text \<open>
  And now for the main proof:
\<close>
  lemma max'_is_max: "max' a b = max a b"
    unfolding max'_def min'_def max_def
    using n1_minus_flips_ord
    by force

end

text \<open>
  In the next section, we will see how to use AutoCorres to simplify
  larger, more realistic C programs.
\<close>

(*<*)
end
(*>*)


theory Chapter8
imports "HOL-IMP.Compiler" "Short_Theory"
begin

text\<open>
\section*{Chapter 8}

For the following exercises copy and adjust theory @{short_theory "Compiler"}.
Intrepid readers only should attempt to adjust theory @{text Compiler2} too.

\begin{exercise}
A common programming idiom is @{text "IF b THEN c"}, i.e.,
the @{text ELSE}-branch is a @{term SKIP} command.
Look at how, for example, the command @{term "IF Less (V ''x'') (N 5) THEN ''y'' ::= N 3 ELSE SKIP"}
is compiled by @{const ccomp} and identify a possible compiler optimization.
Modify the definition of @{const ccomp} such that it generates fewer instructions
for commands of the form @{term "IF b THEN c ELSE SKIP"}.
Ideally the proof of theorem @{thm[source] ccomp_bigstep} should still work;
otherwise adapt it.
\end{exercise}

\begin{exercise}
Building on Exercise~\ref{exe:IMP:REPEAT}, extend the compiler @{const ccomp}
and its correctness theorem @{thm[source] ccomp_bigstep} to @{text REPEAT}
loops. Hint: the recursion pattern of the big-step semantics
and the compiler for @{text REPEAT} should match.
\end{exercise}

\begin{exercise}\label{exe:COMP:addresses}
Modify the machine language such that instead of variable names to values,
the machine state maps addresses (integers) to values. Adjust the compiler
and its proof accordingly.

In the simple version of this exercise, assume the existence of a globally
bijective function @{term "addr_of :: vname => int"} with @{term "bij addr_of"}
to adjust the compiler. Use the @{text find_theorems} search to find applicable
theorems for bijectivte functions.

For the more advanced version and a slightly larger project, only assume that
the function works on a finite set of variables: those that occur in the
program. For the other, unused variables, it should return a suitable default
address. In this version, you may want to split the work into two parts:
first, update the compiler and machine language, assuming the existence of
such a function and the (partial) inverse it provides. Second, separately
construct this function from the input program, having extracted the
properties needed for it in the first part. In the end, rearrange you theory
file to combine both into a final theorem.
\end{exercise}

\begin{exercise}
This is a slightly more challenging project. Based on
\autoref{exe:COMP:addresses}, and similarly to \autoref{exe:register-machine}
and \autoref{exe:accumulator}, define a second machine language that does not
possess a built-in stack, but instead, in addition to the program counter, a
stack pointer register. Operations that previously worked on the stack now
work on memory, accessing locations based on the stack pointer.

For instance, let @{term "(pc, s, sp)"} be a configuration of this new machine consisting of
program counter, store, and stack pointer. Then the configuration after an @{const ADD} instruction
is \mbox{@{term "(pc + 1::int, s(sp + 1 := s (sp + 1::int) + s sp), sp + 1)"}}, that is, @{const ADD} dereferences
the memory at @{term "sp + 1::int"} and @{term sp}, adds these two values and stores them at
@{term "sp + 1::int"}, updating the values on the stack. It also increases the stack pointer by one
to pop one value from the stack and leave the result at the top of the stack. This means the stack grows downwards.

Modify the compiler from \autoref{exe:COMP:addresses} to work on this new machine language. Reformulate and reprove the easy direction of compiler correctness.

\emph{Hint:} Let the stack start below @{text 0}, growing downwards, and use type @{typ nat} for addressing variable in @{const LOAD} and @{const STORE} instructions, so that it is clear by type that these instructions do not interfere with the stack.

\emph{Hint:} When the new machine pops a value from the stack, this now unused value is left behind in the store. This means, even after executing a purely arithmetic expression, the values in initial and final stores are not all equal. But: they are equal above a given address. Define an abbreviation for this concept and use it to express the intermediate correctness statements.

\end{exercise}

\<close>
end


(*  Title:      Uint_Userguide.thy
    Author:     Andreas Lochbihler, ETH Zurich
*)

chapter \<open>User guide for native words\<close>

(*<*)
theory Uint_Userguide imports
  Uint32
  Uint16
  Code_Target_Bits_Int
begin
(*>*)

text \<open>
  This tutorial explains how to best use the types for native
  words like @{typ "uint32"} in your formalisation.
  You can base your formalisation
  \begin{enumerate}
  \item either directly on these types,
  \item or on the generic @{typ "'a word"} and only introduce native
    words a posteriori via code generator refinement.
  \end{enumerate}

  The first option causes the least overhead if you have to prove only
  little about the words you use and start a fresh formalisation.
  Just use the native type @{typ uint32} instead of @{typ "32 word"}
  and similarly for \<open>uint64\<close>, \<open>uint16\<close>, and \<open>uint8\<close>.
  As native word types are meant only for code generation, the lemmas
  about @{typ "'a word"}  have not been duplicated, but you can transfer
  theorems between native word types and @{typ "'a word"} using the
  transfer package.

  Note, however, that this option restricts your work a bit:
  your own functions cannot be ``polymorphic'' in the word length,
  but you have to define a separate function for every word length you need.

  The second option is recommended if you already have a formalisation
  based on @{typ "'a word"} or if your proofs involve words and their
  properties. It separates code generation from modelling and proving,
  i.e., you can work with words as usual. Consequently, you have to
  manually setup the code generator to use the native types wherever
  you want. The following describes how to achieve this with moderate
  effort.

  Note, however, that some target languages of the code generator
  (especially OCaml) do not support all the native word types provided.
  Therefore, you should only import those types that you need -- the
  theory file for each type mentions at the top the restrictions for
  code generation. For example, PolyML does not provide the Word16
  structure, and OCaml provides neither Word8 nor Word16.
  You can still use these theories provided that you also import
  the theory @{theory Native_Word.Code_Target_Bits_Int} (which implements
  @{typ int} by target-language integers), but these words will
  be implemented via Isabelle's \<open>HOL-Word\<close> library, i.e.,
  you do not gain anything in terms of efficiency.

  \textbf{There is a separate code target \<open>SML_word\<close> for SML.}
  If you use one of the native words that PolyML does not support
  (such as \<open>uint16\<close> and \<open>uint64\<close> in 32-bit mode), but would
  like to map its operations to the Standard Basis Library functions,
  make sure to use the target \<open>SML_word\<close> instead of \<open>SML\<close>;
  if you only use native word sizes that PolyML supports, you can stick
  with \<open>SML\<close>.  This ensures that code generation within Isabelle
  as used by \<open>Quickcheck\<close>, \<open>value\<close> and @\{code\} in ML blocks
  continues to work.
\<close>

section \<open>Lifting functions from @{typ "'a word"} to native words\<close>

text \<open>
  This section shows how to convert functions from @{typ "'a word"} to native
  words. For example, the following function \<open>sum_squares\<close> computes
  the sum of the first @{term n} square numbers in 16 bit arithmetic using
  a tail-recursive function \<open>gen_sum_squares\<close> with accumulator;
  for convenience, \<open>sum_squares_int\<close> takes an integer instead of a word.
\<close>

function gen_sum_squares :: "16 word \<Rightarrow> 16 word \<Rightarrow> 16 word" where (*<*)[simp del]:(*>*)

  "gen_sum_squares accum n =
   (if n = 0 then accum else gen_sum_squares (accum + n * n) (n - 1))"
(*<*)by pat_completeness simp
termination by(relation "measure (nat \<circ> uint \<circ> snd)")
  (simp_all, metis (hide_lams, mono_tags) uint_1 uint_eq_0 uint_minus_simple_alt uint_sub_ge word_le_sub1 word_less_def word_neq_0_conv word_zero_le zle_diff1_eq)(*>*)

definition sum_squares :: "16 word \<Rightarrow> 16 word" where
   "sum_squares = gen_sum_squares 0"

definition sum_squares_int :: "int \<Rightarrow> 16 word" where
  "sum_squares_int n = sum_squares (word_of_int n)"

text \<open>
  The generated code for @{term sum_squares} and @{term sum_squares_int}
  emulates words with unbounded integers and explicit modulus as specified
  in the theory @{theory "HOL-Word.Word"}. But for efficiency, we want that the
  generated code uses machine words and machine arithmetic. Unfortunately,
  as @{typ "'a word"} is polymorphic in the word length, the code generator
  can only do this if we use another type for machine words. The theory
  @{theory Native_Word.Uint16} defines the type @{typ uint16} for machine words of
  16~bits. We just have to follow two steps to use it:

  First, we lift all our functions from @{typ "16 word"} to @{typ uint16},
  i.e., @{term sum_squares}, @{term gen_sum_squares}, and
  @{term sum_squares_int} in our case. The theory @{theory Native_Word.Uint16} sets
  up the lifting package for this and has already taken care of the
  arithmetic and bit-wise operations.
\<close>
lift_definition gen_sum_squares_uint :: "uint16 \<Rightarrow> uint16 \<Rightarrow> uint16"
  is gen_sum_squares .
lift_definition sum_squares_uint :: "uint16 \<Rightarrow> uint16" is sum_squares .
lift_definition sum_squares_int_uint :: "int \<Rightarrow> uint16" is sum_squares_int .

text \<open>
  Second, we also have to transfer the code equations for our functions.
  The attribute \<open>Transfer.transferred\<close> takes care of that, but it is
  better to check that the transfer succeeded: inspect the theorem to check
  that the new constants are used throughout.
\<close>

lemmas [Transfer.transferred, code] =
  gen_sum_squares.simps
  sum_squares_def
  sum_squares_int_def

text \<open>
  Finally, we export the code to standard ML.  We use the target
  \<open>SML_word\<close> instead of \<open>SML\<close> to have the operations
  on @{typ uint16} mapped to the Standard Basis Library. As PolyML
  does not provide a Word16 type, the mapping for @{typ uint16} is only
  active in the refined target \<open>SML_word\<close>.
\<close>
export_code sum_squares_int_uint in SML_word

text \<open>
  Nevertheless, we can still evaluate terms with @{term "uint16"} within
  Isabelle, i.e., PolyML, but this will be translated to @{typ "16 word"}
  and therefore less efficient.
\<close>

value "sum_squares_int_uint 40"

section \<open>Storing native words in datatypes\<close>

text \<open>
  The above lifting is necessary for all functions whose type mentions
  the word type. Fortunately, we do not have to duplicate functions that
  merely operate on datatypes that contain words. Nevertheless, we have
  to tell the code generator that these functions should call the new ones,
  which operate on machine words. This section shows how to achieve this
  with data refinement.
\<close>

subsection \<open>Example: expressions and two semantics\<close>

text \<open>
  As the running example, we consider a language of expressions (literal values, less-than comparisions and conditional) where values are either booleans or 32-bit words.
  The original specification uses the type @{typ "32 word"}.
\<close>

datatype val = Bool bool | Word "32 word"
datatype expr = Lit val | LT expr expr | IF expr expr expr

abbreviation (input) word :: "32 word \<Rightarrow> expr" where "word i \<equiv> Lit (Word i)"
abbreviation (input) bool :: "bool \<Rightarrow> expr" where "bool i \<equiv> Lit (Bool i)"

\<comment> \<open>Denotational semantics of expressions, @{term None} denotes a type error\<close>
fun eval :: "expr \<Rightarrow> val option" where
  "eval (Lit v) = Some v"
| "eval (LT e\<^sub>1 e\<^sub>2) =
  (case (eval e\<^sub>1, eval e\<^sub>2)
   of (Some (Word i\<^sub>1), Some (Word i\<^sub>2)) \<Rightarrow> Some (Bool (i\<^sub>1 < i\<^sub>2))
   | _ \<Rightarrow> None)"
| "eval (IF e\<^sub>1 e\<^sub>2 e\<^sub>3) =
  (case eval e\<^sub>1 of Some (Bool b) \<Rightarrow> if b then eval e\<^sub>2 else eval e\<^sub>3
   | _ \<Rightarrow> None)"

\<comment> \<open>Small-step semantics of expressions, it gets stuck upon type errors.\<close>
inductive step :: "expr \<Rightarrow> expr \<Rightarrow> bool" ("_ \<rightarrow> _" [50, 50] 60) where
  "e \<rightarrow> e' \<Longrightarrow> LT e e\<^sub>2 \<rightarrow> LT e' e\<^sub>2"
| "e \<rightarrow> e' \<Longrightarrow> LT (word i) e \<rightarrow> LT (word i) e'"
| "LT (word i\<^sub>1) (word i\<^sub>2) \<rightarrow> bool (i\<^sub>1 < i\<^sub>2)"
| "e \<rightarrow> e' \<Longrightarrow> IF e e\<^sub>1 e\<^sub>2 \<rightarrow> IF e' e\<^sub>1 e\<^sub>2"
| "IF (bool True) e\<^sub>1 e\<^sub>2 \<rightarrow> e\<^sub>1"
| "IF (bool False) e\<^sub>1 e\<^sub>2 \<rightarrow> e\<^sub>2"

\<comment> \<open>Compile the inductive definition with the predicate compiler\<close>
code_pred (modes: i \<Rightarrow> o \<Rightarrow> bool as reduce, i \<Rightarrow> i \<Rightarrow> bool as step') step .

subsection \<open>Change the datatype to use machine words\<close>

text \<open>
  Now, we want to use @{typ uint32} instead of @{typ "32 word"}.
  The goal is to make the code generator use the new type without
  duplicating any of the types (@{typ val}, @{typ expr}) or the
  functions (@{term eval}, @{term reduce}) on such types.

  The constructor @{term Word} has @{typ "32 word"} in its type, so
  we have to lift it to \<open>Word'\<close>, and the same holds for the
  case combinator @{term case_val}, which @{term case_val'} replaces.%
  \footnote{%
    Note that we should not declare a case translation for the new
    case combinator because this will break parsing case expressions
    with old case combinator.
  }
  Next, we set up the code generator accordingly:
  @{term Bool} and @{term Word'} are the new constructors for @{typ val},
  and @{term case_val'} is the new case combinator with an appropriate
  case certificate.%
  \footnote{%
    Case certificates tell the code generator to replace the HOL
    case combinator for a datatype with the case combinator of the
    target language.  Without a case certificate, the code generator
    generates a function that re-implements the case combinator;
    in a strict languages like ML or Scala, this means that the code
    evaluates all possible cases before it decides which one is taken.

    Case certificates are described in Haftmann's PhD thesis
    \cite[Def.\ 27]{Haftmann2009PhD}. For a datatype \<open>dt\<close>
    with constructors \<open>C\<^sub>1\<close> to \<open>C\<^sub>n\<close>
    where each constructor \<open>C\<^sub>i\<close> takes \<open>k\<^sub>i\<close> parameters,
    the certificate for the case combinator \<open>case_dt\<close>
    looks as follows:

    {
      \isamarkuptrue\isacommand{lemma}\isamarkupfalse\isanewline%
      \ \ \isakeyword{assumes}\ {\isachardoublequoteopen}CASE\ {\isasymequiv}\ dt{\isacharunderscore}case\ c\isactrlsub {\isadigit{1}}\ c\isactrlsub {\isadigit{2}}\ \ldots\ c\isactrlsub{n}{\isachardoublequoteclose}\isanewline
      \ \ \isakeyword{shows}\ {\isachardoublequoteopen}{\isacharparenleft}CASE\ {\isacharparenleft}C\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{1}}\isactrlsub {k\ensuremath{{}_1}}{\isacharparenright}\ {\isasymequiv}\ c\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{1}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{1}}\isactrlsub {k\ensuremath{{}_1}}{\isacharparenright}\isanewline
      \ \ \ \ {\isacharampersand}{\isacharampersand}{\isacharampersand}\ {\isacharparenleft}CASE\ {\isacharparenleft}C\isactrlsub {\isadigit{2}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{2}}\isactrlsub {k\ensuremath{{}_2}}{\isacharparenright}\ {\isasymequiv}\ c\isactrlsub {\isadigit{2}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{1}}\ a\isactrlsub {\isadigit{2}}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {\isadigit{2}}\isactrlsub {k\ensuremath{{}_2}}{\isacharparenright}\isanewline
      \ \ \ \ {\isacharampersand}{\isacharampersand}{\isacharampersand}\ \ldots\isanewline
      \ \ \ \ {\isacharampersand}{\isacharampersand}{\isacharampersand}\ {\isacharparenleft}CASE\ {\isacharparenleft}C\isactrlsub {n}\ a\isactrlsub {n}\isactrlsub {\isadigit{1}}\ a\isactrlsub {n}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {n}\isactrlsub {k\ensuremath{{}_n}}{\isacharparenright}\ {\isasymequiv}\ c\isactrlsub {n}\ a\isactrlsub {n}\isactrlsub {\isadigit{1}}\ a\isactrlsub {n}\isactrlsub {\isadigit{2}}\ \ldots\ a\isactrlsub {n}\isactrlsub {k\ensuremath{{}_n}}{\isacharparenright}{\isachardoublequoteclose}\isanewline
    }
  }
  We delete the code equations for the old constructor @{term Word}
  and case combinator @{term case_val} such that the code generator
  reports missing adaptations.
\<close>

lift_definition Word' :: "uint32 \<Rightarrow> val" is Word .

code_datatype Bool Word'

lift_definition case_val' :: "(bool \<Rightarrow> 'a) \<Rightarrow> (uint32 \<Rightarrow> 'a) \<Rightarrow> val \<Rightarrow> 'a" is case_val .

lemmas [code, simp] = val.case [Transfer.transferred]

lemma case_val'_cert:
  fixes bool word' b w
  assumes "CASE \<equiv> case_val' bool word'"
  shows "(CASE (Bool b) \<equiv> bool b) &&& (CASE (Word' w) \<equiv> word' w)"
  by (simp_all add: assms)

setup \<open>Code.declare_case_global @{thm case_val'_cert}\<close>

declare [[code drop: case_val Word]]

subsection \<open>Make functions use functions on machine words\<close>

text \<open>
  Finally, we merely have to change the code equations to use the
  new functions that operate on @{typ uint32}. As before, the
  attribute \<open>Transfer.transferred\<close> does the job. In our example,
  we adapt the equality test on @{typ val} (code equations
  @{thm [source] val.eq.simps}) and the denotational and small-step
  semantics (code equations @{thm [source] eval.simps} and
  @{thm [source] step.equation}, respectively).

  We check that the adaptation has suceeded by exporting the functions.
  As we only use native word sizes that PolyML supports, we can use
  the usual target \<open>SML\<close> instead of \<open>SML_word\<close>.
\<close>

lemmas [code] =
  val.eq.simps[THEN meta_eq_to_obj_eq, Transfer.transferred, THEN eq_reflection]
  eval.simps[Transfer.transferred]
  step.equation[Transfer.transferred]

export_code reduce step' eval checking SML

section \<open>Troubleshooting\<close>

text \<open>
  This section explains some possible problems when using native words.
  If you experience other difficulties, please contact the author.
\<close>

subsection \<open>\<open>export_code\<close> raises an exception \label{section:export_code:exception}\<close>

text \<open>
  Probably, you have defined and are using a function on a native word type,
  but the code equation refers to emulated words. For example, the following
  defines a function \<open>double\<close> that doubles a word. When we try to export
  code for \<open>double\<close> without any further setup, \<open>export_code\<close> will
  raise an exception or generate code that does not compile.
\<close>

lift_definition double :: "uint32 \<Rightarrow> uint32" is "\<lambda>x. x + x" .

text \<open>
  We have to prove a code equation that only uses the existing operations on
  @{typ uint32}. Then, \<open>export_code\<close> works again.
\<close>

lemma double_code [code]: "double n = n + n"
by transfer simp

subsection \<open>The generated code does not compile\<close>

text \<open>
  Probably, you have been exporting to a target language for which there
  is no setup, or your compiler does not provide the required API. Every
  theory for native words mentions at the start the limitations on code
  generation. Check that your concrete application meets all the
  requirements.

  Alternatively, this might be an instance of the problem described
  in \S\ref{section:export_code:exception}.

  For Haskell, you have to enable the extension TypeSynonymInstances with \texttt{-XTypeSynonymInstances}
  if you are using polymorphic bit operations on the native word types.
\<close>

subsection \<open>The generated code is too slow\<close>

text \<open>
  The generated code will most likely not be as fast as a direct implementation in the target language with manual tuning.
  This is because we want the configuration of the code generation to be sound (as it can be used to prove theorems in Isabelle).
  Therefore, the bit operations sometimes perform range checks before they call the target language API.
  Here are some examples:
  \begin{itemize}
  \item Shift distances and bit indices in target languages are often expected to fit into a bounded integer or word.
    However, the size of these types varies across target languages and platforms.
    Hence, no Isabelle/HOL type can model uniformly all of them.
    Instead, the bit operations use arbitrary-precision integers for such quantities and check at run-time that the values fit into a bounded integer or word, respectively -- if not, they raise an exception.

  \item Division and modulo operations explicitly test whether the divisor is $0$ and return the HOL value of division by $0$ in that case.
    This is necessary because some languages leave the behaviour of division by 0 unspecified.
  \end{itemize}

  If you have better ideas how to eliminate such checks and speed up the generated code without sacrificing soundness, please contact the author!
\<close>

(*<*)end(*>*)