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