1 (* Title: solve an example by interpreting a method's script
2 Author: Walther Neuper 1999
3 (c) copyright due to lincense terms.
6 signature SOLVE_PHASE =
8 datatype auto = CompleteCalc | CompleteCalcHead | CompleteModel | CompleteSubpbl
9 | CompleteToSubpbl | Steps of int
10 val autoord : auto -> int
11 val specsteps : string list
13 val all_solve : auto -> Ctree.pos' list -> Ctree.state ->
14 string * Ctree.pos' list * (Ctree.ctree * (int list * Ctree.pos_))
16 auto -> Ctree.pos' list -> Ctree.state -> string * Ctree.pos' list * Ctree.state
17 val inform : Chead.calcstate' -> string -> string * Chead.calcstate'
19 val detailrls : Ctree.ctree -> Ctree.pos' -> string * Ctree.ctree * Ctree.pos'
20 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
22 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
24 ( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
26 (*----- unused code, kept as hints to design ideas ---------------------------------------------*)
31 structure Solve(**): SOLVE_PHASE(**) =
37 type squ = ctree; (* TODO: safe etc. *)
39 val specsteps = ["Init_Proof", "Refine_Tacitly", "Refine_Problem", "Model_Problem",
40 "Add_Given", "Del_Given", "Add_Find", "Del_Find", "Add_Relation", "Del_Relation",
41 "Specify_Theory", "Specify_Problem", "Specify_Method"];
43 (* tell how may steps of a calculation should be done by "fun autocalc"
44 FIXXXME040624: does NOT match interfaces/ITOCalc.java
45 TODO.WN0512 redesign togehter with autocalc ? *)
47 Steps of int (*1 do #int steps (may stop in model/specify)
48 IS VERY INEFFICIENT IN MODEL/SPECIY *)
49 | CompleteModel (*2 complete modeling
50 if model complete, finish specifying *)
51 | CompleteCalcHead (*3 complete model/specify in one go *)
52 | CompleteToSubpbl (*4 stop at the next begin of a subproblem,
53 if none, complete the actual (sub)problem *)
54 | CompleteSubpbl (*5 complete the actual (sub)problem (incl.ev.subproblems) *)
55 | CompleteCalc; (*6 complete the calculation as a whole *)
57 fun autoord (Steps _ ) = 1
58 | autoord CompleteModel = 2
59 | autoord CompleteCalcHead = 3
60 | autoord CompleteToSubpbl = 4
61 | autoord CompleteSubpbl = 5
62 | autoord CompleteCalc = 6;
64 fun complete_solve auto c (ptp as (_, p as (_, p_))) =
66 then ("end-of-calculation", [], ptp)
68 if member op = [Pbl,Met] p_
71 val ptp = Chead.all_modspec ptp
72 val (_, c', ptp) = all_solve auto c ptp
73 in complete_solve auto (c @ c') ptp end
75 case LucinNEW.do_solve_step ptp of
76 ((Tactic.Subproblem _, _, _) :: _, c', ptp') =>
78 then ("ok", c @ c', ptp)
81 val ptp = Chead.all_modspec ptp'
82 val (_, c'', ptp) = all_solve auto (c @ c') ptp
83 in complete_solve auto (c @ c'@ c'') ptp end
84 | ((Tactic.Check_Postcond _, _, _) :: _, c', ptp' as (_, p')) =>
85 if autoord auto < 6 orelse p' = ([], Res)
86 then ("ok", c @ c', ptp')
87 else complete_solve auto (c @ c') ptp'
88 | ((Tactic.End_Detail, _, _) :: _, c', ptp') =>
90 then ("ok", c @ c', ptp')
91 else complete_solve auto (c @ c') ptp'
92 | (_, c', ptp') => complete_solve auto (c @ c') ptp'
93 and all_solve auto c (ptp as (pt, pos as (p,_)): ctree * pos') =
95 val (_, _, mI) = get_obj g_spec pt p
96 val ctxt = get_ctxt pt pos
97 val (_, c', ptp) = LucinNEW.by_tactic (Tactic.Apply_Method' (mI, NONE, Istate.e_istate, ctxt)) (Istate.e_istate, ctxt) ptp
99 complete_solve auto (c @ c') ptp
102 (* aux.fun for detailrls with Rrls, reverse rewriting *)
103 fun rul_terms_2nds _ nds _ [] = nds
104 | rul_terms_2nds thy nds t ((rule, res as (t', _)) :: rts) =
105 (append_atomic [] (Istate.e_istate, ContextC.e_ctxt) t (Tactic.rule2tac thy [] rule) res Complete EmptyPtree) ::
106 (rul_terms_2nds thy nds t' rts);
108 (* detail steps done internally by Rewrite_Set* into ctree by use of a script *)
109 fun detailrls pt (pos as (p, _)) =
111 val t = get_obj g_form pt p
112 val tac = get_obj g_tac pt p
113 val rls = (assoc_rls o Tactic.rls_of) tac
114 val ctxt = get_ctxt pt pos
117 Rule.Rrls {scr = Rule.Rfuns {init_state, ...}, ...} =>
119 val (_, _, _, rul_terms) = init_state t
120 val newnds = rul_terms_2nds (Proof_Context.theory_of ctxt) [] t rul_terms
121 val pt''' = ins_chn newnds pt p
122 in ("detailrls", pt''', (p @ [length newnds], Res)) end
125 val is = Generate.init_istate tac t
126 (*TODO.WN060602 Pstate (["(t_, Problem (Isac,[equation,univar]))"]
127 is wrong for simpl, but working ?!? *)
128 val tac_ = Tactic.Apply_Method' (Celem.e_metID(*WN0402: see generate1 !?!*), SOME t, is, ctxt)
129 val pos' = ((lev_on o lev_dn) p, Frm)
130 val thy = Celem.assoc_thy "Isac_Knowledge"
131 val (_, _, _, pt') = Generate.generate1 thy tac_ (is, ctxt) pos' pt (* implicit Take *)
132 val (_,_, (pt'', _)) = complete_solve CompleteSubpbl [] (pt', pos')
133 val newnds = children (get_nd pt'' p)
134 val pt''' = ins_chn newnds pt p (*complete_solve cuts branches after*)
135 in ("detailrls", pt''', (p @ [length newnds], Res)) end
138 fun inform (next_cs as (_, _, (pt, pos as (p, _))): Chead.calcstate') istr =
139 case TermC.parse (Celem.assoc_thy "Isac_Knowledge") istr of
140 NONE => ("syntax error in '" ^ istr ^ "'", Chead.e_calcstate' (*TODO: previous cs'*))
143 val f_in = Thm.term_of f_in
144 val pos_pred = lev_back(*'*) pos
145 val f_pred = Ctree.get_curr_formula (pt, pos_pred);
146 val f_succ = Ctree.get_curr_formula (pt, pos);
149 then ("same-formula", next_cs) (* ctree not cut with replaceFormula *)
151 case Inform.cas_input f_in of
152 SOME (pt, _) => ("ok",([], [], (pt, (p, Pos.Met))))
153 | NONE => (*/-------------------------------------- NEW fun locate_input_formula------*)
155 val (_, _, metID) = get_obj g_spec pt (par_pblobj pt p)
156 val {scr = prog, ...} = Specify.get_met metID
157 val istate = get_istate pt pos
158 val ctxt = get_ctxt pt pos
160 case LucinNEW.locate_input_formula prog (pt, pos) istate ctxt f_in of
161 LucinNEW.Found_Step (cstate, _(*istate*), _(*ctxt*)) =>
162 ("ok" , ([], [], cstate (* already contains istate, ctxt *)))
163 | LucinNEW.Not_Derivable calcstate' =>
165 val pp = Ctree.par_pblobj pt p
166 val (errpats, nrls, prog) = case Specify.get_met (Ctree.get_obj Ctree.g_metID pt pp) of
167 {errpats, nrls, scr = Rule.Prog prog, ...} => (errpats, nrls, prog)
168 | _ => error "inform: uncovered case of get_met"
169 val {env, ...} = Ctree.get_istate pt pos |> Istate.the_pstate
171 case Inform.check_error_patterns (f_pred, f_in) (prog, env) (errpats, nrls) of
172 SOME errpatID => ("error pattern #" ^ errpatID ^ "#", calcstate')
173 | NONE => ("no derivation found", calcstate')