test/Tools/isac/Interpret/appl.sml
author Alexander Kargl <akargl@brgkepler.net>
Tue, 26 Jul 2011 15:52:07 +0200
branchdecompose-isar
changeset 42202 3ef5679743fb
parent 41977 a3ce4017f41d
child 48761 4162c4f6f897
permissions -rw-r--r--
intermed: uncommented tests
neuper@41943
     1
(* Title:  test/../appl.sml
neuper@41943
     2
   Author: Walther Neuper 110320
neuper@41943
     3
   (c) copyright due to lincense terms.
neuper@41943
     4
*)
neuper@41958
     5
neuper@41958
     6
"-----------------------------------------------------------------";
neuper@41958
     7
"table of contents -----------------------------------------------";
neuper@41958
     8
"-----------------------------------------------------------------";
neuper@41958
     9
"-------------- fun applicable_in..Apply_Method ------------------";
neuper@41958
    10
"-----------------------------------------------------------------";
neuper@41958
    11
"-----------------------------------------------------------------";
neuper@41958
    12
"-----------------------------------------------------------------";
neuper@41958
    13
neuper@41958
    14
neuper@41958
    15
"-------------- fun applicable_in..Apply_Method ------------------";
neuper@41958
    16
"-------------- fun applicable_in..Apply_Method ------------------";
neuper@41958
    17
"-------------- fun applicable_in..Apply_Method ------------------";
neuper@41958
    18
val fmz = ["equality (x+1=(2::real))",
neuper@41958
    19
	   "solveFor (x::real)","solutions L"];
neuper@41958
    20
val (dI',pI',mI') =
neuper@41958
    21
  ("Test",["sqroot-test","univariate","equation","test"],
neuper@41958
    22
   ["Test","squ-equ-test-subpbl1"]);
neuper@41958
    23
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@41958
    24
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    25
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    26
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    27
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    28
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    29
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    30
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    31
neuper@41958
    32
val (PblObj{origin = (_, (dI, pI, _), _), probl, ...}) = get_obj I pt (fst p);
neuper@41958
    33
val {where_, ...} = get_pbt pI;
neuper@41958
    34
val where_ = [str2term "(lhs e_e) is_poly_in v_v"];(*just for test<>[]*)
neuper@41958
    35
val pres = map (mk_env probl |> subst_atomic) where_;
neuper@41958
    36
(*val pres = mk_env pbl |> subst_atomic #> where_;*)
neuper@41958
    37
if pres = [str2term "lhs (x + 1 = 2) is_poly_in x"] then ()
neuper@41958
    38
else error "appl.sml Apply_Method diff.behav.";
neuper@41958
    39
neuper@41958
    40
val ctxt = assoc_thy dI |> ProofContext.init_global |> insert_assumptions pres;
neuper@41958
    41
(*TODO.WN110416 read pres from ctxt and check*)
neuper@41958
    42
neuper@41958
    43
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@41958
    44
show_pt pt;
neuper@41975
    45
neuper@41975
    46
neuper@41975
    47
neuper@41975
    48
neuper@41975
    49
neuper@41975
    50
akargl@42202
    51
(*-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.*)
neuper@41975
    52
"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
neuper@41975
    53
val pIopt = get_pblID (pt,ip);
neuper@41975
    54
tacis; (*= []*)
neuper@41975
    55
pIopt; (*= SOME ["sqroot-test", "univariate", ...]*)
neuper@41975
    56
member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= true*)
neuper@41975
    57
"~~~~~ fun nxt_specify_, args:"; val (ptp as (pt, pos as (p,p_))) = (pt,ip);
akargl@42202
    58
(*============ inhibit exn AK110726 ==============================================
akargl@42202
    59
(* ERROR: Exception Bind raised and subsequent errors (not declared...)*)
akargl@42202
    60
val pblobj as (PblObj{meth, origin = origin as (oris,(dI', pI', mI'), _),
akargl@42202
    61
			  probl, spec = (dI, pI, mI), ...}) = get_obj I pt p;
neuper@41975
    62
just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin; (*false*)
neuper@41975
    63
val cpI = if pI = e_pblID then pI' else pI;
neuper@41975
    64
		val cmI = if mI = e_metID then mI' else mI;
neuper@41975
    65
		val {ppc, prls, where_, ...} = get_pbt cpI;
neuper@41975
    66
		val pre = check_preconds "thy 100820" prls where_ probl;
neuper@41975
    67
		val pb = foldl and_ (true, map fst pre);
neuper@41975
    68
val (_,tac) = nxt_spec p_ pb oris (dI',pI',mI') (probl, meth) 
neuper@41975
    69
			  (ppc, (#ppc o get_met) cmI) (dI, pI, mI);
akargl@42202
    70
============ inhibit exn AK110726 ==============================================*)
akargl@42202
    71
akargl@42202
    72
(*============ inhibit exn AK110726 ==============================================
akargl@42202
    73
(* ERROR: Exception Bind raised and subsequent errors (not declared...)*)
neuper@41975
    74
"~~~~~ fun nxt_specif, args:"; val (Add_Given ct, ptp) = (tac, ptp);
neuper@41975
    75
"~~~~~ fun nxt_specif_additem, args:"; val (sel, ct, ptp as (pt, (p, Pbl))) = ("#Given", ct, ptp);
neuper@41975
    76
val (PblObj{meth=met,origin=(oris,(dI',pI',_),_),
neuper@41975
    77
		  probl=pbl,spec=(dI,pI,_),...}) = get_obj I pt p;
neuper@41975
    78
val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
neuper@41975
    79
val cpI = if pI = e_pblID then pI' else pI;
neuper@41975
    80
val ctxt = get_ctxt pt (p, Pbl);
neuper@41975
    81
oris; (*= [(1, [1], "#Given", Const ("Descript.equality", "HOL.bool...*)
neuper@41975
    82
"~~~~~ fun appl_add, args:"; val (ctxt, sel, oris, ppc, pbt, str) = 
neuper@41975
    83
                               (ctxt, sel, oris, pbl, (#ppc o get_pbt) cpI, ct);
neuper@41975
    84
val SOME t = parseNEW ctxt str;
neuper@41975
    85
if t = parseNEW "-1 + x = (0::real)" then ()
neuper@41975
    86
else error "TODO"
neuper@41975
    87
is_known ctxt sel oris t; (*= ("identifiers [equality] not in example", ...WN110504???*)
akargl@42202
    88
============ inhibit exn AK110726 ==============================================*)
akargl@42202
    89
(*-.-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.*)