
diff -r 62b188959c8a -r 170830bea194 QuotMain.thy
--- a/QuotMain.thy	Mon Nov 23 14:16:41 2009 +0100
+++ b/QuotMain.thy	Mon Nov 23 14:32:11 2009 +0100
@@ -485,66 +485,6 @@
 *}
 *)
 
-
-ML {*
-fun negF absF = repF
-  | negF repF = absF
-
-fun get_fun_noexchange flag (rty, qty) lthy ty =
-let
-  fun get_fun_aux s fs_tys =
-  let
-    val (fs, tys) = split_list fs_tys
-    val (otys, ntys) = split_list tys
-    val oty = Type (s, otys)
-    val nty = Type (s, ntys)
-    val ftys = map (op -->) tys
-  in
-   (case (maps_lookup (ProofContext.theory_of lthy) s) of
-      SOME info => (list_comb (Const (#mapfun info, ftys ---> (oty --> nty)), fs), (oty, nty))
-    | NONE      => error ("no map association for type " ^ s))
-  end
-
-  fun get_fun_fun fs_tys =
-  let
-    val (fs, tys) = split_list fs_tys
-    val ([oty1, oty2], [nty1, nty2]) = split_list tys
-    val oty = nty1 --> oty2
-    val nty = oty1 --> nty2
-    val ftys = map (op -->) tys
-  in
-    (list_comb (Const (@{const_name "fun_map"}, ftys ---> oty --> nty), fs), (oty, nty))
-  end
-
-  val thy = ProofContext.theory_of lthy
-
-  fun get_const flag (rty, qty) =
-  let 
-    val qty_name = Long_Name.base_name (fst (dest_Type qty))
-  in
-    case flag of
-      absF => (Const (Sign.full_bname thy ("ABS_" ^ qty_name), rty --> qty), (rty, qty))
-    | repF => (Const (Sign.full_bname thy ("REP_" ^ qty_name), qty --> rty), (qty, rty))
-  end
-
-  fun mk_identity ty = Abs ("", ty, Bound 0)
-
-in
-  if (Sign.typ_instance thy (ty, rty))
-  then (get_const flag (ty, (exchange_ty lthy rty qty ty)))
-  else (case ty of
-          TFree _ => (mk_identity ty, (ty, ty))
-        | Type (_, []) => (mk_identity ty, (ty, ty))
-        | Type ("fun" , [ty1, ty2]) =>
-                 get_fun_fun [get_fun_noexchange (negF flag) (rty, qty) lthy ty1,
-                 get_fun_noexchange flag (rty, qty) lthy ty2]
-        | Type (s, tys) => get_fun_aux s (map (get_fun_noexchange flag (rty, qty) lthy) tys)
-        | _ => raise ERROR ("no type variables"))
-end
-fun get_fun_noex flag (rty, qty) lthy ty =
-  fst (get_fun_noexchange flag (rty, qty) lthy ty)
-*}
-
 ML {*
 fun find_matching_types rty ty =
   if Type.raw_instance (Logic.varifyT ty, rty)
@@ -622,38 +562,6 @@
   end
 *}
 
-(*
-consts Rl :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool"
-axioms Rl_eq: "EQUIV Rl"
-
-quotient ql = "'a list" / "Rl"
-  by (rule Rl_eq)
-
-ML {* val al = snd (dest_Free (term_of @{cpat "f :: ?'a list"})) *}
-ML {* val aq = snd (dest_Free (term_of @{cpat "f :: ?'a ql"})) *}
-ML {* val ttt = term_of @{cterm "f :: bool list \<Rightarrow> nat list"} *}
-
-ML {*
-  get_fun_noexchange absF (al, aq) @{context} (fastype_of ttt)
-*}
-ML {*
-  get_fun_new absF al aq @{context} (fastype_of ttt)
-*}
-ML {*
-  fun mk_abs tm =
-    let
-      val ty = fastype_of tm
-    in (get_fun_noexchange absF (al, aq) @{context} ty) $ tm end
-  fun mk_repabs tm =
-    let
-      val ty = fastype_of tm
-    in (get_fun_noexchange repF (al, aq) @{context} ty) $ (mk_abs tm) end
-*}
-ML {*
-  cterm_of @{theory} (mk_repabs ttt)
-*}
-*)
-
 text {* Does the same as 'subst' in a given prop or theorem *}
 ML {*
 fun eqsubst_prop ctxt thms t =




