src/Tools/isac/Specify/specify.sml
author wneuper <Walther.Neuper@jku.at>
Thu, 08 Dec 2022 17:55:45 +0100
changeset 60611 a25716353782
parent 60609 5967b6e610b5
child 60638 8942f07ead44
permissions -rw-r--r--
make Minisubplb/400-start-meth-subpbl.sml from Thy_Info
walther@59984
     1
signature SPECIFY =
walther@59763
     2
sig
walther@59775
     3
  val find_next_step: Calc.T -> string * (Pos.pos_ * Tactic.input)
walther@59990
     4
  val do_all: Calc.T -> Calc.T 
walther@59990
     5
  val finish_phase: Calc.T -> Calc.T
walther@59990
     6
walther@60002
     7
  val item_to_add: theory -> O_Model.T -> Model_Pattern.T -> I_Model.T ->
walther@60002
     8
    (Model_Def.m_field * TermC.as_string) option
walther@60016
     9
  val by_Add_: string -> TermC.as_string -> Calc.T -> string * Calc.state_post
Walther@60578
    10
(*from isac_test for Minisubpbl*)
Walther@60575
    11
  val for_problem: Proof.context -> O_Model.T -> References.T * References.T -> I_Model.T * I_Model.T ->
walther@60019
    12
    string * (Pos.pos_ * Tactic.input)
Walther@60575
    13
  val for_method: Proof.context -> O_Model.T -> References.T * References.T -> I_Model.T * I_Model.T ->
walther@60019
    14
    string * (Pos.pos_ * Tactic.input)
Walther@60578
    15
Walther@60578
    16
\<^isac_test>\<open>
Walther@60578
    17
(**)
wenzelm@60223
    18
\<close>
walther@59763
    19
end
walther@59763
    20
walther@59763
    21
(**)
walther@59984
    22
structure Specify(**): SPECIFY(**) =
walther@59763
    23
struct
walther@59763
    24
(**)
walther@59763
    25
walther@59990
    26
(*
walther@59990
    27
  select an item in oris, notyet input in itms 
walther@59990
    28
  (precondition: in itms are only I_Model.Cor, I_Model.Sup, I_Model.Inc)
walther@60011
    29
args of item_to_add
walther@59990
    30
  thy : for?
walther@59990
    31
  oris: from formalization 'type fmz', structured for efficient access 
walther@59990
    32
  pbt : the problem-pattern to be matched with oris in order to get itms
walther@59990
    33
  itms: already input items
walther@59990
    34
*)
walther@60002
    35
fun item_to_add thy [] pbt itms = (*root (only) ori...fmz=[]*)
walther@60002
    36
    let
Walther@60477
    37
      fun test_d d (i, _, _, _, itm_) = (d = (I_Model.descriptor itm_)) andalso i <> 0
walther@60002
    38
      fun is_elem itms (_, (d, _)) = 
walther@60002
    39
        case find_first (test_d d) itms of SOME _ => true | NONE => false
walther@60002
    40
    in
walther@60002
    41
      case filter_out (is_elem itms) pbt of
walther@60002
    42
        (f, (d, _)) :: _ => SOME (f, ((UnparseC.term_in_thy thy) o Input_Descript.join) (d, []))
walther@60002
    43
      | _ => NONE
walther@60002
    44
    end
walther@60004
    45
    (* m_field is in ------vvvv *)
walther@60002
    46
  | item_to_add thy oris _ itms =
walther@60002
    47
    let
