src/Tools/isac/Specify/specify.sml
author Walther Neuper <walther.neuper@jku.at>
Mon, 01 Jun 2020 16:11:05 +0200
changeset 60015 77c0abec88fa
parent 60011 25e6810ca0e7
child 60016 d5ab2f4bc153
permissions -rw-r--r--
remove Specify.find_next_step'

leftover of early attempt to pre-calculate Pos.
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@59990
     9
(*TODO: vvvvvvvvvvvvvv unify code*)
walther@59990
    10
  val by_tactic_input': string -> TermC.as_string -> Calc.T -> Calc.state_post
walther@59990
    11
  val by_tactic': string -> TermC.as_string -> Calc.T -> string * Calc.state_post
walther@59990
    12
(*TODO: ^^^^^^^^^^^^^^ unify code*)
walther@59806
    13
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
walther@59806
    14
  (*NONE*)
walther@59886
    15
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
walther@59806
    16
  (*NONE*)
walther@59886
    17
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
walther@59763
    18
end
walther@59763
    19
walther@59763
    20
(**)
walther@59984
    21
structure Specify(**): SPECIFY(**) =
walther@59763
    22
struct
walther@59763
    23
(**)
walther@59763
    24
walther@59990
    25
(*
walther@59990
    26
  select an item in oris, notyet input in itms 
walther@59990
    27
  (precondition: in itms are only I_Model.Cor, I_Model.Sup, I_Model.Inc)
walther@60011
    28
args of item_to_add
walther@59990
    29
  thy : for?
walther@59990
    30
  oris: from formalization 'type fmz', structured for efficient access 
walther@59990
    31
  pbt : the problem-pattern to be matched with oris in order to get itms
walther@59990
    32
  itms: already input items
walther@59990
    33
*)
walther@60002
    34
fun item_to_add thy [] pbt itms = (*root (only) ori...fmz=[]*)
walther@60002
    35
    let
walther@60002
    36
      fun test_d d (i, _, _, _, itm_) = (d = (I_Model.d_in itm_)) andalso i <> 0
walther@60002
    37
      fun is_elem itms (_, (d, _)) = 
walther@60002
    38
        case find_first (test_d d) itms of SOME _ => true | NONE => false
walther@60002
    39
    in
walther@60002
    40
      case filter_out (is_elem itms) pbt of
walther@60002
    41
        (f, (d, _)) :: _ => SOME (f, ((UnparseC.term_in_thy thy) o Input_Descript.join) (d, []))
walther@60002
    42
      | _ => NONE
walther@60002
    43
    end
walther@60004
    44
    (* m_field is in ------vvvv *)
walther@60002
    45
  | item_to_add thy oris _ itms =
walther@60002
    46
    let
