src/Tools/isac/Interpret/solve.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Thu, 15 Mar 2018 10:17:44 +0100
changeset 59405 49d7d410b83c
parent 59310 14333576fb70
child 59411 3e241a6938ce
permissions -rw-r--r--
separate structure Celem: CALC_ELEMENT, all but Knowledge/
neuper@41968
     1
(* Title:  solve an example by interpreting a method's script
neuper@41968
     2
   Author: Walther Neuper 1999
neuper@41968
     3
   (c) copyright due to lincense terms.
neuper@37906
     4
*)
neuper@37906
     5
wneuper@59286
     6
signature SOLVE =
wneuper@59286
     7
sig
wneuper@59286
     8
  datatype auto = CompleteCalc | CompleteCalcHead | CompleteModel | CompleteSubpbl 
wneuper@59286
     9
  | CompleteToSubpbl | Step of int
wneuper@59286
    10
  val autoord : auto -> int
wneuper@59286
    11
  type tac'_
wneuper@59302
    12
  val mk_tac'_ : Tac.tac -> string * Tac.tac
wneuper@59286
    13
  val specsteps : string list
wneuper@59286
    14
wneuper@59286
    15
  val nxt_solve_ : Ctree.ctree * Ctree.pos' ->
wneuper@59302
    16
    (Tac.tac * Tac.tac_ * (Ctree.pos' * (Selem.istate * Proof.context))) list *
wneuper@59286
    17
      Ctree.pos' list * Ctree.state
wneuper@59286
    18
  val all_solve : auto -> Ctree.pos' list -> Ctree.state ->
wneuper@59286
    19
    string * Ctree.pos' list * (Ctree.ctree * (int list * Ctree.pos_))
wneuper@59286
    20
  val complete_solve :
wneuper@59286
    21
     auto -> Ctree.pos' list -> Ctree.state -> string * Ctree.pos' list * Ctree.state
wneuper@59302
    22
  val nxt_solv : Tac.tac_ -> Selem.istate * Proof.context -> Ctree.state -> Chead.calcstate'
wneuper@59302
    23
  val solve : string * Tac.tac_ -> Ctree.state -> string * Chead.calcstate'
wneuper@59286
    24
wneuper@59286
    25
  val detailrls : Ctree.ctree -> Ctree.pos' -> string * Ctree.ctree * Ctree.pos'
wneuper@59310
    26
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
wneuper@59286
    27
  val get_form : tac'_ -> Ctree.pos' -> Ctree.ctree -> Generate.mout
wneuper@59299
    28
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
wneuper@59286
    29
  (* NONE *)
wneuper@59299
    30
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
wneuper@59310
    31
wneuper@59310
    32
(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
wneuper@59310
    33
  (* NONE *)
wneuper@59286
    34
end
wneuper@59286
    35
wneuper@59286
    36
(**)
wneuper@59286
    37
structure Solve(**): SOLVE(**) =
wneuper@59273
    38
struct
wneuper@59286
    39
(**)
wneuper@59276
    40
open Ctree;
wneuper@59273
    41
neuper@37906
    42
type mstID = string;
wneuper@59302
    43
type tac'_ = mstID * Tac.tac; (*DG <-> ME*)
neuper@37906
    44
wneuper@59286
    45
fun mk_tac'_   m = case m of (* scr not cleaned -- will disappear eventually *)
wneuper@59302
    46
  Tac.Init_Proof (ppc, spec)    => ("Init_Proof", Tac.Init_Proof (ppc, spec )) 
wneuper@59302
    47
| Tac.Model_Problem             => ("Model_Problem", Tac.Model_Problem)
wneuper@59302
    48
| Tac.Refine_Tacitly pblID      => ("Refine_Tacitly", Tac.Refine_Tacitly pblID)
wneuper@59302
    49
| Tac.Refine_Problem pblID      => ("Refine_Problem", Tac.Refine_Problem pblID)
wneuper@59302
    50
| Tac.Add_Given cterm'          => ("Add_Given", Tac.Add_Given cterm') 
wneuper@59302
    51
| Tac.Del_Given cterm'          => ("Del_Given", Tac.Del_Given cterm') 
wneuper@59302
    52
| Tac.Add_Find cterm'           => ("Add_Find", Tac.Add_Find cterm') 
wneuper@59302
    53
| Tac.Del_Find cterm'           => ("Del_Find", Tac.Del_Find cterm') 
wneuper@59302
    54
| Tac.Add_Relation cterm'       => ("Add_Relation", Tac.Add_Relation cterm') 
wneuper@59302
    55
| Tac.Del_Relation cterm'       => ("Del_Relation", Tac.Del_Relation cterm') 
neuper@37906
    56
wneuper@59302
    57
| Tac.Specify_Theory domID	    => ("Specify_Theory", Tac.Specify_Theory domID) 
wneuper@59302
    58
