test/Tools/isac/Minisubpbl/200-start-method-NEXT_STEP.sml
author Walther Neuper <walther.neuper@jku.at>
Wed, 03 Jun 2020 11:25:19 +0200
changeset 60017 cdcc5eba067b
parent 59997 46fe5a8c3911
child 60154 2ab0d1523731
permissions -rw-r--r--
follow 2 ancient updates of Library.ML
walther@59781
     1
(* Title:  "Minisubpbl/200-start-method-NEXT_STEP.sml"
walther@59781
     2
   Author: Walther Neuper 1105
walther@59781
     3
   (c) copyright due to lincense terms.
walther@59781
     4
*)
walther@59781
     5
walther@59781
     6
"----------- Minisubplb/200-start-method-NEXT_STEP.sml ---------------------------------------";
walther@59781
     7
"----------- Minisubplb/200-start-method-NEXT_STEP.sml ---------------------------------------";
walther@59781
     8
"----------- Minisubplb/200-start-method-NEXT_STEP.sml ---------------------------------------";
walther@59997
     9
val fmz = ["equality (x+1=(2::real))", "solveFor x", "solutions L"];
walther@59781
    10
val (dI',pI',mI') =
walther@59997
    11
  ("Test", ["sqroot-test", "univariate", "equation", "test"],
walther@59997
    12
   ["Test", "squ-equ-test-subpbl1"]);
walther@59781
    13
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
walther@59787
    14
(*[], Pbl*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Model_Problem*)
walther@59851
    15
walther@59851
    16
(*rewrite__set_ called with 'Rule_Set.Empty' for 'precond_rootpbl x'*)
walther@59851
    17
(*[], Pbl*)val (_, ([(tac''''', _, _)], _, (pt''''', p'''''))) = Step.do_next p ((pt, e_pos'), []);(*Specify_Theory*)
walther@59851
    18
walther@59851
    19
(*/--------- step into Specify_Theory --------------------------------------------------------\*)
walther@59851
    20
"~~~~~ fun do_next , args:"; val ((ip as (_, p_)), (ptp as (pt, p), tacis)) = (p, ((pt, e_pos'), []));
walther@59851
    21
    val pIopt = Ctree.get_pblID (pt, ip);
walther@59851
    22
    (*if*) ip = ([], Pos.Res) (*else*);
walther@59851
    23
      val _ = (*case*) tacis (*of*);
walther@59851
    24
      val SOME _ = (*case*) pIopt (*of*);
walther@59851
    25
walther@59851
    26
(*rewrite__set_ called with 'Rule_Set.Empty' for 'precond_rootpbl x'*)
walther@59851
    27
           switch_specify_solve p_ (pt, ip);
walther@59851
    28
"~~~~~ fun switch_specify_solve , args:"; val (state_pos, (pt, input_pos)) = (p_, (pt, ip));
walther@60017
    29
      (*if*) member op = [Pos.Pbl, Pos.Met] state_pos (*then*);
walther@59851
    30
walther@59851
    31
(*rewrite__set_ called with 'Rule_Set.Empty' for 'precond_rootpbl x'*)
walther@59851
    32
           specify_do_next (pt, input_pos);
walther@59851
    33
"~~~~~ fun specify_do_next , args:"; val (ptp as (pt, (p, p_))) = (pt, input_pos);
walther@59851
    34
walther@59851
    35
(*rewrite__set_ called with 'Rule_Set.Empty' for 'precond_rootpbl x'*)
walther@59851
    36
    val (_, (_, _)) =
walther@59976
    37
Specify.find_next_step ptp;
walther@59851
    38
"~~~~~ fun find_next_step , args:"; val (pt, (p, p_)) = ptp;
walther@59851
    39
    val (pblobj, met, origin, oris, dI', pI', mI', pbl, dI, pI, mI) = 
walther@59851
    40
  	  case Ctree.get_obj I pt p of
walther@59851
    41
  	    pblobj as (Ctree.PblObj {meth, origin = origin as (oris, (dI', pI', mI'), _),
walther@59851
    42
  		  probl, spec = (dI, pI, mI), ...}) => (pblobj, meth, origin, oris, dI', pI', mI', probl, dI, pI, mI)
walther@59851
    43
      | Ctree.PrfObj _ => error "nxt_specify_: not on PrfObj";
walther@59851
    44
    (*if*) Ctree.just_created_ pblobj (*by Subproblem*) andalso origin <> Ctree.e_origin (*else*);
walther@59903
    45
        val cpI = if pI = Problem.id_empty then pI' else pI;
walther@59903
    46
  	    val cmI = if mI = Method.id_empty then mI' else mI;
walther@59970
    47
  	    val {ppc = pbt, prls, where_, ...} = Problem.from_store cpI;
walther@59851
    48
walther@59851
    49
(*+* )------- in f3cac3053e7b (Rule_Set.empty just renamed, NOT deleted) we had
walther@59851
    50
(*+*)  prls =
walther@59852
    51
(*+*)    Rule_Set.Repeat {calc = [], erls = Rule_Set.Empty, errpatts = [], id = "empty", preconds = [], rew_ord =
walther@59878
    52
(*+*)      ("dummy_ord", fn), rules = [], scr = Empty_Prog, srls = Rule_Set.Empty}:
walther@59851
    53
(*+*).. THIS IS Rule_Set.empty, BUT IT DID not CAUSE ANY ERROR !
walther@59851
    54
(*+*)------- WITH Rule_Set.empty REMOVED (based on f3cac3053e7b) we had
walther@59851
    55
(*+*)val Empty = prls (* <---ERROR: rewrite__set_ called with 'Rule_Set.Empty' for 'precond_rootpbl x' *)
walther@59851
    56
( *+*)val ["sqroot-test", "univariate", "equation", "test"] = cpI
walther@59851
    57
(*\--------- step into Specify_Theory --------------------------------------------------------/*)
walther@59851
    58
walther@59851
    59
(*[], Pbl*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p''''' ((pt''''', e_pos'), []);(*Specify_Problem ["sqroot-test", "univariate", "equation", "test"*)
walther@59787
    60
(*[], Met*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Specify_Method ["Test", "squ-equ-test-subpbl1"]*)
walther@59787
    61
(*[1], Frm*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Apply_Method ["Test", "squ-equ-test-subpbl1"]*)
walther@59787
    62
(*[1], Res*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Rewrite_Set "norm_equation"*)
walther@59787
    63
(*[2], Res*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Rewrite_Set "Test_simplify"*)
walther@59787
    64
(*[3], Pbl*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(* Subproblem ("Test", ["LINEAR", "univariate", "equation", "test"])*)
walther@59787
    65
(*[3], Pbl*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Model_Problem*)
walther@59787
    66
(*[3], Pbl*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Specify_Theory "Test"*)
walther@59787
    67
(*[3], Pbl*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Specify_Problem ["LINEAR", "univariate", "equation", "test"]*)
walther@59787
    68
(*[3], Met*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Specify_Method ["Test", "solve_linear"]*)
walther@59787
    69
(*[3, 1], Frm*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Apply_Method ["Test", "solve_linear"]*)
walther@59787
    70
(*[3, 1], Res*)val (_, ([(tac, _, _)], _, (pt, p))) = Step.do_next p ((pt, e_pos'), []);(*Rewrite_Set_Inst (["(''bdv'', x)"], "isolate_bdv")*)
walther@59851
    71
walther@59851
    72
val  Rewrite_Set_Inst (["(''bdv'', x)"], "isolate_bdv") = tac;
walther@59851
    73
walther@59868
    74
if p = ([3, 1], Res) andalso (get_obj g_res pt (fst p) |> UnparseC.term) = "x = 0 + -1 * -1"
walther@59851
    75
then case tac of Rewrite_Set_Inst (["(''bdv'', x)"], "isolate_bdv") => ()
walther@59851
    76
  | _ => error "Minisubplb/200-start-method-NEXT_STEP.sml CHANGED 1"
walther@59851
    77
else error "Minisubplb/200-start-method-NEXT_STEP.sml CHANGED 2"