sml-050215a-interSteps: corrected an error sml-050215a-interSteps
authorwneuper
Tue, 15 Feb 2005 10:32:34 +0100
changeset 20900912fe37ade0
parent 2089 abf2d790467b
child 2091 975866b2730b
sml-050215a-interSteps: corrected an error
src/sml/FE-interface/interface.sml
src/sml/ME/ctree.sml
src/sml/ROOT.ML
src/sml/systest/FE-interface.sml
     1.1 --- a/src/sml/FE-interface/interface.sml	Mon Feb 14 17:19:42 2005 +0100
     1.2 +++ b/src/sml/FE-interface/interface.sml	Tue Feb 15 10:32:34 2005 +0100
     1.3 @@ -205,20 +205,22 @@
     1.4  (* val (cI, iI) = (1,1);
     1.5     *)
     1.6  fun interSteps cI (*iI*) ip = 
     1.7 -    let val ((pt,p), tacis) = get_calc cI
     1.8 -	(*val ip = get_pos cI iI*)
     1.9 -    in if fst_onlev ip
    1.10 -       then interStepsERROR cI "first formula on level has NO \
    1.11 -			       \intermediate steps"
    1.12 -       else (case detailstep pt ip of
    1.13 -		 ("detailrls", pt(*, pos'forms*), lastpos) => 
    1.14 -		 (upd_calc cI ((pt, p), tacis);
    1.15 -		  interStepsOK cI (*pos'forms*) ip ip lastpos)
    1.16 -	       | ("donesteps", _(*, pos'formshds*), lastpos) => 
    1.17 -		 interStepsOK cI (*pos'formshds*) ip ip lastpos)
    1.18 -	    handle _ => sysERROR2xml cI ""
    1.19 -    end;
    1.20 -    
    1.21 +	let val ((pt,p), tacis) = get_calc cI
    1.22 +	(*val ip = get_pos cI iI*)(*WN050215 quick and dirty*)
    1.23 +	in if fst_onlev ip
    1.24 +	   then interStepsERROR cI "first formula on level has NO \
    1.25 +				   \intermediate steps"
    1.26 +	   else let val ip' = lev_pred' pt ip
    1.27 +		in (case detailstep pt ip of
    1.28 +			("detailrls", pt(*, pos'forms*), lastpos) => 
    1.29 +			(upd_calc cI ((pt, p), tacis);
    1.30 +			 interStepsOK cI (*pos'forms*) ip' ip' lastpos)
    1.31 +		      | ("donesteps", _(*, pos'formshds*), lastpos) => 
    1.32 +			interStepsOK cI (*pos'formshds*) ip' ip' lastpos)
    1.33 +		   handle _ => sysERROR2xml cI "syserror in detailstep"
    1.34 +		end
    1.35 +	end;
    1.36 +	
    1.37  fun modifyCalcHead (cI:calcID) (ichd as ((p,_),_,_,_,_):icalhd) =
    1.38      let val ((pt,_),_) = get_calc cI
    1.39      in case input_icalhd pt ichd of
     2.1 --- a/src/sml/ME/ctree.sml	Mon Feb 14 17:19:42 2005 +0100
     2.2 +++ b/src/sml/ME/ctree.sml	Tue Feb 15 10:32:34 2005 +0100
     2.3 @@ -734,6 +734,7 @@
     2.4  val it = [1,2,2] : pos
     2.5  > lev_pred [1];
     2.6  val it = [0] : pos          *)
     2.7 +
     2.8  fun lev_dn p = p @ [0];
     2.9  (*> (lev_dn o lev_on) [1,2,3];
    2.10  val it = [1,2,4,0] : pos    *)
    2.11 @@ -891,6 +892,8 @@
    2.12      else false;
    2.13  
    2.14  fun fst_onlev (([], Frm):pos') = true
    2.15 +  | fst_onlev (([], Pbl):pos') = true
    2.16 +  | fst_onlev (([], Met):pos') = true
    2.17    | fst_onlev (pos, Frm) = last_elem pos = 1
    2.18    | fst_onlev _ = false;
    2.19  fun last_onlev pt pos = not (existpt (lev_on pos) pt);
    2.20 @@ -1788,6 +1791,11 @@
    2.21      if is_pblobj (get_obj I pt p) 
    2.22      then (p, Pbl) else (par_pblobj pt p, Pbl);
    2.23   
    2.24 +(*WN0502 made for interSteps; _only_ regards branch TransitiveB*)
    2.25 +fun lev_pred' pt (pos:pos' as (p,Res)) =
    2.26 +    if (is_pblobj o (get_obj I pt)) p then (p,Pbl):pos' else move_up [] pt pos
    2.27 +  | lev_pred' pt p = move_up [] pt p;
    2.28 +
    2.29  
    2.30  
    2.31    
     3.1 --- a/src/sml/ROOT.ML	Mon Feb 14 17:19:42 2005 +0100
     3.2 +++ b/src/sml/ROOT.ML	Tue Feb 15 10:32:34 2005 +0100
     3.3 @@ -75,7 +75,7 @@
     3.4  
     3.5  *)
     3.6  
     3.7 -  val version_kernel = "sml-050214a-intermediateSteps";
     3.8 +  val version_kernel = "sml-050215a-intermediateSteps";
     3.9  
    3.10    print_depth 3; 
    3.11  
     4.1 --- a/src/sml/systest/FE-interface.sml	Mon Feb 14 17:19:42 2005 +0100
     4.2 +++ b/src/sml/systest/FE-interface.sml	Tue Feb 15 10:32:34 2005 +0100
     4.3 @@ -819,25 +819,26 @@
     4.4   val ((pt,_),_) = get_calc 1;
     4.5   show_pt pt;
     4.6  
     4.7 -(*---------------this is NOT according to the interface ----------
     4.8 - interSteps 1 ([],Pbl); (*not necessary on subproblems*);
     4.9 - val (unc, del, gen) = (([],Pbl),([],Pbl),([4],Res));
    4.10 - getElementsFromTo 1 unc gen 1 false;
    4.11 -------------------------------------------------------------------*)
    4.12 + (*UC\label{SOLVE:INFO:intermediate-steps}*)
    4.13 + interSteps 1 ([2],Res);
    4.14 + val ((pt,_),_) = get_calc 1; show_pt pt (*new ([2,1],Frm)..([2,6],Res)*);
    4.15 + val (unc, del, gen) = (([1],Res),([1],Res),([2,6],Res));
    4.16 + getElementsFromTo 1 unc gen 1 false; 
    4.17  
    4.18   (*UC\label{SOLVE:INFO:intermediate-steps}*)
    4.19 - interSteps 1 ([2],Res);
    4.20 -     (*delivers        (([2],Res),([2],Res),([2,6],Res)); wrong!!!*)
    4.21 - val ((pt,_),_) = get_calc 1; show_pt pt (*calculates 6 intermediate steps*);
    4.22 - val (unc, del, gen) = (([1],Res),([1],Res),([2,6],Res));
    4.23 -     (*TODO.WN050214      2         2                  correct to above!!!*)
    4.24 + interSteps 1 ([3,2],Res);
    4.25 + val ((pt,_),_) = get_calc 1; show_pt pt (*new ([3,2,1],Frm)..([3,2,2],Res)*);
    4.26 + val (unc, del, gen) = (([3,1],Res),([3,1],Res),([3,2,2],Res));
    4.27 + getElementsFromTo 1 unc gen 1 false; 
    4.28 +
    4.29 + (*UC\label{SOLVE:INFO:intermediate-steps}*)
    4.30 + interSteps 1 ([3],Res)  (*no new steps in subproblems*);
    4.31 + val (unc, del, gen) = (([3],Pbl),([3],Pbl),([3,2],Res));
    4.32   getElementsFromTo 1 unc gen 1 false; 
    4.33  
    4.34   (*UC\label{SOLVE:INFO:intermediate-steps}*)
    4.35   interSteps 1 ([],Res)  (*no new steps in subproblems*);
    4.36 -     (*delivers        (([],Res),([],Res),([4],Res)); wrong!!!*)
    4.37   val (unc, del, gen) = (([],Pbl),([],Pbl),([4],Res));
    4.38 -     (*TODO.WN050214      2         2                  correct to above!!!*)
    4.39   getElementsFromTo 1 unc gen 1 false; 
    4.40  
    4.41