walther@60017
    48
      fun testr_vt v ori = member op= (#2 (ori : O_Model.single)) v andalso (#3 ori) <> "#undef"
walther@60017
    49
      fun testi_vt v itm = member op= (#2 (itm : I_Model.single)) v
walther@60017
    50
      fun test_id ids r = member op= ids (#1 (r : O_Model.single))
walther@60002
    51
      fun test_subset itm (_, _, _, d, ts) = 
Walther@60477
    52
        (I_Model.descriptor (#5 (itm: I_Model.single))) = d andalso subset op = (I_Model.o_model_values (#5 itm), ts)
walther@60002
    53
      fun false_and_not_Sup (_, _, false, _, I_Model.Sup _) = false
walther@60002
    54
        | false_and_not_Sup (_, _, false, _, _) = true
walther@60002
    55
        | false_and_not_Sup _ = false
Walther@60477
    56
      val v = if itms = [] then 1 else I_Model.max_variant itms
walther@60011
    57
      val vors = if v = 0 then oris else filter (testr_vt v) oris
walther@60002
    58
      val vits =
walther@60002
    59
        if v = 0
walther@60002
    60
        then itms                                 (* because of dsc without dat *)
walther@60002
    61
  	    else filter (testi_vt v) itms;                             (* itms..vat *)
walther@60002
    62
      val icl = filter false_and_not_Sup vits;                    (* incomplete *)
walther@60002
    63
    in
walther@60002
    64
      if icl = [] then
walther@60002
    65
        case filter_out (test_id (map #1 vits)) vors of
walther@60002
    66
          [] => NONE
Walther@60469
    67
        | miss => SOME (O_Model.get_field_term thy (hd miss))
walther@60002
    68
      else
walther@60002
    69
        case find_first (test_subset (hd icl)) vors of
walther@60011
    70
          NONE => raise ERROR "item_to_add: types or dsc DO NOT MATCH BETWEEN fmz --- pbt"
Walther@60477
    71
        | SOME ori => SOME (I_Model.get_field_term thy ori (hd icl))
walther@60002
    72
    end
walther@60002
    73
walther@60019
    74
walther@60019
    75
(** find a next step in the specify-phase **)
walther@60021
    76
(*
Walther@60575
    77
  here should be mutual recursion between for_problem ctxt and for_method
walther@60021
    78
*)
Walther@60575
    79
fun for_problem ctxt oris ((dI', pI', mI'), (dI, pI, mI)) (pbl, met) =
walther@59763
    80
  let
walther@60019
    81
    val cpI = if pI = Problem.id_empty then pI' else pI;
walther@60154
    82
    val cmI = if mI = MethodC.id_empty then mI' else mI;
Walther@60585
    83
    val {model = pbt, where_rls, where_, ...} = Problem.from_store ctxt cpI;
Walther@60586
    84
    val {model = mpc, ...} = MethodC.from_store ctxt cmI
Walther@60590
    85
    val (preok, _) = Pre_Conds.check ctxt where_rls where_ pbl 0;
walther@60019
    86
  in
walther@60021
    87
    if dI' = ThyC.id_empty andalso dI = ThyC.id_empty then
walther@60019
    88
      ("dummy", (Pos.Pbl, Tactic.Specify_Theory dI'))
walther@60019
    89
    else if pI' = Problem.id_empty andalso pI = Problem.id_empty then
walther@60019
    90
        ("dummy", (Pos.Pbl, Tactic.Specify_Problem pI'))
walther@60019
    91
    else
walther@60019
    92
      case find_first (I_Model.is_error o #5) pbl of
walther@60019
    93
        SOME (_, _, _, fd, itm_) =>
walther@60019
    94
          ("dummy", (Pos.Pbl, P_Model.mk_delete (ThyC.get_theory
walther@60019
    95
            (if dI = ThyC.id_empty then dI' else dI)) fd itm_))
walther@60019
    96
      | NONE => 
Walther@60578
    97
        (case item_to_add (ThyC.get_theory_PIDE ctxt
Walther@60578
    98
            (if dI = ThyC.id_empty then dI' else dI)) oris pbt pbl of
walther@60019
    99
           SOME (fd, ct') => ("dummy", (Pos.Pbl, P_Model.mk_additem fd ct'))
walther@60019
   100
         | NONE => (*pbl-items complete*)        
walther@60019
   101
           if not preok then ("dummy", (Pos.Pbl, Tactic.Refine_Problem pI'))
walther@60019
   102
           else if dI = ThyC.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Theory dI'))
walther@60019
   103
           else if pI = Problem.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Problem pI'))
walther@60154
   104
           else if mI = MethodC.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Method mI'))
walther@60019
   105
           else
walther@60019
   106
            case find_first (I_Model.is_error o #5) met of
walther@60019
   107
              SOME (_, _, _, fd, itm_) =>
walther@60019
   108
                 ("dummy", (Pos.Met, P_Model.mk_delete (ThyC.get_theory dI) fd itm_))
walther@60019
   109
            | NONE => 
walther@60019
   110
              (case item_to_add (ThyC.get_theory dI) oris mpc met of
walther@60019
   111
    	          SOME (fd, ct') =>
Walther@60586
   112
                   ("dummy", (Pos.Met, P_Model.mk_additem fd ct')) (*30.8.01: where_?!?*)
walther@60021
   113
    		      | NONE => ("dummy", (Pos.Met, Tactic.Apply_Method mI))))
walther@60019
   114
  end
walther@60019
   115
Walther@60575
   116
fun for_method ctxt oris ((dI', pI', mI'), (dI, pI, mI)) (pbl, met) =
walther@60019
   117
  let
walther@60154
   118
    val cmI = if mI = MethodC.id_empty then mI' else mI;
Walther@60586
   119
    val {model = mpc, where_rls, where_, ...} = MethodC.from_store ctxt cmI;
Walther@60590
   120
    val (preok, _) = Pre_Conds.check ctxt where_rls where_ pbl 0;
walther@60019
   121
  in
walther@60019
   122
    (case find_first (I_Model.is_error o #5) met of
walther@60019
   123
      SOME (_,_,_, fd, itm_) =>
Walther@60578
   124
        ("dummy", (Pos.Met, P_Model.mk_delete (ThyC.get_theory_PIDE ctxt
Walther@60578
   125
            (if dI = ThyC.id_empty then dI' else dI)) fd itm_))
walther@60019
   126
    | NONE => 
Walther@60578
   127
      case item_to_add (ThyC.get_theory_PIDE ctxt 
Walther@60578
   128
          (if dI = ThyC.id_empty then dI' else dI)) oris mpc met of
walther@60019
   129
        SOME (fd, ct') =>
walther@60019
   130
          ("dummy", (Pos.Met, P_Model.mk_additem fd ct')) (*->->*)
walther@60019
   131
      | NONE => 
walther@60019
   132
        (if dI = ThyC.id_empty then ("dummy", (Pos.Met, Tactic.Specify_Theory dI'))
walther@60019
   133
         else if pI = Problem.id_empty then ("dummy", (Pos.Met, Tactic.Specify_Problem pI'))
walther@60019
   134
         else if not preok then ("dummy", (Pos.Met, Tactic.Specify_Method mI))
walther@60019
   135
         else ("dummy", (Pos.Met, Tactic.Apply_Method mI))))
walther@60019
   136
  end
walther@60019
   137
walther@60019
   138
(*
walther@60019
   139
  on finding a next step switching from problem to method or vice versa is possible,
walther@60019
   140
  because the user is free to switch and edit the respective models independently.
walther@60019
   141
TODO: this free switch is NOT yet implemented; e.g. 
Walther@60575
   142
  preok is relevant for problem + method, i.e. in for_problem ctxt + for_method
walther@60019
   143
*)
walther@60019
   144
fun find_next_step (pt, pos as (_, p_)) =
walther@60019
   145
  let
walther@60019
   146
    val {meth = met, origin = origin as (oris, o_refs as (_, pI', mI'), _), probl = pbl,
walther@60019
   147
      spec = refs, ...} = Calc.specify_data (pt, pos);
Walther@60556
   148
    val ctxt = Ctree.get_ctxt pt pos
walther@60011
   149
    in
walther@60019
   150
      if Ctree.just_created (pt, pos) andalso origin <> Ctree.e_origin then
walther@60011
   151
        case mI' of
walther@60011
   152
          ["no_met"] => ("ok", (Pos.Pbl, Tactic.Refine_Tacitly pI'))
walther@60011
   153
        | _ => ("ok", (Pos.Pbl, Tactic.Model_Problem))
walther@60019
   154
      else if p_ = Pos.Pbl then
Walther@60575
   155
        for_problem ctxt oris (o_refs, refs) (pbl, met)
walther@60011
   156
      else
Walther@60575
   157
        for_method ctxt oris (o_refs, refs) (pbl, met)
walther@60019
   158
    end
walther@60019
   159
walther@60019
   160
walther@60021
   161
(** tools **)
walther@59763
   162
Walther@60556
   163
fun by_Add_  m_field ct (pt, pos as (_, p_)) =
walther@60016
   164
  let
walther@60097
   165
    val (met, oris, (_, pI', mI'), pbl, (_, pI, mI), ctxt) = SpecificationC.get_data (pt, pos)
walther@60016
   166
    val (i_model, m_patt) =
walther@60016
   167
       if p_ = Pos.Met then
walther@60016
   168
         (met,
Walther@60586
   169
           (if mI = MethodC.id_empty then mI' else mI) |> MethodC.from_store ctxt |> #model)
walther@60016
   170
       else
walther@60016
   171
         (pbl,
Walther@60585
   172
           (if pI = Problem.id_empty then pI' else pI) |> Problem.from_store ctxt |> #model)
walther@60016
   173
    in
walther@60016
   174
      case I_Model.check_single ctxt m_field oris i_model m_patt ct of
walther@60016
   175
        I_Model.Add i_single => (*..union old input *)
walther@60016
   176
	        let
walther@60016
   177
	          val i_model' = I_Model.add_single (Proof_Context.theory_of ctxt) i_single i_model
Walther@60477
   178
            val tac' = I_Model.make_tactic m_field (ct, i_model')
walther@60016
   179
	          val  (_, _, _, pt') =  Specify_Step.add tac' (Istate_Def.Uistate, ctxt) (pt, pos)
walther@60016
   180
	        in
Walther@60611
   181
            ("ok", ([(Tactic.input_from_T ctxt tac', tac', (pos, (Istate_Def.Uistate, ctxt)))],
walther@60021
   182
              [], (pt', pos)))
walther@60016
   183
          end
walther@60016
   184
      | I_Model.Err msg => (msg, ([], [], (pt, pos)))
walther@60016
   185
    end
walther@59990
   186
walther@59990
   187
(* complete _NON_empty calc-head for autocalc (sub-)pbl from oris
walther@59990
   188
  + met from fmz; assumes pos on PblObj, meth = []                    *)
walther@59990
   189
fun finish_phase (pt, pos as (p, p_)) =
walther@59990
   190
  let
walther@59990
   191
    val _ = if p_ <> Pos.Pbl 
walther@59990
   192
	    then raise ERROR ("###finish_phase: only impl.for Pbl, called with " ^ Pos.pos'2str pos)
walther@59990
   193
	    else ()
walther@59990
   194
	  val (oris, ospec, probl, spec) = case Ctree.get_obj I pt p of
walther@59990
   195
	    Ctree.PblObj {origin = (oris, ospec, _), probl, spec, ...} => (oris, ospec, probl, spec)
walther@59990
   196
	  | _ => raise ERROR "finish_phase: unvered case get_obj"
Walther@60494
   197
  	val (_, pI, mI) = References.select_input ospec spec
Walther@60556
   198
  	val ctxt = Ctree.get_ctxt pt pos
Walther@60586
   199
  	val mpc = (#model o MethodC.from_store ctxt) mI
Walther@60586
   200
  	val model = (#model o Problem.from_store ctxt) pI
Walther@60586
   201
  	val (pits, mits) = I_Model.complete_method (oris, mpc, model, probl)
walther@59990
   202
    val pt = Ctree.update_pblppc pt p pits
walther@59990
   203
	  val pt = Ctree.update_metppc pt p mits
walther@59990
   204
  in (pt, (p, Pos.Met)) end
Walther@60556
   205
walther@59990
   206
(* do all specification in one single step:
walther@59990
   207
   complete calc-head for autocalc (sub-)pbl from oris (+ met from fmz);
walther@59990
   208
   oris and spec (incl. pbl-refinement) given from init_calc or SubProblem
walther@59990
   209
*)
Walther@60557
   210
fun do_all (pt, pos as (p, _)) =
walther@59990
   211
  let
walther@59990
   212
    val (pors, dI, pI, mI) = case Ctree.get_obj I pt p of
walther@59990
   213
      Ctree.PblObj {origin = (pors, (dI, pI, mI), _), ...}
walther@59990
   214
        => (pors, dI, pI, mI)
walther@59990
   215
    | _ => raise ERROR "do_all: uncovered case get_obj"
Walther@60557
   216
    val ctxt = Ctree.get_ctxt pt pos
Walther@60586
   217
	  val {model, ...} = MethodC.from_store ctxt mI
Walther@60609
   218
    val (_, vals) = O_Model.values' ctxt pors
Walther@60609
   219
	  val ctxt = ContextC.initialise ctxt vals
walther@59990
   220
    val (pt, _) = Ctree.cupdate_problem pt p ((dI, pI, mI),
Walther@60586
   221
      map (I_Model.complete' model) pors, map (I_Model.complete' model) pors, ctxt)
walther@59990
   222
  in
walther@59990
   223
    (pt, (p, Pos.Met))
walther@59990
   224
  end
walther@59990
   225
walther@59946
   226
(**)end(**)