| Tac.Specify_Problem pblID     => ("Specify_Problem", Tac.Specify_Problem pblID)
wneuper@59302
    59
| Tac.Specify_Method metID	    => ("Specify_Method", Tac.Specify_Method metID) 
wneuper@59302
    60
| Tac.Apply_Method metID	    => ("Apply_Method", Tac.Apply_Method metID) 
wneuper@59302
    61
| Tac.Check_Postcond pblID	    => ("Check_Postcond", Tac.Check_Postcond pblID)
wneuper@59302
    62
| Tac.Free_Solve                => ("Free_Solve", Tac.Free_Solve)
neuper@37906
    63
		    
wneuper@59302
    64
| Tac.Rewrite_Inst (subs, thm') => ("Rewrite_Inst", Tac.Rewrite_Inst (subs, thm')) 
wneuper@59302
    65
| Tac.Rewrite thm'		    => ("Rewrite", Tac.Rewrite thm') 
wneuper@59302
    66
| Tac.Rewrite_Asm thm'	    => ("Rewrite_Asm", Tac.Rewrite_Asm thm') 
wneuper@59302
    67
| Tac.Rewrite_Set_Inst (subs, rls')
wneuper@59302
    68
               => ("Rewrite_Set_Inst", Tac.Rewrite_Set_Inst (subs, rls')) 
wneuper@59302
    69
| Tac.Rewrite_Set rls'          => ("Rewrite_Set", Tac.Rewrite_Set rls') 
wneuper@59302
    70
| Tac.End_Ruleset		    => ("End_Ruleset", Tac.End_Ruleset)
neuper@37906
    71
wneuper@59302
    72
| Tac.End_Detail                => ("End_Detail", Tac.End_Detail)
wneuper@59302
    73
| Tac.Detail_Set rls'           => ("Detail_Set", Tac.Detail_Set rls')
wneuper@59302
    74
| Tac.Detail_Set_Inst (s, rls') => ("Detail_Set_Inst", Tac.Detail_Set_Inst (s, rls'))
neuper@37906
    75
wneuper@59302
    76
| Tac.Calculate op_             => ("Calculate", Tac.Calculate op_)
wneuper@59302
    77
| Tac.Substitute sube           => ("Substitute", Tac.Substitute sube) 
wneuper@59302
    78
| Tac.Apply_Assumption cts'	    => ("Apply_Assumption", Tac.Apply_Assumption cts')
neuper@37906
    79
wneuper@59302
    80
| Tac.Take cterm'               => ("Take", Tac.Take cterm') 
wneuper@59302
    81
| Tac.Take_Inst cterm'          => ("Take_Inst", Tac.Take_Inst cterm') 
wneuper@59302
    82
| Tac.Subproblem (domID, pblID) => ("Subproblem", Tac.Subproblem (domID, pblID)) 
neuper@37906
    83
(*
wneuper@59304
    84
| Tac.Subproblem_Full(spec,cts')=> ("Subproblem_Full", Tac.Subproblem_Full(spec,cts')) 
neuper@37906
    85
*)
wneuper@59302
    86
| Tac.End_Subproblem            => ("End_Subproblem", Tac.End_Subproblem)
wneuper@59302
    87
| Tac.CAScmd cterm'		    => ("CAScmd", Tac.CAScmd cterm')
neuper@37906
    88
			    
wneuper@59302
    89
| Tac.Split_And                 => ("Split_And", Tac.Split_And) 
wneuper@59302
    90
| Tac.Conclude_And		    => ("Conclude_And", Tac.Conclude_And) 
wneuper@59302
    91
| Tac.Split_Or                  => ("Split_Or", Tac.Split_Or) 
wneuper@59302
    92
| Tac.Conclude_Or		    => ("Conclude_Or", Tac.Conclude_Or) 
wneuper@59302
    93
| Tac.Begin_Trans               => ("Begin_Trans", Tac.Begin_Trans) 
wneuper@59302
    94
| Tac.End_Trans		    => ("End_Trans", Tac.End_Trans) 
wneuper@59302
    95
| Tac.Begin_Sequ                => ("Begin_Sequ", Tac.Begin_Sequ) 
wneuper@59302
    96
| Tac.End_Sequ                  => ("End_Sequ", Tac.Begin_Sequ) 
wneuper@59302
    97
| Tac.Split_Intersect           => ("Split_Intersect", Tac.Split_Intersect) 
wneuper@59302
    98
| Tac.End_Intersect		    => ("End_Intersect", Tac.End_Intersect) 
wneuper@59302
    99
| Tac.Check_elementwise cterm'  => ("Check_elementwise", Tac.Check_elementwise cterm')
wneuper@59302
   100
| Tac.Or_to_List                => ("Or_to_List", Tac.Or_to_List) 
wneuper@59302
   101
| Tac.Collect_Trues	            => ("Collect_Results", Tac.Collect_Trues) 
neuper@37906
   102
			    
wneuper@59302
   103
