src/Tools/isac/Interpret/solve-step.sml
changeset 60567 bb3140a02f3d
parent 60559 aba19e46dd84
child 60568 dd387c9fa89a
     1.1 --- a/src/Tools/isac/Interpret/solve-step.sml	Sun Oct 09 09:01:29 2022 +0200
     1.2 +++ b/src/Tools/isac/Interpret/solve-step.sml	Wed Oct 19 10:43:04 2022 +0200
     1.3 @@ -21,6 +21,7 @@
     1.4    val get_eval: string -> Pos.pos' -> Ctree.ctree -> string * ThyC.id * Eval.ml
     1.5  
     1.6  \<^isac_test>\<open>
     1.7 +  val get_ctxt: Ctree.ctree -> Pos.pos' -> Proof.context
     1.8    val rew_info: Rule_Def.rule_set -> string * Rule_Def.rule_set * Eval.ml_from_prog list
     1.9  \<close>
    1.10  end
    1.11 @@ -84,6 +85,31 @@
    1.12  		  end
    1.13    end;
    1.14  
    1.15 +(** get context reliably at switch_specify_solve **)
    1.16 +
    1.17 +fun at_begin_program (is, Pos.Res) = last_elem is = 0
    1.18 +  | at_begin_program _ = false;
    1.19 +
    1.20 +(* strange special case at Apply_Method *)
    1.21 +fun get_ctxt_from_PblObj pt (p_, Pos.Res) =
    1.22 +    let
    1.23 +      val pp = Ctree.par_pblobj pt p_ (*drops the "0"*)
    1.24 +      val {ctxt, ...} = Ctree.get_obj I pt pp |> Ctree.rep_specify_data
    1.25 +    in ctxt end
    1.26 +  | get_ctxt_from_PblObj _ _ = raise ERROR "get_ctxt_from_PblObj called by PrfObj or EmptyPtree";
    1.27 +
    1.28 +fun get_ctxt pt (p_, Pos.Pbl) =
    1.29 +    let
    1.30 +      val pp = Ctree.par_pblobj pt p_ (*drops the "0"*)
    1.31 +      val {ctxt, ...} = Ctree.get_obj I pt pp |> Ctree.rep_specify_data
    1.32 +    in ctxt end
    1.33 +  | get_ctxt pt pos =
    1.34 +    if at_begin_program pos
    1.35 +    then get_ctxt_from_PblObj pt pos
    1.36 +    else Ctree.get_ctxt pt pos
    1.37 +
    1.38 +
    1.39 +
    1.40  (** Solve_Step.check **)
    1.41  
    1.42  (*
    1.43 @@ -94,7 +120,7 @@
    1.44        let
    1.45          val (dI, pI, probl, ctxt) = case Ctree.get_obj I pt p of
    1.46            Ctree.PblObj {origin = (_, (dI, pI, _), _), probl, ctxt, ...} => (dI, pI, probl, ctxt)
    1.47 -        | _ => raise ERROR "Specify_Step.check Apply_Method: uncovered case Ctree.get_obj"
    1.48 +        | _ => raise ERROR "Solve_Step.check Apply_Method: uncovered case Ctree.get_obj"
    1.49          val {where_, ...} = Problem.from_store ctxt pI
    1.50          val pres = map (I_Model.environment probl |> subst_atomic) where_
    1.51          val ctxt = if ContextC.is_empty ctxt (*vvvvvvvvvvvvvv DO THAT EARLIER?!?*)
    1.52 @@ -196,7 +222,7 @@
    1.53          val thy = Proof_Context.theory_of ctxt
    1.54          val f = Calc.current_formula cs;
    1.55  		    val {rew_ord', erls, ...} = MethodC.from_store ctxt (Ctree.get_obj Ctree.g_metID pt pp)
    1.56 -		    val subte = Subst.input_to_terms sube (*?TODO: input requires parse _: _ -> _ option?*)
    1.57 +		    val subte = Subst.input_to_terms ctxt sube (*?TODO: input requires parse _: _ -> _ option?*)
    1.58  		    val ro = get_rew_ord ctxt rew_ord'
    1.59  		  in
    1.60  		    if foldl and_ (true, map TermC.contains_Var subte)
    1.61 @@ -218,7 +244,17 @@
    1.62        in
    1.63          Applicable.Yes (Tactic.Tac_ (thy, UnparseC.term f, id, UnparseC.term f))
    1.64        end
    1.65 -  | check (Tactic.Take str) _ = Applicable.Yes (Tactic.Take' (TermC.str2term str)) (* always applicable ?*)
    1.66 +(*/----------------- updated----------------------------------* )
    1.67 +  | check (Tactic.Take str) (pt, pos) =
    1.68 +      Applicable.Yes (Tactic.Take'
    1.69 +        (TermC.parse ((*Solve_Step.*)get_ctxt pt pos) str)) (*always applicable*)
    1.70 +( *------------------- updated----------------------------------*)
    1.71 +  | check (Tactic.Take str) (pt, pos) =
    1.72 +    let
    1.73 +      val ctxt = (*Solve_Step.*)get_ctxt pt pos
    1.74 +      val t = Prog_Tac.Take_adapt_to_type ctxt str
    1.75 +    in Applicable.Yes (Tactic.Take' t) end
    1.76 +(*\----------------- updated----------------------------------*)
    1.77    | check (Tactic.Begin_Trans) cs =
    1.78        Applicable.Yes (Tactic.Begin_Trans' (Calc.current_formula cs))
    1.79    | check (Tactic.End_Trans) (pt, (p, p_)) = (*TODO: check parent branches*)
    1.80 @@ -327,9 +363,11 @@
    1.81            Ctree.cappend_atomic pt p l t (Tactic.Substitute (Subst.eqs_to_input subte)) (t',[]) Ctree.Complete
    1.82          in ((p, Pos.Res), c, Test_Out.FormKF (UnparseC.term t'), pt) 
    1.83          end
    1.84 -  | add (Tactic.Tac_ (_, f, id, f')) l (pt, (p, _)) =
    1.85 +  | add (Tactic.Tac_ (_, f, id, f')) l (pt, pos as (p, _)) =
    1.86        let
    1.87 -        val (pt, c) = Ctree.cappend_atomic pt p l (TermC.str2term f) (Tactic.Tac id) (TermC.str2term f', []) Ctree.Complete
    1.88 +        val ctxt = Ctree.get_ctxt pt pos
    1.89 +        val (pt, c) = Ctree.cappend_atomic pt p l
    1.90 +          (TermC.parse ctxt f) (Tactic.Tac id) (TermC.parse ctxt f', []) Ctree.Complete
    1.91        in
    1.92          ((p,Pos.Res), c, Test_Out.FormKF f', pt)
    1.93        end