src/Tools/isac/Specify/step-specify.sml
author Walther Neuper <walther.neuper@jku.at>
Sun, 14 Jun 2020 15:39:55 +0200
changeset 60021 d70d5b668794
parent 60020 2d962612dd0a
child 60111 2e996663e5a7
permissions -rw-r--r--
unify code (and replace Specify.by_tactic_input' by Specify.by_Add_)

test Specify/refine --- Refine_Problem (from subp-rooteq.sml) ---
revealed undetected failure of Specify.find_next_step
walther@59747
     1
(* Title:  Specify/step-specify.sml
walther@59747
     2
   Author: Walther Neuper 2019
walther@59747
     3
   (c) due to copyright terms
walther@59747
     4
*)
walther@59747
     5
walther@59747
     6
signature STEP_SPECIFY =
walther@59747
     7
sig
walther@59791
     8
(*val do_next: Step.specify_do_next requires LI.by_tactic, which is not yet known in Step_Specify*)
walther@60020
     9
  val by_tactic_input: Tactic.input -> Calc.T -> string * Calc.state_post
walther@59981
    10
  val by_tactic: Tactic.T -> Calc.T -> string * Calc.state_post
walther@59975
    11
walther@59810
    12
(* ---- keep, probably required later in devel. ----------------------------------------------- *)
walther@59946
    13
  val nxt_specify_init_calc: Formalise.T -> Calc.T * State_Steps.T
walther@59886
    14
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
walther@60020
    15
  (*NONE*)
walther@59886
    16
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
walther@59747
    17
walther@59747
    18
end
walther@59747
    19
walther@59747
    20
(**)
walther@59747
    21
structure Step_Specify(**): STEP_SPECIFY(**) =
walther@59747
    22
struct
walther@59747
    23
(**)
walther@59763
    24
open Pos
walther@59763
    25
open Ctree
walther@59977
    26
open Specification
walther@59747
    27
walther@59806
    28
fun by_tactic_input (tac as Tactic.Model_Problem) (pt, pos as (p, _)) =
walther@59763
    29
    let
walther@59763
    30
      val (oris, ospec, probl, spec, ctxt) = case get_obj I pt p of
walther@59763
    31
        PblObj {origin = (oris, ospec, _), probl, spec, ctxt, ...} => (oris, ospec, probl, spec, ctxt)
walther@59962
    32
      | _ => raise ERROR "by_tactic_input Model_Problem; uncovered case get_obj"
walther@59995
    33
      val (_, pI, mI) = References.select ospec spec
walther@59988
    34
      val mpc = (#ppc o Method.from_store) mI (* just for reuse I_Model.complete_method *)
walther@59970
    35
      val {cas, ppc, ...} = Problem.from_store pI
walther@59958
    36
      val pbl = I_Model.init ppc (* fill in descriptions *)
walther@59763
    37
      (*----------------if you think, this should be done by the Dialog 
walther@59763
    38
       in the java front-end, search there for WN060225-modelProblem----*)
walther@59763
    39
      val (pbl, met) = case cas of
walther@59763
    40
        NONE => (pbl, [])
walther@59988
    41
  		| _ => I_Model.complete_method (oris, mpc, ppc, probl)
walther@59763
    42
      (*----------------------------------------------------------------*)
walther@59763
    43
      val tac_ = Tactic.Model_Problem' (pI, pbl, met)
walther@59933
    44
      val (pos,c,_,pt) = Specify_Step.add tac_ (Istate_Def.Uistate, ctxt) (pt, pos)
walther@60020
    45
    in
walther@60020
    46
      ("ok",([(tac, tac_, (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt,pos)))
walther@60020
    47
    end
walther@60021
    48
  | by_tactic_input (Tactic.Add_Given ct) ptp = Specify.by_Add_ "#Given" ct ptp
walther@60021
    49
  | by_tactic_input (Tactic.Add_Find  ct) ptp = Specify.by_Add_ "#Find"  ct ptp
walther@60021
    50
  | by_tactic_input (Tactic.Add_Relation ct) ptp = Specify.by_Add_"#Relate" ct ptp
walther@60021
    51
walther@60020
    52
    (* called with Method.id_empty *)     
walther@59810
    53
  | by_tactic_input (Tactic.Refine_Tacitly pI) (ptp as (pt, pos as (p, _))) =
walther@59763
    54
    let 
walther@59763
    55
      val (oris, dI, ctxt) = case get_obj I pt p of
walther@59763
    56
        (PblObj {origin = (oris, (dI, _, _), _), ctxt, ...}) => (oris, dI, ctxt)
walther@59962
    57
      | _ => raise ERROR "by_tactic_input Refine_Tacitly: uncovered case get_obj"
walther@59968
    58
      val opt = Refine.refine_ori oris pI
walther@59763
    59
    in 
walther@59763
    60
      case opt of
walther@59763
    61
	      SOME pI' => 
walther@59763
    62
	        let 
walther@59970
    63
            val {met, ...} = Problem.from_store pI'
walther@59763
    64
	          (*val pt = update_pbl pt p pbl ..done by Model_Problem*)
walther@59903
    65
	          val mI = if length met = 0 then Method.id_empty else hd met
walther@59763
    66
	          val (pos, c, _, pt) = 
walther@59933
    67
		          Specify_Step.add (Tactic.Refine_Tacitly' (pI, pI', dI, mI,(*pbl*)[])) (Istate_Def.Uistate, ctxt) (pt, pos)
walther@59763
    68
	        in
walther@60020
    69
	          ("ok", ([(Tactic.Refine_Tacitly pI, Tactic.Refine_Tacitly' (pI,pI',dI,mI,(*pbl*)[]),
walther@60020
    70
	              (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt,pos)))
walther@59763
    71
          end
walther@60021
    72
	    | NONE => ("failure", ([], [], ptp))
walther@59763
    73
    end
walther@59806
    74
  | by_tactic_input (Tactic.Refine_Problem pI) (ptp as (pt, pos as (p,_))) =
walther@59763
    75
    let
walther@59763
    76
      val (dI, dI', probl, ctxt) = case get_obj I pt p of
walther@59763
    77
        PblObj {origin= (_, (dI, _, _), _), spec = (dI', _, _), probl, ctxt, ...} =>
walther@59763
    78
          (dI, dI', probl, ctxt)
walther@59962
    79
      | _ => raise ERROR "by_tactic_input Refine_Problem: uncovered case get_obj"
walther@59879
    80
	    val thy = if dI' = ThyC.id_empty then dI else dI'
walther@59763
    81
    in 
walther@59960
    82
      case Refine.problem (ThyC.get_theory thy) pI probl of
walther@60021
    83
	      NONE => ("failure", ([], [], ptp))
walther@59763
    84
	    | SOME rfd => 
walther@59763
    85
	      let 
walther@59933
    86
          val (pos,c,_,pt) = Specify_Step.add (Tactic.Refine_Problem' rfd) (Istate_Def.Uistate, ctxt) (pt, pos)
walther@59763
    87
	      in
walther@60020
    88
	        ("ok", ([(Tactic.Refine_Problem pI, Tactic.Refine_Problem' rfd,
walther@60020
    89
            (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt,pos)))
walther@59763
    90
        end
walther@59763
    91
    end
walther@60020
    92
  | by_tactic_input (Tactic.Specify_Problem pI) (pt, pos as (p, _)) =
walther@59763
    93
    let
walther@59763
    94
      val (oris, dI, dI', pI', probl, ctxt) = case get_obj I pt p of
walther@59763
    95
        PblObj {origin = (oris, (dI,_,_),_), spec = (dI',pI',_), probl, ctxt, ...} =>
walther@59763
    96
          (oris, dI, dI', pI', probl, ctxt)
walther@59962
    97
      | _ => raise ERROR ""
walther@59881
    98
	    val thy = ThyC.get_theory (if dI' = ThyC.id_empty then dI else dI');
walther@59970
    99
      val {ppc,where_,prls,...} = Problem.from_store pI
walther@59763
   100
	    val pbl = 
walther@59903
   101
	      if pI' = Problem.id_empty andalso pI = Problem.id_empty
walther@59958
   102
	      then (false, (I_Model.init ppc, []))
walther@59984
   103
	      else M_Match.match_itms_oris thy probl (ppc,where_,prls) oris
walther@59763
   104
	      (*FIXXXME~~~~~~~~~~~~~~~: take pbl and compare with new pI WN.8.03*)
walther@59810
   105
	    val (c, pt) =
walther@59933
   106
	      case Specify_Step.add (Tactic.Specify_Problem' (pI, pbl)) (Istate_Def.Uistate, ctxt) (pt, pos) of
walther@59810
   107
  	      ((_, Pbl), c, _, pt) => (c, pt)
walther@59962
   108
  	    | _ => raise ERROR ""
walther@59763
   109
    in
walther@60020
   110
      ("ok", ([(Tactic.Specify_Problem pI, Tactic.Specify_Problem' (pI, pbl),
walther@60020
   111
        (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt, pos)))
walther@59763
   112
    end
walther@60014
   113
  | by_tactic_input (Tactic.Specify_Method id) (pt, pos) =
walther@59763
   114
    let
walther@60014
   115
      val (o_model, ctxt, i_model) = Specify_Step.complete_for id (pt, pos)
walther@60014
   116
      val (pos, _, _, pt) = Specify_Step.add (Tactic.Specify_Method' (id, o_model, i_model))
walther@60014
   117
        (Istate_Def.Uistate, ctxt) (pt, pos)
walther@60011
   118
    in
walther@60020
   119
      ("ok", ([(Tactic.Specify_Method id, Tactic.Specify_Method' (id, o_model, i_model),
walther@60020
   120
        (pos, (Istate_Def.Uistate, ContextC.empty)))], [], (pt, pos)))
walther@59763
   121
    end    
walther@59806
   122
  | by_tactic_input (Tactic.Specify_Theory dI) (pt, pos as (_, Pbl)) =
walther@59763
   123
    let
walther@59763
   124
      val ctxt = get_ctxt pt pos
walther@60014
   125
	    val (pos, c, _, pt) =            
walther@59933
   126
	      Specify_Step.add (Tactic.Specify_Theory' dI)  (Istate_Def.Uistate, ctxt) (pt, pos)
walther@59763
   127
    in (*FIXXXME: check if pbl can still be parsed*)
walther@60020
   128
	    ("ok", ([(Tactic.Specify_Theory dI, Tactic.Specify_Theory' dI,
walther@60020
   129
        (pos, (Istate_Def.Uistate, ctxt)))], c, (pt, pos)))
walther@59763
   130
    end
walther@59806
   131
  | by_tactic_input (Tactic.Specify_Theory dI) (pt, pos as (_, Met)) =
walther@59763
   132
    let
walther@59763
   133
      val ctxt = get_ctxt pt pos
walther@59933
   134
	    val (pos, c, _, pt) = Specify_Step.add (Tactic.Specify_Theory' dI) (Istate_Def.Uistate, ctxt) (pt, pos)
walther@59763
   135
    in  (*FIXXXME: check if met can still be parsed*)
walther@60020
   136
	    ("ok", ([(Tactic.Specify_Theory dI, Tactic.Specify_Theory' dI,
walther@60020
   137
        (pos, (Istate_Def.Uistate, ctxt)))], c, (pt, pos)))
walther@59763
   138
    end
walther@59962
   139
  | by_tactic_input m' _ = raise ERROR ("by_tactic_input: not impl. for " ^ Tactic.input_to_string m')
walther@60020
   140
(**)
walther@60020
   141
walther@59806
   142
walther@60015
   143
fun by_tactic (Tactic.Model_Problem' (id, pbl, met)) (pt, pos)  =
walther@59806
   144
    let 
walther@60015
   145
      val ((p, _), _, _, pt) = Specify_Step.add (Tactic.Model_Problem'(id, pbl, met))
walther@60015
   146
        (Istate_Def.Uistate, ContextC.empty) (pt, pos)
walther@60015
   147
(* deprecated^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *)
walther@59806
   148
    in
walther@59806
   149
      ("ok", ([], [], (pt, (p, Pbl))))
walther@59806
   150
    end
walther@59806
   151
    (* called only if no_met is specified *)     
walther@59806
   152
  | by_tactic (Tactic.Refine_Tacitly' (pI, pIre, _, _, _)) (pt, pos) =
walther@59806
   153
      let
walther@59970
   154
        val {met, thy,...} = Problem.from_store pIre
walther@59903
   155
        val (domID, metID) = (Context.theory_name thy, if length met = 0 then Method.id_empty else hd met)
walther@59806
   156
        val ((p,_), _, _, pt) = 
walther@59933
   157
	        Specify_Step.add (Tactic.Refine_Tacitly' (pI, pIre, domID, metID, [(*pbl*)]))
walther@59846
   158
            (Istate_Def.Uistate, ContextC.empty) (pt, pos)
walther@59806
   159
(* deprecated^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *)
walther@59806
   160
      in 
walther@59806
   161
        ("ok", ([], [], (pt,(p, Pbl))))
walther@59806
   162
      end
walther@60021
   163
  | by_tactic (Tactic.Refine_Problem' (rfd as (id, _))) (pt, pos)  =
walther@59806
   164
      let
walther@59806
   165
        val ctxt = get_ctxt pt pos
walther@59806
   166
        val (pos, _, _, pt) =
walther@59933
   167
          Specify_Step.add (Tactic.Refine_Problem' rfd) (Istate_Def.Uistate, ctxt) (pt, pos)
walther@59806
   168
      in
walther@60021
   169
        ("ok", ([(Tactic.Refine_Problem id, Tactic.Refine_Problem' rfd,
walther@60021
   170
            (pos, (Istate_Def.Uistate,ctxt)))], [], (pt, pos)))
walther@59806
   171
      end
walther@59810
   172
  | by_tactic (Tactic.Specify_Problem' (pI, (ok, (itms, pre)))) (pt, pos as (p, _)) =
walther@59806
   173
      let
walther@59995
   174
        val (_, _, _, _, _, _, ctxt, _) = case get_obj I pt p of
walther@59806
   175
          PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, _, mI), ctxt, meth = met, ...} =>
walther@59806
   176
            (oris, dI', pI', mI', dI, mI, ctxt, met)
walther@59962
   177
        | _ => raise ERROR "Step_Solve.by_tactic (Specify_Problem': uncovered case get_obj"
walther@59806
   178
        val (p, pt) =
walther@59933
   179
          case  Specify_Step.add (Tactic.Specify_Problem' (pI, (ok, (itms, pre)))) (Istate_Def.Uistate, ctxt) (pt, pos) of
walther@59806
   180
            ((p, Pbl), _, _, pt) => (p, pt)
walther@59962
   181
          | _ => raise ERROR "Step_Solve.by_tactic (Specify_Problem': uncovered case generate1 (WARNING WHY ?)"
walther@59806
   182
      in
walther@59806
   183
        ("ok", ([], [], (pt, (p, Pbl))))
walther@59806
   184
      end    
walther@60014
   185
  | by_tactic (Tactic.Specify_Method' (id, _, _)) (pt, pos) =
walther@59806
   186
      let
walther@60014
   187
        val (o_model, ctxt, i_model) = Specify_Step.complete_for id (pt, pos)
walther@60014
   188
        val (pos, _, _, pt) = Specify_Step.add (Tactic.Specify_Method' (id, o_model, i_model))
walther@60014
   189
          (Istate_Def.Uistate, ctxt) (pt, pos)
walther@60011
   190
      in
walther@59806
   191
        ("ok", ([], [], (pt, pos)))
walther@60014
   192
      end
walther@60016
   193
  | by_tactic (Tactic.Add_Given' (ct, _)) (pt, p)  = Specify.by_Add_ "#Given" ct (pt, p)
walther@60016
   194
  | by_tactic (Tactic.Add_Find'  (ct, _)) (pt, p) = Specify.by_Add_ "#Find" ct (pt, p)
walther@60016
   195
  | by_tactic (Tactic.Add_Relation' (ct, _)) (pt, p) = Specify.by_Add_"#Relate" ct (pt, p)
walther@60020
   196
    (*strange old code, redes*)
walther@60015
   197
  | by_tactic (Tactic.Specify_Theory' domID) (pt, (p, p_)) =
walther@59806
   198
      let
walther@59806
   199
        val p_ = case p_ of Met => Met | _ => Pbl
walther@60015
   200
        val {spec = (dI, _, _), ctxt, ...} = Calc.specify_data (pt, (p, p_))
walther@59806
   201
      in
walther@60015
   202
        if domID = dI then
walther@60015
   203
          ("ok", ([], [], (pt, (p, p_))))
walther@59806
   204
        else (*FIXME: check ppc wrt. (new!) domID ..? still parsable?*)
walther@59806
   205
	        let 
walther@60015
   206
	          val ((p, p_), _, _, pt) = Specify_Step.add (Tactic.Specify_Theory' domID)
walther@60015
   207
	            (Istate_Def.Uistate, ctxt) (pt, (p, p_))
walther@59806
   208
	        in
walther@59806
   209
            ("ok", ([], [], (pt, (p, p_))))
walther@59990
   210
          end                
walther@59806
   211
      end
walther@59806
   212
  | by_tactic _ _ = raise ERROR "Step_Specify.by_tactic uncovered pattern in fun.def"
walther@59806
   213
walther@59806
   214
(* create a calc-tree with oris via an cas.refined pbl *)
walther@59806
   215
fun nxt_specify_init_calc ([], (dI, pI, mI)) =
walther@59806
   216
    if pI <> [] 
walther@59806
   217
    then (* from pbl-browser or from CAS cmd with pI=[e_pblID] *)
walther@59806
   218
	    let 
walther@59970
   219
        val {cas, met, ppc, thy, ...} = Problem.from_store pI
walther@59880
   220
	      val dI = if dI = "" then Context.theory_name thy else dI
walther@59806
   221
	      val mI = if mI = [] then hd met else mI
walther@59806
   222
	      val hdl = case cas of NONE => Auto_Prog.pblterm dI pI | SOME t => t
walther@59952
   223
	      val (pt, _) = cappend_problem e_ctree [] (Istate_Def.Uistate, ContextC.empty) ([], (dI, pI, mI))
walther@59846
   224
				  ([], (dI,pI,mI), hdl, ContextC.empty)
walther@59806
   225
	      val pt = update_spec pt [] (dI, pI, mI)
walther@59958
   226
	      val pits = I_Model.init ppc
walther@59806
   227
	      val pt = update_pbl pt [] pits
walther@59806
   228
	    in ((pt, ([] , Pbl)), []) end
walther@59806
   229
    else 
walther@59806
   230
      if mI <> [] 
walther@59806
   231
      then (* from met-browser *)
walther@59806
   232
	      let 
walther@59970
   233
          val {ppc, ...} = Method.from_store mI
walther@59806
   234
	        val dI = if dI = "" then "Isac_Knowledge" else dI
walther@59846
   235
	        val (pt, _) = cappend_problem e_ctree [] (Istate_Def.empty, ContextC.empty)
walther@59861
   236
	          ([], (dI, pI, mI)) ([], (dI, pI, mI), TermC.empty, ContextC.empty)
walther@59806
   237
	        val pt = update_spec pt [] (dI, pI, mI)
walther@59958
   238
	        val mits = I_Model.init ppc
walther@59806
   239
	        val pt = update_met pt [] mits
walther@59806
   240
	      in ((pt, ([], Met)), []) end
walther@59806
   241
      else (* new example, pepare for interactive modeling *)
walther@59806
   242
	      let
walther@59846
   243
	        val (pt, _) = cappend_problem e_ctree [] (Istate_Def.empty, ContextC.empty) 
walther@59976
   244
	          ([], References.empty) ([], References.empty, TermC.empty, ContextC.empty)
walther@59806
   245
	      in ((pt, ([], Pbl)), []) end
walther@59806
   246
  | nxt_specify_init_calc (fmz, (dI, pI, mI)) = 
walther@59806
   247
    let           (* both """"""""""""""""""""""""" either empty or complete *)
walther@59881
   248
	    val thy = ThyC.get_theory dI
walther@59806
   249
	    val (pI, (pors, pctxt), mI) = 
walther@59806
   250
	      if mI = ["no_met"] 
walther@59806
   251
	      then 
walther@59806
   252
          let 
walther@59970
   253
            val (pors(*, pctxt*)) = Problem.from_store pI |> #ppc |> O_Model.init fmz thy;
walther@59952
   254
            val pctxt = ContextC.initialise' thy fmz;
walther@59968
   255
		        val pI' = Refine.refine_ori' pors pI;
walther@59806
   256
		      in (pI', (pors(*refinement over models with diff.precond only*), pctxt),
walther@59970
   257
		        (hd o #met o Problem.from_store) pI')
walther@59806
   258
		      end
walther@59952
   259
	      else
walther@59952
   260
	        let
walther@59970
   261
	          val pors = Problem.from_store pI |> #ppc |> O_Model.init fmz thy;
walther@59952
   262
            val pctxt = ContextC.initialise' thy fmz;
walther@59952
   263
	        in (pI, (pors, pctxt), mI) end;
walther@59970
   264
	    val {cas, ppc, thy = thy', ...} = Problem.from_store pI (*take dI from _refined_ pbl*)
walther@59965
   265
	    val dI = Context.theory_name (ThyC.sub_common (thy, thy'))
walther@59806
   266
	    val hdl = case cas of
walther@59806
   267
		    NONE => Auto_Prog.pblterm dI pI
walther@59987
   268
		  | SOME t => subst_atomic ((Model_Pattern.variables ppc) ~~~ O_Model.values pors) t
walther@59846
   269
      val (pt, _) = cappend_problem e_ctree [] (Istate_Def.empty, pctxt)
walther@59819
   270
        (fmz, (dI, pI, mI)) (pors, (dI, pI, mI), hdl, pctxt)
walther@59806
   271
    in
walther@60020
   272
      ((pt, ([], Pbl)), (fst3 o snd) (by_tactic_input Tactic.Model_Problem (pt, ([], Pbl))))
walther@59806
   273
    end
walther@59763
   274
walther@59763
   275
(**)end(**)