walther@59938
|
1 |
(* Title: Specify/i-model.sml
|
walther@59938
|
2 |
Author: Walther Neuper 110226
|
walther@59938
|
3 |
(c) due to copyright terms
|
walther@59998
|
4 |
|
walther@60004
|
5 |
\<open>I_Model\<close> serves students' interactive modelling and gives feedback in the specify-phase.
|
walther@59998
|
6 |
*)
|
walther@59938
|
7 |
|
Walther@60694
|
8 |
signature INTERACTION_MODEL =
|
walther@59938
|
9 |
sig
|
walther@59969
|
10 |
|
walther@59961
|
11 |
type T
|
Walther@60771
|
12 |
type T_POS
|
Walther@60467
|
13 |
val empty: T
|
Walther@60771
|
14 |
val empty_POS: T_POS
|
Walther@60747
|
15 |
|
walther@59961
|
16 |
type single
|
Walther@60771
|
17 |
type single_POS
|
Walther@60467
|
18 |
val empty_single: single
|
Walther@60771
|
19 |
val empty_single_POS: single_POS
|
Walther@60771
|
20 |
val is_empty_single_POS: single_POS -> bool
|
Walther@60747
|
21 |
|
walther@60018
|
22 |
type variant
|
walther@59960
|
23 |
type variants
|
walther@59961
|
24 |
type m_field
|
walther@59961
|
25 |
type descriptor
|
Walther@60762
|
26 |
type values
|
Walther@60747
|
27 |
|
walther@59948
|
28 |
datatype feedback = datatype Model_Def.i_model_feedback
|
Walther@60771
|
29 |
datatype feedback_POS = datatype Model_Def.i_model_feedback_POS
|
Walther@60771
|
30 |
val feedback_empty_POS: Model_Def.i_model_feedback_POS
|
Walther@60747
|
31 |
|
Walther@60705
|
32 |
type env
|
walther@59998
|
33 |
type message
|
walther@59938
|
34 |
|
Walther@60771
|
35 |
val single_to_string_POS: Proof.context -> single_POS -> string
|
Walther@60771
|
36 |
val to_string_POS: Proof.context -> T_POS -> string
|
Walther@60763
|
37 |
|
Walther@60772
|
38 |
datatype add_single = Add of single_POS | Err of string
|
Walther@60771
|
39 |
val init_POS: Proof.context -> O_Model.T -> Model_Pattern.T -> T_POS
|
Walther@60778
|
40 |
val check_single: Proof.context -> m_field -> O_Model.T -> T_POS -> Model_Pattern.T ->
|
Walther@60477
|
41 |
TermC.as_string -> add_single
|
Walther@60773
|
42 |
val add_single: theory -> single_POS -> T_POS -> T_POS
|
walther@59956
|
43 |
|
Walther@60774
|
44 |
val make_tactic: m_field -> TermC.as_string * T_POS -> Tactic.T
|
Walther@60772
|
45 |
|
Walther@60771
|
46 |
val descriptor_POS: feedback_POS -> descriptor
|
Walther@60777
|
47 |
val get_values: T_POS -> values list
|
Walther@60777
|
48 |
val feedb_values: feedback_POS -> values
|
Walther@60777
|
49 |
val order_by_patt: Model_Pattern.T -> T_POS ->T_POS
|
Walther@60771
|
50 |
val descr_pairs_to_string: Proof.context -> (Model_Pattern.single * single_POS) list -> string
|
Walther@60771
|
51 |
val variables: Model_Pattern.T -> Model_Def.i_model_POS -> term list
|
Walther@60772
|
52 |
val is_notyet_input: Proof.context -> T_POS -> O_Model.values -> O_Model.single ->
|
Walther@60772
|
53 |
Model_Pattern.T -> message * single_POS
|
walther@59956
|
54 |
|
Walther@60771
|
55 |
val fill_from_o: O_Model.T -> single_POS -> single_POS option
|
Walther@60763
|
56 |
|
Walther@60771
|
57 |
val add_other: variant -> T_POS -> single_POS -> single_POS
|
Walther@60771
|
58 |
val fill_method: O_Model.T -> T_POS * T_POS-> Model_Pattern.T -> T_POS
|
Walther@60771
|
59 |
val s_make_complete: Proof.context -> O_Model.T -> T_POS * T_POS -> Problem.id * MethodC.id ->
|
Walther@60771
|
60 |
T_POS * T_POS
|
Walther@60771
|
61 |
val s_are_complete: Proof.context -> O_Model.T -> T_POS * T_POS -> Problem.id * MethodC.id -> bool
|
Walther@60747
|
62 |
|
Walther@60776
|
63 |
val is_error: feedback_POS -> bool
|
Walther@60776
|
64 |
val to_p_model: theory -> feedback_POS -> string
|
Walther@60767
|
65 |
|
Walther@60756
|
66 |
(*/----- from isac_test for Minisubpbl*)
|
Walther@60771
|
67 |
val msg: variants -> feedback_POS -> string
|
Walther@60771
|
68 |
val transfer_terms: O_Model.single -> single_POS
|
Walther@60751
|
69 |
|
Walther@60771
|
70 |
val feedback_POS_to_string: Proof.context -> feedback_POS -> string
|
Walther@60763
|
71 |
val descr_vals_to_string: Proof.context -> descriptor * values -> string
|
Walther@60771
|
72 |
val feedb_args_to_string: Proof.context -> feedback_POS -> string
|
Walther@60741
|
73 |
|
Walther@60778
|
74 |
val single_from_o: feedback_POS -> descriptor -> Model_Def.values -> O_Model.single -> single_POS
|
Walther@60773
|
75 |
val seek_ppc: int -> single_POS list -> single_POS option
|
Walther@60773
|
76 |
val overwrite_ppc: theory -> single_POS -> T_POS -> T_POS
|
Walther@60756
|
77 |
(*\----- from isac_test for Minisubpbl*)
|
Walther@60723
|
78 |
|
Walther@60694
|
79 |
\<^isac_test>\<open>
|
Walther@60772
|
80 |
(*copy "from isac_test for Minisubpbl" here*)
|
Walther@60723
|
81 |
|
Walther@60694
|
82 |
\<close>
|
Walther@60694
|
83 |
|
walther@59938
|
84 |
end
|
walther@59938
|
85 |
|
walther@59942
|
86 |
(**)
|
Walther@60694
|
87 |
structure I_Model(**) : INTERACTION_MODEL(**) =
|
walther@59938
|
88 |
struct
|
walther@59942
|
89 |
(**)
|
walther@59955
|
90 |
|
walther@59958
|
91 |
(** data types **)
|
walther@59958
|
92 |
|
walther@60018
|
93 |
type variant = Model_Def.variant;
|
walther@59940
|
94 |
type variants = Model_Def.variants;
|
walther@59952
|
95 |
type m_field = Model_Def.m_field;
|
walther@59952
|
96 |
type descriptor = Model_Def.descriptor;
|
Walther@60766
|
97 |
type values = Model_Def.values
|
walther@59938
|
98 |
|
walther@59940
|
99 |
type T = Model_Def.i_model_single list;
|
Walther@60771
|
100 |
(* for developing input from PIDE, we use T_POS with these ideas:
|
Walther@60702
|
101 |
(1) the new structure is as close to old T, because we want to preserve the old tests
|
Walther@60771
|
102 |
(2) after development (with *_POS) of essential parts of the Specification's semantics,
|
Walther@60771
|
103 |
we adapt the old tests to the new T_POS
|
Walther@60771
|
104 |
(3) together with adaption of the tests we remove the *_POS
|
Walther@60702
|
105 |
*)
|
Walther@60771
|
106 |
type T_POS = Model_Def.i_model_single_POS list;
|
walther@59940
|
107 |
datatype feedback = datatype Model_Def.i_model_feedback;
|
Walther@60771
|
108 |
datatype feedback_POS = datatype Model_Def.i_model_feedback_POS;
|
Walther@60771
|
109 |
val feedback_empty_POS = Model_Def.feedback_empty_POS
|
walther@59940
|
110 |
type single = Model_Def.i_model_single;
|
Walther@60771
|
111 |
type single_POS = Model_Def.i_model_single_POS;
|
Walther@60467
|
112 |
val empty_single = Model_Def.i_model_empty;
|
Walther@60771
|
113 |
val empty_single_POS = Model_Def.i_model_empty_POS;
|
Walther@60771
|
114 |
fun is_empty_single_POS (0, [], false, "i_model_empty", _) = true
|
Walther@60771
|
115 |
| is_empty_single_POS _ = false
|
Walther@60747
|
116 |
|
Walther@60467
|
117 |
val empty = []: T;
|
Walther@60771
|
118 |
val empty_POS = []: T_POS;
|
Walther@60733
|
119 |
|
Walther@60740
|
120 |
type env = Env.T
|
Walther@60740
|
121 |
|
walther@59998
|
122 |
type message = string;
|
Walther@60771
|
123 |
fun feedback_POS_to_string ctxt (Cor_POS (d, ts)) =
|
Walther@60771
|
124 |
"Cor_POS " ^ UnparseC.term ctxt (Input_Descript.join (d, ts)) ^ " , pen2str"
|
Walther@60771
|
125 |
| feedback_POS_to_string _ (Syn_POS c) =
|
Walther@60771
|
126 |
"Syn_POS " ^ c
|
Walther@60771
|
127 |
| feedback_POS_to_string ctxt (Inc_POS (d, [])) =
|
Walther@60771
|
128 |
"Inc_POS " ^ UnparseC.term ctxt (Input_Descript.join (d, [])) ^ " " ^
|
Walther@60733
|
129 |
Model_Pattern.empty_for d
|
Walther@60771
|
130 |
| feedback_POS_to_string ctxt (Inc_POS (d, ts)) =
|
Walther@60771
|
131 |
"Inc_POS " ^ UnparseC.term ctxt (Input_Descript.join (d, ts)) ^ " , pen2str"
|
Walther@60771
|
132 |
| feedback_POS_to_string ctxt (Sup_POS (d, ts)) =
|
Walther@60771
|
133 |
"Sup_POS " ^ UnparseC.term ctxt (Input_Descript.join (d, ts))
|
walther@59942
|
134 |
|
Walther@60766
|
135 |
fun descr_vals_to_string ctxt (descr, values) =
|
Walther@60769
|
136 |
UnparseC.term ctxt (descr $ Model_Def.values_to_present values)
|
Walther@60763
|
137 |
|
Walther@60771
|
138 |
(*prepare for presentation to user; thus Syn_POS does NOT raise an exn*)
|
Walther@60771
|
139 |
fun feedb_args_to_string ctxt (Cor_POS (descr, values)) =
|
Walther@60769
|
140 |
UnparseC.term ctxt (descr $ Model_Def.values_to_present values)
|
Walther@60771
|
141 |
| feedb_args_to_string _ (Syn_POS str) = str
|
Walther@60771
|
142 |
| feedb_args_to_string ctxt (Inc_POS (descr, [])) =
|
Walther@60766
|
143 |
UnparseC.term ctxt descr ^ Model_Pattern.empty_for descr
|
Walther@60771
|
144 |
| feedb_args_to_string ctxt (Inc_POS (descr, values)) =
|
Walther@60769
|
145 |
UnparseC.term ctxt (descr $ Model_Def.values_to_present values)
|
Walther@60771
|
146 |
| feedb_args_to_string ctxt (Sup_POS (descr, values)) =
|
Walther@60769
|
147 |
UnparseC.term ctxt (descr $ Model_Def.values_to_present values)
|
Walther@60763
|
148 |
|
Walther@60771
|
149 |
fun single_to_string_POS ctxt (i, is, b, s, (itm_, _(*Position.T*))) =
|
Walther@60694
|
150 |
"(" ^ string_of_int i ^ ", " ^ ints2str' is ^ ", " ^ bool2str b ^ " ," ^
|
Walther@60771
|
151 |
s ^ ", (" ^ feedback_POS_to_string ctxt itm_ ^ ", Position.T))";
|
Walther@60771
|
152 |
fun to_string_POS ctxt itms = strs2str' (map (linefeed o (single_to_string_POS ctxt)) itms);
|
walther@59942
|
153 |
|
walther@59958
|
154 |
|
Walther@60694
|
155 |
(** make a Tactic.T **)
|
Walther@60694
|
156 |
|
Walther@60477
|
157 |
fun make_tactic m_field (term_as_string, i_model) =
|
walther@59992
|
158 |
case m_field of
|
walther@59992
|
159 |
"#Given" => Tactic.Add_Given' (term_as_string, i_model)
|
walther@59992
|
160 |
| "#Find" => Tactic.Add_Find' (term_as_string, i_model)
|
walther@59992
|
161 |
| "#Relate" => Tactic.Add_Relation'(term_as_string, i_model)
|
walther@59992
|
162 |
| str => raise ERROR ("specify_additem Frm, Pbl: uncovered case with " ^ str);
|
walther@59992
|
163 |
|
walther@59992
|
164 |
|
walther@59958
|
165 |
(** initialise a model **)
|
walther@59958
|
166 |
|
walther@59958
|
167 |
fun init pbt =
|
walther@59958
|
168 |
let
|
walther@59958
|
169 |
fun pbt2itm (f, (d, _)) = (0, [], false, f, Inc ((d, []), (TermC.empty, [])))
|
walther@59958
|
170 |
in map pbt2itm pbt end
|
Walther@60556
|
171 |
|
Walther@60702
|
172 |
(*
|
Walther@60770
|
173 |
NEW design decision:
|
Walther@60705
|
174 |
* Now the Model in Specification is intialised such that the placement of items can be
|
Walther@60702
|
175 |
maximally stable during interactive input to the Specification.
|
Walther@60702
|
176 |
* Template.show provides the initial output to the user and thus determines what will be parsed
|
Walther@60702
|
177 |
by Outer_Syntax later during interaction.
|
Walther@60705
|
178 |
* The relation between O_Model.T and I_Model.T becomes much simpler.
|
Walther@60702
|
179 |
*)
|
Walther@60702
|
180 |
(**)
|
Walther@60770
|
181 |
fun patt_to_item ctxt o_model (_, (descriptor, _)) =
|
Walther@60702
|
182 |
case find_first (fn (_, _, _, desc, _) => desc = descriptor) o_model of
|
Walther@60770
|
183 |
NONE => raise ERROR ("I_Model.patt_to_item NONE for " ^ UnparseC.term ctxt descriptor)
|
Walther@60702
|
184 |
| SOME (_, variants, m_field, descr, _) => (variants, false, m_field,
|
Walther@60771
|
185 |
(Inc_POS (descr, []), Position.none))
|
Walther@60771
|
186 |
fun init_POS ctxt o_model model_patt =
|
Walther@60690
|
187 |
let
|
Walther@60770
|
188 |
val pre_items = map (patt_to_item ctxt o_model) model_patt
|
Walther@60702
|
189 |
in
|
Walther@60702
|
190 |
O_Model.add_enumerate pre_items |> map (fn (a, (b, c, d, e)) => (a, b, c, d, e))
|
Walther@60702
|
191 |
end
|
walther@59943
|
192 |
|
walther@59943
|
193 |
|
Walther@60664
|
194 |
val unique = Syntax.read_term\<^context> "UnIqE_tErM";
|
Walther@60770
|
195 |
(*DANGEROUS: do NOT use "UnIqE_tErM" *)
|
Walther@60771
|
196 |
fun descriptor_POS (Cor_POS (d ,_)) = d
|
Walther@60771
|
197 |
| descriptor_POS (Syn_POS _) = ((*tracing ("*** descriptor: Syn ("^c^")");*) unique)
|
Walther@60771
|
198 |
| descriptor_POS (Inc_POS (d, _)) = d
|
Walther@60771
|
199 |
| descriptor_POS (Sup_POS (d, _)) = d
|
Walther@60777
|
200 |
fun feedb_values (Cor_POS (_, ts)) = ts
|
Walther@60777
|
201 |
| feedb_values (Syn_POS _) = raise ERROR "feedb_values NOT for Syn_POS"
|
Walther@60777
|
202 |
| feedb_values (Inc_POS (_, ts)) = ts
|
Walther@60777
|
203 |
| feedb_values (Sup_POS (_, ts)) = ts
|
Walther@60777
|
204 |
|
Walther@60777
|
205 |
(*assumption: i_model has filtered max_vnt*)
|
Walther@60777
|
206 |
local
|
Walther@60777
|
207 |
fun order_by_pa i_model (_, (descr, _ )) =
|
Walther@60777
|
208 |
case find_first (fn (_, _, _, _, (feedb, _)) => descr = descriptor_POS feedb) i_model of
|
Walther@60777
|
209 |
SOME i_single => [i_single]
|
Walther@60777
|
210 |
| NONE => []
|
Walther@60777
|
211 |
in
|
Walther@60777
|
212 |
fun order_by_patt model_patt i_model = model_patt |> map (order_by_pa i_model) |> flat
|
Walther@60777
|
213 |
end
|
Walther@60777
|
214 |
fun feedb_vals (Cor_POS (_, ts)) = [ts]
|
Walther@60777
|
215 |
| feedb_vals (Syn_POS _) = []
|
Walther@60777
|
216 |
| feedb_vals (Inc_POS (_, ts)) = [ts]
|
Walther@60777
|
217 |
| feedb_vals (Sup_POS (_, ts)) = [ts]
|
Walther@60777
|
218 |
fun get_values i_model =
|
Walther@60777
|
219 |
map (fn (_, _, _, _, (feedb, _)) => feedb_vals feedb) i_model
|
Walther@60777
|
220 |
|> flat
|
Walther@60762
|
221 |
|
Walther@60710
|
222 |
fun descr_pairs_to_string ctxt equal_descr_pairs =
|
Walther@60771
|
223 |
(map (fn (a, b) => pair (Model_Pattern.single_to_string ctxt a) (single_to_string_POS ctxt b)
|
Walther@60710
|
224 |
|> pair2str) equal_descr_pairs)
|
Walther@60710
|
225 |
|> strs2str'
|
Walther@60710
|
226 |
|
Walther@60741
|
227 |
fun variables model_patt i_model =
|
Walther@60771
|
228 |
Pre_Conds.environment_POS model_patt i_model
|
Walther@60733
|
229 |
|> map snd
|
walther@59943
|
230 |
|
Walther@60740
|
231 |
(*update the itm_ already input, all..from ori*)
|
Walther@60778
|
232 |
fun single_from_o (feedb:feedback_POS) _ all (id, vt, fd, d, ts) =
|
walther@59956
|
233 |
let
|
Walther@60777
|
234 |
val ts' = union op = (feedb_values feedb) ts;
|
walther@59956
|
235 |
val complete = if eq_set op = (ts', all) then true else false
|
walther@59956
|
236 |
in
|
Walther@60772
|
237 |
case feedb of
|
Walther@60772
|
238 |
Cor_POS _ => if fd = "#undef"
|
Walther@60772
|
239 |
then (id, vt, complete, fd, (Sup_POS (d, ts'), Position.none))
|
Walther@60772
|
240 |
else (id, vt, complete, fd, (Cor_POS (d, ts'), Position.none))
|
Walther@60772
|
241 |
| Inc_POS _ => if complete
|
Walther@60772
|
242 |
then (id, vt, true, fd, (Cor_POS (d, ts'), Position.none))
|
Walther@60772
|
243 |
else (id, vt, false, fd, (Inc_POS (d, ts'), Position.none))
|
Walther@60772
|
244 |
| Sup_POS (d, ts') =>
|
Walther@60772
|
245 |
(id, vt, complete, fd, (Sup_POS (d, ts'), Position.none))
|
Walther@60778
|
246 |
| i => raise ERROR ("single_from_o: uncovered case of " ^ feedback_POS_to_string (ContextC.for_ERROR ()) i)
|
walther@59956
|
247 |
end
|
walther@59956
|
248 |
|
Walther@60740
|
249 |
|
Walther@60740
|
250 |
(** find next step **)
|
Walther@60740
|
251 |
|
Walther@60772
|
252 |
(*old code kept for test/*)
|
walther@59956
|
253 |
fun is_notyet_input ctxt itms all (i, v, f, d, ts) pbt =
|
Walther@60772
|
254 |
case find_first (fn (_, (d', _)) => d = d') pbt of
|
walther@59956
|
255 |
SOME (_, (_, pid)) =>
|
Walther@60772
|
256 |
(case find_first (fn (_, _, _, f', (feedb, _)) =>
|
Walther@60772
|
257 |
f = f' andalso d = (descriptor_POS feedb)) itms of
|
Walther@60772
|
258 |
SOME (_, _, _, _, (feedb, _)) =>
|
Walther@60773
|
259 |
let
|
Walther@60777
|
260 |
val ts' = inter op = (feedb_values feedb) ts
|
Walther@60772
|
261 |
in
|
walther@59956
|
262 |
if subset op = (ts, ts')
|
Walther@60772
|
263 |
then (((strs2str' o map (UnparseC.term ctxt)) ts') ^ " already input", empty_single_POS)
|
Walther@60778
|
264 |
else ("", single_from_o feedb pid all (i, v, f, d, subtract op = ts' ts))
|
Walther@60772
|
265 |
end
|
Walther@60778
|
266 |
| NONE => ("", single_from_o (Inc_POS (TermC.empty, [])) pid all (i, v, f, d, ts)))
|
Walther@60778
|
267 |
| NONE => ("", single_from_o (Sup_POS (d, ts)) TermC.empty all (i, v, f, d, ts))
|
walther@59956
|
268 |
|
Walther@60477
|
269 |
datatype add_single =
|
Walther@60772
|
270 |
Add of single_POS (* return-value of check_single *)
|
walther@59998
|
271 |
| Err of string (* error-message *)
|
walther@59956
|
272 |
|
walther@59956
|
273 |
(*
|
walther@59956
|
274 |
Create feedback for input of TermC.as_string to m_field;
|
walther@59956
|
275 |
check w.r.t. O_Model.T and Model_Pattern.T.
|
walther@59998
|
276 |
In case of O_Model.T = [] (i.e. no data for user-guidance in Formalise.T)
|
walther@59958
|
277 |
check_single is extremely permissive.
|
walther@59956
|
278 |
*)
|
Walther@60658
|
279 |
(*will come directly from PIDE -----------------vvvvvvvvvvv
|
Walther@60658
|
280 |
in case t comes from Step.specify_do_next -----------vvv = Position.none*)
|
Walther@60658
|
281 |
fun check_single ctxt m_field [] i_model m_patt (ct(*, pos*)) =
|
Walther@60658
|
282 |
let
|
Walther@60658
|
283 |
val i = 1 + (if i_model = [] then 0 else map #1 i_model |> maxl)
|
Walther@60661
|
284 |
(*/------------ replace by ParseC.term_position -----------\*)
|
Walther@60661
|
285 |
val t = Syntax.read_term ctxt ct
|
Walther@60658
|
286 |
handle ERROR msg => error (msg (*^ Position.here pos*))
|
Walther@60661
|
287 |
(*\------------ replace by ParseC.term_position -----------/*)
|
Walther@60658
|
288 |
(*NONE => Add (i, [], false, m_field, Syn ct)*)
|
Walther@60658
|
289 |
val (d, ts) = Input_Descript.split t
|
Walther@60772
|
290 |
in
|
Walther@60772
|
291 |
(*if d = TermC.empty then .. *)
|
Walther@60772
|
292 |
(case find_first (fn (_, (d', _)) => d = d') m_patt of
|
Walther@60772
|
293 |
NONE => Add (i, [], true, m_field, (Sup_POS (d,ts), Position.none))
|
Walther@60658
|
294 |
| SOME (f, (_, id)) =>
|
Walther@60778
|
295 |
case find_first (fn (i, _, _, _, (feedb, _)) => d = (descriptor_POS feedb) andalso i <> 0) i_model of
|
Walther@60772
|
296 |
NONE =>
|
Walther@60772
|
297 |
Add (i, [], true, f, (Cor_POS (d, ts), Position.none))
|
Walther@60778
|
298 |
| SOME (i', _, _, _, (itm_, _)) =>
|
Walther@60772
|
299 |
if Input_Descript.for_list d then
|
Walther@60772
|
300 |
let
|
Walther@60778
|
301 |
val in_itm = feedb_values itm_
|
Walther@60772
|
302 |
val ts' = union op = ts in_itm
|
Walther@60772
|
303 |
val i'' = if in_itm = [] then i else i'
|
Walther@60772
|
304 |
in Add (i'', [], true, f, (Cor_POS (d, ts'), Position.none)) end
|
Walther@60772
|
305 |
else Add (i', [], true, f, (Cor_POS (d, ts), Position.none)))
|
Walther@60658
|
306 |
end
|
Walther@60658
|
307 |
(*will come directly from PIDE ----------------------vvvvvvvvvvv*)
|
Walther@60658
|
308 |
| check_single ctxt m_field o_model i_model m_patt (str(*, pos*)) =
|
Walther@60658
|
309 |
let
|
Walther@60659
|
310 |
val (t as (descriptor $ _)) = Syntax.read_term ctxt str
|
Walther@60740
|
311 |
handle ERROR msg => error (msg (*TODO: ^ Position.here pp*))
|
Walther@60659
|
312 |
(*old code: NONE => Err ("ERROR I_Model.check_single: syntax error in \"" ^ str ^ "\"")*)
|
Walther@60658
|
313 |
in
|
Walther@60658
|
314 |
case Model_Pattern.get_field descriptor m_patt of
|
Walther@60658
|
315 |
NONE => Err ("ERROR I_Model.check_single: unknown descriptor \"" ^
|
Walther@60675
|
316 |
UnparseC.term ctxt descriptor ^ "\"")
|
Walther@60658
|
317 |
| SOME m_field' =>
|
Walther@60658
|
318 |
if m_field <> m_field' then
|
Walther@60675
|
319 |
Err ("ERROR I_Model.check_single: \"" ^ UnparseC.term ctxt t ^ "\"" ^
|
Walther@60658
|
320 |
"\" not for field \"" ^ m_field ^ "\"")
|
Walther@60658
|
321 |
else
|
Walther@60658
|
322 |
case O_Model.contains ctxt m_field o_model t of
|
Walther@60658
|
323 |
("", ori', all) =>
|
Walther@60778
|
324 |
(case is_notyet_input ctxt i_model all ori' m_patt of
|
Walther@60658
|
325 |
("", itm) => Add itm
|
Walther@60658
|
326 |
| (msg, _) => Err ("ERROR I_Model.check_single: is_notyet_input: " ^ msg))
|
Walther@60658
|
327 |
| (msg, _, _) => Err ("ERROR I_Model.check_single: contains: " ^ msg)
|
Walther@60658
|
328 |
end
|
Walther@60658
|
329 |
|
walther@59958
|
330 |
|
walther@59958
|
331 |
(** add input **)
|
walther@59958
|
332 |
|
Walther@60586
|
333 |
fun overwrite_ppc thy itm model =
|
walther@59958
|
334 |
let
|
Walther@60773
|
335 |
fun repl _ (_, _, _, _, (itm_, _)) [] =
|
Walther@60773
|
336 |
raise ERROR ("overwrite_ppc: " ^ feedback_POS_to_string (Proof_Context.init_global thy) itm_
|
walther@60360
|
337 |
^ " not found")
|
Walther@60586
|
338 |
| repl model' itm (p :: model) =
|
walther@59958
|
339 |
if (#1 itm) = (#1 p)
|
Walther@60586
|
340 |
then model' @ [itm] @ model
|
Walther@60586
|
341 |
else repl (model' @ [p]) itm model
|
Walther@60586
|
342 |
in repl [] itm model end
|
walther@59958
|
343 |
|
Walther@60740
|
344 |
(*find_first item with #1 equal to id*)
|
walther@59958
|
345 |
fun seek_ppc _ [] = NONE
|
Walther@60773
|
346 |
| seek_ppc id (p :: model) = if id = #1 (p: single_POS) then SOME p else seek_ppc id model
|
walther@59958
|
347 |
|
Walther@60763
|
348 |
(* 10.3.00: insert the parsed itm into model;
|
walther@59958
|
349 |
ev. filter_out untouched (in FE: (0,...)) item related to insert-item *)
|
Walther@60586
|
350 |
fun add_single thy itm model =
|
walther@59958
|
351 |
let
|
Walther@60773
|
352 |
fun eq_untouched d (0, _, _, _, (itm_, _)) = (d = descriptor_POS itm_)
|
walther@59958
|
353 |
| eq_untouched _ _ = false
|
Walther@60586
|
354 |
val model' = case seek_ppc (#1 itm) model of
|
Walther@60586
|
355 |
SOME _ => overwrite_ppc thy itm model (*itm updated in is_notyet_input WN.11.03*)
|
Walther@60586
|
356 |
| NONE => (model @ [itm])
|
Walther@60773
|
357 |
in filter_out (eq_untouched ((descriptor_POS o #1 o #5) itm)) model' end
|
walther@59956
|
358 |
|
Walther@60740
|
359 |
|
Walther@60747
|
360 |
(** complete I_Model.T **)
|
Walther@60747
|
361 |
|
Walther@60756
|
362 |
fun s_are_complete _ _ ([], _) _ = false
|
Walther@60756
|
363 |
| s_are_complete _ _ (_, []) _ = false
|
Walther@60756
|
364 |
| s_are_complete ctxt o_model (pbl_imod, met_imod) (pbl_id, met_id) =
|
Walther@60756
|
365 |
let
|
Walther@60756
|
366 |
val pbl_max_vnts = Model_Def.max_variants o_model pbl_imod
|
Walther@60756
|
367 |
val met_max_vnts = Model_Def.max_variants o_model met_imod
|
Walther@60756
|
368 |
val max_vnts = inter op= pbl_max_vnts met_max_vnts
|
Walther@60756
|
369 |
val max_vnt = if max_vnts = []
|
Walther@60756
|
370 |
then raise ERROR "I_Model.s_are_complete: request user to review met_imod"
|
Walther@60756
|
371 |
else hd max_vnts
|
Walther@60747
|
372 |
|
Walther@60756
|
373 |
val (pbl_imod', met_imod') = (
|
Walther@60756
|
374 |
filter (fn (_, vnts, _, _, _) => member_swap op = max_vnt vnts) pbl_imod,
|
Walther@60756
|
375 |
filter (fn (_, vnts, _, _, _) => member_swap op = max_vnt vnts) met_imod)
|
Walther@60747
|
376 |
|
Walther@60756
|
377 |
val (pbl_check, _) = Pre_Conds.check_internal ctxt pbl_imod' (Pos.Pbl, pbl_id)
|
Walther@60756
|
378 |
val (met_check, _) = Pre_Conds.check_internal ctxt met_imod' (Pos.Met, met_id)
|
Walther@60756
|
379 |
in
|
Walther@60756
|
380 |
pbl_check andalso met_check
|
Walther@60756
|
381 |
end
|
walther@59988
|
382 |
|
Walther@60776
|
383 |
fun is_error (Cor_POS _) = false
|
Walther@60776
|
384 |
| is_error (Sup_POS _) = false
|
Walther@60776
|
385 |
| is_error (Inc_POS _) = false
|
Walther@60776
|
386 |
| is_error (Syn_POS _) = true
|
walther@59988
|
387 |
|
Walther@60740
|
388 |
(*create output-string for itm*)
|
Walther@60776
|
389 |
fun to_p_model thy (Cor_POS (d, ts)) = UnparseC.term_in_thy thy (Input_Descript.join (d, ts))
|
Walther@60776
|
390 |
| to_p_model _ (Syn_POS c) = c
|
Walther@60776
|
391 |
| to_p_model thy (Inc_POS (d, ts)) = UnparseC.term_in_thy thy (Input_Descript.join (d, ts))
|
Walther@60776
|
392 |
| to_p_model thy (Sup_POS (d, ts)) = UnparseC.term_in_thy thy (Input_Descript.join (d, ts))
|
walther@59988
|
393 |
|
Walther@60766
|
394 |
fun fill_from_o o_model (i, vnts, bool, _, (feedb, pos)) =
|
Walther@60766
|
395 |
let
|
Walther@60766
|
396 |
val (m_field, all_values) =
|
Walther@60767
|
397 |
case find_first (fn (_, _, _, descr', _) => Model_Def.descriptor_exists descr' feedb) o_model of
|
Walther@60766
|
398 |
SOME (_, _, m_field, _, ts) => (m_field, ts)
|
Walther@60766
|
399 |
| NONE => raise ERROR "I_Model.fill_from_o does NOT find a descriptor in O_Model"
|
Walther@60767
|
400 |
val descr = Model_Def.get_descr feedb (*i_single has been filtered appropriately*)
|
Walther@60766
|
401 |
in
|
Walther@60772
|
402 |
(*---------------vvvvvvvvvvvvv MV if TermC.is_list all_value-----*)
|
Walther@60766
|
403 |
if Model_Def.is_list_descr descr
|
Walther@60766
|
404 |
then
|
Walther@60766
|
405 |
let
|
Walther@60777
|
406 |
val already_input = feedb |> feedb_values
|
Walther@60766
|
407 |
val miss = subtract op= already_input all_values (*"[[c], [c_2], [c_3], [c_4]]"*)
|
Walther@60766
|
408 |
val ts = already_input @ [hd miss]
|
Walther@60766
|
409 |
in
|
Walther@60766
|
410 |
if length all_values = length ts
|
Walther@60771
|
411 |
then SOME (i, vnts, bool, m_field, (Cor_POS (descr, [Model_Def.values_to_present ts]), pos))
|
Walther@60771
|
412 |
else SOME (i, vnts, bool, m_field, (Inc_POS (descr, [Model_Def.values_to_present ts]), pos))
|
Walther@60766
|
413 |
end
|
Walther@60771
|
414 |
else SOME (i, vnts, bool, m_field, (Cor_POS (descr, all_values(*only 1 term*)), pos))
|
Walther@60766
|
415 |
end
|
walther@59988
|
416 |
|
Walther@60760
|
417 |
(*
|
Walther@60771
|
418 |
in case there is an item in i2_model(= met) with Sup_POS,
|
Walther@60771
|
419 |
find_first an appropriate (variant, descriptor) item in i1_model(= pbl) and add it instead Sup_POS,
|
Walther@60760
|
420 |
otherwise keep the items of i2_model.
|
Walther@60760
|
421 |
*)
|
Walther@60771
|
422 |
fun add_other max_vnt i1_model (i2, _, bool2, m_field2, (Sup_POS (descr2, ts2), pos2)) =
|
Walther@60767
|
423 |
(case find_first (fn (_, vnts1, _, _, (feedb1, _)) => case Model_Def.get_dscr_opt feedb1 of
|
Walther@60760
|
424 |
NONE => false
|
Walther@60760
|
425 |
| SOME descr1 => descr1 = descr2 andalso Model_Def.member_vnt vnts1 max_vnt) i1_model of
|
Walther@60760
|
426 |
NONE =>
|
Walther@60771
|
427 |
(i2, [max_vnt], bool2, m_field2, (Sup_POS (descr2, ts2), pos2)) (*the present in i2_model*)
|
Walther@60772
|
428 |
| SOME i1_single => i1_single) (*shift the item from i1_model to i2_model*)
|
Walther@60772
|
429 |
| add_other _ _ i2_single = i2_single (*keep all the other items in i2_model*)
|
Walther@60760
|
430 |
|
Walther@60770
|
431 |
(*fill method from items already input*)
|
Walther@60760
|
432 |
fun fill_method o_model (pbl_imod, met_imod) met_patt =
|
Walther@60760
|
433 |
let
|
Walther@60760
|
434 |
val pbl_max_vnts = Model_Def.max_variants o_model pbl_imod
|
Walther@60760
|
435 |
(*probably pbl/met_imod = [], so take met_patt; if empty return Sup*)
|
Walther@60760
|
436 |
val i_from_met = map (fn (_, (descr, _)) => (*order from met_patt*)
|
Walther@60760
|
437 |
Pre_Conds.get_descr_vnt descr pbl_max_vnts met_imod) met_patt (*\<longrightarrow> right order for args*)
|
Walther@60760
|
438 |
|
Walther@60760
|
439 |
val met_max_vnts = Model_Def.max_variants o_model i_from_met;
|
Walther@60760
|
440 |
val max_vnt = hd (inter op= pbl_max_vnts met_max_vnts);
|
Walther@60760
|
441 |
(*add items from pbl_imod (without overwriting existing items in met_imod)*)
|
Walther@60760
|
442 |
in
|
Walther@60760
|
443 |
map (add_other max_vnt pbl_imod) i_from_met
|
Walther@60760
|
444 |
end
|
Walther@60760
|
445 |
|
Walther@60755
|
446 |
fun msg vnts feedb = "get_descr_vnt' returns NONE: i.e. it does not find an item of o_model with\n" ^
|
Walther@60755
|
447 |
"variants " ^ ints2str' vnts ^ " and descriptor " ^
|
Walther@60767
|
448 |
(feedb |> Model_Def.get_dscr_opt |> the |> UnparseC.term (ContextC.for_ERROR ()))
|
Walther@60755
|
449 |
fun transfer_terms (i, vnts, m_field, descr, ts) =
|
Walther@60771
|
450 |
(i, vnts, true, m_field, (Cor_POS (descr, ts), Position.none))
|
Walther@60757
|
451 |
fun s_make_complete ctxt o_model (pbl_imod, met_imod) (pbl_id, met_id) =
|
Walther@60751
|
452 |
let
|
Walther@60757
|
453 |
val {model = pbl_patt, ...} = Problem.from_store ctxt pbl_id;
|
Walther@60757
|
454 |
val {model = met_patt, ...} = MethodC.from_store ctxt met_id;
|
Walther@60752
|
455 |
val pbl_max_vnts = Model_Def.max_variants o_model pbl_imod;
|
Walther@60751
|
456 |
val i_from_pbl = map (fn (_, (descr, _)) =>
|
Walther@60751
|
457 |
Pre_Conds.get_descr_vnt descr pbl_max_vnts pbl_imod) pbl_patt
|
Walther@60751
|
458 |
val pbl_from_o_model = map ((fn i_single as (_, _, _, _, (feedb, _)) =>
|
Walther@60771
|
459 |
if is_empty_single_POS i_single
|
Walther@60751
|
460 |
then
|
Walther@60751
|
461 |
case Pre_Conds.get_descr_vnt' feedb pbl_max_vnts o_model of
|
Walther@60751
|
462 |
[] => raise ERROR (msg pbl_max_vnts feedb)
|
Walther@60751
|
463 |
| o_singles => map transfer_terms o_singles
|
Walther@60751
|
464 |
else [i_single (*fetched before from pbl_imod*)])) i_from_pbl |> flat
|
Walther@60751
|
465 |
|
Walther@60751
|
466 |
val i_from_met = map (fn (_, (descr, _)) =>
|
Walther@60752
|
467 |
Pre_Conds.get_descr_vnt descr pbl_max_vnts met_imod) met_patt
|
Walther@60752
|
468 |
val met_max_vnts = Model_Def.max_variants o_model i_from_met;
|
Walther@60752
|
469 |
val max_vnt = hd met_max_vnts (*need only one for solve-phase*)
|
Walther@60751
|
470 |
|
Walther@60751
|
471 |
val met_from_pbl = map ((fn i_single as (_, _, _, _, (feedb, _)) =>
|
Walther@60771
|
472 |
if is_empty_single_POS i_single
|
Walther@60751
|
473 |
then
|
Walther@60752
|
474 |
case Pre_Conds.get_descr_vnt' feedb [max_vnt] o_model of
|
Walther@60752
|
475 |
[] => raise ERROR (msg [max_vnt] feedb)
|
Walther@60751
|
476 |
| o_singles => map transfer_terms o_singles
|
Walther@60751
|
477 |
else [i_single (*fetched before from met_imod*)])) i_from_met |> flat
|
Walther@60751
|
478 |
in
|
Walther@60752
|
479 |
(filter (fn (_, vnts', _, _, _) => member op = vnts' max_vnt) pbl_from_o_model,
|
Walther@60752
|
480 |
met_from_pbl)
|
Walther@60751
|
481 |
end
|
Walther@60751
|
482 |
|
walther@60126
|
483 |
(**)end(**);
|