Quot/Examples/AbsRepTest.thy
changeset 795 a28f805df355
parent 790 3a48ffcf0f9a
child 796 64f9c76f70c7
--- a/Quot/Examples/AbsRepTest.thy	Sat Dec 26 20:45:37 2009 +0100
+++ b/Quot/Examples/AbsRepTest.thy	Sat Dec 26 21:36:20 2009 +0100
@@ -4,142 +4,101 @@
 
 ML {* open Quotient_Term *}
 
-print_maps
-
+ML {*
+fun test_funs flag ctxt (rty, qty) =
+  (absrep_fun_chk flag ctxt (rty, qty)
+   |> Syntax.string_of_term ctxt
+   |> writeln;
+   equiv_relation_chk ctxt (rty, qty) 
+   |> Syntax.string_of_term ctxt
+   |> writeln)  
+*}
 
-quotient_type 
-  'a fset = "'a list" / "\<lambda>xs ys. \<forall>e. e \<in> set xs \<longleftrightarrow> e \<in> set ys" 
-  apply(rule equivpI)
-  unfolding reflp_def symp_def transp_def
-  by auto
+definition
+  erel1 (infixl "\<approx>1" 50)
+where
+  "erel1 \<equiv> \<lambda>xs ys. \<forall>e. e \<in> set xs \<longleftrightarrow> e \<in> set ys"
 
 quotient_type 
-  'a foo = "('a * 'a) list" / "\<lambda>(xs::('a * 'a) list) ys. \<forall>e. e \<in> set xs \<longleftrightarrow> e \<in> set ys" 
+  'a fset = "'a list" / erel1
   apply(rule equivpI)
-  unfolding reflp_def symp_def transp_def
+  unfolding erel1_def reflp_def symp_def transp_def
   by auto
 
+definition
+  erel2 (infixl "\<approx>2" 50)
+where
+  "erel2 \<equiv> \<lambda>(xs::('a * 'a) list) ys. \<forall>e. e \<in> set xs \<longleftrightarrow> e \<in> set ys"
+
 quotient_type 
-  'a bar = "('a * int) list" / "\<lambda>(xs::('a * int) list) ys. \<forall>e. e \<in> set xs \<longleftrightarrow> e \<in> set ys" 
+  'a foo = "('a * 'a) list" / erel2
   apply(rule equivpI)
-  unfolding reflp_def symp_def transp_def
+  unfolding erel2_def reflp_def symp_def transp_def
+  by auto
+
+definition
+  erel3 (infixl "\<approx>3" 50)
+where
+  "erel3 \<equiv> \<lambda>(xs::('a * int) list) ys. \<forall>e. e \<in> set xs \<longleftrightarrow> e \<in> set ys"
+
+quotient_type 
+  'a bar = "('a * int) list" / "erel3"
+  apply(rule equivpI)
+  unfolding erel3_def reflp_def symp_def transp_def
   by auto
 
 fun
-  intrel :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> bool" 
+  intrel :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat) \<Rightarrow> bool" (infixl "\<approx>4" 50)
 where
   "intrel (x, y) (u, v) = (x + v = u + y)"
 
-quotient_type int = "nat \<times> nat" / intrel
+quotient_type myint = "nat \<times> nat" / intrel
   by (auto simp add: equivp_def expand_fun_eq)
 
-print_quotients
-
 ML {*
-absrep_fun_chk absF @{context} 
-     (@{typ "('a * 'a) list"}, 
-      @{typ "'a foo"})
-|> Syntax.string_of_term @{context}
-|> writeln
+test_funs absF @{context} 
+     (@{typ "nat \<times> nat"}, 
+      @{typ "myint"})
 *}
 
-(* PROBLEM
 ML {*
-absrep_fun_chk absF @{context} 
+test_funs absF @{context} 
+     (@{typ "('a * 'a) list"}, 
+      @{typ "'a foo"})
+*}
+
+ML {*
+test_funs absF @{context} 
      (@{typ "(('a list) * int) list"}, 
       @{typ "('a fset) bar"})
-|> Syntax.string_of_term @{context}
-|> writeln
-*}*)
-
-ML {*
-absrep_fun_chk absF @{context} 
-     (@{typ "('a list) list"}, 
-      @{typ "('a fset) fset"})
-|> Syntax.string_of_term @{context}
-|> writeln
 *}
 
 ML {*
-absrep_fun_chk absF @{context} 
-     (@{typ "nat \<times> nat"}, 
-      @{typ "int"})
-|> Syntax.string_of_term @{context}
-|> writeln
+test_funs absF @{context} 
+     (@{typ "('a list) list"}, 
+      @{typ "('a fset) fset"})
+*}
+
+ML {*
+test_funs absF @{context} 
+     (@{typ "(('a * 'a) list) list"}, 
+      @{typ "(('a * 'a) fset) fset"})
+*}
+
+ML {*
+test_funs absF @{context} 
+      (@{typ "(nat * nat) list"}, 
+       @{typ "myint fset"})
+*}
+
+ML {*
+test_funs absF @{context} 
+     (@{typ "('a list) list \<Rightarrow> 'a"}, 
+      @{typ "('a fset) fset \<Rightarrow> 'a"})
 *}
 
 
-term abs_foo
-term rep_foo
-term "abs_foo o map (prod_fun id id)"
-term "map (prod_fun id id) o rep_foo"
-
-ML {*
-absrep_fun_chk absF @{context} 
-     (@{typ "('a * 'a) list"}, 
-      @{typ "'a foo"})
-|> Syntax.string_of_term @{context}
-|> writeln
-*}
-
-typ "('a fset) foo"
-
-print_quotients
-
-ML{*
-Quotient_Info.quotient_rules_get @{context}
-*}
-
-print_quotients
-
-ML {*
-open Quotient_Term;
-*}
-
-ML {*
-absrep_fun_chk absF @{context} 
-     (@{typ "(('a * 'a) list) list"}, 
-      @{typ "(('a * 'a) fset) fset"})
-|> Syntax.string_of_term @{context}
-|> writeln
-*}
-
-(*
-ML {*
-absrep_fun_chk absF @{context} 
-     (@{typ "('a * 'a) list"}, 
-      @{typ "'a foo"})
-|> Syntax.string_of_term @{context}
-|> writeln
-*}
-*)
-
-term "option_map (prod_fun (abs_fset \<circ> map abs_int) id)"
-term "option_map (prod_fun (map rep_int \<circ> rep_fset) id)"
-term "option_map (map rep_int \<circ> rep_fset)"
-term "option_map (abs_fset o (map abs_int))"
-term "abs_fset"
-
-ML {*
-absrep_fun_chk absF @{context} (@{typ "(nat * nat) list"}, @{typ "int fset"})
-|> Syntax.string_of_term @{context}
-|> writeln
-*}
-
-term "map abs_int"
-term "abs_fset o map abs_int"
 
 
-ML {*
-absrep_fun_chk absF @{context} (@{typ "('a list) list"}, @{typ "('a fset) fset"})
-|> Syntax.string_of_term @{context}
-|> writeln
-*}
-
-ML {*
-absrep_fun_chk absF @{context} (@{typ "('a list) list \<Rightarrow> 'a"}, @{typ "('a fset) fset \<Rightarrow> 'a"})
-|> Syntax.string_of_term @{context}
-|> writeln
-*}
 
 end
\ No newline at end of file