test/Tools/isac/Interpret/calchead.sml
author Walther Neuper <neuper@ist.tugraz.at>
Fri, 01 Oct 2010 10:23:38 +0200
branchisac-update-Isa09-2
changeset 38036 02a9b2540eb7
parent 38032 121765ba0a34
child 38051 efdeff9df986
permissions -rw-r--r--
repaired 'prepat's, the patterns and preconditions for Rrls

fun parse_patt still lacks numbers_to_string, typ_a2real
because this causes a strange error in Poly.thy to be removed next
     1 (* Title: tests on calchead.sml
     2    Author: Walther Neuper 051013,
     3    (c) due to copyright terms
     4 
     5 12345678901234567890123456789012345678901234567890123456789012345678901234567890
     6         10        20        30        40        50        60        70        80
     7 *)
     8 
     9 "--------------------------------------------------------";
    10 "table of contents --------------------------------------";
    11 "--------------------------------------------------------";
    12 "--------- get_interval after replace} other 2 ----------";
    13 "--------- maximum example with 'specify' ---------------";
    14 "--------- maximum example with 'specify', fmz <> [] ----";
    15 "--------- maximum example with 'specify', fmz = [] -----";
    16 "--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
    17 "--------- regression test fun is_copy_named ------------";
    18 "--------- regr.test fun cpy_nam ------------------------";
    19 "--------------------------------------------------------";
    20 "--------------------------------------------------------";
    21 "--------------------------------------------------------";
    22 
    23 (*========== inhibit exn =======================================================
    24 "--------- get_interval after replace} other 2 ----------";
    25 "--------- get_interval after replace} other 2 ----------";
    26 "--------- get_interval after replace} other 2 ----------";
    27 states := [];
    28  CalcTree
    29  [(["equality (x+1=2)", "solveFor x","solutions L"], 
    30    ("Test.thy", 
    31     ["sqroot-test","univariate","equation","test"],
    32     ["Test","squ-equ-test-subpbl1"]))];
    33  Iterator 1;
    34  moveActiveRoot 1;
    35  autoCalculate 1 CompleteCalc;
    36  moveActiveFormula 1 ([2],Res); (*there is "-1 + x = 0"*)
    37  replaceFormula 1 "x = 1"; 
    38  (*... returns calcChangedEvent with ...*)
    39  val (unc, del, gen) = (([1],Res), ([4],Res), ([3,2],Res));
    40  val ((pt,_),_) = get_calc 1;
    41 
    42 print_depth 99;map fst (get_interval ([],Pbl) ([],Res) 9999 pt);print_depth 3;
    43 if map fst (get_interval ([],Pbl) ([],Res) 9999 pt) = 
    44     [([], Pbl), ([1], Frm),([1], Res), ([2], Res), ([3], Pbl), ([3, 1], Frm), 
    45      ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
    46       ([3, 2], Res)] then () else
    47 error "calchead.sml: diff.behav. get_interval after replace} other 2 a";
    48 
    49 print_depth 99;map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt);
    50 print_depth 3;
    51 if map fst (get_interval ([3, 2, 1], Res) ([],Res) 9999 pt) = 
    52     [([3, 2, 1], Res), ([3, 2, 2], Res), ([3, 2], Res)] then () else
    53 error "modspec.sml: diff.behav. get_interval after replace} other 2 b";
    54 
    55 
    56 
    57 
    58 "--------- maximum example with 'specify' ------------------------";
    59 "--------- maximum example with 'specify' ------------------------";
    60 "--------- maximum example with 'specify' ------------------------";
    61 (*"              Specify_Problem (match_itms_oris)       ";*)
    62 val fmz =
    63     ["fixedValues [r=Arbfix]","maximum A",
    64      "valuesFor [a,b]",
    65      "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
    66      "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
    67      "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
    68 
    69      "boundVariable a","boundVariable b","boundVariable alpha",
    70      "interval {x::real. 0 <= x & x <= 2*r}",
    71      "interval {x::real. 0 <= x & x <= 2*r}",
    72      "interval {x::real. 0 <= x & x <= pi}",
    73      "errorBound (eps=(0::real))"];
    74 val (dI',pI',mI') =
    75   ("DiffApp.thy",["maximum_of","function"],
    76    ["DiffApp","max_by_calculus"]);
    77 val c = []:cid;
    78 
    79 (*val nxt = Init_Proof' (fmz,(dI',pI',mI'));
    80 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] EmptyPtree;
    81 *)
    82 val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
    83 val nxt = tac2tac_ pt p nxt; 
    84 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
    85 (*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
    86 
    87 val nxt = tac2tac_ pt p nxt; 
    88 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
    89 (**)
    90 
    91 (*---6.5.03
    92 val nxt = tac2tac_ pt p (Add_Find "valuesFor [(a::real)]"); 
    93 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
    94 (*uncaught exception TYPE 6.5.03*)
    95 
    96 if ppc<>(Problem [],  
    97          {Find=[Incompl "maximum",Incompl "valuesFor [a]"],
    98 	  Given=[Correct "fixedValues [r = Arbfix]"],
    99 	  Relate=[Incompl "relations []"], Where=[],With=[]})
   100 then error "test-maximum.sml: model stepwise - different behaviour" 
   101 else (); (*different with show_types !!!*)
   102 6.5.03---*)
   103 
   104 (*-----appl_add should not create Error', but accept as Sup,Syn
   105 val nxt = tac2tac_ pt p (Add_Given "boundVariable a"); 
   106 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   107 (**)
   108 val nxt = tac2tac_ pt p (Add_Given "boundVariable a+"); 
   109 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   110 (**)---*)
   111 
   112 val m = Specify_Problem ["maximum_of","function"];
   113 val nxt = tac2tac_ pt p m; 
   114 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   115 (**)
   116 
   117 if ppc<>(Problem ["maximum_of","function"],  
   118          {Find=[Incompl "maximum",Incompl "valuesFor"],
   119 	  Given=[Correct "fixedValues [r = Arbfix]"],
   120 	  Relate=[Incompl "relations []"], Where=[],With=[]})
   121 then error "diffappl.sml: Specify_Problem different behaviour" 
   122 else ();
   123 (* WN.3.9.03 (#391) Model_Specify did init_pbl newly 
   124 if ppc<>(Problem ["maximum_of","function"],
   125    {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
   126     Given=[Correct "fixedValues [r = Arbfix]"],
   127     Relate=[Missing "relations rs_"],Where=[],With=[]})
   128 then error "diffappl.sml: Specify_Problem different behaviour" 
   129 else ();*)
   130 
   131 val nxt = tac2tac_ pt p(Specify_Method ["DiffApp","max_by_calculus"]);
   132 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   133 (**)
   134 
   135 if ppc<>(Method ["DiffApp","max_by_calculus"],
   136 	 {Find=[Incompl "maximum",Incompl "valuesFor"],
   137 	  Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_v",
   138 		 Missing "interval itv_",Missing "errorBound err_"],
   139 	  Relate=[Incompl "relations []"],Where=[],With=[]})
   140 then error "diffappl.sml: Specify_Method different behaviour" 
   141 else ();
   142 (* WN.3.9.03 (#391) Model_Specify did init_pbl newly 
   143 if ppc<>(Method ["DiffApp","max_by_calculus"],
   144    {Find=[Missing "maximum m_",Missing "valuesFor vs_"],
   145     Given=[Correct "fixedValues [r = Arbfix]",Missing "boundVariable v_v",
   146            Missing "interval itv_",Missing "errorBound err_"],
   147     Relate=[Missing "relations rs_"],Where=[],With=[]})
   148 then error "diffappl.sml: Specify_Method different behaviour" 
   149 else ();*)
   150 
   151 
   152 
   153 "--------- maximum example with 'specify', fmz <> [] -------------";
   154 "--------- maximum example with 'specify', fmz <> [] -------------";
   155 "--------- maximum example with 'specify', fmz <> [] -------------";
   156 val fmz =
   157     ["fixedValues [r=Arbfix]","maximum A",
   158      "valuesFor [a,b]",
   159      "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
   160      "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
   161      "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
   162 
   163      "boundVariable a","boundVariable b","boundVariable alpha",
   164      "interval {x::real. 0 <= x & x <= 2*r}",
   165      "interval {x::real. 0 <= x & x <= 2*r}",
   166      "interval {x::real. 0 <= x & x <= pi}",
   167      "errorBound (eps=(0::real))"];
   168 val (dI',pI',mI') =
   169   ("DiffApp.thy",["maximum_of","function"],
   170    ["DiffApp","max_by_calculus"]);
   171 val c = []:cid;
   172 (*val nxt = Init_Proof' (fmz,(dI',pI',mI'));*)
   173 val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
   174 
   175 val nxt = tac2tac_ pt p nxt; 
   176 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] pt;
   177 val nxt = tac2tac_ pt p nxt; 
   178 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   179 (*val nxt = Add_Given "fixedValues [(r::real) = Arbfix]" : tac*)
   180 
   181 val nxt = tac2tac_ pt p nxt; 
   182 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   183 (*val nxt = Add_Find "maximum (A::bool)" : tac*)
   184 
   185 val nxt = tac2tac_ pt p nxt; 
   186 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   187 (*val nxt = Add_Find "valuesFor [(a::real)]" : tac*)
   188 
   189 val nxt = tac2tac_ pt p nxt; 
   190 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   191 (*val nxt = Add_Find "valuesFor [(b::real)]" : tac*)
   192 
   193 val nxt = tac2tac_ pt p nxt; 
   194 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   195 (*val nxt = Add_Relation "relations [A = a * b]" *)
   196 
   197 val nxt = tac2tac_ pt p nxt; 
   198 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   199 (*Add_Relation "relations\n [((a::real) // (#2::real)) ..."*)
   200 
   201 (*---------------------------- FIXXXXME.meNEW !!! partial Add-Relation !!!
   202   nxt_specif <> specify ?!
   203 
   204 if nxt<>(Add_Relation 
   205  "relations [(a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]")
   206 then error "test specify, fmz <> []: nxt <> Add_Relation (a/2)^2.." else (); (*different with show_types !!!*)
   207 
   208 val nxt = tac2tac_ pt p nxt; 
   209 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   210 ------------------------------ FIXXXXME.meNEW !!! ---*)
   211 
   212 (*val nxt = Specify_Theory "DiffApp.thy" : tac*)
   213 
   214 val itms = get_obj g_pbl pt (fst p);writeln(itms2str_ ctxt itms);
   215 
   216 val nxt = tac2tac_ pt p nxt; 
   217 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   218 (*val nxt = Specify_Problem ["maximum_of","function"]*)
   219 
   220 val nxt = tac2tac_ pt p nxt; 
   221 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   222 (*val nxt = Specify_Method ("DiffApp.thy","max_by_calculus")*)
   223 
   224 val nxt = tac2tac_ pt p nxt; 
   225 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   226 (*val nxt = Add_Given "boundVariable a" : tac*)
   227 
   228 val nxt = tac2tac_ pt p nxt; 
   229 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   230 (*val nxt = Add_Given "interval {x. #0 <= x & x <= #2 * r}" : *)
   231 
   232 val nxt = tac2tac_ pt p nxt; 
   233 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   234 (*val nxt = Add_Given "errorBound (eps = #0)" : tac*)
   235 
   236 val nxt = tac2tac_ pt p nxt; 
   237 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   238 (*val nxt = Apply_Method ("DiffApp.thy","max_by_calculus") *)
   239 if nxt<>(Apply_Method ["DiffApp","max_by_calculus"])
   240 then error "test specify, fmz <> []: nxt <> Apply_Method max_by_calculus" else ();
   241 
   242 
   243 "--------- maximum example with 'specify', fmz = [] --------------";
   244 "--------- maximum example with 'specify', fmz = [] --------------";
   245 "--------- maximum example with 'specify', fmz = [] --------------";
   246 val fmz = [];
   247 val (dI',pI',mI') = empty_spec;
   248 val c = []:cid;
   249 
   250 val nxt = Init_Proof' (fmz,(dI',pI',mI'));(*!!!!!!!!*)
   251 (*val (p,_,f,(_,nxt),_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))]; !!!*)
   252 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt e_pos' [] 
   253   EmptyPtree;
   254 val nxt = tac2tac_ pt p nxt; 
   255 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   256 (*val nxt = Specify_Theory "e_domID" : tac*)
   257 
   258 val nxt = Specify_Theory "DiffApp.thy";
   259 val nxt = tac2tac_ pt p nxt; 
   260 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   261 (*val nxt = Specify_Problem ["e_pblID"] : tac*)
   262 
   263 val nxt = Specify_Problem ["maximum_of","function"];
   264 val nxt = tac2tac_ pt p nxt; 
   265 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   266 (*val nxt = Add_Given "fixedValues" : tac*)
   267 
   268 val nxt = Add_Given "fixedValues [r=Arbfix]";
   269 val nxt = tac2tac_ pt p nxt; 
   270 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   271 (*val nxt = Add_Find "maximum" : tac*)
   272 
   273 val nxt = Add_Find "maximum A";
   274 val nxt = tac2tac_ pt p nxt; 
   275 
   276 
   277 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   278 (*val nxt = Add_Find "valuesFor" : tac*)
   279 
   280 val nxt = Add_Find "valuesFor [a]";
   281 val nxt = tac2tac_ pt p nxt; 
   282 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   283 (*val nxt = Add_Relation "relations" --- 
   284   --- [b=Arbfix] KANN NICHT VERLANGT WERDEN !!!!*)
   285 
   286 (*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
   287 if nxt<>(Add_Relation "relations []")
   288 then error "test specify, fmz <> []: nxt <> Add_Relation.." 
   289 else (); (*different with show_types !!!*)
   290 *)
   291 
   292 val nxt = Add_Relation "relations [(A=a+b)]";
   293 val nxt = tac2tac_ pt p nxt; 
   294 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   295 (*val nxt = Specify_Method ("e_domID","e_metID") : tac*)
   296 
   297 val nxt = Specify_Method ["DiffApp","max_by_calculus"];
   298 val nxt = tac2tac_ pt p nxt; 
   299 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   300 (*val nxt = Add_Given "boundVariable" : tac*)
   301 
   302 val nxt = Add_Given "boundVariable alpha";
   303 val nxt = tac2tac_ pt p nxt; 
   304 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   305 (*val nxt = Add_Given "interval" : tac*)
   306 
   307 val nxt = Add_Given "interval {x. 2 <= x & x <= 3}";
   308 val nxt = tac2tac_ pt p nxt; 
   309 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   310 (*val nxt = Add_Given "errorBound" : tac*)
   311 
   312 val nxt = Add_Given "errorBound (eps=999)";
   313 val nxt = tac2tac_ pt p nxt; 
   314 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt;
   315 (*val nxt = Apply_Method ("DiffApp","max_by_calculus") *)
   316 (*30.8.01 ... funktioniert nicht mehr nach Einfuehrung env ....
   317 if nxt<>(Apply_Method ("DiffApp.thy","max_by_calculus"))
   318 then error "test specify, fmz <> []: nxt <> Add_Relation.." 
   319 else ();
   320 *)
   321 
   322 (* 2.4.00 nach Transfer specify -> hard_gen
   323 val nxt = Apply_Method ("DiffApp.thy","max_by_calculus");
   324 val(p,_,Form'(PpcKF(_,_,_,_,ppc)),nxt,_,pt) = specify nxt p [] pt; *)
   325 (*val nxt = Empty_Tac : tac*)
   326 
   327 ============ inhibit exn =====================================================*)
   328 
   329 "--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
   330 "--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
   331 "--------- match_ags, is_cp, cpy_nam +with EqSystem (!)--";
   332 val Const ("Script.SubProblem",_) $
   333 	  (Const ("Pair",_) $
   334 		 Free (dI',_) $ 
   335 		 (Const ("Pair",_) $ pI' $ mI')) $ ags' =
   336     (*...copied from stac2tac_*)
   337     str2term (
   338 	"SubProblem (EqSystem', [linear, system], [no_met])         " ^
   339         "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
   340         "      REAL_LIST [c, c_2]]");
   341 val ags = isalist2list ags';
   342 val pI = ["linear","system"];
   343 val pats = (#ppc o get_pbt) pI;
   344 "-a1-----------------------------------------------------";
   345 (*match_ags = fn : theory -> pat list -> term list -> ori list*)
   346 val xxx = match_ags (theory "EqSystem") pats ags;
   347 "-a2-----------------------------------------------------";
   348 case match_ags (theory "Isac") pats ags of 
   349     [(1, [1], "#Given", Const ("Descript.equalities", _), _),
   350      (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
   351       [ _ $ Free ("c", _) $ _, _ $ Free ("c_2", _) $ _]),
   352      (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])] 
   353     =>()
   354   | _ => error "calchead.sml match_ags 2 args Nok ----------------";
   355 
   356 
   357 "-b------------------------------------------------------";
   358 val Const ("Script.SubProblem",_) $
   359 	  (Const ("Pair",_) $
   360 		 Free (dI',_) $ 
   361 		 (Const ("Pair",_) $ pI' $ mI')) $ ags' =
   362     (*...copied from stac2tac_*)
   363     str2term (
   364 	"SubProblem (EqSystem', [linear, system], [no_met])         " ^
   365         "     [BOOL_LIST [c_2 = 0, L * c + c_2 = q_0 * L ^^^ 2 / 2]," ^
   366         "      REAL_LIST [c, c_2], BOOL_LIST ss''']");
   367 val ags = isalist2list ags';
   368 val pI = ["linear","system"];
   369 val pats = (#ppc o get_pbt) pI;
   370 "-b1-----------------------------------------------------";
   371 val xxx = match_ags (theory "Isac") pats ags;
   372 "-b2-----------------------------------------------------";
   373 case match_ags (theory "EqSystem") pats ags of 
   374     [(1, [1], "#Given", Const ("Descript.equalities", _), _),
   375      (2, [1], "#Given", Const ("EqSystem.solveForVars", _),
   376          [_ $ Free ("c", _) $ _,
   377           _ $ Free ("c_2", _) $ _]),
   378      (3, [1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)])]
   379     (*         type of Find:            [Free ("ss'''", "bool List.list")]*)
   380     =>()
   381   | _ => error "calchead.sml match_ags copy-named dropped --------";
   382 
   383 
   384 "-c---ERROR case: stac is missing #Given equalities e_s--";
   385 val stac as Const ("Script.SubProblem",_) $
   386 	 (Const ("Pair",_) $
   387 		Free (dI',_) $ 
   388 		(Const ("Pair",_) $ pI' $ mI')) $ ags' =
   389     (*...copied from stac2tac_*)
   390     str2term (
   391 	"SubProblem (EqSystem', [linear, system], [no_met]) " ^
   392         "     [REAL_LIST [c, c_2]]");
   393 val ags = isalist2list ags'; 
   394 val pI = ["linear","system"];
   395 val pats = (#ppc o get_pbt) pI;
   396 (*===inhibit exn provided by this testcase==========================
   397 val xxx = match_ags (theory "EqSystem") pats ags;
   398 ===================================================================*)
   399 "-c1-----------------------------------------------------";
   400 "--------------------------step through code match_ags---";
   401 val (thy, pbt:pat list, ags) = (theory "EqSystem", pats, ags);
   402 fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
   403 	val pbt' = filter_out is_copy_named pbt; (*=equalities, solveForVars*)
   404 	val cy = filter is_copy_named pbt;       (*=solution*)
   405 (*===inhibit exn provided by this testcase==========================
   406 	val oris' = matc thy pbt' ags [];
   407 ===================================================================*)
   408 "-------------------------------step through code matc---";
   409 val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt', ags, []);
   410 (is_copy_named_idstr o free2str) t;
   411 "---if False:...";
   412 (*===inhibit exn provided by this testcase==========================
   413 val opt = mtc thy p a;
   414 ===================================================================*)
   415 "--------------------------------step through code mtc---";
   416 val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
   417 cterm_of;
   418 val ttt = (dsc $ var);
   419 (*===inhibit exn provided by this testcase==========================
   420 cterm_of thy (dsc $ var);
   421 ===================================================================*)
   422 "-------------------------------------step through end---";
   423 
   424 case ((match_ags (theory "EqSystem") pats ags)
   425       handle ERROR _ => []) of (*why not TYPE ?WN100920*)
   426     [] => match_ags_msg pI stac ags
   427   | _ => error "calchead.sml match_ags 1st arg missing --------";
   428 
   429 
   430 "-d------------------------------------------------------";
   431 val stac as Const ("Script.SubProblem",_) $
   432 	 (Const ("Pair",_) $
   433 		Free (dI',_) $ 
   434 		(Const ("Pair",_) $ pI' $ mI')) $ ags' =
   435     (*...copied from stac2tac_*)
   436     str2term (
   437 	"SubProblem (Test',[univariate,equation,test]," ^
   438         "             [no_met]) [BOOL (x+1=2), REAL x]");
   439 val AGS = isalist2list ags';
   440 val pI = ["univariate","equation","test"];
   441 val PATS = (#ppc o get_pbt) pI;
   442 "-d1-----------------------------------------------------";
   443 "--------------------------step through code match_ags---";
   444 val (thy, pbt:pat list, ags) = (theory "Test", PATS, AGS);
   445 fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_);
   446 	val pbt' = filter_out is_copy_named pbt; 
   447 	val cy = filter is_copy_named pbt;       
   448 	val oris' = matc thy pbt' ags [];
   449 "-------------------------------step through code matc---";
   450 val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt', ags, []);
   451 (is_copy_named_idstr o free2str) t;
   452 "---if False:...";
   453 val opt = mtc thy p a;
   454 "--------------------------------step through code mtc---";
   455 val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
   456 val ttt = (dsc $ var);
   457 cterm_of thy (dsc $ var);
   458 val ori = ((([1], str, dsc, (*[var]*) split_dts' (dsc, var))): preori);
   459 
   460 "-d2-----------------------------------------------------";
   461 pbt = [];  (*false*)
   462 "-------------------------------step through code matc---";
   463 val (thy, (p as (s,(d,t)))::pbt, a::ags, oris) = (thy, pbt, ags, oris @ [ori]);
   464 (is_copy_named_idstr o free2str) t;
   465 "---if False:...";
   466 val opt = mtc thy p a;
   467 "--------------------------------step through code mtc---";
   468 val (thy, (str, (dsc, _)):pat, ty $ var) = (thy, p, a);
   469 val ttt = (dsc $ var);
   470 cterm_of thy (dsc $ var);
   471 val ori = ((([1], str, dsc, (*[var]*) split_dts' (dsc, var))): preori);
   472 "-d3-----------------------------------------------------";
   473 pbt = [];  (*true, base case*)
   474 "-----------------continue step through code match_ags---";
   475 	val oris' = oris @ [ori]; (*result 2 oris, cpy_nam added later*)
   476 "--------------------------------step through cpy_nam----";
   477 val (pbt, oris, p as (field, (dsc, t)):pat) = (pbt', oris', hd cy);
   478 (*t = "v_v'i'" : term             OLD: t = "v_i_"*)
   479 "--------------------------------------------------------";
   480 fun is_copy_named_generating_idstr str =
   481     if is_copy_named_idstr str
   482     then case (rev o explode) str of
   483       (*"_"::"_"::"_"::_ => false*)
   484 	"'"::"'"::"'"::_ => false
   485       | _ => true
   486     else false;
   487 fun is_copy_named_generating (_, (_, t)) = 
   488     (is_copy_named_generating_idstr o free2str) t;
   489 "--------------------------------------------------------";
   490 is_copy_named_generating p (*true*);
   491            fun sel (_,_,d,ts) = comp_ts (d, ts);
   492 	   val cy' = (implode o (drop_last_n 3) o explode o free2str) t;
   493                (*"v_v"             OLD: "v_"*)
   494 	   val ext = (last_elem o drop_last o explode o free2str) t;
   495                (*"i"               OLD: "i"*)
   496 	   val vars' = map (free2str o snd o snd) pbt(*cpy-nam filtered_out*);
   497                (*["e_e", "v_v"]    OLD: ["e_", "v_"]*)
   498 	   val vals = map sel oris;
   499                (*[x+1=2, x]        OLD: [x+1=2, x] : term list*)
   500 vars' ~~ vals;
   501 (*[("e_e", [x+1=2), ("v_v", x)]    OLD: [("e_", [x+1=2), ("v_", x)]*)
   502 (assoc (vars'~~vals, cy'));
   503 (*SOME (Free ("x", "RealDef.real")) : term option*)
   504 	   val cy_ext = (free2str o the) (assoc (vars'~~vals, cy'))^"_"^ext;
   505                (*x_i*)
   506 "-----------------continue step through code match_ags---";
   507 	val cy' = map (cpy_nam pbt' oris') cy;
   508                (*[([1], "#Find", "solutions, [x_i"] (*as terms*) )]*)
   509 "-------------------------------------step through end---";
   510 
   511 case match_ags thy PATS AGS of
   512 [(1, [1], "#Given", Const ("Descript.equality", _),
   513   [Const ("op =", _) $ (Const ("Groups.plus_class.plus", _) $
   514 		Free ("x", _) $ Free ("1", _)) $ Free ("2", _)]),
   515  (2, [1], "#Given", Const ("Descript.solveFor", _), [Free ("x", _)]),
   516  (3, [1], "#Find", Const ("Descript.solutions", _), [Free ("x_i", _)])]
   517     => ()
   518   | _ => error "calchead.sml match_ags [univariate,equation,test]--";
   519 
   520 
   521 "--------- regression test fun is_copy_named ------------";
   522 "--------- regression test fun is_copy_named ------------";
   523 "--------- regression test fun is_copy_named ------------";
   524 val trm = (1, (2, @{term "v'i'"}));
   525 if is_copy_named trm then () else error "regr. is_copy_named 1";
   526 val trm = (1, (2, @{term "e_e"}));
   527 if is_copy_named trm then error "regr. is_copy_named 2" else ();
   528 val trm = (1, (2, @{term "L'''"}));
   529 if is_copy_named trm then () else error "regr. is_copy_named 3";
   530 
   531 (* out-comment 'structure CalcHead'...
   532 val trm = (1, (2, @{term "v'i'"}));
   533 if is_copy_named_generating trm then () else error "regr. is_copy_named";
   534 val trm = (1, (2, @{term "L'''"}));
   535 if is_copy_named_generating trm then error "regr. is_copy_named" else ();
   536 *)
   537 
   538 "--------- regr.test fun cpy_nam ------------------------";
   539 "--------- regr.test fun cpy_nam ------------------------";
   540 "--------- regr.test fun cpy_nam ------------------------";
   541 (*data from above - match_ags, is_cp, cpy_nam +with EqSystem (!)-:*)
   542 (*the model-pattern, is_copy_named are filter_out*)
   543 pbt = [("#Given", (@{term "equality"}, @{term "e_e :: bool"})),
   544        ("#Given", (@{term "solveFor"}, @{term "v_v :: real"} ))];
   545 (*the model specific for an example*)
   546 oris = [([1], "#Given", @{term "equality"} , [str2term "x+1= 2"]),
   547 	([1], "#Given", @{term "solveFor"} , [@{term "x :: real"} ])];
   548 cy = [("#Find", (@{term "solutions"}, @{term "v_v'i' :: bool list"}))];
   549 (*...all must be true*)
   550 
   551 case cpy_nam pbt oris (hd cy) of 
   552     ([1], "#Find", Const ("Descript.solutions", _), [Free ("x_i", _)]) => ()
   553   | _ => error "calchead.sml regr.test cpy_nam-1-";
   554 
   555 (*new data: cpy_nam without changing the name*)
   556 @{term "equalities"}; type_of @{term "[x_1+1=2,x_2=0]"};
   557 @{term "solveForVars"}; type_of @{term "[x_1,x_2]::real list"};
   558 @{term "solution"}; type_of @{term "ss''' :: bool list"};
   559 (*the model-pattern for ["linear", "system"], is_copy_named are filter_out*)
   560 val pbt = [("#Given", (@{term "equalities"}, @{term "e_s :: bool list"})),
   561        ("#Given", (@{term "solveForVars v_s"}, @{term "v_s :: bool list"} ))];
   562 (*the model specific for an example*)
   563 val oris = [([1], "#Given", @{term "equalities"} ,[str2term "[x_1+1=2,x_2=0]"]),
   564     ([1], "#Given", @{term "solveForVars"} , [@{term "[x_1,x_2]::real list"}])];
   565 val cy = [("#Find", (@{term "solution"}, @{term "ss''' :: bool list"}))
   566         (*could be more than 1*)];
   567 
   568 case cpy_nam pbt oris (hd cy) of
   569     ([1], "#Find", Const ("EqSystem.solution", _), [Free ("ss'''", _)]) => ()
   570   | _ => error "calchead.sml regr.test cpy_nam-2-";