src/sml/ME/mathengine.sml
author wneuper
Wed, 26 Jul 2006 19:01:11 +0200
branchstart_Take
changeset 615 96dbf1ca6e27
parent 607 117904920570
child 617 a37b5b4abdc5
permissions -rw-r--r--
debugging setContext; pbl ok
     1 (* The _functional_ mathematics engine, ie. without a state.
     2    Input and output are Isabelle's formulae as strings.
     3    authors: Walther Neuper 2000
     4    (c) due to copyright terms
     5 
     6 use"mathengine.sml";
     7 *)
     8 
     9 signature MATHENGINE =
    10   sig
    11     type nxt_
    12     (* datatype nxt_ = HElpless | Nexts of CalcHead.calcstate *)
    13     type NEW
    14     type lOc_
    15     (*datatype
    16       lOc_ =
    17           ERror of string
    18         | UNsafe of CalcHead.calcstate'
    19         | Updated of CalcHead.calcstate' *)
    20 
    21     val CalcTreeTEST :
    22        fmz list ->
    23        pos' * NEW * mout * (string * tac) * safe * ptree
    24 
    25     val TESTg_form : ptree * (int list * pos_) -> mout
    26     val autocalc :
    27        pos' list ->
    28        pos' ->
    29        (ptree * pos') * taci list ->
    30        auto -> string * pos' list * (ptree * pos')
    31     val detailstep : ptree -> pos' -> string * ptree * pos'
    32    (* val e_tac_ : tac_ *)
    33     val f2str : mout -> cterm'
    34    (* val get_pblID : ptree * pos' -> pblID Library.option *)
    35     val initmatch : ptree -> pos' -> ptform
    36    (* val loc_solve_ :
    37        string * tac_ -> ptree * (int list * pos_) -> lOc_ *)
    38    (* val loc_specify_ : tac_ -> ptree * pos' -> lOc_ *)
    39     val locatetac :     (*tests only*)
    40        tac ->
    41        ptree * (posel list * pos_) ->
    42        string * (taci list * pos' list * (ptree * (posel list * pos_)))
    43     val me :
    44        tac'_ ->
    45        pos' ->
    46        NEW ->
    47        ptree -> pos' * NEW * mout * tac'_ * safe * ptree
    48 
    49     val nxt_specify_ : ptree * (int list * pos_) -> calcstate'(*tests only*)
    50     val set_method : metID -> ptree * pos' -> ptree * ocalhd
    51     val set_problem : pblID -> ptree * pos' -> ptree * ocalhd
    52     val set_theory : thyID -> ptree * pos' -> ptree * ocalhd
    53     val step : pos' -> calcstate -> string * calcstate'
    54     val trymatch : pblID -> ptree -> pos' -> ptform
    55     val tryrefine : pblID -> ptree -> pos' -> ptform
    56   end
    57 
    58 
    59 
    60 (*------------------------------------------------------------------(**)
    61 structure MathEngine : MATHENGINE =
    62 struct
    63 (**)------------------------------------------------------------------*)
    64 
    65 fun get_pblID (pt, (p,_):pos') =
    66     let val p' = par_pblobj pt p
    67 	val (_,pI,_) = get_obj g_spec pt p'
    68 	val (_,(_,oI,_),_) = get_obj g_origin pt p'
    69     in if pI <> e_pblID then Some pI
    70        else if oI <> e_pblID then Some oI
    71        else None end;
    72 (*fun get_pblID (pt, (p,_):pos') =
    73     ((snd3 o (get_obj g_spec pt)) (par_pblobj pt p));*)
    74 
    75 
    76 (*--vvv--dummies for test*)
    77 val e_tac_ = Tac_ (Pure.thy,"","","");
    78 datatype lOc_ =
    79   ERror of string         (*after loc_specify, loc_solve*)
    80 | UNsafe of calcstate'    (*after loc_specify, loc_solve*)
    81 | Updated of calcstate';   (*after loc_specify, loc_solve*)
    82 fun loc_specify_ m (pt,pos) =
    83 (* val pos = ip;
    84    *)
    85     let val (p,_,f,_,s,pt) = specify m pos [] pt;
    86 (*      val (_,_,_,_,_,pt')= specify m pos [] pt;
    87    *) 
    88    in case f of
    89 	   (Error' (Error_ e)) => ERror e
    90 	 | _ => Updated ([], [], (pt,p)) end;
    91 
    92 fun loc_solve_ m (pt,pos) =
    93 (* val (m, pos) = ((mI,m), ip);
    94    val (m,(pt,pos) ) = ((mI,m), ptp);
    95    *)  
    96     let val (msg, cs') = solve m (pt, pos);
    97 (* val (tacis,dels,(pt',p')) = cs';
    98    (writeln o istate2str) (get_istate pt' p');
    99    (term2str o fst) (get_obj g_result pt' (fst p'));
   100    *)
   101     in case msg of
   102 	   "ok" => Updated cs' 
   103 	 | msg => ERror msg 
   104     end;
   105 
   106 datatype nxt_ =
   107 	 HElpless  (**)
   108        | Nexts of calcstate; (**)
   109 
   110 (*report applicability of tac in tacis; pt is dropped in setNextTactic*)
   111 fun locatetac _ (ptp as (_,([],Res))) = ("end-of-calculation", ([], [], ptp))
   112   | locatetac tac (ptp as (pt, p)) =
   113 (* val ptp as (pt, p) = (pt, ip);
   114    val ptp as (pt, p) = (pt, p);
   115    *)
   116     let val (mI,m) = mk_tac'_ tac;
   117     in case applicable_in p pt m of
   118 	   Notappl e => ("not-applicable", ([],[],  ptp):calcstate')
   119 	 | Appl m =>
   120 (* val Appl m = applicable_in p pt m;
   121     *) 
   122 	   let val x = if mI mem specsteps
   123 		       then loc_specify_ m ptp else loc_solve_ (mI,m) ptp
   124 	   in case x of 
   125 		  ERror e => ("failure", ([], [], ptp))
   126 		(*FIXXXXXME: loc_specify_, loc_solve_ TOGETHER with dropping meOLD+detail.sml*)
   127 		| UNsafe cs' => ("unsafe-ok", cs')
   128 		| Updated (cs' as (_,_,(_,p'))) =>
   129 		  (*ev.SEVER.tacs like Begin_Trans*)
   130 		  (if p' = ([],Res) then "end-of-calculation" else "ok", 
   131 		   cs')(*for -"-  user to ask ? *)
   132 	   end
   133     end;
   134 
   135 
   136 (*------------------------------------------------------------------
   137 fun init_detail ptp = e_calcstate;(*15.8.03.MISSING-->solve.sml!?*)
   138 (*----------------------------------------------------from solve.sml*)
   139   | nxt_solv (Detail_Set'(thy', rls, t)) (pt, p) =
   140     let (*val rls = the (assoc(!ruleset',rls'))
   141 	    handle _ => raise error ("solve: '"^rls'^"' not known");*)
   142 	val thy = assoc_thy thy';
   143         val (srls, sc, is) = 
   144 	    case rls of
   145 		Rrls {scr=sc as Rfuns {init_state=ii,...},...} => 
   146 		(e_rls, sc, RrlsState (ii t))
   147 	      | Rls {srls=srls,scr=sc as Script s,...} => 
   148 		(srls, sc, ScrState ([(one_scr_arg s,t)], [], 
   149 			       None, e_term, Sundef, true));
   150 	val pt = update_tac pt (fst p) (Detail_Set (id_rls rls));
   151 	val (p,cid,_,pt) = generate1 thy (Begin_Trans' t) is p pt;
   152 	val nx = (tac_2tac o fst3) (next_tac (thy',srls) (pt,p) sc is);
   153 	val aopt = applicable_in p pt nx;
   154     in case aopt of
   155 	   Notappl s => raise error ("solve Detail_Set: "^s)
   156 	 (* val Appl m = aopt;
   157 	    *)
   158 	 | Appl m => solve ("discardFIXME",m) p pt end
   159 ------------------------------------------------------------------*)
   160 
   161 
   162 (*iterated by nxt_me; there (the resulting) ptp dropped
   163   may call nxt_solve Apply_Method --- thus evaluated here after solve.sml*)
   164 fun nxt_specify_ (ptp as (pt, pos as (p,p_))) =
   165 (* val (ptp as (pt, pos as (p,p_))) = ptp;
   166    (*1*)val (ptp as (pt, pos as (p,p_))) = (pt,ip);
   167    *)
   168     let val pblobj as (PblObj{meth,origin=origin as (oris,(dI',pI',mI'),_),
   169 			      probl,spec=(dI,pI,mI),...}) = get_obj I pt p;
   170     in if just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin
   171        then case mI' of
   172 	 ["no_met"] => nxt_specif (Refine_Tacitly pI') (pt, (p,Pbl))
   173        | _ => nxt_specif Model_Problem (pt, (p,Pbl))
   174        else let val cpI = if pI = e_pblID then pI' else pI;
   175 		val cmI = if mI = e_metID then mI' else mI;
   176 		val {ppc,prls,where_,...} = get_pbt cpI;
   177 		val pre = check_preconds thy prls where_ probl;
   178 		val pb = foldl and_ (true, map fst pre);
   179 		(*FIXME.WN0308:    ~~~~~: just check true in itms of pbl/met?*)
   180 		val (_,tac) =
   181 		    nxt_spec p_ pb oris (dI',pI',mI') (probl,meth) 
   182 			     (ppc,(#ppc o get_met) cmI) (dI,pI,mI);
   183 	    in case tac of
   184 		   Apply_Method mI => 
   185 (* val Apply_Method mI = tac;
   186    *)
   187 		   nxt_solv (Apply_Method' (mI, None, e_istate)) e_istate ptp
   188 		 | _ => nxt_specif tac ptp end
   189     end;
   190 
   191 
   192 (*.specify a new method;
   193    WN0512 impl.incomplete, see 'nxt_specif (Specify_Method ' .*)
   194 fun set_method (mI:metID) ptp =
   195     let val ([(_, Specify_Method' (_, _, mits), _)], [], (pt, pos as (p,_))) = 
   196 	    nxt_specif (Specify_Method mI) ptp
   197 	val pre = []        (*...from Specify_Method'*)
   198 	val complete = true (*...from Specify_Method'*)
   199 	(*from Specify_Method'  ? vvv,  vvv ?*)
   200 	val PblObj {origin = (_,_,hdf), spec,...} = get_obj I pt p
   201     in (pt, (complete, Met, hdf, mits, pre, spec):ocalhd) end;
   202 
   203 (* val ([(_, Specify_Method' (_, _, mits), _)], [],_) = 
   204     nxt_specif (Specify_Method mI) ptp;
   205  *)
   206 
   207 (*.specify a new problem;
   208    WN0512 impl.incomplete, see 'nxt_specif (Specify_Problem ' .*)
   209 (* val (pI, ptp) = (pI, (pt, ip));
   210    *)
   211 fun set_problem pI (ptp: ptree * pos') =
   212     let val ([(_, Specify_Problem' (_, (complete, (pits, pre))),_)],
   213 	     _, (pt, pos as (p,_))) = nxt_specif (Specify_Problem pI) ptp
   214 	(*from Specify_Problem' ? vvv,  vvv ?*)
   215 	val PblObj {origin = (_,_,hdf), spec,...} = get_obj I pt p
   216     in (pt, (complete, Pbl, hdf, pits, pre, spec):ocalhd) end;
   217 
   218 fun set_theory (tI:thyID) (ptp: ptree * pos') =
   219     let val ([(_, Specify_Problem' (_, (complete, (pits, pre))),_)],
   220 	     _, (pt, pos as (p,_))) = nxt_specif (Specify_Theory tI) ptp
   221 	(*from Specify_Theory'  ? vvv,  vvv ?*)
   222 	val PblObj {origin = (_,_,hdf), spec,...} = get_obj I pt p
   223     in (pt, (complete, Pbl, hdf, pits, pre, spec):ocalhd) end;
   224 
   225 (*.does a step forward; returns tactic used, ctree updated.
   226 TODO.WN0512 redesign after specify-phase became more separated from solve-phase
   227 arg ip: 
   228     calcstate
   229 .*)
   230 (* val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'),[]));
   231    val (ip as (_,p_), (ptp as (pt,p), tacis)) = (get_pos 1 1, get_calc 1);
   232    (*1*)val (ip as (_,p_), (ptp as (pt,p), tacis)) = (ip,cs);
   233    val (ip as (_,p_), (ptp as (pt,p), tacis)) = (pos, cs);
   234    *)
   235 fun step ((ip as (_,p_)):pos') ((ptp as (pt,p), tacis):calcstate) =
   236     let val pIopt = get_pblID (pt,ip);
   237     in if (*p = ([],Res) orelse*) ip = ([],Res)
   238        then ("end-of-calculation",(tacis, [], ptp):calcstate') else
   239        case tacis of
   240 	   (_::_) =>
   241 (* val((tac,_,_)::_) = tacis;
   242    *) 
   243 	   if ip = p (*the request is done where ptp waits for*)
   244 	   then let val (pt',c',p') = generate tacis (pt,[],p)
   245 		in ("ok", (tacis, c', (pt', p'))) end
   246 	   else (case (if p_ mem [Pbl,Met]
   247 		       then nxt_specify_ (pt,ip) else nxt_solve_ (pt,ip))
   248 		      handle _ => ([],[],ptp)(*e.g.by Add_Given "equality///"*)
   249 		  of cs as ([],_,_) => ("helpless", cs)
   250 		   | cs => ("ok", cs))
   251 (* val [] = tacis;
   252    *) 
   253 	 | _ => (case pIopt of
   254 		     None => ("no-fmz-spec", ([], [], ptp))
   255 		   | Some pI =>
   256 (* (*1*)val Some pI = pIopt; 
   257    val cs = (if p_ mem [Pbl,Met] andalso is_none (get_obj g_env pt (fst p))
   258 	     then nxt_specify_ (pt,ip) else nxt_solve_ (pt,ip))
   259        handle _ => ([], ptp);
   260    *)
   261 		     (case (if p_ mem [Pbl,Met]
   262 			       andalso is_none (get_obj g_env pt (fst p))
   263 			    (*^^^^^^^^: Apply_Method without init_form*)
   264 			    then nxt_specify_ (pt,ip) else nxt_solve_ (pt,ip) )
   265 			   handle _ => ([],[],ptp)(*e.g.by Add_Giv"equality/"*)
   266 		       of cs as ([],_,_) =>("helpless", cs)(*FIXXMEdel.handle*)
   267 			| cs => ("ok", cs)))
   268     end;
   269 
   270 (*  (nxt_solve_ (pt,ip)) handle e => print_exn e ;
   271 
   272    *)
   273 
   274 (*.does several steps within one calculation as given by "type auto";
   275    the steps may arbitrarily go into and leave different phases, 
   276    i.e. specify-phase and solve-phase.*)
   277 (*TODO.WN0512 ? redesign after the phases have been more separated
   278   at the fron-end in 05: 
   279   eg. CompleteCalcHead could be done by a separate fun !!!*)
   280 (* val (ip, cs as (ptp as (pt,p),tacis)) = (get_pos cI 1, get_calc cI);
   281 
   282    (*1*)val (c, ip, cs as (ptp as (_,p),tacis), Step s) = 
   283        ([]:pos' list, pold, get_calc cI, auto);
   284    *) 
   285 fun autocalc c ip (cs as (ptp as (_,p),tacis)) (Step s) =
   286     if s <= 1
   287     then let val (str, (_, c', ptp)) = step ip cs;(*1*)
   288 	 (*at least does 1 step, ev.1 too much*)
   289 	 in (str, c@c', ptp) end
   290     else let val (str, (_, c', ptp as (_, p))) = step ip cs;
   291 	 in if str = "ok" 
   292 	    then autocalc (c@c') p (ptp,[]) (Step (s-1))
   293 	    else (str, c@c', ptp) end
   294 (*handles autoord <= 3, autoord > 3 handled by all_/complete_solve*)
   295   | autocalc c (pos as (_,p_)) ((pt,_), _(*tacis would help 1x in solve*))auto=
   296 (* val (c:pos' list, (pos as (_,p_)),((pt,_),_),auto) = 
   297       ([], pold, get_calc cI, auto);
   298    *)
   299      if autoord auto > 3 andalso just_created (pt, pos)
   300      then let val ptp = all_modspec (pt, pos);
   301 	  in all_solve auto c ptp end
   302      else
   303 	 if p_ mem [Pbl, Met]
   304 	 then if not (is_complete_mod (pt, pos))
   305 	      then let val ptp = complete_mod (pt, pos)
   306 		   in if autoord auto < 3 then ("ok", c, ptp)
   307 		      else 
   308 			  if not (is_complete_spec ptp)
   309 			  then let val ptp = complete_spec ptp
   310 			       in if autoord auto = 3 then ("ok", c, ptp)
   311 				  else all_solve auto c ptp
   312 			       end
   313 			  else if autoord auto = 3 then ("ok", c, ptp)
   314 			  else all_solve auto c ptp 
   315 		   end
   316 	      else 
   317 		  if not (is_complete_spec (pt,pos))
   318 		  then let val ptp = complete_spec (pt, pos)
   319 		       in if autoord auto = 3 then ("ok", c, ptp)
   320 			  else all_solve auto c ptp
   321 		       end
   322 		  else if autoord auto = 3 then ("ok", c, (pt, pos))
   323 		  else all_solve auto c (pt, pos)
   324 	 else complete_solve auto c (pt, pos);
   325 (* val pbl = get_obj g_pbl (fst ptp) [];
   326    val (oris,_,_) = get_obj g_origin (fst ptp) [];
   327 *)    
   328 
   329 
   330 
   331 
   332 
   333 (*.initialiye matching; before 'tryMatch' get the pblID to match with:
   334    if no pbl has been specified, take the init from origin.*)
   335 (*fun initmatch pt (pos as (p,_):pos') =
   336     let val PblObj {probl,origin=(os,(_,pI,_),_),spec=(dI',pI',mI'),...} = 
   337 	    get_obj I pt p
   338 	val pblID = if pI' = e_pblID 
   339 		    then (*TODO.WN051125 (#init o get_pbt) pI          <<<*) 
   340 			takelast (2, pI) (*FIXME.WN051125 a hack, impl.^^^*)
   341 		    else pI'
   342 	val spec = (dI',pblID,mI')
   343 	val {ppc,where_,prls,...} = get_pbt pblID
   344 	val (model_ok, (pbl, pre)) = 
   345 	    match_itms_oris (assoc_thy "Isac.thy") probl (ppc,where_,prls) os
   346     in ModSpec (ocalhd_complete pbl pre spec,
   347 		Pbl, e_term, pbl, pre, spec) end;*)
   348 fun initcontext_pbl pt (pos as (p,_):pos') =
   349     let val PblObj {probl,origin=(os,(_,pI,_),hdl),spec=(dI',pI',mI'),...} = 
   350 	    get_obj I pt p
   351 	val pblID = if pI' = e_pblID 
   352 		    then (*TODO.WN051125 (#init o get_pbt) pI          <<<*) 
   353 			takelast (2, pI) (*FIXME.WN051125 a hack, impl.^^^*)
   354 		    else pI'
   355 	val {ppc,where_,prls,...} = get_pbt pblID
   356 	val (model_ok, (pbl, pre)) = 
   357 	    match_itms_oris (assoc_thy "Isac.thy") probl (ppc,where_,prls) os
   358     in (model_ok, pblID, hdl, pbl, pre) end;
   359 
   360 fun initcontext_met pt (pos as (p,_):pos') =
   361     let val PblObj {meth,origin=(os,(_,_,mI), _),spec=(_, _, mI'),...} = 
   362 	    get_obj I pt p
   363 	val metID = if mI' = e_metID 
   364 		    then (*TODO.WN051125 (#init o get_pbt) pI          <<<*) 
   365 			takelast (2, mI) (*FIXME.WN051125 a hack, impl.^^^*)
   366 		    else mI'
   367 	val {ppc,pre,prls,scr,...} = get_met metID
   368 	val (model_ok, (pbl, pre)) = 
   369 	    match_itms_oris (assoc_thy "Isac.thy") meth (ppc,pre,prls) os
   370     in (model_ok, metID, scr, pbl, pre) end;
   371 
   372 (*.match the model of a problem at pos p 
   373    with the model-pattern of the problem with pblID*)
   374 fun context_pbl pI pt (p:pos) =
   375     let val PblObj {probl,origin=(os,_,hdl),...} = get_obj I pt p
   376 	val {ppc,where_,prls,...} = get_pbt pI
   377 	val (model_ok, (pbl, pre)) = 
   378 	    match_itms_oris (assoc_thy "Isac.thy") probl (ppc,where_,prls) os
   379     in (model_ok, pI, hdl, pbl, pre) end;
   380 
   381 fun context_met mI pt (p:pos) =
   382     let val PblObj {meth,origin=(os,_,hdl),...} = get_obj I pt p
   383 	val {ppc,pre,prls,scr,...} = get_met mI
   384 	val (model_ok, (pbl, pre)) = 
   385 	    match_itms_oris (assoc_thy "Isac.thy") meth (ppc,pre,prls) os
   386     in (model_ok, mI, scr, pbl, pre) end
   387 
   388 
   389 fun tryrefine pI pt (pos as (p,_):pos') =
   390     let val PblObj {probl,origin=(os,_,_),spec=(dI,_,mI),...} = get_obj I pt p
   391     in case refine_pbl (assoc_thy "Isac.thy") pI probl of
   392 	   None => (*copy from trymatch*)
   393 	   let val {ppc,where_,prls,...} = get_pbt pI
   394 	       val (_, (pbl, pre)) = match_itms_oris (assoc_thy "Isac.thy") 
   395 						     probl (ppc,where_,prls) os
   396 	   in ModSpec (ocalhd_complete pbl pre (dI,pI,mI),
   397 		       Pbl, e_term, pbl, pre, (dI,pI,mI)) end
   398 	 | Some (pI, (pbl, pre)) => 
   399 	   ModSpec (ocalhd_complete pbl pre (dI,pI,mI),
   400 		    Pbl, e_term, pbl, pre, (dI,pI,mI)) 
   401     end;
   402 (*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
   403 (* val (pI, pt, pos as (p,_)) = (pblID, pt, p);
   404    *)
   405 fun tryrefine pI pt (pos as (p,_):pos') =
   406     let val PblObj {probl,origin=(os,_,hdl),...} = get_obj I pt p
   407     in case refine_pbl (assoc_thy "Isac.thy") pI probl of
   408 	   None => (*copy from context_pbl*)
   409 	   let val {ppc,where_,prls,...} = get_pbt pI
   410 	       val (_, (pbl, pre)) = match_itms_oris (assoc_thy "Isac.thy") 
   411 						     probl (ppc,where_,prls) os
   412 	   in (false, pI, hdl, pbl, pre) end
   413 	 | Some (pI, (pbl, pre)) => 
   414 	   (true, pI, hdl, pbl, pre) 
   415     end;
   416 
   417 (*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*)
   418 
   419 (* val (pt, (pos as (p,p_):pos')) = (pt, ip);
   420    *)
   421 fun detailstep pt (pos as (p,p_):pos') = 
   422     let val nd = get_nd pt p
   423 	val cn = children nd
   424     in if null cn 
   425        then if (is_rewset o (get_obj g_tac nd)) [(*root of nd*)]
   426 	    then detailrls pt pos
   427 	    else ("no-Rewrite_Set...", EmptyPtree, e_pos')
   428        else ("donesteps", pt(*, get_formress [] ((lev_on o lev_dn) p) cn*),
   429 	     (p @ [length (children (get_nd pt p))], Res) ) 
   430     end;
   431 
   432 
   433 
   434 (***. for mathematics authoring on sml-toplevel; no XML .***)
   435 
   436 type NEW = int list;
   437 (* val sp = (dI',pI',mI');
   438    *)
   439 
   440 (*15.8.03 for me with loc_specify/solve, nxt_specify/solve
   441  delete as soon as TESTg_form -> _mout_ dropped*)
   442 fun TESTg_form ptp =
   443 (* val ptp = (pt,p);
   444    *) 
   445     let val (form,_,_) = pt_extract ptp
   446     in case form of
   447 	   Form t => Form' (FormKF (~1,EdUndef,0,Nundef,term2str t))
   448 	 | ModSpec (_,p_, head, gfr, pre, _) => 
   449 	   Form' (PpcKF (0,EdUndef,0,Nundef,
   450 			 (case p_ of Pbl => Problem[] | Met => Method[],
   451 			  itms2itemppc (assoc_thy"Isac.thy") gfr pre)))
   452     end;
   453 
   454 (*.create a calc-tree; for use within sml: thus ^^^ NOT decoded to ^;
   455    compare "fun CalcTree" which DOES decode.*)
   456 fun CalcTreeTEST [(fmz, sp):fmz] = 
   457 (* val [(fmz, sp):fmz] = [(fmz, (dI',pI',mI'))];
   458    val [(fmz, sp):fmz] = [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
   459    *)
   460     let val cs as ((pt,p), tacis) = nxt_specify_init_calc (fmz, sp)
   461 	val tac = case tacis of [] => Empty_Tac | _ => (#1 o hd) tacis
   462 	val f = TESTg_form (pt,p)
   463     in (p, []:NEW, f, (tac2IDstr tac, tac), Sundef, pt) end; 
   464        
   465 (*for tests > 15.8.03 after separation setnexttactic / nextTac:
   466   external view: me should be used by math-authors as done so far
   467   internal view: loc_specify/solve, nxt_specify/solve used
   468                  i.e. same as in setnexttactic / nextTac*)
   469 (*ENDE TESTPHASE 08/10.03:
   470   NEW loeschen, eigene Version von locatetac, step
   471   meNEW, CalcTreeTEST: tac'_ -replace-> tac, remove [](cid) *)
   472 
   473 
   474 fun me ((_,tac):tac'_) (p:pos') (_:NEW(*remove*)) (pt:ptree) =
   475 (* val (_,tac) = nxt;
   476    *) let val (pt, p) = 
   477 (* val (msg, (tacis, pos's, (pt',p'))) = locatetac tac (pt,p);
   478    f2str (TESTg_form (pt', p'));
   479    (writeln o (itms2str thy)) (get_obj g_pbl pt' (fst p'));
   480    writeln( istate2str (get_istate pt' ([3],Res)));
   481    term2str (fst (get_obj g_result pt' [3]));
   482    val (pt,p) = (pt',p');
   483    *)
   484 	      (*locatetac is here for testing by me; step would suffice in me*)
   485 	    case locatetac tac (pt,p) of
   486 		("ok", (_, _, ptp))  => ptp
   487 	      | ("unsafe-ok", (_, _, ptp)) => ptp
   488 	      | ("not-applicable",_) => (pt, p)
   489 	      | ("end-of-calculation", (_, _, ptp)) => ptp
   490 	      | ("failure",_) => raise error "sys-error";
   491 	val (_, ts) = 
   492 (* val (eee, (ts, _, (pt'',_))) = step p ((pt, e_pos'),[]);
   493    *)
   494 	    (case step p ((pt, e_pos'),[]) of
   495 		 ("ok", (ts as (tac,_,_)::_, _, _)) => ("",ts)
   496 	       | ("helpless",_) => ("helpless: cannot propose tac", [])
   497 	       | ("no-fmz-spec",_) => raise error "no-fmz-spec"
   498 	       | ("end-of-calculation", (ts, _, _)) => ("",ts))
   499 	    handle _ => raise error "sys-error";
   500 	val tac = case ts of tacis as (_::_) => 
   501 			     let val (tac,_,_) = last_elem tacis
   502 			     in tac end 
   503 			   | _ => if p = ([],Res) then End_Proof'
   504 				  else Empty_Tac;
   505       (*form output comes from locatetac*)
   506     in(p:pos',[]:NEW, TESTg_form (pt, p), 
   507 	(tac2IDstr tac, tac):tac'_, Sundef, pt)  end;
   508 
   509 (*for quick test-print-out, until 'type inout' is removed*)
   510 fun f2str (Form' (FormKF (_, _, _, _, cterm'))) = cterm';
   511 
   512 
   513 
   514 (*------------------------------------------------------------------(**)
   515 end
   516 open MathEngine;
   517 (**)------------------------------------------------------------------*)
   518