src/HOL/Orderings.thy
changeset 32215 87806301a813
parent 31998 2c7a24f74db9
child 32887 85e7ab9020ba
--- a/src/HOL/Orderings.thy	Sun Jul 26 22:24:13 2009 +0200
+++ b/src/HOL/Orderings.thy	Sun Jul 26 22:28:31 2009 +0200
@@ -6,7 +6,9 @@
 
 theory Orderings
 imports HOL
-uses "~~/src/Provers/order.ML"
+uses
+  "~~/src/Provers/order.ML"
+  "~~/src/Provers/quasi.ML"  (* FIXME unused? *)
 begin
 
 subsection {* Quasi orders *}
@@ -289,7 +291,7 @@
 sig
   val print_structures: Proof.context -> unit
   val setup: theory -> theory
-  val order_tac: thm list -> Proof.context -> int -> tactic
+  val order_tac: Proof.context -> thm list -> int -> tactic
 end;
 
 structure Orders: ORDERS =
@@ -329,7 +331,7 @@
 
 (** Method **)
 
-fun struct_tac ((s, [eq, le, less]), thms) prems =
+fun struct_tac ((s, [eq, le, less]), thms) ctxt prems =
   let
     fun decomp thy (@{const Trueprop} $ t) =
       let
@@ -354,13 +356,13 @@
       | decomp thy _ = NONE;
   in
     case s of
-      "order" => Order_Tac.partial_tac decomp thms prems
-    | "linorder" => Order_Tac.linear_tac decomp thms prems
+      "order" => Order_Tac.partial_tac decomp thms ctxt prems
+    | "linorder" => Order_Tac.linear_tac decomp thms ctxt prems
     | _ => error ("Unknown kind of order `" ^ s ^ "' encountered in transitivity reasoner.")
   end
 
-fun order_tac prems ctxt =
-  FIRST' (map (fn s => CHANGED o struct_tac s prems) (Data.get (Context.Proof ctxt)));
+fun order_tac ctxt prems =
+  FIRST' (map (fn s => CHANGED o struct_tac s ctxt prems) (Data.get (Context.Proof ctxt)));
 
 
 (** Attribute **)
@@ -394,7 +396,7 @@
 (** Setup **)
 
 val setup =
-  Method.setup @{binding order} (Scan.succeed (SIMPLE_METHOD' o order_tac []))
+  Method.setup @{binding order} (Scan.succeed (fn ctxt => SIMPLE_METHOD' (order_tac ctxt [])))
     "transitivity reasoner" #>
   attrib_setup;
 
@@ -532,7 +534,7 @@
       Simplifier.simproc thy name raw_ts proc) procs)) thy;
 fun add_solver name tac =
   Simplifier.map_simpset (fn ss => ss addSolver
-    mk_solver' name (fn ss => tac (Simplifier.prems_of_ss ss) (Simplifier.the_context ss)));
+    mk_solver' name (fn ss => tac (Simplifier.the_context ss) (Simplifier.prems_of_ss ss)));
 
 in
   add_simprocs [