src/Tools/isac/Specify/i-model.sml
author wneuper <Walther.Neuper@jku.at>
Wed, 25 Oct 2023 12:34:12 +0200
changeset 60760 3b173806efe2
parent 60758 5319a8dc84f5
child 60762 f10bbfb2b3bb
permissions -rw-r--r--
prepare 12: M_Model.match_itms_oris takes Position.T and new max_mariants

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