src/Provers/typedsimp.ML
author wenzelm
Sun, 07 Feb 2010 19:33:34 +0100
changeset 35021 c839a4c670c6
parent 33339 d41f77196338
child 45659 09539cdffcd7
permissions -rw-r--r--
renamed old-style Drule.standard to Drule.export_without_context, to emphasize that this is in no way a standard operation;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
32960
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
     1
(*  Title:      Provers/typedsimp.ML
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
     2
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     3
    Copyright   1993  University of Cambridge
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     5
Functor for constructing simplifiers.  Suitable for Constructive Type
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
Theory with its typed reflexivity axiom a:A ==> a=a:A.  For most logics try
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     7
simp.ML.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     8
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     9
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    10
signature TSIMP_DATA =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    11
  sig
32960
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
    12
  val refl: thm         (*Reflexive law*)
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
    13
  val sym: thm          (*Symmetric law*)
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
    14
  val trans: thm        (*Transitive law*)
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
    15
  val refl_red: thm     (* reduce(a,a) *)
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
    16
  val trans_red: thm    (* [|a=b; reduce(b,c) |] ==> a=c *)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    17
  val red_if_equal: thm (* a=b ==> reduce(a,b) *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    18
  (*Built-in rewrite rules*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    19
  val default_rls: thm list
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    20
  (*Type checking or similar -- solution of routine conditions*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    21
  val routine_tac: thm list -> int -> tactic
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    22
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    23
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    24
signature TSIMP =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    25
  sig
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    26
  val asm_res_tac: thm list -> int -> tactic   
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    27
  val cond_norm_tac: ((int->tactic) * thm list * thm list) -> tactic
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    28
  val cond_step_tac: ((int->tactic) * thm list * thm list) -> int -> tactic
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    29
  val norm_tac: (thm list * thm list) -> tactic
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    30
  val process_rules: thm list -> thm list * thm list
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    31
  val rewrite_res_tac: int -> tactic   
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    32
  val split_eqn: thm
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    33
  val step_tac: (thm list * thm list) -> int -> tactic
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    34
  val subconv_res_tac: thm list -> int -> tactic   
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    35
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    36
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    37
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    38
functor TSimpFun (TSimp_data: TSIMP_DATA) : TSIMP = 
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    39
struct
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    40
local open TSimp_data
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    41
in
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    42
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    43
(*For simplifying both sides of an equation:
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    44
      [| a=c; b=c |] ==> b=a
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    45
  Can use resolve_tac [split_eqn] to prepare an equation for simplification. *)
35021
c839a4c670c6 renamed old-style Drule.standard to Drule.export_without_context, to emphasize that this is in no way a standard operation;
wenzelm
parents: 33339
diff changeset
    46
val split_eqn = Drule.export_without_context (sym RSN (2,trans) RS sym);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    47
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    48
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    49
(*    [| a=b; b=c |] ==> reduce(a,c)  *)
35021
c839a4c670c6 renamed old-style Drule.standard to Drule.export_without_context, to emphasize that this is in no way a standard operation;
wenzelm
parents: 33339
diff changeset
    50
val red_trans = Drule.export_without_context (trans RS red_if_equal);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    51
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    52
(*For REWRITE rule: Make a reduction rule for simplification, e.g.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    53
  [| a: C(0); ... ; a=c: C(0) |] ==> rec(0,a,b) = c: C(0) *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    54
fun simp_rule rl = rl RS trans;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    55
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    56
(*For REWRITE rule: Make rule for resimplifying if possible, e.g.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    57
  [| a: C(0); ...; a=c: C(0) |] ==> reduce(rec(0,a,b), c)  *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    58
fun resimp_rule rl = rl RS red_trans;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    59
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    60
(*For CONGRUENCE rule, like a=b ==> succ(a) = succ(b)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    61
  Make rule for simplifying subterms, e.g.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    62
  [| a=b: N; reduce(succ(b), c) |] ==> succ(a)=c: N   *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    63
fun subconv_rule rl = rl RS trans_red;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    64
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    65
(*If the rule proves an equality then add both forms to simp_rls
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    66
  else add the rule to other_rls*)
33339
d41f77196338 eliminated some old folds;
wenzelm
parents: 32960
diff changeset
    67
fun add_rule rl (simp_rls, other_rls) =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    68
    (simp_rule rl :: resimp_rule rl :: simp_rls, other_rls)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    69
    handle THM _ => (simp_rls, rl :: other_rls);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    70
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    71
(*Given the list rls, return the pair (simp_rls, other_rls).*)
33339
d41f77196338 eliminated some old folds;
wenzelm
parents: 32960
diff changeset
    72
fun process_rules rls = fold_rev add_rule rls ([], []);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    73
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    74
(*Given list of rewrite rules, return list of both forms, reject others*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    75
fun process_rewrites rls = 
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    76
  case process_rules rls of
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    77
      (simp_rls,[])  =>  simp_rls
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    78
    | (_,others) => raise THM 
32960
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
    79
        ("process_rewrites: Ill-formed rewrite", 0, others);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    80
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    81
(*Process the default rewrite rules*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    82
val simp_rls = process_rewrites default_rls;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    83
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    84
(*If subgoal is too flexible (e.g. ?a=?b or just ?P) then filt_resolve_tac
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    85
  will fail!  The filter will pass all the rules, and the bound permits
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    86
  no ambiguity.*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    87
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    88
(*Resolution with rewrite/sub rules.  Builds the tree for filt_resolve_tac.*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    89
val rewrite_res_tac = filt_resolve_tac simp_rls 2;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    90
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    91
(*The congruence rules for simplifying subterms.  If subgoal is too flexible
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    92
    then only refl,refl_red will be used (if even them!). *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    93
fun subconv_res_tac congr_rls =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    94
  filt_resolve_tac (map subconv_rule congr_rls) 2
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    95
  ORELSE'  filt_resolve_tac [refl,refl_red] 1;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    96
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    97
(*Resolve with asms, whether rewrites or not*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    98
fun asm_res_tac asms =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    99
    let val (xsimp_rls,xother_rls) = process_rules asms
32960
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
   100
    in  routine_tac xother_rls  ORELSE'  
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32957
diff changeset
   101
        filt_resolve_tac xsimp_rls 2
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   102
    end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   103
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   104
(*Single step for simple rewriting*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   105
fun step_tac (congr_rls,asms) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   106
    asm_res_tac asms   ORELSE'  rewrite_res_tac  ORELSE'  
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   107
    subconv_res_tac congr_rls;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   108
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   109
(*Single step for conditional rewriting: prove_cond_tac handles new subgoals.*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   110
fun cond_step_tac (prove_cond_tac, congr_rls, asms) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   111
    asm_res_tac asms   ORELSE'  rewrite_res_tac  ORELSE'  
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   112
    (resolve_tac [trans, red_trans]  THEN'  prove_cond_tac)  ORELSE'  
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   113
    subconv_res_tac congr_rls;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   114
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   115
(*Unconditional normalization tactic*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   116
fun norm_tac arg = REPEAT_FIRST (step_tac arg)  THEN
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   117
    TRYALL (resolve_tac [red_if_equal]);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   118
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   119
(*Conditional normalization tactic*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   120
fun cond_norm_tac arg = REPEAT_FIRST (cond_step_tac arg)  THEN
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   121
    TRYALL (resolve_tac [red_if_equal]);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   122
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   123
end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   124
end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   125
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   126