| Tac.Empty_Tac               => ("Empty_Tac", Tac.Empty_Tac)
wneuper@59302
   104
| Tac.Tac string              => ("Tac", Tac.Tac string)
wneuper@59302
   105
| Tac.End_Proof'                => ("End_Proof'", Tac.End_Proof')
wneuper@59286
   106
| _ => error "mk_tac'_: uncovered case"; 
neuper@37906
   107
wneuper@59279
   108
type squ = ctree; (* TODO: safe etc. *)
neuper@37906
   109
wneuper@59286
   110
val specsteps = ["Init_Proof", "Refine_Tacitly", "Refine_Problem", "Model_Problem",
wneuper@59286
   111
  "Add_Given", "Del_Given", "Add_Find", "Del_Find", "Add_Relation", "Del_Relation",
wneuper@59286
   112
  "Specify_Theory", "Specify_Problem", "Specify_Method"];
neuper@37906
   113
wneuper@59257
   114
fun step2taci ((tac_, _, pt, p, _) : Lucin.step) = (*FIXXME.040312: redesign step*)
wneuper@59276
   115
    (Lucin.tac_2tac tac_, tac_, (p, Ctree.get_loc pt p)): Generate.taci;
neuper@37906
   116
wneuper@59286
   117
(*FIXME.WN050821 compare solve ... nxt_solv*)
wneuper@59302
   118
