walther@59866
|
1 |
(* Title: BaseDefinitions/rule-set.sml
|
walther@59850
|
2 |
Author: Walther Neuper
|
walther@59850
|
3 |
(c) due to copyright terms
|
walther@59850
|
4 |
|
walther@59887
|
5 |
In ISAC a Rule_Set serves rewriting. Know_Store holds all rule-sets for ubiquitous access.
|
walther@60384
|
6 |
*)
|
walther@59850
|
7 |
signature RULE_SET =
|
walther@59850
|
8 |
sig
|
walther@59851
|
9 |
datatype T = datatype Rule_Def.rule_set
|
walther@59867
|
10 |
eqtype id
|
walther@59850
|
11 |
|
walther@59867
|
12 |
val id: T -> string
|
Walther@60586
|
13 |
val rep: T -> {calc: Rule_Def.eval_ml_from_prog list, asm_rls: T, errpats: Rule_Def.errpatID list, id: string,
|
Walther@60586
|
14 |
preconds: term list, rew_ord: Rewrite_Ord.T, rules: Rule_Def.rule list, program: Rule_Def.program, prog_rls: T}
|
walther@59852
|
15 |
|
walther@59852
|
16 |
val append_rules: string -> T -> Rule_Def.rule list -> T
|
walther@60384
|
17 |
val append_erls_rules: string -> T -> Rule_Def.rule list -> T
|
walther@59852
|
18 |
val keep_unique_rules: string -> T -> Rule_Def.rule list -> T
|
walther@59852
|
19 |
val merge: string -> T -> T -> T
|
walther@59852
|
20 |
val get_rules: T -> Rule_Def.rule list
|
Walther@60643
|
21 |
val id_from_rule: Proof.context -> Rule.rule -> string
|
walther@59914
|
22 |
val contains: Rule.rule -> T -> bool
|
walther@59852
|
23 |
|
Walther@60592
|
24 |
(*type for_know_store*)
|
walther@59852
|
25 |
type for_kestore
|
walther@59852
|
26 |
val equal: (''a * ('b * 'c)) * (''a * ('d * 'e)) -> bool
|
walther@59852
|
27 |
val to_kestore: for_kestore list * for_kestore list -> for_kestore list
|
walther@59852
|
28 |
|
walther@59869
|
29 |
(*/------- this will disappear eventually ----------------------------------------------------\*)
|
walther@59852
|
30 |
val empty: T
|
walther@59850
|
31 |
type rrlsstate = term * term * Rule_Def.rule list list * (Rule_Def.rule * (term * term list)) list
|
walther@59850
|
32 |
val e_rrlsstate: rrlsstate
|
walther@59851
|
33 |
val e_rrls: T
|
walther@59869
|
34 |
(*\------- this will disappear eventually ----------------------------------------------------/*)
|
Walther@60668
|
35 |
(*from isac_test for Minisubpbl*)
|
Walther@60668
|
36 |
val to_string_test: Proof.context -> T -> string
|
Walther@60668
|
37 |
|
wenzelm@60223
|
38 |
\<^isac_test>\<open>
|
walther@59852
|
39 |
val insert_merge: for_kestore -> for_kestore list -> for_kestore list
|
wenzelm@60223
|
40 |
\<close>
|
walther@59850
|
41 |
end
|
walther@59852
|
42 |
|
walther@59850
|
43 |
(**)
|
walther@59850
|
44 |
structure Rule_Set(**): RULE_SET(**) =
|
walther@59850
|
45 |
struct
|
walther@59850
|
46 |
(**)
|
walther@59867
|
47 |
datatype T = datatype Rule_Def.rule_set;
|
walther@59867
|
48 |
type id = string;
|
walther@59850
|
49 |
|
walther@59852
|
50 |
(*/------- this will disappear eventually ----------------------------------------------------\*)
|
Walther@60594
|
51 |
val dummy_ord = Rewrite_Ord.function_empty;
|
walther@59852
|
52 |
val empty =
|
Walther@60586
|
53 |
Rule_Def.Repeat {id = "empty", preconds = [], rew_ord = ("dummy_ord", dummy_ord), asm_rls = Rule_Def.Empty,
|
Walther@60586
|
54 |
prog_rls = Rule_Def.Empty, calc = [], rules = [], errpatts = [], program = Rule_Def.Empty_Prog}
|
walther@59852
|
55 |
(*\------- this will disappear eventually ----------------------------------------------------/*)
|
walther@59850
|
56 |
|
walther@59867
|
57 |
val id = Rule.set_id;
|
walther@59852
|
58 |
fun rep Rule_Def.Empty = rep empty
|
Walther@60586
|
59 |
| rep (Rule_Def.Repeat {id, preconds, rew_ord, asm_rls, prog_rls, calc, errpatts, rules, program}) =
|
Walther@60586
|
60 |
{id = id, preconds = preconds, rew_ord = rew_ord, asm_rls = asm_rls, prog_rls = prog_rls, errpats = errpatts,
|
Walther@60586
|
61 |
calc = calc, rules = rules, program = program}
|
Walther@60586
|
62 |
| rep (Rule_Def.Sequence {id, preconds, rew_ord, asm_rls, prog_rls, calc, errpatts, rules, program}) =
|
Walther@60586
|
63 |
{id = id, preconds = preconds, rew_ord = rew_ord, asm_rls = asm_rls, prog_rls = prog_rls, errpats = errpatts,
|
Walther@60586
|
64 |
calc = calc, rules = rules, program = program}
|
walther@59852
|
65 |
| rep (Rule_Def.Rrls _) = rep empty
|
Walther@60668
|
66 |
fun to_string_test _ Rule_Def.Empty = "Rule_Set.Empty"
|
Walther@60668
|
67 |
| to_string_test ctxt (Rule_Def.Repeat {id, preconds, rew_ord, asm_rls = _, prog_rls = _, calc = _, errpatts = _, rules, program}) =
|
Walther@60668
|
68 |
"(Rule_Def.Repeat {id = " ^ id ^ ", preconds = " ^ UnparseC.terms_in_ctxt ctxt preconds ^ ", rew_ord = " ^ Rewrite_Ord.to_string rew_ord
|
Walther@60586
|
69 |
^ ",\n asm_rls = _, prog_rls = _, calc = _, errpatts = _, "
|
Walther@60436
|
70 |
^ ",\n rules = " ^ Rule.s_to_string rules
|
Walther@60586
|
71 |
^ ",\n rules = " ^ Rule_Def.program_to_string program ^ "})"
|
Walther@60668
|
72 |
| to_string_test ctxt (Rule_Def.Sequence {id, preconds, rew_ord, asm_rls = _, prog_rls = _, calc = _, errpatts = _, rules, program}) =
|
Walther@60668
|
73 |
"(Rule_Def.Repeat {id = " ^ id ^ ", preconds = " ^ UnparseC.terms_in_ctxt ctxt preconds ^ ", rew_ord = " ^ Rewrite_Ord.to_string rew_ord
|
Walther@60586
|
74 |
^ ",\n asm_rls = _, prog_rls = _, calc = _, errpatts = _, "
|
Walther@60436
|
75 |
^ ",\n rules = " ^ Rule.s_to_string rules
|
Walther@60586
|
76 |
^ ",\n rules = " ^ Rule_Def.program_to_string program ^ "})"
|
Walther@60668
|
77 |
| to_string_test _ (Rule_Def.Rrls _) = "Rule_Def.Rrls _"
|
walther@59850
|
78 |
|
walther@60384
|
79 |
fun append_rules id Rule_Def.Empty r = (*.. required for append_erls_rules *)
|
Walther@60586
|
80 |
Rule_Def.Repeat {id = id, preconds = [], rew_ord = ("dummy_ord", dummy_ord), asm_rls = Rule_Def.Empty,
|
Walther@60586
|
81 |
prog_rls = Rule_Def.Empty, calc = [], rules = r, errpatts = [], program = Rule_Def.Empty_Prog}
|
Walther@60586
|
82 |
| append_rules id (Rule_Def.Repeat {id = _, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
Walther@60586
|
83 |
rules = rs, errpatts = errpatts, program = sc}) r =
|
Walther@60586
|
84 |
Rule_Def.Repeat {id = id, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
Walther@60586
|
85 |
rules = rs @ r, errpatts = errpatts, program = sc}
|
Walther@60586
|
86 |
| append_rules id (Rule_Def.Sequence {id = _, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
Walther@60586
|
87 |
rules = rs, errpatts = errpatts, program = sc}) r =
|
Walther@60586
|
88 |
Rule_Def.Sequence {id = id, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
Walther@60586
|
89 |
rules = rs @ r, errpatts = errpatts, program = sc}
|
walther@59852
|
90 |
| append_rules id (Rule_Def.Rrls _) _ = raise ERROR ("append_rules: not for reverse-rewrite-rule-set " ^ id);
|
walther@59852
|
91 |
|
walther@60384
|
92 |
fun append_erls_rules id_erls Rule_Def.Empty _ =
|
walther@60384
|
93 |
raise ERROR ("append_erls_rules: with \"" ^ id_erls ^ "\" not for Rule_Def.Empty")
|
walther@60384
|
94 |
| append_erls_rules id_erls (Rule_Def.Repeat
|
Walther@60586
|
95 |
{id = id, preconds = pc, rew_ord = ro, asm_rls = asm_rls, prog_rls = sr, calc = ca,
|
Walther@60586
|
96 |
rules = rules, errpatts = errpatts, program = sc}) rs =
|
Walther@60586
|
97 |
Rule_Def.Repeat {id = id, preconds = pc, rew_ord = ro, asm_rls = append_rules id_erls asm_rls rs,
|
Walther@60586
|
98 |
prog_rls = sr, calc = ca, rules = rules, errpatts = errpatts, program = sc}
|
walther@60384
|
99 |
| append_erls_rules id_erls (Rule_Def.Sequence
|
Walther@60586
|
100 |
{id = id, preconds = pc, rew_ord = ro, asm_rls = asm_rls, prog_rls = sr, calc = ca,
|
Walther@60586
|
101 |
rules = rules, errpatts = errpatts, program = sc}) rs =
|
Walther@60586
|
102 |
Rule_Def.Sequence {id = id, preconds = pc, rew_ord = ro, asm_rls = append_rules id_erls asm_rls rs,
|
Walther@60586
|
103 |
prog_rls = sr, calc = ca, rules = rules, errpatts = errpatts, program = sc}
|
walther@60384
|
104 |
| append_erls_rules id_erls (Rule_Def.Rrls _) _ =
|
walther@60384
|
105 |
raise ERROR ("append_erls_rules: not for reverse-rewrite-rule-set " ^ id_erls);
|
walther@60384
|
106 |
|
walther@59852
|
107 |
fun merge_ids rls1 rls2 =
|
walther@59852
|
108 |
let
|
walther@59852
|
109 |
val id1 = (#id o rep) rls1
|
walther@59852
|
110 |
val id2 = (#id o rep) rls2
|
walther@59852
|
111 |
in
|
walther@59852
|
112 |
if id1 = id2 then id1 else "merged_" ^ id1 ^ "_" ^ id2
|
walther@59852
|
113 |
end
|
walther@59852
|
114 |
|
walther@59852
|
115 |
fun merge _ Rule_Def.Empty rls = rls
|
walther@59852
|
116 |
| merge _ rls Rule_Def.Empty = rls
|
walther@59852
|
117 |
| merge _ (Rrls x) _ = Rrls x (* required for merging Theory_Data *)
|
walther@59852
|
118 |
| merge _ _ (Rrls x) = Rrls x
|
walther@59852
|
119 |
| merge id
|
Walther@60586
|
120 |
(Rule_Def.Repeat {preconds = pc1, rew_ord = ro1, asm_rls = er1, prog_rls = sr1, calc = ca1,
|
Walther@60586
|
121 |
rules = rs1, errpatts = eps1, program = sc1, ...})
|
Walther@60586
|
122 |
(Rule_Def.Repeat {preconds = pc2, asm_rls = er2, prog_rls = sr2, calc = ca2,
|
walther@59852
|
123 |
rules = rs2, errpatts = eps2, ...})
|
walther@59852
|
124 |
=
|
Walther@60586
|
125 |
Rule_Def.Repeat {id = id, rew_ord = ro1, program = sc1,
|
walther@59852
|
126 |
preconds = union (op =) pc1 pc2,
|
Walther@60586
|
127 |
asm_rls = merge (merge_ids er1 er2) er1 er2,
|
Walther@60586
|
128 |
prog_rls = merge (merge_ids sr1 sr2) sr1 sr2,
|
Walther@60538
|
129 |
calc = union Eval_Def.equal ca1 ca2,
|
walther@59867
|
130 |
rules = union Rule.equal rs1 rs2,
|
walther@59852
|
131 |
errpatts = union (op =) eps1 eps2}
|
walther@59852
|
132 |
| merge id
|
Walther@60586
|
133 |
(Rule_Def.Sequence {preconds = pc1, rew_ord = ro1, asm_rls = er1, prog_rls = sr1, calc = ca1,
|
Walther@60586
|
134 |
rules = rs1, errpatts = eps1, program = sc1, ...})
|
Walther@60586
|
135 |
(Rule_Def.Sequence {preconds = pc2, asm_rls = er2, prog_rls = sr2, calc = ca2,
|
walther@59852
|
136 |
rules = rs2, errpatts = eps2, ...})
|
walther@59852
|
137 |
=
|
Walther@60586
|
138 |
Rule_Def.Sequence {id = id, rew_ord = ro1, program = sc1,
|
walther@59852
|
139 |
preconds = union (op =) pc1 pc2,
|
Walther@60586
|
140 |
asm_rls = merge (merge_ids er1 er2) er1 er2,
|
Walther@60586
|
141 |
prog_rls = merge (merge_ids sr1 sr2) sr1 sr2,
|
Walther@60538
|
142 |
calc = union Eval_Def.equal ca1 ca2,
|
walther@59867
|
143 |
rules = union Rule.equal rs1 rs2,
|
walther@59852
|
144 |
errpatts = union (op =) eps1 eps2}
|
walther@59962
|
145 |
| merge id _ _ = raise ERROR ("merge: \"" ^ id ^
|
walther@59878
|
146 |
"\"; not for reverse-rewrite-rule-sets and not for mixed Rls -- Rule_Def.Sequence");
|
walther@59852
|
147 |
|
Walther@60588
|
148 |
(* datastructure for Know_Store, intermediate for thehier *)
|
walther@59852
|
149 |
type for_kestore =
|
walther@59867
|
150 |
(id * (* id unique within Isac *)
|
walther@59879
|
151 |
(ThyC.id * (* just for assignment in thehier, not appropriate for parsing etc *)
|
walther@59867
|
152 |
T)) (* ((#id o rep) T) = id by coding discipline *)
|
walther@59852
|
153 |
fun equal ((id1, (_, _)), (id2, (_, _))) = id1 = id2
|
walther@59850
|
154 |
|
walther@59852
|
155 |
fun insert_merge (re as (id, (thyID, r1))) ys =
|
walther@59852
|
156 |
case get_index (fn y => if curry equal re y then SOME y else NONE) ys of
|
walther@59850
|
157 |
NONE => re :: ys
|
walther@59850
|
158 |
| SOME (i, (_, (_, r2))) =>
|
walther@59850
|
159 |
let
|
walther@59852
|
160 |
val r12 = merge id r1 r2
|
walther@59850
|
161 |
in list_update ys i (id, (thyID, r12)) end
|
walther@59852
|
162 |
fun to_kestore (s1, s2) = fold insert_merge s1 s2;
|
walther@59850
|
163 |
|
walther@59852
|
164 |
(* used only for one hack *)
|
walther@59852
|
165 |
fun keep_unique_rules id
|
Walther@60586
|
166 |
(Rule_Def.Repeat {id = _, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
Walther@60586
|
167 |
rules = rs, errpatts = eps, program = sc}) r =
|
Walther@60586
|
168 |
Rule_Def.Repeat {id = id, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
walther@59867
|
169 |
rules = gen_rems Rule.equal (rs, r),
|
walther@59852
|
170 |
errpatts = eps,
|
Walther@60586
|
171 |
program = sc}
|
walther@59852
|
172 |
| keep_unique_rules id
|
Walther@60586
|
173 |
(Rule_Def.Sequence {id = _, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
Walther@60586
|
174 |
rules = rs, errpatts = eps, program = sc}) r =
|
Walther@60586
|
175 |
Rule_Def.Sequence {id = id, preconds = pc, rew_ord = ro, asm_rls = er, prog_rls = sr, calc = ca,
|
walther@59867
|
176 |
rules = gen_rems Rule.equal (rs, r),
|
walther@59852
|
177 |
errpatts = eps,
|
Walther@60586
|
178 |
program = sc}
|
walther@59852
|
179 |
| keep_unique_rules id (Rule_Def.Rrls _) _ = raise ERROR ("keep_unique_rules: not for reverse-rewrite-rule-set "^id)
|
walther@59867
|
180 |
| keep_unique_rules _ rls _ = raise ERROR ("remove_rls called with " ^ id rls);
|
walther@59850
|
181 |
|
walther@59851
|
182 |
fun get_rules Rule_Def.Empty = []
|
walther@59851
|
183 |
| get_rules (Rule_Def.Repeat {rules, ...}) = rules
|
walther@59878
|
184 |
| get_rules (Rule_Def.Sequence {rules, ...}) = rules
|
walther@59851
|
185 |
| get_rules (Rule_Def.Rrls _) = [];
|
walther@59850
|
186 |
|
Walther@60643
|
187 |
fun id_from_rule _ (Rule.Rls_ rls) = id rls
|
Walther@60643
|
188 |
| id_from_rule ctxt r =
|
Walther@60647
|
189 |
raise ERROR ("id_from_rule: not defined for " ^ Rule.to_string ctxt r);
|
walther@59907
|
190 |
|
walther@59914
|
191 |
(* check if a rule is contained in a rule-set (recursivley down in Rls_);
|
walther@59914
|
192 |
this rule can even be a rule-set itself *)
|
walther@59914
|
193 |
fun contains r rls =
|
walther@59914
|
194 |
let
|
walther@59914
|
195 |
fun (*find (_, Rls_ rls) = finds (get_rules rls)
|
walther@59914
|
196 |
| find r12 = equal r12
|
walther@59914
|
197 |
and*) finds [] = false
|
walther@59914
|
198 |
| finds (r1 :: rs) = if Rule.equal (r, r1) then true else finds rs
|
walther@59914
|
199 |
in
|
walther@59914
|
200 |
finds (get_rules rls)
|
walther@59914
|
201 |
end
|
walther@59914
|
202 |
|
walther@59863
|
203 |
(*/------- this will disappear eventually -----------\*)
|
Walther@60586
|
204 |
type rrlsstate = (* state for reverse rewriting, comments see type rule and program | Rfuns *)
|
walther@59863
|
205 |
(term * term * Rule_Def.rule list list * (Rule_Def.rule * (term * term list)) list);
|
walther@59868
|
206 |
val e_rrlsstate = (UnparseC.term_empty, UnparseC.term_empty, [[Rule_Def.Erule]], [(Rule_Def.Erule, (UnparseC.term_empty, []))]) : rrlsstate;
|
walther@59907
|
207 |
local
|
walther@59863
|
208 |
fun ii (_: term) = e_rrlsstate;
|
walther@59868
|
209 |
fun no (_: term) = SOME (UnparseC.term_empty, [UnparseC.term_empty]);
|
walther@59868
|
210 |
fun lo (_: Rule_Def.rule list list) (_: term) (_: Rule_Def.rule) = [(Rule_Def.Erule, (UnparseC.term_empty, [UnparseC.term_empty]))];
|
walther@59863
|
211 |
fun ne (_: Rule_Def.rule list list) (_: term) = SOME Rule_Def.Erule;
|
walther@59868
|
212 |
fun fo (_: Rule_Def.rule list list) (_: term) (_: term) = [(Rule_Def.Erule, (UnparseC.term_empty, [UnparseC.term_empty]))];
|
walther@59863
|
213 |
in
|
walther@59863
|
214 |
val e_rfuns = Rule_Def.Rfuns {init_state = ii, normal_form = no, locate_rule = lo,
|
walther@59863
|
215 |
next_rule = ne, attach_form = fo};
|
walther@59863
|
216 |
end;
|
walther@59863
|
217 |
val e_rrls =
|
Walther@60586
|
218 |
Rule_Def.Rrls {id = "e_rrls", prepat = [], rew_ord = ("dummy_ord", dummy_ord), asm_rls = Rule_Def.Empty,
|
Walther@60586
|
219 |
calc = [], errpatts = [], program = e_rfuns}
|
walther@59863
|
220 |
(*\------- this will disappear eventually -----------/*)
|
walther@59863
|
221 |
|
walther@59850
|
222 |
|
walther@59850
|
223 |
(**)end(**)
|