src/Tools/isac/Interpret/step-solve.sml
author Walther Neuper <walther.neuper@jku.at>
Tue, 21 Apr 2020 15:42:50 +0200
changeset 59898 68883c046963
parent 59881 bdced24f62bf
child 59903 5037ca1b112b
permissions -rw-r--r--
replace Celem. with new struct.s in BaseDefinitions/

Note: the remaining code in calcelems.sml shall be destributed to respective struct.s
     1 (* Title:  Interpret/step-solve.sml
     2    Author: Walther Neuper 2019
     3    (c) due to copyright terms
     4 *)
     5 
     6 signature STEP_SOLVE =
     7 sig
     8   val do_next: Calc.T -> string * Chead.calcstate'
     9   val by_tactic : Tactic.T -> Calc.T -> string * Chead.calcstate'
    10   val by_term : Calc.T -> string -> string * Chead.calcstate' (*TODO: string * Calc.T*)
    11 end
    12 
    13 (**)
    14 structure Step_Solve(**): STEP_SOLVE(**) =
    15 struct
    16 (**)
    17 open Ctree;
    18 open Pos
    19 
    20 fun by_tactic (tac as Tactic.Apply_Method' _) (ptp as (pt, p)) =
    21     LI.by_tactic tac (get_istate_LI pt p, get_ctxt_LI pt p) ptp
    22   | by_tactic (tac as Tactic.Check_Postcond' _) (ptp as (pt, p)) =
    23     LI.by_tactic tac (get_istate_LI pt p, get_ctxt_LI pt p) ptp
    24   | by_tactic (Tactic.Free_Solve')  (pt, po as (p, _)) =
    25     let
    26       val p' = lev_dn_ (p, Res);
    27       val pt = update_metID pt (par_pblobj pt p) Spec.e_metID;
    28     in
    29       ("ok", ([(Tactic.Empty_Tac, Tactic.Empty_Tac_, (po, (Istate.Uistate, ContextC.empty)))], [], (pt,p')))
    30     end
    31   | by_tactic (Tactic.End_Proof'') ptp = ("end-proof", ([], [], ptp))
    32   | by_tactic (Tactic.End_Detail' t) (pt, (p, p_)) = (* could be done by generate1 ?!? *)
    33     let (*Rewrite_Set* done at Detail_Set*: this result is already in ctree*)
    34       val pr = (lev_up p, Res)
    35     in
    36       ("ok", ([(Tactic.End_Detail, Tactic.End_Detail' t , ((p, p_), get_loc pt (p, p_)))], [], (pt, pr)))
    37     end
    38   | by_tactic m (pt, po as (p, p_)) =
    39     if Spec.e_metID = get_obj g_metID pt (par_pblobj pt p) (*29.8.02: could be detail, too !!*)
    40     then
    41       let
    42         val ctxt = get_ctxt pt po
    43         val ((p, p_), ps, _, pt) =
    44           Generate.generate1 m (Istate.empty, ctxt) (pt, (p, p_))
    45 	    in ("no-method-specified", (*Free_Solve*)
    46 	      ([(Tactic.Empty_Tac, Tactic.Empty_Tac_, ((p, p_), (Istate.Uistate, ctxt)))], ps, (pt, (p, p_))))
    47       end
    48     else
    49 	    let 
    50 	      val thy' = get_obj g_domID pt (par_pblobj pt p);
    51 	      val (is, sc) = LItool.resume_prog thy' (p,p_) pt;
    52 	    in
    53         case LI.locate_input_tactic sc (pt, po) (fst is) (snd is) m of
    54           LI.Safe_Step (istate, ctxt, tac) =>
    55             let
    56                val p' = next_in_prog po
    57                val (p'', _, _,pt') =
    58                  Generate.generate1 tac (istate, ctxt) (pt, (p', p_))
    59             in
    60        		    ("ok", ([(Tactic.input_from_T tac, tac, (p'', (istate, ctxt)))],
    61                 [(*Ctree NOT cut*)], (pt', p'')))
    62             end
    63 	      | LI.Unsafe_Step (istate, ctxt, tac) =>
    64             let
    65                val p' = 
    66                  case p_ of Frm => p 
    67                  | Res => lev_on p
    68                  | _ => error ("Step_Solve.by_tactic: call by " ^ pos'2str (p, p_));
    69                val (p'', _, _,pt') =
    70                  Generate.generate1 tac (istate, ctxt) (pt, (p', p_));
    71             in
    72        		    ("ok", ([(Tactic.input_from_T tac, tac, (p'', (istate, ctxt)))],
    73                 [(*Ctree NOT cut*)], (pt', p'')))
    74             end
    75 	      | _ => (* NotLocatable *)
    76 	        let 
    77 	          val (p,ps, _, pt) = Generate.generate_hard (ThyC.get_theory "Isac_Knowledge") m (p, p_) pt;
    78 	        in
    79 	          ("not-found-in-program", ([(Tactic.input_from_T m, m, (po, is))], ps, (pt, p)))
    80           end
    81 	    end;
    82 
    83 val do_next = LI.do_next
    84 
    85 
    86 (*
    87   Locate a step in a program, which has been determined by input of a term.
    88   Special case: if the term is a CAS-command, then create a calchead, and do 1 step.
    89   If "no derivation found" then Error_Fill_Pattern.check_for.
    90   (Error_Fill_Pattern.check_for *within* compare_step seems too expensive)
    91 *)
    92 (*fun by_term (next_cs as (_, _, (pt, pos as (p, _))): Chead.calcstate') istr =*)
    93 fun by_term (pt, pos as (p, _)) istr =
    94   case TermC.parse (ThyC.get_theory "Isac_Knowledge") istr of
    95     NONE => ("syntax error in '" ^ istr ^ "'", Chead.e_calcstate')
    96   | SOME f_in =>
    97     let
    98   	  val f_in = Thm.term_of f_in
    99       val pos_pred = lev_back(*'*) pos
   100   	  val f_pred = Ctree.get_curr_formula (pt, pos_pred);
   101   	  val f_succ = Ctree.get_curr_formula (pt, pos);
   102     in
   103       if f_succ = f_in
   104       then ("same-formula", ([], [], (pt, pos))) (* ctree not cut with replaceFormula *)
   105       else
   106         case In_Chead.cas_input f_in of
   107           SOME (pt, _) => ("ok", ([], [], (pt, (p, Pos.Met))))
   108 		    | NONE =>
   109           case LI.locate_input_term (pt, pos) f_in of
   110             LI.Found_Step cstate =>
   111             ("ok" , ([], [], cstate (* already contains istate, ctxt *)))
   112           | LI.Not_Derivable =>
   113             let
   114           	  val pp = Ctree.par_pblobj pt p
   115           	  val (errpats, nrls, prog) = case Specify.get_met (Ctree.get_obj Ctree.g_metID pt pp) of
   116           		    {errpats, nrls, scr = Rule.Prog prog, ...} => (errpats, nrls, prog)
   117           		  | _ => error "inform: uncovered case of get_met"
   118           	  val {env, ...} = Ctree.get_istate_LI pt pos |> Istate.the_pstate
   119           	in
   120           	  case Error_Fill_Pattern.check_for (f_pred, f_in) (prog, env) (errpats, nrls) of
   121           	    SOME errpatID => ("error pattern #" ^ errpatID ^ "#", Chead.e_calcstate')
   122           	  | NONE => ("no derivation found", Chead.e_calcstate')
   123             end
   124     end
   125 
   126 end