fun solve ("Apply_Method", m as Tac.Apply_Method' (mI, _, _, _)) (pt, (pos as (p, _))) =
wneuper@59286
   119
    let val {srls, ...} = Specify.get_met mI;
wneuper@59286
   120
      val itms = case get_obj I pt p of
wneuper@59286
   121
        PblObj {meth=itms, ...} => itms
wneuper@59286
   122
      | _ => error "solve Apply_Method: uncovered case get_obj"
wneuper@59286
   123
      val thy' = get_obj g_domID pt p;
wneuper@59405
   124
      val thy = Celem.assoc_thy thy';
wneuper@59286
   125
      val (is, env, ctxt, sc) = case Lucin.init_scrstate thy itms mI of
wneuper@59300
   126
        (is as Selem.ScrState (env,_,_,_,_,_), ctxt, sc) =>  (is, env, ctxt, sc)
wneuper@59286
   127
      | _ => error "solve Apply_Method: uncovered case init_scrstate"
wneuper@59286
   128
      val ini = Lucin.init_form thy sc env;
wneuper@59286
   129
      val p = lev_dn p;
wneuper@59286
   130
    in 
wneuper@59286
   131
      case ini of
wneuper@59286
   132
	      SOME t =>
wneuper@59286
   133
          let val (pos,c,_, pt) = 
wneuper@59302
   134
		        Generate.generate1 thy (Tac.Apply_Method' (mI, SOME t, is, ctxt))
wneuper@59286
   135
		        (is, ctxt) (lev_on p, Frm)(*implicit Take*) pt;
wneuper@59302
   136
	        in ("ok",([(Tac.Apply_Method mI, Tac.Apply_Method' (mI, SOME t, is, ctxt), 
wneuper@59286
   137
		        ((lev_on p, Frm), (is, ctxt)))], c, (pt, pos))) 
wneuper@59286
   138
	        end	      
wneuper@59286
   139
	    | NONE => (*execute the first tac in the Script, compare solve m*)
wneuper@59286
   140
	        let
wneuper@59286
   141
            val (m', (is', ctxt'), _) = Lucin.next_tac (thy', srls) (pt, (p, Res)) sc (is, ctxt);
wneuper@59405
   142
	          val d = Celem.e_rls (*FIXME: get simplifier from domID*);
wneuper@59286
   143
	        in 
wneuper@59286
   144
	          case Lucin.locate_gen (thy',srls) m' (pt,(p, Res)) (sc,d) (is', ctxt') of 
wneuper@59286
   145
		          Lucin.Steps (_, ss as (_, _, pt', p', c') :: _) =>
wneuper@59286
   146
		            ("ok", (map step2taci ss, c', (pt', p')))
wneuper@59286
   147
		        | _ => (* NotLocatable *)
wneuper@59405
   148
		            let val (p, ps, _, pt) = Generate.generate_hard (Celem.assoc_thy "Isac") m (p, Frm) pt;
wneuper@59286
   149
		            in 
wneuper@59286
   150
		              ("not-found-in-script",([(Lucin.tac_2tac m, m, (pos, (is, ctxt)))], ps, (pt, p))) 
wneuper@59286
   151
		            end
wneuper@59286
   152
	        end
wneuper@59286
   153
    end
wneuper@59304
   154
  | solve ("Free_Solve", Tac.Free_Solve')  (pt, po as (p, _)) =
wneuper@59286
   155
    let
wneuper@59286
   156
      val p' = lev_dn_ (p, Res);
wneuper@59405
   157
      val pt = update_metID pt (par_pblobj pt p) Celem.e_metID;
wneuper@59286
   158
    in
wneuper@59302
   159
      ("ok", ([(Tac.Empty_Tac, Tac.Empty_Tac_, (po, (Selem.Uistate, Selem.e_ctxt)))], [], (pt,p')))
wneuper@59286
   160
    end
wneuper@59302
   161
  | solve ("Check_Postcond", Tac.Check_Postcond' (pI, _)) (pt, (p, p_)) =
wneuper@59286
   162
    let
wneuper@59286
   163
      val pp = par_pblobj pt p
wneuper@59286
   164
      val asm = 
wneuper@59286
   165
        (case get_obj g_tac pt p of
wneuper@59302
   166
		       Tac.Check_elementwise _ => (*collects and instantiates asms*)
wneuper@59286
   167
		         (snd o (get_obj g_result pt)) p
wneuper@59286
   168
		     | _ => get_assumptions_ pt (p,p_))
wneuper@59286
   169
	      handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*)
wneuper@59286
   170
      val metID = get_obj g_metID pt pp;
wneuper@59286
   171
      val {srls = srls, scr = sc, ...} = Specify.get_met metID;
wneuper@59286
   172
      val (loc, E, l, a, b, ctxt) = case get_loc pt (p, p_) of
wneuper@59300
   173
        loc as (Selem.ScrState (E, l, a, _, _, b), ctxt) => (loc, E, l, a, b, ctxt)
wneuper@59286
   174
      | _ => error "solve Check_Postcond: uncovered case get_loc"
wneuper@59286
   175
      val thy' = get_obj g_domID pt pp;
wneuper@59405
   176
      val thy = Celem.assoc_thy thy';
wneuper@59286
   177
      val (_, _, (scval, scsaf)) = Lucin.next_tac (thy', srls) (pt, (p, p_)) sc loc;
wneuper@59286
   178
    in 
wneuper@59286
   179
      if pp = [] 
wneuper@59286
   180
      then
wneuper@59286
   181
	      let 
wneuper@59300
   182
          val is = Selem.ScrState (E,l,a,scval,scsaf,b)
wneuper@59302
   183
	        val tac_ = Tac.Check_Postcond' (pI, (scval, asm))
wneuper@59286
   184
	        val (pos, ps, _, pt) = Generate.generate1 thy tac_ (is, ctxt) (pp, Res) pt;
wneuper@59302
   185
	      in ("ok", ([(Tac.Check_Postcond pI, tac_, ((pp, Res), (is, ctxt)))], ps, (pt, pos))) end
wneuper@59286
   186
      else
wneuper@59286
   187
        let (*resume script of parpbl, transfer value of subpbl-script*)
wneuper@59286
   188
          val ppp = par_pblobj pt (lev_up p);
wneuper@59286
   189
	        val thy' = get_obj g_domID pt ppp;
wneuper@59405
   190
          val thy = Celem.assoc_thy thy';
wneuper@59286
   191
          val (E, l, a, b, ctxt') = case get_loc pt (pp, Frm) of
wneuper@59300
   192
            (Selem.ScrState (E, l, a, _, _, b), ctxt') => (E, l, a, b, ctxt')
wneuper@59286
   193
          | _ => error "solve Check_Postcond resume script of parpbl: uncovered case get_loc"
wneuper@59308
   194
	        val ctxt'' = Stool.from_subpbl_to_caller ctxt scval ctxt'
wneuper@59302
   195
          val ((p, p_), ps, _, pt) = Generate.generate1 thy (Tac.Check_Postcond' (pI, (scval, asm)))
wneuper@59300
   196
		        (Selem.ScrState (E,l,a,scval,scsaf,b), ctxt'') (pp,Res) pt;
wneuper@59302
   197
       in ("ok", ([(Tac.Check_Postcond pI, Tac.Check_Postcond'(pI, (scval, asm)),
wneuper@59300
   198
  	      ((pp, Res), (Selem.ScrState (E, l, a, scval, scsaf, b), ctxt'')))], ps, (pt, (p, p_)))) end
wneuper@59286
   199
     end
wneuper@59304
   200
  | solve (_, Tac.End_Proof'') (pt, (p, p_)) =
wneuper@59302
   201
    ("end-proof", ([(Tac.Empty_Tac, Tac.Empty_Tac_, (([], Res), (Selem.Uistate, Selem.e_ctxt)))], [], (pt, (p, p_))))
wneuper@59302
   202
  | solve (_, Tac.End_Detail' t) (pt, (p, p_)) = (* could be done by generate1 ?!? *)
wneuper@59286
   203
    let (*Rewrite_Set* done at Detail_Set*: this result is already in ctree*)
wneuper@59286
   204
      val pr = (lev_up p, Res)
wneuper@59286
   205
    in
wneuper@59302
   206
      ("ok", ([(Tac.End_Detail, Tac.End_Detail' t , ((p, p_), get_loc pt (p, p_)))], [], (pt, pr)))
wneuper@59286
   207
    end
wneuper@59286
   208
  | solve (_, m) (pt, po as (p, p_)) =
wneuper@59405
   209
    if Celem.e_metID = get_obj g_metID pt (par_pblobj pt p) (*29.8.02: could be detail, too !!*)
wneuper@59286
   210
    then
wneuper@59286
   211
      let
wneuper@59286
   212
        val ctxt = get_ctxt pt po
wneuper@59405
   213
        val ((p,p_),ps,_,pt) = Generate.generate1 (Celem.assoc_thy (get_obj g_domID pt (par_pblobj pt p))) 
wneuper@59300
   214
		      m (Selem.e_istate, ctxt) (p, p_) pt;
wneuper@59286
   215
	    in ("no-method-specified", (*Free_Solve*)
wneuper@59302
   216
	      ([(Tac.Empty_Tac, Tac.Empty_Tac_, ((p, p_), (Selem.Uistate, ctxt)))], ps, (pt, (p, p_))))
wneuper@59286
   217
      end
wneuper@59286
   218
    else
wneuper@59286
   219
	    let 
wneuper@59286
   220
	      val thy' = get_obj g_domID pt (par_pblobj pt p);
wneuper@59286
   221
	      val (srls, is, sc) = Lucin.from_pblobj_or_detail' thy' (p,p_) pt;
wneuper@59405
   222
		    val d = Celem.e_rls; (*FIXME.WN0108: canon.simplifier for domain is missing: generate from domID?*)
wneuper@59286
   223
	    in
wneuper@59286
   224
        case Lucin.locate_gen (thy',srls) m  (pt,(p, p_)) (sc,d) is of 
wneuper@59286
   225
	        Lucin.Steps (_, ss as (_, _, pt', p', c') :: _) =>
wneuper@59286
   226
	          ("ok", (map step2taci ss, c', (pt', p')))
wneuper@59286
   227
            (*27.8.02:next_tac may change to other branches in pt FIXXXXME*)
wneuper@59286
   228
	      | _ => (* NotLocatable *)
wneuper@59286
   229
	        let 
wneuper@59405
   230
	          val (p,ps, _, pt) = Generate.generate_hard (Celem.assoc_thy "Isac") m (p, p_) pt;
wneuper@59286
   231
	        in
wneuper@59286
   232
	          ("not-found-in-script", ([(Lucin.tac_2tac m, m, (po, is))], ps, (pt, p)))
wneuper@59286
   233
          end
wneuper@59286
   234
	    end;
neuper@37906
   235
wneuper@59286
   236
(* FIXME.WN050821 compare fun solve ... fun nxt_solv
wneuper@59286
   237
   nxt_solv (Apply_Method'     vvv FIXME: get args in applicable_in *)
wneuper@59302
   238
fun nxt_solv (Tac.Apply_Method' (mI, _, _, _)) _ (pt, pos as (p, _)) =
wneuper@59286
   239
   let
wneuper@59286
   240
     val {ppc, ...} = Specify.get_met mI;
wneuper@59286
   241
     val (itms, oris, probl) = case get_obj I pt p of
wneuper@59286
   242
       PblObj {meth = itms, origin = (oris, _, _), probl, ...} => (itms, oris, probl)
wneuper@59286
   243
     | _ => error "nxt_solv Apply_Method': uncovered case get_obj"
wneuper@59286
   244
     val itms = if itms <> [] then itms else Chead.complete_metitms oris probl [] ppc
wneuper@59286
   245
     val thy' = get_obj g_domID pt p;
wneuper@59405
   246
     val thy = Celem.assoc_thy thy';
wneuper@59286
   247
     val (is, env, ctxt, scr) = case Lucin.init_scrstate thy itms mI of
wneuper@59300
   248
       (is as Selem.ScrState (env,_,_,_,_,_), ctxt, scr) => (is, env, ctxt, scr)
wneuper@59286
   249
     | _ => error "nxt_solv Apply_Method': uncovered case init_scrstate"
wneuper@59286
   250
     val ini = Lucin.init_form thy scr env;
wneuper@59286
   251
   in 
wneuper@59286
   252
     case ini of
wneuper@59286
   253
       SOME t =>
wneuper@59286
   254
       let
wneuper@59286
   255
         val pos = ((lev_on o lev_dn) p, Frm)
wneuper@59302
   256
	       val tac_ = Tac.Apply_Method' (mI, SOME t, is, ctxt);
wneuper@59286
   257
	       val (pos, c, _, pt) = Generate.generate1 thy tac_ (is, ctxt) pos pt (* implicit Take *)
wneuper@59286
   258
       in
wneuper@59302
   259
        ([(Tac.Apply_Method mI, tac_, (pos, (is, ctxt)))], c, (pt, pos))
wneuper@59286
   260
       end
wneuper@59286
   261
     | NONE =>
wneuper@59286
   262
       let
wneuper@59286
   263
         val pt = update_env pt (fst pos) (SOME (is, ctxt))
wneuper@59286
   264
	       val (tacis, c, ptp) = nxt_solve_ (pt, pos)
wneuper@59302
   265
       in (tacis @ [(Tac.Apply_Method mI, Tac.Apply_Method' (mI, NONE, Selem.e_istate, ctxt), (pos, (is, ctxt)))],
wneuper@59286
   266
	       c, ptp)
wneuper@59286
   267
       end
wneuper@59286
   268
    end
wneuper@59302
   269
  | nxt_solv (Tac.Check_Postcond' (pI, _)) _ (pt, (p, p_))  =
wneuper@59286
   270
    let
wneuper@59286
   271
      val pp = par_pblobj pt p
wneuper@59286
   272
      val asm = (case get_obj g_tac pt p of
wneuper@59302
   273
		    Tac.Check_elementwise _ => (snd o (get_obj g_result pt)) p (*collects and instantiates asms*)
wneuper@59286
   274
		  | _ => get_assumptions_ pt (p, p_))
wneuper@59286
   275
	      handle _ => [] (*FIXME.WN030527 asms in subpbls not completely clear*)
wneuper@59286
   276
      val metID = get_obj g_metID pt pp;
wneuper@59286
   277
      val {srls = srls, scr = sc, ...} = Specify.get_met metID;
wneuper@59286
   278
      val (loc, E, l, a, b, ctxt) = case get_loc pt (p, p_) of
wneuper@59300
   279
        loc as (Selem.ScrState (E,l,a,_,_,b), ctxt) => (loc, E, l, a, b, ctxt)
wneuper@59286
   280
      | _ => error "nxt_solv Check_Postcond': uncovered case get_loc"
wneuper@59286
   281
      val thy' = get_obj g_domID pt pp;
wneuper@59405
   282
      val thy = Celem.assoc_thy thy';
wneuper@59286
   283
      val (_, _, (scval, scsaf)) = Lucin.next_tac (thy', srls) (pt, (p, p_)) sc loc;
wneuper@59286
   284
    in
wneuper@59286
   285
      if pp = []
wneuper@59286
   286
      then 
wneuper@59286
   287
	      let
wneuper@59300
   288
          val is = Selem.ScrState (E, l, a, scval, scsaf, b)
wneuper@59302
   289
	        val tac_ = Tac.Check_Postcond'(pI,(scval, asm))
wneuper@59286
   290
	        val ((p, p_), ps, _, pt) = Generate.generate1 thy tac_ (is, ctxt) (pp, Res) pt;
wneuper@59302
   291
	      in ([(Tac.Check_Postcond pI, tac_, ((pp, Res), (is, ctxt)))], ps, (pt, (p, p_))) end
wneuper@59286
   292
      else
wneuper@59286
   293
        let (*resume script of parpbl, transfer value of subpbl-script*)
wneuper@59286
   294
          val ppp = par_pblobj pt (lev_up p);
wneuper@59286
   295
	        val thy' = get_obj g_domID pt ppp;
wneuper@59405
   296
          val thy = Celem.assoc_thy thy';
wneuper@59286
   297
          val (E, l, a, b, ctxt') = case get_loc pt (pp, Frm) of
wneuper@59300
   298
            (Selem.ScrState (E,l,a,_,_,b), ctxt') => (E, l, a, b, ctxt')
wneuper@59286
   299
          | _ => error "nxt_solv Check_Postcond' script of parpbl: uncovered case get_loc"
wneuper@59308
   300
	        val ctxt'' = Stool.from_subpbl_to_caller ctxt scval ctxt'
wneuper@59302
   301
          val tac_ = Tac.Check_Postcond' (pI, (scval, asm))
wneuper@59300
   302
	        val is = Selem.ScrState (E,l,a,scval,scsaf,b)
wneuper@59286
   303
          val ((p, p_), ps, _, pt) = Generate.generate1 thy tac_ (is, ctxt'') (pp, Res) pt;
wneuper@59302
   304
        in ([(Tac.Check_Postcond pI, tac_, ((pp, Res), (is, ctxt'')))], ps, (pt, (p, p_))) end
wneuper@59286
   305
    end
wneuper@59304
   306
  | nxt_solv (Tac.End_Proof'') _ ptp = ([], [], ptp)
wneuper@59286
   307
  | nxt_solv tac_ is (pt, pos) =
wneuper@59286
   308
    let
wneuper@59286
   309
      val pos = case pos of
wneuper@59286
   310
 		   (p, Met) => ((lev_on o lev_dn) p, Frm) (* begin script        *)
wneuper@59286
   311
 		  | (p, Res) => (lev_on p, Res)            (* somewhere in script *)
wneuper@59286
   312
 		  | _ => pos
wneuper@59405
   313
 	    val (pos', c, _, pt) = Generate.generate1 (Celem.assoc_thy "Isac") tac_ is pos pt;
wneuper@59286
   314
    in
wneuper@59286
   315
      ([(Lucin.tac_2tac tac_, tac_, (pos, is))], c, (pt, pos'))
wneuper@59286
   316
    end
wneuper@59286
   317
(* find the next tac from the script, nxt_solv will update the ctree *)
wneuper@59286
   318
and nxt_solve_ (ptp as (pt, pos as (p, p_))) =
wneuper@59405
   319
    if Celem.e_metID = get_obj g_metID pt (par_pblobj pt p)
wneuper@59286
   320
    then ([], [], (pt, (p, p_)))
wneuper@59286
   321
    else 
wneuper@59286
   322
      let 
wneuper@59286
   323
        val thy' = get_obj g_domID pt (par_pblobj pt p);
wneuper@59286
   324
	      val (srls, is, sc) = Lucin.from_pblobj_or_detail' thy' (p,p_) pt;
wneuper@59286
   325
	      val (tac_, is, (t, _)) = Lucin.next_tac (thy', srls) (pt, pos) sc is;
wneuper@59286
   326
	      (* TODO here  ^^^  return finished/helpless/ok !*)
wneuper@59286
   327
	    in case tac_ of
wneuper@59302
   328
		    Tac.End_Detail' _ => ([(Tac.End_Detail, Tac.End_Detail' (t, [(*FIXME.04*)]), (pos, is))], [], (pt, pos))
wneuper@59286
   329
	    | _ => nxt_solv tac_ is ptp
wneuper@59286
   330
      end;
neuper@37906
   331
wneuper@59286
   332
(* says how may steps of a calculation should be done by "fun autocalc"
wneuper@59286
   333
   FIXXXME040624: does NOT match interfaces/ITOCalc.java
wneuper@59286
   334
   TODO.WN0512 redesign togehter with autocalc ?                     *)
neuper@37906
   335
datatype auto = 
wneuper@59260
   336
  Step of int      (*1 do #int steps (may stop in model/specify)
wneuper@59260
   337
                       IS VERY INEFFICIENT IN MODEL/SPECIY                    *)
neuper@37906
   338
| CompleteModel    (*2 complete modeling
wneuper@59260
   339
                       if model complete, finish specifying                   *)
wneuper@59260
   340
| CompleteCalcHead (*3 complete model/specify in one go                       *)
neuper@37906
   341
| CompleteToSubpbl (*4 stop at the next begin of a subproblem,
wneuper@59260
   342
                       if none, complete the actual (sub)problem              *)
wneuper@59260
   343
| CompleteSubpbl   (*5 complete the actual (sub)problem (incl.ev.subproblems) *)
wneuper@59260
   344
| CompleteCalc;    (*6 complete the calculation as a whole                    *)
neuper@42092
   345
neuper@37906
   346
fun autoord (Step _ ) = 1
neuper@37906
   347
  | autoord CompleteModel = 2
neuper@37906
   348
  | autoord CompleteCalcHead = 3
neuper@37906
   349
  | autoord CompleteToSubpbl = 4
neuper@37906
   350
  | autoord CompleteSubpbl = 5
neuper@37906
   351
  | autoord CompleteCalc = 6;
neuper@37906
   352
wneuper@59286
   353
fun complete_solve auto c (ptp as (_, p as (_, p_))) =
wneuper@59286
   354
    if p = ([], Res)
wneuper@59286
   355
    then ("end-of-calculation", [], ptp)
neuper@41997
   356
    else
wneuper@59286
   357
      if member op = [Pbl,Met] p_
wneuper@59286
   358
      then
wneuper@59286
   359
        let
wneuper@59286
   360
          val ptp = Chead.all_modspec ptp
wneuper@59286
   361
	        val (_, c', ptp) = all_solve auto c ptp
wneuper@59286
   362
	      in complete_solve auto (c @ c') ptp end
wneuper@59286
   363
      else
wneuper@59286
   364
        case nxt_solve_ ptp of
wneuper@59302
   365
	        ((Tac.Subproblem _, _, _) :: _, c', ptp') =>
wneuper@59286
   366
	          if autoord auto < 5
wneuper@59286
   367
            then ("ok", c @ c', ptp)
wneuper@59286
   368
	          else
wneuper@59286
   369
              let
wneuper@59286
   370
                val ptp = Chead.all_modspec ptp'
wneuper@59286
   371
	             val (_, c'', ptp) = all_solve auto (c @ c') ptp
wneuper@59286
   372
	           in complete_solve auto (c @ c'@ c'') ptp end
wneuper@59302
   373
	      | ((Tac.Check_Postcond _, _, _) :: _, c', ptp' as (_, p')) =>
wneuper@59286
   374
	        if autoord auto < 6 orelse p' = ([], Res)
neuper@41997
   375
          then ("ok", c @ c', ptp')
neuper@41997
   376
	        else complete_solve auto (c @ c') ptp'
wneuper@59304
   377
	      | ((Tac.End_Detail, _, _) :: _, c', ptp') => 
neuper@41997
   378
	        if autoord auto < 6
neuper@41997
   379
          then ("ok", c @ c', ptp')
neuper@41997
   380
	        else complete_solve auto (c @ c') ptp'
wneuper@59286
   381
	      | (_, c', ptp') => complete_solve auto (c @ c') ptp'
wneuper@59279
   382
and all_solve auto c (ptp as (pt, pos as (p,_)): ctree * pos') = 
wneuper@59286
   383
    let
wneuper@59286
   384
      val (_, _, mI) = get_obj g_spec pt p
wneuper@59286
   385
      val ctxt = get_ctxt pt pos
wneuper@59302
   386
      val (_, c', ptp) = nxt_solv (Tac.Apply_Method' (mI, NONE, Selem.e_istate, ctxt)) (Selem.e_istate, ctxt) ptp
wneuper@59286
   387
    in
wneuper@59286
   388
      complete_solve auto (c @ c') ptp
wneuper@59286
   389
    end;
neuper@41997
   390
neuper@41997
   391
(* aux.fun for detailrls with Rrls, reverse rewriting *)
wneuper@59286
   392
fun rul_terms_2nds _ nds _ [] = nds
s1210629013@52153
   393
  | rul_terms_2nds thy nds t ((rule, res as (t', _)) :: rts) =
wneuper@59302
   394
    (append_atomic [] (Selem.e_istate, Selem.e_ctxt) t (Tac.rule2tac thy [] rule) res Complete EmptyPtree) ::
wneuper@59286
   395
      (rul_terms_2nds thy nds t' rts);
neuper@37906
   396
neuper@41997
   397
(* detail steps done internally by Rewrite_Set* into ctree by use of a script *)
wneuper@59286
   398
fun detailrls pt (pos as (p, _)) = 
neuper@41997
   399
  let
neuper@41997
   400
    val t = get_obj g_form pt p
neuper@41997
   401
	  val tac = get_obj g_tac pt p
wneuper@59302
   402
	  val rls = (assoc_rls o Tac.rls_of) tac
neuper@41997
   403
    val ctxt = get_ctxt pt pos
neuper@41997
   404
  in
neuper@41997
   405
    case rls of
wneuper@59405
   406
	    Celem.Rrls {scr = Celem.Rfuns {init_state,...},...} => 
wneuper@59286
   407
	    let
wneuper@59286
   408
        val (_, _, _, rul_terms) = init_state t
wneuper@59286
   409
	      val newnds = rul_terms_2nds (Proof_Context.theory_of ctxt) [] t rul_terms
wneuper@59286
   410
	      val pt''' = ins_chn newnds pt p 
wneuper@59286
   411
	    in ("detailrls", pt''', (p @ [length newnds], Res)) end
neuper@41997
   412
	  | _ =>
wneuper@59286
   413
	    let
wneuper@59286
   414
        val is = Generate.init_istate tac t
wneuper@59286
   415
	      (*TODO.WN060602 ScrState (["(t_, Problem (Isac,[equation,univar]))"]
wneuper@59286
   416
			    is wrong for simpl, but working ?!? *)
wneuper@59405
   417
	      val tac_ = Tac.Apply_Method' (Celem.e_metID(*WN0402: see generate1 !?!*), SOME t, is, ctxt)
wneuper@59286
   418
	      val pos' = ((lev_on o lev_dn) p, Frm)
wneuper@59405
   419
	      val thy = Celem.assoc_thy "Isac"
wneuper@59286
   420
	      val (_, _, _, pt') = Generate.generate1 thy tac_ (is, ctxt) pos' pt (* implicit Take *)
wneuper@59286
   421
	      val (_,_, (pt'', _)) = complete_solve CompleteSubpbl [] (pt', pos')
wneuper@59286
   422
	      val newnds = children (get_nd pt'' p)
wneuper@59286
   423
	      val pt''' = ins_chn newnds pt p (*complete_solve cuts branches after*)
wneuper@59286
   424
	    in ("detailrls", pt''', (p @ [length newnds], Res):pos') end
neuper@41997
   425
  end;
neuper@37906
   426
wneuper@59286
   427
fun get_form (mI, m) (p,p_) pt = 
wneuper@59286
   428
  case Applicable.applicable_in (p, p_) pt m of
wneuper@59271
   429
    Chead.Notappl e => Generate.Error' e
wneuper@59265
   430
  | Chead.Appl m => 
neuper@37935
   431
      if member op = specsteps mI
wneuper@59286
   432
      then
wneuper@59286
   433
        let val (_, _, f, _, _, _) = Chead.specify m (p, p_) [] pt
wneuper@59286
   434
        in f end
wneuper@59286
   435
      else Generate.EmptyMout;
neuper@37906
   436
 
wneuper@59273
   437
end