walther@60011
    47
      fun testr_vt v ori = Library.member op= (#2 (ori : O_Model.single)) v andalso (#3 ori) <> "#undef"
walther@60004
    48
      fun testi_vt v itm = Library.member op= (#2 (itm : I_Model.single)) v
walther@60002
    49
      fun test_id ids r = Library.member op= ids (#1 (r : O_Model.single))
walther@60002
    50
      fun test_subset itm (_, _, _, d, ts) = 
walther@60002
    51
        (I_Model.d_in (#5 (itm: I_Model.single))) = d andalso subset op = (I_Model.ts_in (#5 itm), ts)
walther@60002
    52
      fun false_and_not_Sup (_, _, false, _, I_Model.Sup _) = false
walther@60002
    53
        | false_and_not_Sup (_, _, false, _, _) = true
walther@60002
    54
        | false_and_not_Sup _ = false
walther@60002
    55
      val v = if itms = [] then 1 else I_Model.max_vt itms
walther@60011
    56
      val vors = if v = 0 then oris else filter (testr_vt v) oris
walther@60002
    57
      val vits =
walther@60002
    58
        if v = 0
walther@60002
    59
        then itms                                 (* because of dsc without dat *)
walther@60002
    60
  	    else filter (testi_vt v) itms;                             (* itms..vat *)
walther@60002
    61
      val icl = filter false_and_not_Sup vits;                    (* incomplete *)
walther@60002
    62
    in
walther@60002
    63
      if icl = [] then
walther@60002
    64
        case filter_out (test_id (map #1 vits)) vors of
walther@60002
    65
          [] => NONE
walther@60002
    66
        | miss => SOME (O_Model.getr_ct thy (hd miss))
walther@60002
    67
      else
walther@60002
    68
        case find_first (test_subset (hd icl)) vors of
walther@60011
    69
          NONE => raise ERROR "item_to_add: types or dsc DO NOT MATCH BETWEEN fmz --- pbt"
walther@60002
    70
        | SOME ori => SOME (I_Model.geti_ct thy ori (hd icl))
walther@60002
    71
    end
walther@60002
    72
walther@60002
    73
(*TODO: unify*)
walther@59772
    74
fun find_next_step (pt, (p, p_)) =
walther@59763
    75
  let
walther@60011
    76
    val {meth = met, origin = origin as (oris, (dI', pI', mI'), _), probl = pbl,
walther@60011
    77
      spec = (dI, pI, mI), ...} = Calc.specify_data (pt, (p, p_));
walther@60011
    78
    in
walther@60011
    79
      if Ctree.just_created (pt, (p, p_)) andalso origin <> Ctree.e_origin then
walther@60011
    80
        case mI' of
walther@60011
    81
          ["no_met"] => ("ok", (Pos.Pbl, Tactic.Refine_Tacitly pI'))
walther@60011
    82
        | _ => ("ok", (Pos.Pbl, Tactic.Model_Problem))
walther@60011
    83
      else
walther@60011
    84
        let 
walther@60011
    85
          (*NEW* ) References.select (dI', pI', mI') (dI, pI, mI) ( *NEW*)
walther@60011
    86
          val cpI = if pI = Problem.id_empty then pI' else pI;
walther@60011
    87
    	    val cmI = if mI = Method.id_empty then mI' else mI;
walther@60011
    88
    	    val {ppc = pbt, prls, where_, ...} = Problem.from_store cpI;
walther@60011
    89
    	    val pre = Pre_Conds.check' "thy 100820" prls where_ pbl;
walther@60011
    90
    	    val preok = foldl and_ (true, map fst pre);
walther@60011
    91
    	    (*FIXME.WN0308:    ~~~~~: just check true in itms of pbl/met?*)
walther@60011
    92
          val mpc = (#ppc o Method.from_store) cmI
walther@60011
    93
        in
walther@60011
    94
          case p_ of
walther@60011
    95
  		    (*vvvvvvv---------------------------*)
walther@60011
    96
            Pos.Pbl =>
walther@60011
    97
            (if dI' = ThyC.id_empty andalso dI = ThyC.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Theory dI'))
walther@60011
    98
             else if pI' = Problem.id_empty andalso pI = Problem.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Problem pI'))
walther@60011
    99
             else
walther@60011
   100
               case find_first (I_Model.is_error o #5) pbl of
walther@60011
   101
        	       SOME (_, _, _, fd, itm_) =>
walther@60011
   102
        	         ("dummy", (Pos.Pbl, P_Model.mk_delete (ThyC.get_theory
walther@60011
   103
        	           (if dI = ThyC.id_empty then dI' else dI)) fd itm_))
walther@60011
   104
        	     | NONE => 
walther@60011
   105
        	       (case item_to_add (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) oris pbt pbl of
walther@60011
   106
        	          SOME (fd, ct') => ("dummy", (Pos.Pbl, P_Model.mk_additem fd ct'))
walther@60011
   107
        	        | NONE => (*pbl-items complete*)
walther@60011
   108
        	          if not preok then ("dummy", (Pos.Pbl, Tactic.Refine_Problem pI'))
walther@60011
   109
        	          else if dI = ThyC.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Theory dI'))
walther@60011
   110
        		        else if pI = Problem.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Problem pI'))
walther@60011
   111
        		        else if mI = Method.id_empty then ("dummy", (Pos.Pbl, Tactic.Specify_Method mI'))
walther@60011
   112
        		        else
walther@60011
   113
        			        case find_first (I_Model.is_error o #5) met of
walther@60011
   114
        			          SOME (_, _, _, fd, itm_) => ("dummy", (Pos.Met, P_Model.mk_delete (ThyC.get_theory dI) fd itm_))
walther@60011
   115
        			        | NONE => 
walther@60011
   116
        			          (case item_to_add (ThyC.get_theory dI) oris mpc met of
walther@60011
   117
        				          SOME (fd, ct') => ("dummy", (Pos.Met, P_Model.mk_additem fd ct')) (*30.8.01: pre?!?*)
walther@60011
   118
        				        | NONE => ("dummy", (Pos.Met, Tactic.Apply_Method mI)))))
walther@60011
   119
  		    (*vvvvvvv---------------------------*)
walther@60011
   120
          | Pos.Met =>
walther@60011
   121
            (case find_first (I_Model.is_error o #5) met of
walther@60011
   122
              SOME (_,_,_, fd, itm_) => ("dummy", (Pos.Met, P_Model.mk_delete (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) fd itm_))
walther@59763
   123
            | NONE => 
walther@60011
   124
              case item_to_add (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) oris mpc met of
walther@60011
   125
        	      SOME (fd, ct') => ("dummy", (Pos.Met, P_Model.mk_additem fd ct')) (*->->*)
walther@60011
   126
              | NONE => 
walther@60011
   127
        	      (if dI = ThyC.id_empty then ("dummy", (Pos.Met, Tactic.Specify_Theory dI'))
walther@60011
   128
        	       else if pI = Problem.id_empty then ("dummy", (Pos.Met, Tactic.Specify_Problem pI'))
walther@60011
   129
        		     else if not preok then ("dummy", (Pos.Met, Tactic.Specify_Method mI))
walther@60011
   130
        		     else ("dummy", (Pos.Met, Tactic.Apply_Method mI))))
walther@60011
   131
          | p_ => raise ERROR ("Specify.find_next_step called with " ^ Pos.pos_2str p_)
walther@60011
   132
        end
walther@59763
   133
  end
walther@59763
   134
walther@59990
   135
fun by_tactic' sel ct (pt, pos as (p, Pos.Met)) = 
walther@59990
   136
      let
walther@60015
   137
        val (met, oris, (dI', _, mI'), _, (dI, _, mI), ctxt) = Specification.get_data (pt, pos)
walther@59990
   138
        val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI
walther@59990
   139
        val cmI = if mI = Method.id_empty then mI' else mI
walther@60015
   140
        val {ppc, ...} = Method.from_store cmI
walther@59990
   141
      in 
walther@59990
   142
        case I_Model.check_single ctxt sel oris met ppc ct of
walther@59990
   143
          I_Model.Add itm =>  (*..union old input *)
walther@59990
   144
    	      let
walther@59990
   145
              val met' = I_Model.add_single thy itm met
walther@59992
   146
              val tac' = I_Model.get_tac sel (ct, met')
walther@59990
   147
    	        val (p, pt') =
walther@59992
   148
    	         case Specify_Step.add tac' (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Met)) of
walther@59990
   149
    	          ((p, Pos.Met), _, _, pt') => (p, pt')
walther@59990
   150
    	        | _ => raise ERROR "by_tactic': uncovered case of generate1"
walther@59990
   151
    	      in 
walther@60015
   152
              ("ok", ([], [], (pt', (p, Pos.Met))))
walther@59990
   153
            end
walther@60015
   154
        | I_Model.Err msg => (msg, ([], [], (pt, (p, Pos.Met))))
walther@59990
   155
      end
walther@60015
   156
  | by_tactic' sel ct (pt, pos as (p, p_(*Frm, Pbl*))) =
walther@59990
   157
      let
walther@60015
   158
        val (_, oris, (dI', pI', _), pbl, (dI, pI, _), ctxt) = Specification.get_data (pt, pos)
walther@59990
   159
        val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI
walther@59990
   160
        val cpI = if pI = Problem.id_empty then pI' else pI
walther@60015
   161
        val {ppc,  ...} = Problem.from_store cpI
walther@59990
   162
      in
walther@59990
   163
        case I_Model.check_single ctxt sel oris pbl ppc ct of
walther@59990
   164
          I_Model.Add itm => (*..union old input *)
walther@59990
   165
	          let
walther@59990
   166
	            val pbl' = I_Model.add_single thy itm pbl
walther@59992
   167
              val tac' = I_Model.get_tac sel (ct, pbl')
walther@59990
   168
	            val (p, pt') =
walther@59992
   169
	              case Specify_Step.add tac' (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Pbl)) of
walther@59990
   170
  	              ((p, Pos.Pbl), _, _, pt') => (p, pt')
walther@59990
   171
  	            | _ => raise ERROR "by_tactic': uncovered case of Specify_Step.add"
walther@59990
   172
	          in
walther@59990
   173
              ("ok", ([], [], (pt', (p, p_))))
walther@59990
   174
            end
walther@60015
   175
        | I_Model.Err msg => (msg, ([], [], (pt, (p, p_))))
walther@59990
   176
      end
walther@59990
   177
walther@59990
   178
(*FIXME.WN110515 declare_constraints for ct (without dsc) into PblObj{ctxt, ...}
walther@59990
   179
  -- for input from scratch*)
walther@59990
   180
fun by_tactic_input' sel ct (ptp as (pt, (p, Pos.Pbl))) = 
walther@59990
   181
    let
walther@59990
   182
      val (oris, dI', pI', dI, pI, pbl, ctxt) = case Ctree.get_obj I pt p of
walther@59990
   183
        Ctree.PblObj {origin = (oris, (dI', pI', _), _), spec = (dI, pI, _), probl = pbl, ctxt, ...} =>
walther@59990
   184
           (oris, dI', pI', dI, pI, pbl, ctxt)
walther@59990
   185
      | _ => raise ERROR "specify (Specify_Theory': uncovered case get_obj"
walther@59990
   186
      val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI;
walther@59990
   187
      val cpI = if pI = Problem.id_empty then pI' else pI;
walther@59990
   188
    in
walther@59990
   189
      case I_Model.check_single ctxt sel oris pbl ((#ppc o Problem.from_store) cpI) ct of
walther@59990
   190
	      I_Model.Add itm (*..union old input *) =>
walther@59990
   191
	        let
walther@59990
   192
	          val pbl' = I_Model.add_single thy itm pbl
walther@59990
   193
	          val (tac, tac_) = case sel of
walther@59990
   194
		          "#Given" => (Tactic.Add_Given    ct, Tactic.Add_Given'   (ct, pbl'))
walther@59990
   195
		        | "#Find"  => (Tactic.Add_Find     ct, Tactic.Add_Find'    (ct, pbl'))
walther@59990
   196
		        | "#Relate"=> (Tactic.Add_Relation ct, Tactic.Add_Relation'(ct, pbl'))
walther@60004
   197
		        | sel => raise ERROR ("by_tactic_input': uncovered case of " ^ sel)
walther@59990
   198
		        val (p, c, pt') =
walther@59990
   199
		          case Specify_Step.add tac_ (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Pbl)) of
walther@59990
   200
  		          ((p, Pos.Pbl), c, _, pt') =>  (p, c, pt')
walther@59990
   201
  		        | _ => raise ERROR "by_tactic_input': uncovered case generate1"
walther@59990
   202
	        in
walther@59990
   203
	          ([(tac, tac_, ((p, Pos.Pbl), (Istate_Def.Uistate, ctxt)))], c, (pt', (p, Pos.Pbl)))
walther@59990
   204
          end	       
walther@59990
   205
	    | I_Model.Err msg => (*TODO.WN03 pass error-msgs to the frontend..
walther@59990
   206
                     FIXME ..and dont abuse a tactic for that purpose*)
walther@59990
   207
	        ([(Tactic.Tac msg, Tactic.Tac_ (ThyC.get_theory "Isac_Knowledge", msg,msg,msg),
walther@59990
   208
	          (Pos.e_pos', (Istate_Def.empty, ContextC.empty)))], [], ptp) 
walther@59990
   209
    end
walther@59990
   210
  | by_tactic_input' sel ct (ptp as (pt, (p, Pos.Met))) = 
walther@59990
   211
    let
walther@59998
   212
(*NEW* ) *.specify_data ( *NEW*)
walther@59990
   213
      val (oris, dI', mI', dI, mI, met, ctxt) = case Ctree.get_obj I pt p of
walther@59990
   214
        Ctree.PblObj {origin = (oris, (dI', _, mI'), _), spec = (dI, _, mI), meth = met,ctxt, ...} =>
walther@59990
   215
           (oris, dI', mI', dI, mI, met, ctxt)
walther@59990
   216
      | _ => raise ERROR "by_tactic_input' Met: uncovered case get_obj"
walther@59998
   217
(*NEW* ) References.select ( *NEW*)
walther@59990
   218
      val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI;
walther@59990
   219
      val cmI = if mI = Method.id_empty then mI' else mI;
walther@59990
   220
    in 
walther@59990
   221
      case I_Model.check_single ctxt sel oris met ((#ppc o Method.from_store) cmI) ct of
walther@59990
   222
        I_Model.Add itm (*..union old input *) =>
walther@59990
   223
	        let
walther@59990
   224
	          val met' = I_Model.add_single thy itm met;
walther@60004
   225
	          val (tac, tac_) = case sel of
walther@59990
   226
		          "#Given" => (Tactic.Add_Given    ct, Tactic.Add_Given'   (ct, met'))
walther@59990
   227
		        | "#Find"  => (Tactic.Add_Find     ct, Tactic.Add_Find'    (ct, met'))
walther@59990
   228
		        | "#Relate"=> (Tactic.Add_Relation ct, Tactic.Add_Relation'(ct, met'))
walther@59990
   229
		        | sel => raise ERROR ("by_tactic_input' Met: uncovered case of" ^ sel)
walther@59990
   230
	          val (p, c, pt') =
walther@59990
   231
	            case Specify_Step.add tac_ (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Met)) of
walther@59990
   232
  	            ((p, Pos.Met), c, _, pt') => (p, c, pt')
walther@59990
   233
  		        | _ => raise ERROR "by_tactic_input': uncovered case generate1 (WARNING WHY ?)"
walther@59990
   234
	        in
walther@59990
   235
	          ([(tac, tac_, ((p, Pos.Met), (Istate_Def.Uistate, ctxt)))], c, (pt', (p, Pos.Met)))
walther@59990
   236
	        end
walther@59990
   237
      | I_Model.Err _ => ([(*tacis*)], [], ptp) (*nxt_me collects tacis until not hide; here just no progress*)
walther@59990
   238
    end
walther@59990
   239
  | by_tactic_input' _ _ (_, p) = raise ERROR ("by_tactic_input' not impl. for" ^ Pos.pos'2str p)
walther@59990
   240
walther@59990
   241
(* complete _NON_empty calc-head for autocalc (sub-)pbl from oris
walther@59990
   242
  + met from fmz; assumes pos on PblObj, meth = []                    *)
walther@59990
   243
fun finish_phase (pt, pos as (p, p_)) =
walther@59990
   244
  let
walther@59990
   245
    val _ = if p_ <> Pos.Pbl 
walther@59990
   246
	    then raise ERROR ("###finish_phase: only impl.for Pbl, called with " ^ Pos.pos'2str pos)
walther@59990
   247
	    else ()
walther@59990
   248
	  val (oris, ospec, probl, spec) = case Ctree.get_obj I pt p of
walther@59990
   249
	    Ctree.PblObj {origin = (oris, ospec, _), probl, spec, ...} => (oris, ospec, probl, spec)
walther@59990
   250
	  | _ => raise ERROR "finish_phase: unvered case get_obj"
walther@59990
   251
  	val (_, pI, mI) = References.select ospec spec
walther@59990
   252
  	val mpc = (#ppc o Method.from_store) mI
walther@59990
   253
  	val ppc = (#ppc o Problem.from_store) pI
walther@59990
   254
  	val (pits, mits) = I_Model.complete_method (oris, mpc, ppc, probl)
walther@59990
   255
    val pt = Ctree.update_pblppc pt p pits
walther@59990
   256
	  val pt = Ctree.update_metppc pt p mits
walther@59990
   257
  in (pt, (p, Pos.Met)) end
walther@59990
   258
walther@59990
   259
(* do all specification in one single step:
walther@59990
   260
   complete calc-head for autocalc (sub-)pbl from oris (+ met from fmz);
walther@59990
   261
   oris and spec (incl. pbl-refinement) given from init_calc or SubProblem
walther@59990
   262
*)
walther@59990
   263
fun do_all (pt, (p, _)) =
walther@59990
   264
  let
walther@59990
   265
    val (pors, dI, pI, mI) = case Ctree.get_obj I pt p of
walther@59990
   266
      Ctree.PblObj {origin = (pors, (dI, pI, mI), _), ...}
walther@59990
   267
        => (pors, dI, pI, mI)
walther@59990
   268
    | _ => raise ERROR "do_all: uncovered case get_obj"
walther@59990
   269
	  val {ppc, ...} = Method.from_store mI
walther@59990
   270
    val (_, vals) = O_Model.values' pors
walther@59990
   271
	  val ctxt = ContextC.initialise dI vals
walther@59990
   272
    val (pt, _) = Ctree.cupdate_problem pt p ((dI, pI, mI),
walther@59990
   273
      map (I_Model.complete' ppc) pors, map (I_Model.complete' ppc) pors, ctxt)
walther@59990
   274
  in
walther@59990
   275
    (pt, (p, Pos.Met))
walther@59990
   276
  end
walther@59990
   277
walther@59946
   278
(**)end(**)