Quot/Nominal/nominal_permeq.ML
changeset 1258 7d8949da7d99
parent 1252 4b0563bc4b03
child 1259 db158e995bfc
--- a/Quot/Nominal/nominal_permeq.ML	Wed Feb 24 17:32:43 2010 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,71 +0,0 @@
-(*  Title:      nominal_thmdecls.ML
-    Author:     Brian Huffman, Christian Urban
-*)
-
-signature NOMINAL_PERMEQ =
-sig
-  val eqvt_tac: Proof.context -> int -> tactic 
-
-end;
-
-(* TODO:
-
- - provide a method interface with the usual add and del options
-
- - print a warning if for a constant no eqvt lemma is stored
-
- - there seems to be too much simplified in case of multiple 
-   permutations, like
-
-      p o q o r o x 
-
-   we usually only want the outermost permutation to "float" in
-*)
-
-
-structure Nominal_Permeq: NOMINAL_PERMEQ =
-struct
-
-local
-
-fun eqvt_apply_conv ctxt ct =
-  case (term_of ct) of
-    (Const (@{const_name "permute"}, _) $ _ $ (_ $ _)) =>
-      let
-        val (perm, t) = Thm.dest_comb ct
-        val (_, p) = Thm.dest_comb perm
-        val (f, x) = Thm.dest_comb t
-        val a = ctyp_of_term x;
-        val b = ctyp_of_term t;
-        val ty_insts = map SOME [b, a]
-        val term_insts = map SOME [p, f, x]
-      in
-        Drule.instantiate' ty_insts term_insts @{thm eqvt_apply}
-      end
-  | _ => Conv.no_conv ct
-
-fun eqvt_lambda_conv ctxt ct =
-  case (term_of ct) of
-    (Const (@{const_name "permute"}, _) $ _ $ Abs _) =>
-      Conv.rewr_conv @{thm eqvt_lambda} ct
-  | _ => Conv.no_conv ct
-
-in
-
-fun eqvt_conv ctxt ct =
-  Conv.first_conv
-    [ Conv.rewr_conv @{thm eqvt_bound},
-      eqvt_apply_conv ctxt
-        then_conv Conv.comb_conv (eqvt_conv ctxt),
-      eqvt_lambda_conv ctxt
-        then_conv Conv.abs_conv (fn (v, ctxt) => eqvt_conv ctxt) ctxt,
-      More_Conv.rewrs_conv (Nominal_ThmDecls.get_eqvts_raw_thms ctxt),
-      Conv.all_conv
-    ] ct
-
-fun eqvt_tac ctxt = 
-  CONVERSION (More_Conv.bottom_conv (fn ctxt => eqvt_conv ctxt) ctxt)
-
-end
-
-end; (* structure *)
\ No newline at end of file