# HG changeset patch
# User Cezary Kaliszyk <kaliszyk@in.tum.de>
# Date 1260548546 -3600
# Node ID e68f501f76d04106029c6ba6220a171e13c6ae79
# Parent  a9e55e1ef64c44a8c116924d63e4cf65e2953469# Parent  7b74d77a61aaeae98b6ca0112c1763f517acf218
Merge + Added LarryInt & Fset3 to tests.

diff -r a9e55e1ef64c -r e68f501f76d0 Quot/Examples/LarryInt.thy
--- a/Quot/Examples/LarryInt.thy	Fri Dec 11 17:19:38 2009 +0100
+++ b/Quot/Examples/LarryInt.thy	Fri Dec 11 17:22:26 2009 +0100
@@ -382,10 +382,9 @@
 
 (* PROBLEM: this has to be a definition, not an abbreviation *)
 (* otherwise the lemma nat_le_eq_zle cannot be lifted        *)
-fun
-  nat_aux
-where
-  "nat_aux (x, y) =  x - (y::nat)"
+
+abbreviation
+  "nat_aux \<equiv> \<lambda>(x, y).x - (y::nat)"
 
 quotient_def
   "nat2::int\<Rightarrow>nat"
@@ -405,12 +404,27 @@
 apply(auto)
 done
 
+ML {*
+  let
+   val parser = Args.context -- Scan.lift Args.name_source
+   fun term_pat (ctxt, str) =
+      str |> ProofContext.read_term_pattern ctxt
+          |> ML_Syntax.print_term
+          |> ML_Syntax.atomic
+in
+   ML_Antiquote.inline "term_pat" (parser >> term_pat)
+end
+
+*}
+
+consts test::"'b \<Rightarrow> 'b \<Rightarrow> 'b"
+
+
 lemma nat_le_eq_zle: "0 < w \<or> 0 \<le> z \<Longrightarrow> (nat2 w \<le> nat2 z) = (w\<le>z)"
 unfolding less_int_def
 apply(lifting nat_le_eq_zle_aux)
 apply(injection)
 apply(simp_all only: quot_respect)
 done
-(* PROBLEM *)
 
 end
diff -r a9e55e1ef64c -r e68f501f76d0 Quot/QuotMain.thy
--- a/Quot/QuotMain.thy	Fri Dec 11 17:19:38 2009 +0100
+++ b/Quot/QuotMain.thy	Fri Dec 11 17:22:26 2009 +0100
@@ -162,31 +162,6 @@
   id_apply[THEN eq_reflection]
   id_def[THEN eq_reflection,symmetric]
 
-section {* Matching of Terms and Types *}
-
-ML {*
-fun struct_match_typ (ty, ty') =
-  case (ty, ty') of
-    (_, TVar _) => true
-  | (TFree x, TFree x') => x = x'
-  | (Type (s, tys), Type (s', tys')) => 
-       s = s' andalso 
-       if (length tys = length tys') 
-       then (List.all struct_match_typ (tys ~~ tys')) 
-       else false
-  | _ => false
-
-fun struct_match_term (trm, trm') = 
-   case (trm, trm') of 
-     (_, Var _) => true
-   | (Const (s, ty), Const (s', ty')) => s = s' andalso struct_match_typ (ty, ty')
-   | (Free (x, ty), Free (x', ty')) => x = x' andalso struct_match_typ (ty, ty')
-   | (Bound i, Bound j) => i = j
-   | (Abs (_, T, t), Abs (_, T', t')) => struct_match_typ (T, T') andalso struct_match_term (t, t')
-   | (t $ s, t' $ s') => struct_match_term (t, t') andalso struct_match_term (s, s') 
-   | _ => false
-*}
-
 section {* Computation of the Regularize Goal *} 
 
 (*
@@ -326,10 +301,10 @@
              val thy = ProofContext.theory_of lthy
              val rtrm' = (#rconst (qconsts_lookup thy qtrm)) handle NotFound => raise exc1
            in 
-             if struct_match_term (rtrm, rtrm') then rtrm else
+             if Pattern.matches thy (rtrm', rtrm) then rtrm else
                let
-                 val _ = tracing (Syntax.string_of_term @{context} rtrm);
-                 val _ = tracing (Syntax.string_of_term @{context} rtrm');
+                 val _ = tracing ("rtrm := " ^ Syntax.string_of_term @{context} rtrm);
+                 val _ = tracing ("rtrm':= " ^ Syntax.string_of_term @{context} rtrm');
                in raise exc2 end
            end
        end 
diff -r a9e55e1ef64c -r e68f501f76d0 Quot/ROOT.ML
--- a/Quot/ROOT.ML	Fri Dec 11 17:19:38 2009 +0100
+++ b/Quot/ROOT.ML	Fri Dec 11 17:22:26 2009 +0100
@@ -4,8 +4,10 @@
    ["QuotMain",
     "Examples/FSet",
     "Examples/FSet2",
+    "Examples/FSet3",
     "Examples/IntEx",
     "Examples/IntEx2",
     "Examples/LFex",
     "Examples/LamEx",
-    "Examples/LarryDatatype"];
+    "Examples/LarryDatatype",
+    "Examples/LarryInt"];