src/Tools/isac/Interpret/solve.sml
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 17 May 2011 14:56:54 +0200
branchdecompose-isar
changeset 41997 71704991fbb2
parent 41975 61f358925792
child 41999 2d5a8c47f0c2
permissions -rw-r--r--
intermed. ctxt ..: finished check e_ctxt

results of tests still the same: x+1=2 until Check_Postcond
scanning code suggests to reconsider storing ctxt in *Obj{loc,...}
     1 (* Title:  solve an example by interpreting a method's script
     2    Author: Walther Neuper 1999
     3    (c) copyright due to lincense terms.
     4 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
     5         10        20        30        40        50        60        70        80         90      100
     6 *)
     7 
     8 fun safe (ScrState (_,_,_,_,s,_)) = s
     9   | safe (RrlsState _) = Safe;
    10 
    11 type mstID = string;
    12 type tac'_ = mstID * tac; (*DG <-> ME*)
    13 val e_tac'_ = ("Empty_Tac", Empty_Tac):tac'_;
    14 
    15 fun mk_tac'_   m = case m of
    16   Init_Proof (ppc, spec)    => ("Init_Proof", Init_Proof (ppc, spec )) 
    17 | Model_Problem             => ("Model_Problem", Model_Problem)
    18 | Refine_Tacitly pblID      => ("Refine_Tacitly", Refine_Tacitly pblID)
    19 | Refine_Problem pblID      => ("Refine_Problem", Refine_Problem pblID)
    20 | Add_Given cterm'          => ("Add_Given", Add_Given cterm') 
    21 | Del_Given cterm'          => ("Del_Given", Del_Given cterm') 
    22 | Add_Find cterm'           => ("Add_Find", Add_Find cterm') 
    23 | Del_Find cterm'           => ("Del_Find", Del_Find cterm') 
    24 | Add_Relation cterm'       => ("Add_Relation", Add_Relation cterm') 
    25 | Del_Relation cterm'       => ("Del_Relation", Del_Relation cterm') 
    26 
    27 | Specify_Theory domID	    => ("Specify_Theory", Specify_Theory domID) 
    28 | Specify_Problem pblID     => ("Specify_Problem", Specify_Problem pblID)
    29 | Specify_Method metID	    => ("Specify_Method", Specify_Method metID) 
    30 | Apply_Method metID	    => ("Apply_Method", Apply_Method metID) 
    31 | Check_Postcond pblID	    => ("Check_Postcond", Check_Postcond pblID)
    32 | Free_Solve                => ("Free_Solve",Free_Solve)
    33 		    
    34 | Rewrite_Inst (subs, thm') => ("Rewrite_Inst", Rewrite_Inst (subs, thm')) 
    35 | Rewrite thm'		    => ("Rewrite", Rewrite thm') 
    36 | Rewrite_Asm thm'	    => ("Rewrite_Asm", Rewrite_Asm thm') 
    37 | Rewrite_Set_Inst (subs, rls')
    38                => ("Rewrite_Set_Inst", Rewrite_Set_Inst (subs, rls')) 
    39 | Rewrite_Set rls'          => ("Rewrite_Set", Rewrite_Set rls') 
    40 | End_Ruleset		    => ("End_Ruleset", End_Ruleset)
    41 
    42 | End_Detail                => ("End_Detail", End_Detail)
    43 | Detail_Set rls'           => ("Detail_Set", Detail_Set rls')
    44 | Detail_Set_Inst (s, rls') => ("Detail_Set_Inst", Detail_Set_Inst (s, rls'))
    45 
    46 | Calculate op_             => ("Calculate", Calculate op_)
    47 | Substitute sube           => ("Substitute", Substitute sube) 
    48 | Apply_Assumption cts'	    => ("Apply_Assumption", Apply_Assumption cts')
    49 
    50 | Take cterm'               => ("Take", Take cterm') 
    51 | Take_Inst cterm'          => ("Take_Inst", Take_Inst cterm') 
    52 | Group (con, ints) 	    => ("Group", Group (con, ints)) 
    53 | Subproblem (domID, pblID) => ("Subproblem", Subproblem (domID, pblID)) 
    54 (*
    55 | Subproblem_Full(spec,cts')=> ("Subproblem_Full", Subproblem_Full(spec,cts')) 
    56 *)
    57 | End_Subproblem            => ("End_Subproblem",End_Subproblem)
    58 | CAScmd cterm'		    => ("CAScmd", CAScmd cterm')
    59 			    
    60 | Split_And                 => ("Split_And", Split_And) 
    61 | Conclude_And		    => ("Conclude_And", Conclude_And) 
    62 | Split_Or                  => ("Split_Or", Split_Or) 
    63 | Conclude_Or		    => ("Conclude_Or", Conclude_Or) 
    64 | Begin_Trans               => ("Begin_Trans", Begin_Trans) 
    65 | End_Trans		    => ("End_Trans", End_Trans) 
    66 | Begin_Sequ                => ("Begin_Sequ", Begin_Sequ) 
    67 | End_Sequ                  => ("End_Sequ", Begin_Sequ) 
    68 | Split_Intersect           => ("Split_Intersect", Split_Intersect) 
    69 | End_Intersect		    => ("End_Intersect", End_Intersect) 
    70 | Check_elementwise cterm'  => ("Check_elementwise", Check_elementwise cterm')
    71 | Or_to_List                => ("Or_to_List", Or_to_List) 
    72 | Collect_Trues	            => ("Collect_Results", Collect_Trues) 
    73 			    
    74 | Empty_Tac               => ("Empty_Tac",Empty_Tac)
    75 | Tac string              => ("Tac",Tac string)
    76 | User                      => ("User",User)
    77 | End_Proof'                => ("End_Proof'",End_Proof'); 
    78 
    79 (*Detail*)
    80 val empty_tac'_ = (mk_tac'_ Empty_Tac):tac'_;
    81 
    82 fun mk_tac ((_,m):tac'_) = m; 
    83 fun mk_mstID ((mI,_):tac'_) = mI;
    84 
    85 fun tac'_2str ((ID,ms):tac'_) = ID ^ (tac2str ms);
    86 (* TODO: tac2str, tac'_2str NOT tested *)
    87 
    88 
    89 
    90 type squ = ptree; (* TODO: safe etc. *)
    91 
    92 (*13.9.02--------------
    93 type ctr = (loc * pos) list;
    94 val ops = [("PLUS","Groups.plus_class.plus"),("MINUS","Groups.minus_class.minus"),("TIMES","Groups.times_class.times"),
    95 	   ("cancel","cancel"),("pow","pow"),("sqrt","sqrt")];
    96 ML {* 
    97 @{term "PLUS"};   (*Free ("PLUS", "'a") : term*)
    98 @{term "plus"};   (*Const ("Groups.plus_class.plus", "'a => 'a => 'a")*)
    99 @{term "MINUS"};  (*Free ("MINUS", "'a")*)
   100 @{term "minus"};  (*Const ("Groups.minus_class.minus", "'a => 'a => 'a")*)
   101 @{term "TIMES"};  (*Free ("TIMES", "'a")*)
   102 @{term "times"};  (*Const ("Groups.times_class.times", "'a => 'a => 'a")*)
   103 @{term "CANCEL"}; (*Free ("CANCEL", "'a")*)
   104 @{term "cancel"}; (*Free ("cancel", "'a")*)
   105 @{term "POWER"};  (*Free ("POWER", "'a")*)
   106 @{term "pow"};    (*Free ("pow", "'a")*)
   107 @{term "SQRT"};   (*Free ("SQRT", "'a")*)
   108 @{term "sqrt"};   (*Const ("NthRoot.sqrt", "RealDef.real => RealDef.real")*)
   109 *}
   110 fun op_intern op_ =
   111   case assoc (ops, op_) of
   112     SOME op' => op' | NONE => error ("op_intern: no op= "^op_);
   113 -----------------------*)
   114 
   115 
   116 
   117 (* use"ME/solve.sml";
   118    use"solve.sml";
   119 
   120 val ttt = (term_of o the o (parse thy))"Substitute [(bdv,x)] g";
   121 val ttt = (term_of o the o (parse thy))"Rewrite thmid True g";
   122 
   123   Const ("Script.Rewrite'_Inst",_) $ sub $ Free (thm',_) $ Const (pa,_) $ f'
   124    *)
   125 
   126 
   127 
   128 val specsteps = ["Init_Proof","Refine_Tacitly","Refine_Problem",
   129 		 "Model_Problem",(*"Match_Problem",*)
   130 		 "Add_Given","Del_Given","Add_Find","Del_Find",
   131 		 "Add_Relation","Del_Relation",
   132 		 "Specify_Theory","Specify_Problem","Specify_Method"];
   133 
   134 "-----------------------------------------------------------------------";
   135 
   136 
   137 fun step2taci ((tac_, _, pt, p, _):step) = (*FIXXME.040312: redesign step*)
   138     (tac_2tac tac_, tac_, (p, get_loc pt p)):taci;
   139 
   140 
   141 (*FIXME.WN050821 compare solve ... nxt_solv*)
   142 (* val ("Apply_Method",Apply_Method' (mI,_))=(mI,m);
   143    val (("Apply_Method",Apply_Method' (mI,_,_)),pt, pos as (p,_))=(m,pt, pos);
   144    *)
   145 fun solve ("Apply_Method", m as Apply_Method' (mI, _, _, _)) (pt:ptree, (pos as (p,_))) =
   146   let val {srls, ...} = get_met mI;
   147     val PblObj {meth=itms, ...} = get_obj I pt p;
   148     val thy' = get_obj g_domID pt p;
   149     val thy = assoc_thy thy';
   150     val (is as ScrState (env,_,_,_,_,_), ctxt, sc) = init_scrstate thy itms mI;
   151     val ini = init_form thy sc env;
   152     val p = lev_dn p;
   153   in 
   154       case ini of
   155 	  SOME t => (* val SOME t = ini; 
   156 	             *)
   157 	  let val (pos,c,_,pt) = 
   158 		  generate1 thy (Apply_Method' (mI, SOME t, is, ctxt))
   159 			    (is, ctxt) (lev_on p, Frm)(*implicit Take*) pt;
   160 	  in ("ok",([(Apply_Method mI, Apply_Method' (mI, SOME t, is, ctxt), 
   161 		      ((lev_on p, Frm), (is, ctxt)))], c, (pt,pos)):calcstate') 
   162 	  end	      
   163 	| NONE => (*execute the first tac in the Script, compare solve m*)
   164 	  let val (m', (is', ctxt'), _) = next_tac (thy', srls) (pt, (p, Res)) sc (is, ctxt);
   165 	      val d = e_rls (*FIXME: get simplifier from domID*);
   166 	  in 
   167 	      case locate_gen (thy',srls) m' (pt,(p, Res))(sc,d) (is', ctxt') of 
   168 		  Steps (is'', ss as (m'',f',pt',p',c')::_) =>
   169 (* val Steps (is'', ss as (m'',f',pt',p',c')::_) =
   170        locate_gen (thy',srls) m'  (pt,(p,Res)) (sc,d) is';
   171  *)
   172 		  ("ok", (map step2taci ss, c', (pt',p')))
   173 		| NotLocatable =>  
   174 		  let val (p,ps,f,pt) = 
   175 			  generate_hard (assoc_thy "Isac") m (p,Frm) pt;
   176 		  in ("not-found-in-script",
   177 		      ([(tac_2tac m, m, (pos, (is, ctxt)))], ps, (pt,p))) end
   178     (*just-before------------------------------------------------------
   179 	      ("ok",([(Apply_Method mI,Apply_Method'(mI,NONE,e_istate),
   180 		       (pos, is))],
   181 		     [], (update_env pt (fst pos) (SOME is),pos)))
   182      -----------------------------------------------------------------*)
   183 	  end
   184   end
   185 
   186   | solve ("Free_Solve", Free_Solve')  (pt,po as (p,_)) =
   187       let (*val _=tracing"###solve Free_Solve";*)
   188         val p' = lev_dn_ (p,Res);
   189         val pt = update_metID pt (par_pblobj pt p) e_metID;
   190       in ("ok", ([(Empty_Tac, Empty_Tac_, (po, (Uistate, e_ctxt)))], [], (pt,p')))
   191       end
   192 
   193   | solve ("Check_Postcond",Check_Postcond' (pI,_)) (pt,(pos as (p,p_))) =
   194       let (*val _=tracing"###solve Check_Postcond";*)
   195         val pp = par_pblobj pt p
   196         val asm = 
   197           (case get_obj g_tac pt p of
   198 		         Check_elementwise _ => (*collects and instantiates asms*)
   199 		           (snd o (get_obj g_result pt)) p
   200 		       | _ => get_assumptions_ pt (p,p_))
   201 	        handle _ => [] (*WN.27.5.03 asms in subpbls not completely clear*)
   202         val metID = get_obj g_metID pt pp;
   203         val {srls=srls,scr=sc,...} = get_met metID;
   204         val loc as (ScrState (E,l,a,_,_,b), ctxt) = get_loc pt (p,p_); 
   205         val thy' = get_obj g_domID pt pp;
   206         val thy = assoc_thy thy';
   207         val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc loc;
   208       in 
   209         if pp = [] 
   210         then
   211 	        let 
   212             val is = ScrState (E,l,a,scval,scsaf,b)
   213 	          val tac_ = Check_Postcond'(pI,(scval, map term2str asm))
   214 	          val (pos,ps,f,pt) = generate1 thy tac_ (is, ctxt) (pp,Res) pt;
   215 	        in ("ok", ([(Check_Postcond pI, tac_, ((pp,Res),(is, ctxt)))], ps,(pt,pos))) end
   216         else
   217           let (*resume script of parpbl, transfer value of subpbl-script*)
   218             val ppp = par_pblobj pt (lev_up p);
   219 	          val thy' = get_obj g_domID pt ppp;
   220             val thy = assoc_thy thy';
   221 	          val metID = get_obj g_metID pt ppp;
   222             val sc = (#scr o get_met) metID;
   223             val (ScrState (E,l,a,_,_,b), ctxt') = get_loc pt (pp(*!/p/*),Frm); 
   224 	          val ctxt'' = transfer_from_subproblem ctxt ctxt'
   225             val ((p,p_),ps,f,pt) = 
   226 	            generate1 thy (Check_Postcond' (pI, (scval, map term2str asm)))
   227 		            (ScrState (E,l,a,scval,scsaf,b), ctxt'') (pp,Res) pt;
   228        in ("ok", ([(Check_Postcond pI, Check_Postcond'(pI,(scval, map term2str asm)),
   229 	         ((pp,Res), (ScrState (E,l,a,scval,scsaf,b), ctxt'')))],ps,(pt,(p,p_))))
   230 	     end
   231      end
   232 
   233   | solve (_,End_Proof'') (pt, (p,p_)) =
   234       ("end-proof",
   235        ([(Empty_Tac,Empty_Tac_,(([],Res),(Uistate, e_ctxt)))],[],(pt,(p,p_))))
   236 
   237 (*-----------vvvvvvvvvvv could be done by generate1 ?!?*)
   238   | solve (_,End_Detail' t) (pt, (p,p_)) =
   239       let
   240         val pr as (p',_) = (lev_up p, Res)
   241 	      val pp = par_pblobj pt p
   242 	      val r = (fst o (get_obj g_result pt)) p' 
   243 	      (*Rewrite_Set* done at Detail_Set*: this result is already in ptree*)
   244 	      val thy' = get_obj g_domID pt pp
   245 	      val (srls, is, sc) = from_pblobj' thy' pr pt
   246 	      val (tac_,is',_) = next_tac (thy',srls) (pt,pr) sc is
   247       in ("ok", ([(End_Detail, End_Detail' t , 
   248 	      ((p,p_), get_loc pt (p,p_)))], [], (pt,pr)))
   249       end
   250 
   251   | solve (mI,m) (pt, po as (p,p_)) =
   252       if e_metID = get_obj g_metID pt (par_pblobj pt p)(*29.8.02: could be detail, too !!*)
   253       then
   254         let val ((p,p_),ps,f,pt) = 
   255 		      generate1 (assoc_thy (get_obj g_domID pt (par_pblobj pt p))) 
   256 			      m (e_istate, e_ctxt) (p,p_) pt;
   257 	      in ("no-method-specified", (*Free_Solve*)
   258 	        ([(Empty_Tac,Empty_Tac_, ((p,p_),(Uistate, e_ctxt)))], ps, (pt,(p,p_))))
   259         end
   260       else
   261 	      let 
   262 	        val thy' = get_obj g_domID pt (par_pblobj pt p);
   263 	        val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt;
   264 		      val d = e_rls; (*FIXME.WN0108: canon.simplifier for domain is missing: generate from domID?*)
   265 	      in
   266           case locate_gen (thy',srls) m  (pt,(p,p_)) (sc,d) is of 
   267 	          Steps (is', ss as (m',f',pt',p',c')::_) =>
   268 	            let 
   269 	              (*27.8.02:next_tac may change to other branches in pt FIXXXXME*)
   270 	            in ("ok", (map step2taci ss, c', (pt',p'))) end
   271 	        | NotLocatable =>  
   272 	            let val (p,ps,f,pt) = 
   273 		            generate_hard (assoc_thy "Isac") m (p,p_) pt;
   274 	            in ("not-found-in-script",
   275 		            ([(tac_2tac m, m, (po,is))], ps, (pt,p)))
   276               end
   277 	      end;
   278 
   279 (*FIXME.WN050821 compare fun solve ... fun nxt_solv*)
   280 (* nxt_solv (Apply_Method'     vvv FIXME: get args in applicable_in *)
   281 fun nxt_solv (Apply_Method' (mI,_,_,_)) _ (pt:ptree, pos as (p,_)) =
   282       let
   283         val {srls,ppc,...} = get_met mI;
   284         val PblObj{meth=itms,origin=(oris,_,_),probl,...} = get_obj I pt p;
   285         val itms = if itms <> [] then itms else complete_metitms oris probl [] ppc
   286         val thy' = get_obj g_domID pt p;
   287         val thy = assoc_thy thy';
   288         val ctxt = get_ctxt pt pos
   289         val (is as ScrState (env,_,_,_,_,_), _, scr) = init_scrstate thy itms mI;
   290         val ini = init_form thy scr env;
   291       in 
   292         case ini of
   293           SOME t =>
   294             let
   295               val pos = ((lev_on o lev_dn) p, Frm)
   296 	            val tac_ = Apply_Method' (mI, SOME t, is, ctxt);
   297 	            val (pos,c,_,pt) = (*implicit Take*)
   298 	              generate1 thy tac_ (is, ctxt) pos pt
   299             in ([(Apply_Method mI, tac_, (pos, (is, ctxt)))], c, (pt, pos)):calcstate' end
   300         | NONE =>
   301             let
   302               val pt = update_env pt (fst pos) (SOME (is, ctxt))
   303 	            val (tacis, c, ptp) = nxt_solve_ (pt, pos)
   304             in (tacis @ 
   305 	              [(Apply_Method mI, Apply_Method' (mI, NONE, e_istate, ctxt), (pos, (is, ctxt)))],
   306 	             c, ptp)
   307             end
   308       end
   309 
   310     (*TODO.WN050913 remove unnecessary code below*)
   311   | nxt_solv (Check_Postcond' (pI,_)) _ (pt, pos as (p,p_))  =
   312       let
   313         val pp = par_pblobj pt p
   314         val asm =
   315           (case get_obj g_tac pt p of
   316 		         Check_elementwise _ => (*collects and instantiates asms*)
   317 		           (snd o (get_obj g_result pt)) p
   318 		       | _ => get_assumptions_ pt (p,p_))
   319 	        handle _ => [] (*FIXME.WN030527 asms in subpbls not completely clear*)
   320         val metID = get_obj g_metID pt pp;
   321         val {srls=srls,scr=sc,...} = get_met metID;
   322         val loc as (ScrState (E,l,a,_,_,b), ctxt) = get_loc pt (p,p_); 
   323         val thy' = get_obj g_domID pt pp;
   324         val thy = assoc_thy thy';
   325         val (_,_,(scval,scsaf)) = next_tac (thy',srls) (pt,(p,p_)) sc loc;
   326       in
   327         if pp = []
   328         then 
   329 	        let
   330             val is = ScrState (E,l,a,scval,scsaf,b)
   331 	          val tac_ = Check_Postcond'(pI,(scval, map term2str asm))
   332 	          val ((p,p_),ps,f,pt) = 
   333 		          generate1 thy tac_ (is, ctxt) (pp,Res) pt;
   334 	        in ([(Check_Postcond pI, tac_, ((pp,Res), (is, ctxt)))],ps,(pt, (p,p_))) end
   335         else
   336           let (*resume script of parpbl, transfer value of subpbl-script*)
   337             val ppp = par_pblobj pt (lev_up p);
   338 	          val thy' = get_obj g_domID pt ppp;
   339             val thy = assoc_thy thy';
   340 	          val metID = get_obj g_metID pt ppp;
   341 	          val {scr,...} = get_met metID;
   342             val (ScrState (E,l,a,_,_,b), ctxt') = get_loc pt (pp(*!/p/*),Frm)
   343 	          val ctxt'' = transfer_from_subproblem ctxt ctxt'
   344             val tac_ = Check_Postcond' (pI, (scval, map term2str asm))
   345 	          val is = ScrState (E,l,a,scval,scsaf,b)
   346             val ((p,p_),ps,f,pt) = generate1 thy tac_ (is, ctxt'') (pp, Res) pt;
   347           in ([(Check_Postcond pI, tac_, ((pp, Res), (is, ctxt'')))], ps, (pt, (p,p_))) end
   348       end
   349 
   350   | nxt_solv (End_Proof'') _ ptp = ([], [], ptp)
   351 
   352   | nxt_solv tac_ is (pt, pos as (p,p_)) =
   353 (* val (pt, pos as (p,p_)) = ptp;
   354    *)
   355     let val pos = case pos of
   356 		      (p, Met) => ((lev_on o lev_dn) p, Frm)(*begin script*)
   357 		    | (p, Res) => (lev_on p,Res) (*somewhere in script*)
   358 		    | _ => pos  (*somewhere in script*)
   359     (*val _= tracing"### nxt_solv4 Apply_Method: stored is =";
   360         val _= tracing(istate2str is);*)
   361 	val (pos',c,_,pt) = generate1 (assoc_thy "Isac") tac_ is pos pt;
   362     in ([(tac_2tac tac_, tac_, (pos,is))], c, (pt, pos')) end
   363 
   364 
   365   (*(p,p_), (([],Res),Uistate,Empty_Tac_), EmptyMout, Empty_Tac, Safe, pt*)
   366 
   367 
   368 (*.find the next tac from the script, nxt_solv will update the ptree.*)
   369 (* val (ptp as (pt,pos as (p,p_))) = ptp';
   370    val (ptp as (pt, pos as (p,p_))) = ptp'';
   371    val (ptp as (pt, pos as (p,p_))) = ptp;
   372    val (ptp as (pt, pos as (p,p_))) = (pt,ip);
   373    val (ptp as (pt, pos as (p,p_))) = (pt, pos);
   374    *)
   375 and nxt_solve_ (ptp as (pt, pos as (p,p_))) =
   376       if e_metID = get_obj g_metID pt (par_pblobj pt p)
   377       then ([], [], (pt,(p,p_))):calcstate'
   378       else 
   379         let 
   380           val thy' = get_obj g_domID pt (par_pblobj pt p);
   381 	        val (srls, is, sc) = from_pblobj_or_detail' thy' (p,p_) pt;
   382 	        val (tac_,is,(t,_)) = next_tac (thy',srls) (pt,pos) sc is;
   383 	        (*TODO here ^^^  return finished/helpless/ok !*)
   384 	      in case tac_ of
   385 		         End_Detail' _ => ([(End_Detail, End_Detail' (t,[(*FIXME.040215*)]), 
   386 				       (pos, is))], [], (pt, pos))
   387 	         | _ => nxt_solv tac_ is ptp end;
   388 
   389 (*.says how may steps of a calculation should be done by "fun autocalc".*)
   390 (*TODO.WN0512 redesign togehter with autocalc ?*)
   391 datatype auto = 
   392   Step of int      (*1 do #int steps; may stop in model/specify:
   393 		     IS VERY INEFFICIENT IN MODEL/SPECIY*)
   394 | CompleteModel    (*2 complete modeling
   395                      if model complete, finish specifying + start solving*)
   396 | CompleteCalcHead (*3 complete model/specify in one go + start solving*)
   397 | CompleteToSubpbl (*4 stop at the next begin of a subproblem,
   398                      if none, complete the actual (sub)problem*)
   399 | CompleteSubpbl   (*5 complete the actual (sub)problem (incl.ev.subproblems)*)
   400 | CompleteCalc;    (*6 complete the calculation as a whole*)	
   401 fun autoord (Step _ ) = 1
   402   | autoord CompleteModel = 2
   403   | autoord CompleteCalcHead = 3
   404   | autoord CompleteToSubpbl = 4
   405   | autoord CompleteSubpbl = 5
   406   | autoord CompleteCalc = 6;
   407 
   408 (* val (auto, c, (ptp as (_, p))) = (auto, (c@c'), ptp);
   409    *)
   410 fun complete_solve auto c (ptp as (_, p): ptree * pos') =
   411   if p = ([], Res)
   412   then ("end-of-calculation", [], ptp)
   413   else
   414     case nxt_solve_ ptp of
   415 	    ((Subproblem _, tac_, (_, is))::_, c', ptp') =>
   416 	      if autoord auto < 5
   417         then ("ok", c@c', ptp)
   418 	      else
   419           let
   420             val ptp = all_modspec ptp';
   421 	          val (_, c'', ptp) = all_solve auto (c@c') ptp;
   422 	        in complete_solve auto (c@c'@c'') ptp end
   423     | ((Check_Postcond _, tac_, (_, is))::_, c', ptp' as (_, p')) =>
   424 	      if autoord auto < 6 orelse p' = ([],Res)
   425         then ("ok", c @ c', ptp')
   426 	      else complete_solve auto (c @ c') ptp'
   427     | ((End_Detail, _, _)::_, c', ptp') => 
   428 	      if autoord auto < 6
   429         then ("ok", c @ c', ptp')
   430 	      else complete_solve auto (c @ c') ptp'
   431     | (_, c', ptp') => complete_solve auto (c @ c') ptp'
   432 
   433 and all_solve auto c (ptp as (pt, pos as (p,_)): ptree * pos') = 
   434    let
   435      val (_,_,mI) = get_obj g_spec pt p;
   436      val ctxt = get_ctxt pt pos
   437      val (_, c', ptp) = nxt_solv (Apply_Method' (mI, NONE, e_istate, ctxt))
   438 			 (e_istate, ctxt) ptp;
   439    in complete_solve auto (c @ c') ptp end;
   440 
   441 fun complete_solve auto c (ptp as (_, p as (_,p_)): ptree * pos') =
   442   if p = ([], Res)
   443   then ("end-of-calculation", [], ptp)
   444   else
   445     if member op = [Pbl,Met] p_
   446     then
   447       let
   448         val ptp = all_modspec ptp
   449 	      val (_, c', ptp) = all_solve auto c ptp
   450 	    in complete_solve auto (c @ c') ptp end
   451     else
   452       case nxt_solve_ ptp of
   453 	      ((Subproblem _, tac_, (_, is))::_, c', ptp') =>
   454 	        if autoord auto < 5
   455           then ("ok", c @ c', ptp)
   456 	        else
   457             let
   458               val ptp = all_modspec ptp'
   459 	           val (_, c'', ptp) = all_solve auto (c @ c') ptp
   460 	         in complete_solve auto (c @ c'@ c'') ptp end
   461 	    | ((Check_Postcond _, tac_, (_, is))::_, c', ptp' as (_, p')) =>
   462 	        if autoord auto < 6 orelse p' = ([],Res)
   463           then ("ok", c @ c', ptp')
   464 	        else complete_solve auto (c @ c') ptp'
   465 	    | ((End_Detail, _, _)::_, c', ptp') => 
   466 	        if autoord auto < 6
   467           then ("ok", c @ c', ptp')
   468 	        else complete_solve auto (c @ c') ptp'
   469 	    | (_, c', ptp') => complete_solve auto (c @ c') ptp'
   470 
   471 and all_solve auto c (ptp as (pt, pos as (p,_)): ptree * pos') = 
   472   let
   473     val (_,_,mI) = get_obj g_spec pt p
   474     val ctxt = get_ctxt pt pos
   475     val (_, c', ptp) = nxt_solv (Apply_Method' (mI, NONE, e_istate, ctxt))
   476 			(e_istate, ctxt) ptp
   477   in complete_solve auto (c @ c') ptp end;
   478 
   479 (* aux.fun for detailrls with Rrls, reverse rewriting *)
   480 fun rul_terms_2nds nds t [] = nds
   481   | rul_terms_2nds nds t ((rule, res as (t', _)) :: rts) =
   482     (append_atomic [] (e_istate, e_ctxt) t (rule2tac [] rule) res Complete EmptyPtree) ::
   483     (rul_terms_2nds nds t' rts);
   484 
   485 (* detail steps done internally by Rewrite_Set* into ctree by use of a script *)
   486 fun detailrls pt (pos as (p,p_):pos') = 
   487   let
   488     val t = get_obj g_form pt p
   489 	  val tac = get_obj g_tac pt p
   490 	  val rls = (assoc_rls o rls_of) tac
   491     val ctxt = get_ctxt pt pos
   492   in
   493     case rls of
   494 	    Rrls {scr = Rfuns {init_state,...},...} => 
   495 	      let
   496           val (_,_,_,rul_terms) = init_state t
   497 	        val newnds = rul_terms_2nds [] t rul_terms
   498 	        val pt''' = ins_chn newnds pt p 
   499 	      in ("detailrls", pt''', (p @ [length newnds], Res):pos') end
   500 	  | _ =>
   501 	      let
   502           val is = init_istate tac t
   503 	        (*TODO.WN060602 ScrState (["(t_, Problem (Isac,[equation,univar]))"]
   504 				    is wrong for simpl, but working ?!? *)
   505 	        val tac_ = Apply_Method' (e_metID(*WN0402: see generate1 !?!*), SOME t, is, ctxt)
   506 	        val pos' = ((lev_on o lev_dn) p, Frm)
   507 	        val thy = assoc_thy "Isac"
   508 	        val (_,_,_,pt') = (*implicit Take*)generate1 thy tac_ (is, ctxt) pos' pt
   509 	        val (_,_,(pt'',_)) = complete_solve CompleteSubpbl [] (pt',pos')
   510 	        val newnds = children (get_nd pt'' p)
   511 	        val pt''' = ins_chn newnds pt p 
   512 	        (*complete_solve cuts branches after*)
   513 	     in ("detailrls", pt''', (p @ [length newnds], Res):pos') end
   514   end;
   515 
   516 
   517 
   518 (* val(mI,m)=m;val ppp=p;(*!!!*)val(p,p_)=pos;val(_,pt,_)=ppp(*!!!*);
   519    get_form ((mI,m):tac'_) ((p,p_):pos') ppp;
   520    *)
   521 fun get_form ((mI,m):tac'_) ((p,p_):pos') pt = 
   522   case applicable_in (p,p_) pt m of
   523     Notappl e => Error' (Error_ e)
   524   | Appl m => 
   525       (* val Appl m=applicable_in (p,p_) pt m;
   526          *)
   527       if member op = specsteps mI
   528 	then let val (_,_,f,_,_,_) = specify m (p,p_) [] pt
   529 	     in f end
   530       else let val (*_,_,f,_,_,_*)_ = solve (mI,m) (pt,(p,p_))
   531 	   in (*f*) EmptyMout end;
   532