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