src/Provers/project_rule.ML
author wenzelm
Thu, 22 Dec 2005 00:29:17 +0100
changeset 18483 c3027c8df1bf
child 19874 cc4b2b882e4c
permissions -rw-r--r--
Transform mutual rule into projection.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
18483
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     1
(*  Title:      Provers/project_rule.ML
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     3
    Author:     Makarius
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     4
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     5
Transform mutual rule:
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     6
  HH ==> (x1:A1 --> P1 x1) & ... & (xn:An --> Pn xn)
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     7
into projection:
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     8
  xi:Ai ==> HH ==> Pi xi
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
     9
*)
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    10
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    11
signature PROJECT_RULE_DATA =
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    12
sig
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    13
  val conjunct1: thm
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    14
  val conjunct2: thm
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    15
  val mp: thm
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    16
end;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    17
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    18
signature PROJECT_RULE =
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    19
sig
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    20
  val project: thm -> int -> thm
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    21
  val projections: thm -> thm list
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    22
end;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    23
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    24
functor ProjectRuleFun(Data: PROJECT_RULE_DATA): PROJECT_RULE =
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    25
struct
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    26
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    27
fun conj1 th = th RS Data.conjunct1;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    28
fun conj2 th = th RS Data.conjunct2;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    29
fun imp th = th RS Data.mp;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    30
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    31
val freeze = Drule.zero_var_indexes #> Drule.freeze_all;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    32
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    33
fun project rule i =
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    34
  let
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    35
    fun proj 1 th = the_default th (try conj1 th)
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    36
      | proj k th = proj (k - 1) (conj2 th);
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    37
    fun prems k th =
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    38
      (case try imp th of
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    39
        NONE => (k, th)
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    40
      | SOME th' => prems (k + 1) th');
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    41
  in
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    42
    rule
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    43
    |> freeze
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    44
    |> proj i
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    45
    |> prems 0 |-> (fn k =>
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    46
      Thm.permute_prems 0 (~ k)
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    47
      #> Drule.standard'
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    48
      #> RuleCases.save rule
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    49
      #> RuleCases.add_consumes k)
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    50
  end;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    51
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    52
fun projections rule =
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    53
  let
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    54
    fun projs k th =
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    55
      (case try conj2 th of
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    56
        NONE => k
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    57
      | SOME th' => projs (k + 1) th');
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    58
    val n = projs 1 (freeze rule);
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    59
  in map (project rule) (1 upto n) end;
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    60
c3027c8df1bf Transform mutual rule into projection.
wenzelm
parents:
diff changeset
    61
end;