Quot/Examples/FSet.thy
changeset 768 e9e205b904e2
parent 767 37285ec4387d
child 774 b4ffb8826105
--- a/Quot/Examples/FSet.thy	Sun Dec 20 00:53:35 2009 +0100
+++ b/Quot/Examples/FSet.thy	Mon Dec 21 22:36:31 2009 +0100
@@ -1,5 +1,5 @@
 theory FSet
-imports "../QuotMain" List
+imports "../QuotMain" "../QuotList" List
 begin
 
 inductive
@@ -26,6 +26,61 @@
   fset = "'a list" / "list_eq"
   by (rule equivp_list_eq)
 
+
+fun
+  intrel :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> bool"
+where
+  "intrel (x, y) (u, v) = (x + v = u + y)"
+
+quotient_type int = "nat \<times> nat" / intrel
+  apply(unfold equivp_def)
+  apply(auto simp add: mem_def expand_fun_eq)
+  done
+
+
+ML {*
+open Quotient_Def;
+*}
+
+ML {*
+get_fun absF @{context} (@{typ "'a list"}, 
+                         @{typ "'a fset"})
+|> Syntax.check_term @{context}
+|> Syntax.string_of_term @{context}
+|> writeln
+*}
+
+term "map id"
+term "abs_fset o (map id)"
+
+ML {*
+get_fun absF @{context} (@{typ "(nat * nat) list"}, 
+                         @{typ "int fset"})
+|> Syntax.check_term @{context}
+|> Syntax.string_of_term @{context}
+|> writeln
+*}
+
+term "map abs_int"
+term "abs_fset o map abs_int"
+
+
+ML {*
+get_fun absF @{context} (@{typ "('a list) list"}, 
+                         @{typ "('a fset) fset"})
+|> Syntax.check_term @{context}
+|> Syntax.string_of_term @{context}
+|> writeln
+*}
+
+ML {*
+get_fun absF @{context} (@{typ "('a list) list \<Rightarrow> 'a"}, 
+                         @{typ "('a fset) fset \<Rightarrow> 'a"})
+|> Syntax.check_term @{context}
+|> Syntax.string_of_term @{context}
+|> writeln
+*}
+
 quotient_definition
    "EMPTY :: 'a fset"
 as
@@ -52,11 +107,19 @@
 as
   "card1"
 
-(* text {*
+quotient_definition
+  "fconcat :: ('a fset) fset \<Rightarrow> 'a fset"
+as
+  "concat"
+
+term concat
+term fconcat
+
+text {*
  Maybe make_const_def should require a theorem that says that the particular lifted function
  respects the relation. With it such a definition would be impossible:
- make_const_def @{binding CARD} @{term "length"} NoSyn @{typ "'a list"} @{typ "'a fset"} #> snd
-*}*)
+ make_const_def CARD @{term "length"} NoSyn @{typ "'a list"} @{typ "'a fset"} #> snd
+*}
 
 lemma card1_0:
   fixes a :: "'a list"
@@ -213,7 +276,8 @@
 done
 
 lemma "IN x (INSERT y xa) = (x = y \<or> IN x xa)"
-by (lifting member.simps(2))
+apply (lifting member.simps(2))
+done
 
 lemma "INSERT a (INSERT a x) = INSERT a x"
 apply (lifting list_eq.intros(4))