1 signature SUB_PROBLEM =
3 val tac_from_prog: Ctree.state -> term -> Tactic.input * Tactic.T
4 val common_sub_thy: theory * theory -> theory
8 structure Sub_Problem(**): SUB_PROBLEM(**) =
12 fun common_sub_thy (thy1, thy2) =
13 if Context.subthy (thy1, thy2) then thy2
14 else if Context.subthy (thy2, thy1) then thy1
15 else Know_Store.get_ref_last_thy ()
17 fun tac_from_prog (pt, _) (stac as Const (\<^const_name>\<open>Prog_Tac.SubProblem\<close>, _) $ spec' $ ags') =
19 val (dI, pI, mI) = Prog_Tac.dest_spec spec'
20 val thy = common_sub_thy (Know_Store.get_via_last_thy dI, Ctree.root_thy pt);
21 val init_ctxt = Proof_Context.init_global thy
22 val ags = TermC.isalist2list ags';
27 val pors = (M_Match.arguments thy ((#model o (Problem.from_store init_ctxt)) pI) ags): O_Model.T
28 handle ERROR "actual args do not match formal args"
29 => (M_Match.arguments_msg init_ctxt pI stac ags (*raise exn*);[]);
30 val pI' = Refine.by_o_model' init_ctxt pors pI;
31 in (pI', pors (* refinement over models with diff.precond only *),
32 (hd o #solve_mets o Problem.from_store init_ctxt) pI') end
33 else (pI, (M_Match.arguments thy ((#model o Problem.from_store init_ctxt) pI) ags)
34 handle ERROR "actual args do not match formal args"
35 => (M_Match.arguments_msg init_ctxt pI stac ags(*raise exn*); []), mI);
36 val (fmz_, vals) = O_Model.values' init_ctxt pors;
37 val {cas, model, thy, ...} = Problem.from_store init_ctxt pI
38 val dI = Context.theory_name thy (*take dI from _refined_ pbl*)
39 val dI = Context.theory_name
40 (common_sub_thy (Know_Store.get_via_last_thy dI, Ctree.root_thy pt))
41 val ctxt = ContextC.init_for_prog init_ctxt vals
44 NONE => Auto_Prog.pblterm dI pI
45 | SOME t => subst_atomic ((Model_Pattern.variables model) ~~~ vals) t
46 val f = Auto_Prog.subpbl (ThmC.cut_longid dI) pI
48 (Tactic.Subproblem (dI, pI), Tactic.Subproblem' ((dI, pI, mI), pors, hdl, fmz_, ctxt, f))
51 raise ERROR ("Sub_Problem.tac_from_prog not impl. for " ^ UnparseC.term (ContextC.for_ERROR ()) t)