(* Title:  Interpret/lucas-interpreter.sml

   Author: Walther Neuper 2019

   (c) due to copyright terms

*)

signature LUCAS_INTERPRETER =

sig

  datatype next_step_result =

      Next_Step of Istate.T * Proof.context * Tactic.T

    | Helpless | End_Program of Istate.T (*TODO ?needed when..*)* Tactic.T

  val find_next_step: Program.T -> Calc.T -> Istate.T -> Proof.context

    -> next_step_result

  datatype input_tactic_result =

      Safe_Step of Istate.T * Proof.context * Tactic.T

    | Unsafe_Step of Istate.T * Proof.context * Tactic.T

    | Not_Locatable (*TODO rm..*) of string

  val locate_input_tactic: Program.T -> Calc.T -> Istate.T -> Proof.context

      -> Tactic.T -> input_tactic_result

  datatype input_term_result = Found_Step of Calc.T | Not_Derivable (**)

  val locate_input_term: Calc.T -> term -> input_term_result (**)

  (* must reside here:

     find_next_step calls do_next and is called by by_tactic;

     by_tactic and do_next are mutually recursive via by_tactic..Apply_Method'

   *)

  val by_tactic: Tactic.T -> Istate.T * Proof.context -> Calc.T -> string * Calc.state_post

  val do_next: Calc.T -> string * Calc.state_post

  datatype expr_val1 = (* constructors for tests only *)

      Accept_Tac1 of Istate.pstate * Proof.context * Tactic.T

    | Reject_Tac1 of Istate.pstate * Proof.context * Tactic.T

    | Term_Val1 of term;

\<^isac_test>\<open>

  val assoc2str: expr_val1 -> string

\<close>

(* ---- for Doc/Lucas-Interpreter ------------------------------------------------------------- *)

  val check_Seq_up: Istate.pstate -> term -> term

  datatype expr_val = Accept_Tac of Tactic.T * Istate.pstate * Proof.context

    | Reject_Tac | Term_Val of term

  val scan_dn: Calc.T * Proof.context -> Istate.pstate -> term -> expr_val

  val scan_up: term * (Calc.T * Proof.context) -> Istate.pstate -> term -> expr_val

  val go_scan_up: term * (Calc.T * Proof.context) -> Istate.pstate -> expr_val

  val scan_to_tactic: term * (Calc.T * Proof.context) -> Istate.T -> expr_val

  val check_tac: Calc.T * Proof.context -> Istate.pstate -> term * term option -> expr_val

\<^isac_test>\<open>

  val check_Let_up: Istate.pstate -> term -> term * term

  val compare_step: State_Steps.T * Pos.pos' list * Calc.T -> term -> string * Calc.state_post

  val scan_dn1: (Calc.T * Proof.context * Tactic.T) -> Istate.pstate -> term -> expr_val1

  val scan_up1: term * (Calc.T * Proof.context * Tactic.T) -> Istate.pstate -> term -> expr_val1;

  val go_scan_up1: term * (Calc.T * Proof.context * Tactic.T) -> Istate.pstate -> expr_val1;

  val scan_to_tactic1: term * (Calc.T * Proof.context * Tactic.T) -> Istate.T -> expr_val1

  val check_tac1: Calc.T * Proof.context * Tactic.T -> Istate.pstate -> term * term option -> expr_val1

\<close>

end

(**)

structure LI(**): LUCAS_INTERPRETER(**) =

struct

(**)

open Ctree

open Pos

open TermC

open Istate

(*** auxiliary functions ***)

fun check_Let_up ({path, ...}: pstate) prog =

  case TermC.sub_at (drop_last path) prog of

    Const (\<^const_name>\<open>Let\<close>,_) $ _ $ (Abs (i, T, body)) => (TermC.mk_Free (i, T), body)

  | t => raise ERROR ("scan_up1..\"HOL.Let $ _\" with: \"" ^ UnparseC.term t ^ "\"")

fun check_Seq_up  ({path, ...}: pstate) prog =

  case TermC.sub_at (drop_last path) prog of

    Const (\<^const_name>\<open>Tactical.Chain\<close>,_) $ _ $ e2=> e2

  | t => raise ERROR ("scan_up1..\"Tactical.Chain $ _\" with: \"" ^ UnparseC.term t ^ "\"")

(*** determine a next tactic within a program ***)

datatype next_step_result = Next_Step of Istate.T * Proof.context * Tactic.T

  | Helpless | End_Program of Istate.T * Tactic.T (*contains prog_result, without asms*)

(** scan to a Prog_Tac **)

datatype expr_val = (* "ExprVal" in the sense of denotational semantics           *)

  Reject_Tac        (* tactic is found but NOT acknowledged, scan is continued    *)

| Accept_Tac of     (* tactic is found and acknowledged, scan is stalled          *)

    Tactic.T *      (* Prog_Tac is applicable_in cstate                           *)

    Istate.pstate * (* created by application of Tactic.T, for resuming execution *)

    Proof.context   (* created by application of Tactic.T                         *)

| Term_Val of       (* Prog_Expr is found and evaluated, scan is continued        *)

    term;           (* value of Prog_Expr, for updating environment               *)

(* check if a prog_tac found in a program is applicable_in *)

fun check_tac ((pt, p), ctxt) ist (prog_tac, form_arg) =

  let

    val m = LItool.tac_from_prog pt (Proof_Context.theory_of ctxt) prog_tac

  in

    case m of

      Tactic.Subproblem _ => (*might involve problem refinement etc*)

        let

          val m' = snd (Sub_Problem.tac_from_prog pt prog_tac)

        in

          Accept_Tac (m', ist |> set_subst_found (form_arg, Tactic.result m'), ctxt)

        end

    | _ =>

      (case Solve_Step.check m (pt, p) of

        Applicable.Yes m' => 

          Accept_Tac (m', ist |> set_subst_found (form_arg, Tactic.result m'),

            Tactic.insert_assumptions m' ctxt)

      | _ => Reject_Tac)

  end

(*

  scan_dn, go_scan_up, scan_up scan for find_next_step.

  (1) scan_dn is recursive descent depth first strictly from L to R;

  (2) go_scan_up goes to the parent node and calls (3);

  (3) scan_up resumes according to the interpreter-state.

  Call of (2) means that there was an applicable Prog_Tac below = before.

*)

fun scan_dn cc (ist as {act_arg, ...}) (Const (\<^const_name>\<open>Tactical.Try\<close>(*1*), _) $ e $ a) =

    (case scan_dn cc (ist|> path_down_form ([L, R], a)) e of

      Reject_Tac => Term_Val act_arg

    | (*Accept_Tac*) goback => goback)

  | scan_dn cc (ist as {act_arg, ...}) (Const (\<^const_name>\<open>Tactical.Try\<close>(*2*), _) $ e) =

    (case scan_dn cc (ist |> path_down [R]) e of

      Reject_Tac => Term_Val act_arg

    | (*Accept_Tac*) goback => goback)

  | scan_dn cc ist (Const (\<^const_name>\<open>Tactical.Repeat\<close>(*1*), _) $ e $ a) = 

    scan_dn cc (ist |> path_down_form ([L, R], a)) e

  | scan_dn cc ist (Const (\<^const_name>\<open>Tactical.Repeat\<close>(*2*), _) $ e) =

    scan_dn cc (ist |> path_down [R]) e

  | scan_dn cc ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*1*), _) $ e1 $ e2 $ a) =

    (case scan_dn cc (ist |> path_down_form ([L, L, R], a)) e1 of

	    Term_Val v => scan_dn cc (ist |> path_down_form ([L, R], a) |> set_act v) e2

    | (*Accept_Tac*) goback => goback)

  | scan_dn cc ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*2*), _) $ e1 $ e2) =

    (case scan_dn cc (ist |> path_down [L, R]) e1 of

	    Term_Val v => scan_dn cc (ist |> path_down [R] |> set_act v) e2

    | (*Accept_Tac*) goback => goback)

  | scan_dn cc ist (Const (\<^const_name>\<open>Let\<close>(*1*), _) $ e $ (Abs (i, T, b))) =

     (case scan_dn cc (ist |> path_down [L, R]) e of

       Term_Val res => scan_dn cc (ist |> path_down [R, D] |> upd_env'' (Free (i, T), res)) b

    | (*Accept_Tac*) goback => goback)

  | scan_dn (cc as (_, ctxt)) (ist as {eval, act_arg, ...}) (Const (\<^const_name>\<open>Tactical.While\<close>(*1*), _) $ c $ e $ a) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (ist |> get_act_env |> Env.update' a) c)

    then scan_dn cc (ist |> path_down_form ([L, R], a)) e

    else Term_Val act_arg

  | scan_dn (cc as (_, ctxt)) (ist as {eval, act_arg, ...}) (Const (\<^const_name>\<open>Tactical.While\<close>(*2*), _) $ c $ e) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update_opt' (get_subst ist)) c)

    then scan_dn cc (ist |> path_down [R]) e

    else Term_Val act_arg

  |scan_dn cc ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*1*), _) $e1 $ e2 $ a) =

    (case scan_dn cc (ist |> path_down_form ([L, L, R], a)) e1 of

	    Accept_Tac lme => Accept_Tac lme

    | _ => scan_dn cc (ist |> path_down_form ([L, R], a)) e2)

  | scan_dn cc ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*2*), _) $e1 $ e2) =

    (case scan_dn cc (ist |> path_down [L, R]) e1 of

	    Accept_Tac lme => Accept_Tac lme

    | _ => scan_dn cc (ist |> path_down [R]) e2)

  |  scan_dn (cc as (_, ctxt)) (ist as {eval, ...}) (Const (\<^const_name>\<open>Tactical.If\<close>(*1*), _) $ c $ e1 $ e2) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update_opt' (get_subst ist)) c)

    then scan_dn cc (ist |> path_down [L, R]) e1

    else scan_dn cc (ist |> path_down [R]) e2

  | scan_dn (cc as (_, ctxt)) (ist as {eval, ...}) t (*fall-through*) =

    if Tactical.contained_in t

    then raise TERM ("scan_dn expects Prog_Tac or Prog_Expr", [t])

    else

      case LItool.check_leaf "next  " ctxt eval (get_subst ist) t of

  	    (Program.Expr s, _) => Term_Val s (*TODO?: include set_found here and drop those after call*)

      | (Program.Tac prog_tac, form_arg) =>

          (tracing ("### scan_dn fall-through, prog_tac = " ^ quote (UnparseC.term prog_tac) ^ " |");

check_tac cc ist (prog_tac, form_arg))

fun go_scan_up (pcc as (sc, _)) (ist as {path, act_arg, found_accept, ...}) = 

    if path = [R] (*root of the program body*) then

      if found_accept then

        Term_Val act_arg

      else raise ERROR "LItool.find_next_step without result"

    else scan_up pcc (ist |> path_up) (go_up path sc)

(* scan is strictly to R, because at L there was an \<open>expr_val\<close> *)

and scan_up pcc ist (Const (\<^const_name>\<open>Tactical.Try\<close>(*1*), _) $ _ $ _) = go_scan_up pcc ist

  | scan_up pcc ist (Const (\<^const_name>\<open>Tactical.Try\<close>(*2*), _) $ _) = go_scan_up pcc ist

  | scan_up (pcc as (_, cc)) ist (Const (\<^const_name>\<open>Tactical.Repeat\<close>(*1*), _) $ e $ _) =

    (case scan_dn cc (ist |> path_down [L, R]) e of

      Accept_Tac ict => Accept_Tac ict

    | Reject_Tac =>  go_scan_up pcc ist

    | Term_Val v =>  go_scan_up pcc (ist |> set_act v |> set_found))

  | scan_up (pcc as (_, cc)) ist (Const (\<^const_name>\<open>Tactical.Repeat\<close>(*2*), _) $ e) =

    (case scan_dn cc (ist |> path_down [R]) e of

      Accept_Tac ict => Accept_Tac ict

    | Reject_Tac => go_scan_up pcc ist

    | Term_Val v => go_scan_up pcc (ist |> set_act v |> set_found))

  | scan_up pcc ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*1*), _) $ _ $ _ $ _) = go_scan_up pcc ist

  | scan_up pcc ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*2*), _) $ _ $ _) = go_scan_up pcc ist

  | scan_up (pcc as (sc, cc)) ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*3*), _) $ _) =

      let 

        val e2 = check_Seq_up ist sc

      in

        case scan_dn cc (ist |> path_up_down [R]) e2 of

          Accept_Tac ict => Accept_Tac ict

        | Reject_Tac => go_scan_up pcc (ist |> path_up)

        | Term_Val v => go_scan_up pcc (ist |> path_up |> set_act v |> set_found)

      end

  | scan_up (pcc as (sc, cc)) ist (Const (\<^const_name>\<open>Let\<close>(*1*), _) $ _) =

	    let

        val (i, body) = check_Let_up ist sc

      in

        case scan_dn cc (ist |> path_up_down [R, D] |> upd_env i) body of

	        Accept_Tac ict => Accept_Tac ict

	      | Reject_Tac => go_scan_up pcc (ist |> path_up)

	      | Term_Val v => go_scan_up pcc (ist |> path_up |> set_act v |> set_found)

	    end

  | scan_up pcc ist (Abs _(*2*)) = go_scan_up pcc ist

  | scan_up pcc ist (Const (\<^const_name>\<open>Let\<close>(*3*), _) $ _ $ (Abs _)) = go_scan_up pcc ist

  | scan_up (pcc as (_, cc as (_, ctxt)))  (ist as {eval, ...})

      (Const (\<^const_name>\<open>Tactical.While\<close>(*1*), _) $ c $ e $ _) = 

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update_opt' (get_subst ist)) c) 

    then

      case scan_dn cc (ist |> path_down [L, R]) e of

  	     Accept_Tac ict => Accept_Tac ict

  	  | Reject_Tac => go_scan_up pcc ist

  	  | Term_Val v => go_scan_up pcc (ist |> set_act v |> set_found)

    else

      go_scan_up pcc (ist (*|> set_found*))

  | scan_up  (pcc as (_, cc as (_, ctxt))) (ist as {eval, ...})

      (Const (\<^const_name>\<open>Tactical.While\<close>(*2*), _) $ c $ e) = 

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update_opt' (get_subst ist)) c) 

    then

      case scan_dn cc (ist |> path_down [R]) e of

  	    Accept_Tac ict => Accept_Tac ict

  	  | Reject_Tac => go_scan_up pcc ist

  	  | Term_Val v => go_scan_up pcc (ist |> set_act v |> set_found)

    else

      go_scan_up pcc ist

  | scan_up pcc ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*1*), _) $ _ $ _ $ _) = go_scan_up pcc ist

  | scan_up pcc ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*2*), _) $ _ $ _) = go_scan_up pcc ist

  | scan_up pcc ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*3*), _) $ _ ) = go_scan_up pcc ist

  | scan_up pcc ist (Const (\<^const_name>\<open>Tactical.If\<close>(*1*), _) $ _ $ _ $ _) = go_scan_up pcc ist

  | scan_up _ _ t = raise ERROR ("scan_up not impl for " ^ UnparseC.term t)

(* scan program until an applicable tactic is found *)

fun scan_to_tactic (prog, cc) (Pstate (ist as {path, ...})) =

  if path = [] then

    scan_dn cc (trans_scan_dn ist) (Program.body_of prog)

  else go_scan_up (prog, cc) (trans_scan_up ist)

| scan_to_tactic _ _ = raise ERROR "scan_to_tactic: uncovered pattern";

(* find the next applicable Prog_Tac in a prog *)

fun find_next_step (Rule.Prog prog) (ptp as (pt, pos as (p, _))) (Pstate ist) ctxt =

   (case scan_to_tactic (prog, (ptp, ctxt)) (Pstate ist) of

      Accept_Tac (tac, ist, ctxt) =>

        Next_Step (Pstate ist, Tactic.insert_assumptions tac ctxt, tac)

    | Term_Val prog_result =>

        (case LItool.parent_node pt pos of

          (true, p', _, _) => 

            let

              val (_, pblID, _) = get_obj g_spec pt p';

            in

              End_Program (Pstate ist, Tactic.Check_Postcond' (pblID, prog_result))

            end

        | _ => End_Program (Pstate ist, Tactic.End_Detail' (TermC.empty,[])))

    | Reject_Tac => Helpless)

  | find_next_step _ _ ist _ =

    raise ERROR ("find_next_step: not impl for " ^ Istate.string_of ist);

(*** locate an input tactic within a program ***)

datatype input_tactic_result =

    Safe_Step of Istate.T * Proof.context * Tactic.T

  | Unsafe_Step of Istate.T * Proof.context * Tactic.T

  | Not_Locatable of string

(*all functions ending with "1" are supposed to be replaced by those without "1"*)

datatype expr_val1 = (* "ExprVal" in the sense of denotational semantics        *)

  Reject_Tac1 of     (* tactic is found but NOT acknowledged, scan is continued *)

    Istate.pstate * Proof.context * Tactic.T (*TODO: revise Pstate {or,...},no args as Reject_Tac*)

| Accept_Tac1 of     (* tactic is found and acknowledged, scan is stalled       *)

    Istate.pstate *  (* the current state, returned for resuming execution      *)

    Proof.context *  (* updated according to evaluation of Prog_Tac             *)

    Tactic.T         (* Prog_Tac is associated to Tactic.input                  *)

| Term_Val1 of       (* Prog_Expr is found and evaluated, scan is continued     *)

	  term             (* value of Prog_Expr, for updating environment            *)

\<^isac_test>\<open>

fun assoc2str (Accept_Tac1 _) = "Accept_Tac1"                                         

  | assoc2str (Term_Val1 _) = "Term_Val1"

  | assoc2str (Reject_Tac1 _) = "Reject_Tac1";

\<close>

(** check a Prog_Tac: is it associated to Tactic ? **)

fun check_tac1 ((pt, p), ctxt, tac) (ist as {act_arg, or, ...}) (prog_tac, form_arg) =

  case LItool.associate pt ctxt (tac, prog_tac) of

      LItool.Associated      (m, v', ctxt)

        => Accept_Tac1 (ist |> set_subst_true  (form_arg, v') |> set_found, ctxt, m)

    | LItool.Ass_Weak (m, v', ctxt) (*the ONLY ones in locate_tac ^v^v^v^v^ *)

        => Accept_Tac1 (ist |> set_subst_false (form_arg, v') |> set_found, ctxt, m)

    | LItool.Not_Associated =>

      (case or of (* switch for Tactical.Or: 1st AssOnly, 2nd AssGen *)

         AssOnly => Term_Val1 act_arg

       | _(*ORundef*) =>

          case Solve_Step.check (LItool.tac_from_prog pt (ThyC.get_theory "Isac_Knowledge") prog_tac) (pt, p) of

             Applicable.Yes m' => Reject_Tac1 (ist |> set_subst_false (form_arg, Tactic.result m'), ctxt, tac)

           | Applicable.No _ => Term_Val1 act_arg)

(** scan to a Prog_Tac **)

(* scan is strictly first L, then R; tacticals have 2 args at maximum *)

fun scan_dn1 cct ist (Const (\<^const_name>\<open>Tactical.Try\<close>(*1*), _) $ e $ a) =

    (case scan_dn1 cct (ist |> path_down_form ([L, R], a)) e of goback => goback) 

  | scan_dn1 cct ist (Const (\<^const_name>\<open>Tactical.Try\<close>(*2*), _) $ e) =

    (case scan_dn1 cct (ist |> path_down [R]) e of goback => goback)

  | scan_dn1 cct ist (Const (\<^const_name>\<open>Tactical.Repeat\<close>(*1*), _) $ e $ a) =

    scan_dn1 cct (ist |> path_down_form ([L, R], a)) e

  | scan_dn1 cct ist (Const (\<^const_name>\<open>Tactical.Repeat\<close>(*2*), _) $ e) =

    scan_dn1 cct (ist |> path_down [R]) e

  | scan_dn1 (cct as (cstate, _, _)) ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*1*), _) $ e1 $ e2 $ a) =

    (case scan_dn1 cct (ist |> path_down_form ([L, L, R], a)) e1 of

	     Term_Val1 v => scan_dn1 cct (ist |> path_down [L, R] |> set_subst' (a, v)) e2

     | Reject_Tac1 (ist', ctxt', tac') => scan_dn1 (cstate, ctxt', tac') (ist

        |> path_down_form ([L, R], a) |> trans_env_act ist') e2

     | goback => goback)

  | scan_dn1 (cct as (cstate, _, _)) ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*2*), _) $ e1 $ e2) =

    (case scan_dn1 cct (ist |> path_down [L, R]) e1 of

	     Term_Val1 v => scan_dn1 cct (ist |> path_down [R] |> set_act v) e2

     | Reject_Tac1 (ist', ctxt', tac') =>

        scan_dn1 (cstate, ctxt', tac') (ist |> path_down [R] |> trans_env_act ist') e2

     | goback => goback)

  | scan_dn1 cct ist (Const (\<^const_name>\<open>Let\<close>, _) $ e $ (Abs (id, T, b))) =

    (case scan_dn1 cct (ist |> path_down [L, R]) e of

       Reject_Tac1 (ist', _, _) =>

         scan_dn1 cct (ist' |> path_down [R, D] |> upd_env (TermC.mk_Free (id, T)) |> trans_ass ist) b

     | Term_Val1 v =>

         scan_dn1 cct (ist |> path_down [R, D] |> upd_env'' (TermC.mk_Free (id, T), v)) b

     | goback => goback)

  | scan_dn1 (cct as (_, ctxt, _)) (ist as {eval, act_arg, ...})

      (Const (\<^const_name>\<open>Tactical.While\<close>(*1*), _) $ c $ e $ a) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (ist |> get_act_env |> Env.update' a) c)

    then scan_dn1 cct (ist |> path_down_form ([L, R], a)) e

    else Term_Val1 act_arg

  | scan_dn1 (cct as (_, ctxt, _)) (ist as {eval, act_arg, ...})

      (Const (\<^const_name>\<open>Tactical.While\<close>(*2*),_) $ c $ e) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update_opt' (get_subst ist)) c) 

    then scan_dn1 cct (ist |> path_down [R]) e

    else Term_Val1 act_arg

  | scan_dn1 cct (ist as {or = ORundef, ...}) (Const (\<^const_name>\<open>Tactical.Or\<close>(*1*), _) $e1 $ e2 $ a) =

    (case scan_dn1 cct (ist |> path_down_form ([L, L, R], a) |> set_or AssOnly) e1 of

	     Term_Val1 v =>

	       (case scan_dn1 cct (ist |> path_down [L, R] |> set_subst' (a, v) |> set_or AssOnly) e2 of

	          Term_Val1 v => 

	            (case scan_dn1 cct (ist |> path_down [L, L, R] |> upd_env'' (a, v) |> set_or AssGen) e1 of

	               Term_Val1 v => 

	                 scan_dn1 cct (ist |> path_down [L, R] |> upd_env'' (a, v) |> set_or AssGen) e2

	             | goback => goback)

	        | goback => goback)

     | Reject_Tac1 _ => raise ERROR ("scan_dn1 Tactical.Or(*1*): must not return Reject_Tac1")

     | goback => goback)

  | scan_dn1 cct ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*2*), _) $e1 $ e2) =

    (case scan_dn1 cct (ist |> path_down [L, R]) e1 of

	     Term_Val1 v => scan_dn1 cct (ist |> path_down [R] |> set_act v) e2

     | goback => goback)

  | scan_dn1 (cct as (_, ctxt, _)) (ist as {eval, ...}) (Const (\<^const_name>\<open>Tactical.If\<close>, _) $ c $ e1 $ e2) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update_opt' (get_subst ist)) c)

    then scan_dn1 cct (ist |> path_down [L, R]) e1

    else scan_dn1 cct (ist |> path_down [R]) e2

  | scan_dn1 (cct as (_, ctxt, _)) (ist as {eval, ...}) t =

    if Tactical.contained_in t then raise TERM ("scan_dn1 expects Prog_Tac or Prog_Expr", [t])

    else

      case LItool.check_leaf "locate" ctxt eval (get_subst ist) t of

  	    (Program.Expr _, form_arg) => 

  	      Term_Val1 (Rewrite.eval_prog_expr ctxt eval

  		      (subst_atomic (Env.update_opt'' (get_act_env ist, form_arg)) t))

      | (Program.Tac prog_tac, form_arg) =>

          check_tac1 cct ist (prog_tac, form_arg)

fun go_scan_up1 (pcct as (prog, _)) (ist as {path, act_arg, ...}) =

    if 1 < length path then

      scan_up1 pcct (ist |> path_up) (TermC.sub_at (path_up' path) prog)

    else Term_Val1 act_arg

(* scan is strictly to R, because at L there was a expr_val *)

and scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.Try\<close>(*1*), _) $ _ $ _) = go_scan_up1 pcct ist

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.Try\<close>(*2*), _) $ _) = go_scan_up1 pcct ist

  | scan_up1 (pcct as (prog, cct as (cstate, _, _))) ist (t as Const (\<^const_name>\<open>Tactical.Repeat\<close>(*1*), _) $ e $ a) =

    (case scan_dn1 cct (ist |> path_down_form ([L, R], a) |> set_or ORundef) e of 

      Term_Val1 v => go_scan_up1 pcct (ist |> set_act v |> set_form a)

    | Reject_Tac1 (ist', ctxt', tac') => scan_up1 (prog, (cstate, ctxt', tac')) ist' t

    | goback => goback)

  | scan_up1 (pcct as (prog, cct as (cstate, _, _))) ist (t as Const (\<^const_name>\<open>Tactical.Repeat\<close>(*2*), _) $ e) =

    (case scan_dn1 cct (ist |> path_down [R] |> set_or ORundef) e of

       Term_Val1 v' => go_scan_up1 pcct (ist |> set_act v')

     | Reject_Tac1 (ist', ctxt', tac') => scan_up1 (prog, (cstate, ctxt', tac')) ist' t

     | goback => goback)

    (*all has been done in (*2*) below*)

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*1*), _) $ _ $ _ $ _) = go_scan_up1 pcct ist

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*2*), _) $ _ $ _) = go_scan_up1 pcct ist (*comes from e2*)    

  | scan_up1 (pcct as (prog, cct as (cstate, _, _))) ist (Const (\<^const_name>\<open>Tactical.Chain\<close>(*3*), _) $ _ ) =

     let 

       val e2 = check_Seq_up ist prog (*comes from e1, goes to e2*)

     in

       case scan_dn1 cct (ist |> path_up_down [R] |> set_or ORundef) e2 of

         Term_Val1 v => go_scan_up1 pcct (ist |> path_up |> set_act v)

       | Reject_Tac1 (ist', ctxt', tac') => go_scan_up1 (prog, (cstate, ctxt', tac')) ist'

       | goback => goback 

     end

  | scan_up1 (pcct as (prog, cct as (cstate, _, _))) ist (Const (\<^const_name>\<open>Let\<close>(*1*), _) $ _) =

    let 

      val (i, body) = check_Let_up ist prog

    in case scan_dn1 cct (ist |> path_up_down [R, D] |> upd_env i |> set_or ORundef) body of

	       Accept_Tac1 iss => Accept_Tac1 iss

	     | Reject_Tac1 (ist', ctxt', tac') => go_scan_up1 (prog, (cstate, ctxt', tac')) ist'

	     | Term_Val1 v => go_scan_up1 pcct (ist |> path_up |> set_act v) 

	  end

  | scan_up1 pcct ist (Abs(*2*) _) = go_scan_up1 pcct ist

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Let\<close>(*3*), _) $ _ $ (Abs _)) = go_scan_up1 pcct ist

  | scan_up1 (pcct as (prog, cct as (cstate, ctxt, _))) (ist as {eval, ...})

      (t as Const (\<^const_name>\<open>Tactical.While\<close>(*1*),_) $ c $ e $ a) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update' a (get_act_env ist)) c)

    then

      case scan_dn1 cct (ist |> path_down_form ([L, R], a) |> set_or ORundef) e of 

        Term_Val1 v => go_scan_up1 pcct (ist |> set_act v |> set_form a)

      | Reject_Tac1 (ist', ctxt', tac') => scan_up1 (prog, (cstate, ctxt', tac')) ist' t

      | goback => goback

    else go_scan_up1 pcct (ist |> set_form a)

  | scan_up1 (pcct as (prog, cct as (cstate, ctxt, _))) (ist as {eval, ...})

      (t as Const (\<^const_name>\<open>Tactical.While\<close>(*2*), _) $ c $ e) =

    if Rewrite.eval_true_ ctxt eval (subst_atomic (Env.update_opt' (get_subst ist)) c)

    then

      case scan_dn1 cct (ist |> path_down [R] |> set_or ORundef) e of 

        Term_Val1 v => go_scan_up1 pcct (ist |> set_act v)

       | Reject_Tac1 (ist', ctxt', tac') => scan_up1 (prog, (cstate, ctxt', tac')) ist' t

       | goback => goback

    else go_scan_up1 pcct ist

  | scan_up1 pcct ist (Const (\<^const_name>\<open>If\<close>, _) $ _ $ _ $ _) = go_scan_up1 pcct ist

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*1*), _) $ _ $ _ $ _) = go_scan_up1 pcct ist

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*2*), _) $ _ $ _) = go_scan_up1 pcct ist

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.Or\<close>(*3*), _) $ _ ) = go_scan_up1 pcct (ist |> path_up)

  | scan_up1 pcct ist (Const (\<^const_name>\<open>Tactical.If\<close>,_) $ _ $ _ $ _) = go_scan_up1 pcct ist

  | scan_up1 _ _ t = raise ERROR ("scan_up1 not impl for t= " ^ UnparseC.term t)

fun scan_to_tactic1 (prog, (cctt as ((_, p), _, _))) (Pstate (ist as {path, ...})) =

    if path = [] orelse Pos.at_first_tactic(*RM prog path RM WITH find_next_step IN solve*)p

    then scan_dn1 cctt (ist |> set_path [R] |> set_or ORundef) (Program.body_of prog)

    else go_scan_up1 (prog, cctt) ist

  | scan_to_tactic1 _ _ = raise ERROR "scan_to_tactic1: uncovered pattern in fun.def"

(*locate an input tactic within a program*)

fun locate_input_tactic (Rule.Prog prog) cstate istate ctxt tac =

    (case scan_to_tactic1 (prog, (cstate, ctxt, tac)) istate of

         Accept_Tac1 ((ist as {assoc, ...}), ctxt, tac') =>

          if assoc then

            Safe_Step (Pstate ist, ctxt, tac')

 	        else Unsafe_Step (Pstate ist, ctxt, tac')

      | Reject_Tac1 _ => Not_Locatable (Tactic.string_of tac ^ " not locatable")

      | err => raise ERROR ("not-found-in-program: NotLocatable from " ^ @{make_string} err))

  | locate_input_tactic _ _ _ _ _ = raise ERROR "locate_input_tactic: uncovered case in definition"

(*** locate an input formula within a program ***)

datatype input_term_result = Found_Step of Calc.T | Not_Derivable

fun by_tactic (Tactic.Apply_Method' (mI, _, _, _)) (_, ctxt) (pt, pos as (p, _)) =

      let

         val (itms, oris, probl) = case get_obj I pt p of (*STILL asms=[]*)

           PblObj {meth = itms, origin = (oris, _, _), probl, ...} => (itms, oris, probl)

         | _ => raise ERROR "LI.by_tactic Apply_Method': uncovered case get_obj"

         val {ppc, ...} = MethodC.from_store ctxt mI;

         val itms = if itms <> [] then itms else I_Model.complete oris probl [] ppc

         val srls = LItool.get_simplifier (pt, pos)

         val (is, env, ctxt, prog) = case LItool.init_pstate srls ctxt itms mI of

           (is as Pstate {env, ...}, ctxt, scr) => (is, env, ctxt, scr)

         | _ => raise ERROR "LI.by_tactic Apply_Method': uncovered case init_pstate"

        val ini = LItool.implicit_take prog env;

        val pos = start_new_level pos

      in 

        case ini of

          SOME t =>

          let                                                                   (* implicit Take *)

            val show_add = Tactic.Apply_Method' (mI, SOME t, is, ctxt);

            val (pos, c, _, pt) = Solve_Step.add show_add (is, ctxt) (pt, pos)

          in

           ("ok", ([(Tactic.Apply_Method mI, show_add, (pos, (is, ctxt)))], c, (pt, pos)))

          end

        | NONE =>

          let

            val (tac', ist', ctxt') = 

              case find_next_step prog (pt, (lev_dn p, Res)) is ctxt of

                Next_Step (ist, ctxt, tac) => (tac, ist, ctxt)

              | _ => raise ERROR ("LI.by_tactic..Apply_Method find_next_step \<rightarrow> " ^ strs2str' mI)

          in

            case tac' of

              Tactic.Take' t =>

                let                                                             (* explicit Take *)

                  val show_add = Tactic.Apply_Method' (mI, SOME t, ist', ctxt');

                  val (pos, c, _, pt) = Solve_Step.add show_add (ist', ctxt') (pt, pos)

                in

                 ("ok", ([(Tactic.Apply_Method mI, show_add, (pos, (is, ctxt)))], c, (pt, pos)))

                end

            | add as Tactic.Subproblem' (_, _, headline, _, _, _) =>

                let                                                                (* Subproblem *)

                  val show = Tactic.Apply_Method' (mI, SOME headline, ist', ctxt');

                  val (pos, c, _, pt) = Solve_Step.add add (ist', ctxt') (pt, pos)

                in

                 ("ok", ([(Tactic.Apply_Method mI, show, (pos, (ist', ctxt')))], c, (pt, pos)))

                end

            | tac =>

                raise ERROR ("LI.by_tactic..Apply_Method' does NOT expect " ^ Tactic.string_of tac)

          end

      end

  | by_tactic (Tactic.Check_Postcond' (pI, _)) (sub_ist, sub_ctxt) (pt, pos as (p, _)) =

      let

        val parent_pos = par_pblobj pt p

        val ctxt = Ctree.get_ctxt pt pos

        val {scr, ...} = MethodC.from_store ctxt (get_obj g_metID pt parent_pos);

        val prog_res =

           case find_next_step scr (pt, pos) sub_ist sub_ctxt of

             Next_Step (_, _, Tactic.Check_elementwise' (_, _, (prog_res, _))) => prog_res

           | End_Program (_, Tactic.Check_Postcond' (_, prog_res)) => prog_res

           | _ => raise ERROR ("Step_Solve.by_tactic Check_Postcond " ^ strs2str' pI)

      in

        if parent_pos = [] then 

  	      let

            val tac = Tactic.Check_Postcond' (pI, prog_res)

            val is = Pstate (sub_ist |> the_pstate |> set_act prog_res |> set_found)

  	        val ((p, p_), ps, _, pt) = Solve_Step.add_general tac (is, sub_ctxt) (pt, (parent_pos, Res))

  	      in

  	        ("ok", ([(Tactic.Check_Postcond pI, tac, ((parent_pos, Res), (is, sub_ctxt)))], ps, (pt, (p, p_))))

  	      end

        else

          let (*resume program of parent PblObj, transfer result of Subproblem-program*)

            val (ist_parent, ctxt_parent) = case get_loc pt (parent_pos, Frm) of

              (Pstate i, c) => (i, c)

            | _ => raise ERROR "LI.by_tactic Check_Postcond': uncovered case get_loc"

            val (prog_res', ctxt') = ContextC.subpbl_to_caller sub_ctxt prog_res ctxt_parent

            val tac = Tactic.Check_Postcond' (pI, prog_res')

            val ist' = Pstate (ist_parent |> set_act prog_res |> set_found)

            val ((p, p_), ps, _, pt) = Solve_Step.add_general tac (ist', ctxt') (pt, (parent_pos, Res))

          in

            ("ok", ([(Tactic.input_from_T tac, tac, ((parent_pos, Res), (ist', ctxt')))], ps, (pt, (p, p_))))

          end

      end

  | by_tactic (Tactic.End_Proof'') _ ptp = ("end-of-calculation", ([], [], ptp))

  | by_tactic tac_ ic (pt, pos) =

    let

      val pos = next_in_prog' pos

 	    val (pos', c, _, pt) = Solve_Step.add_general tac_ ic (pt, pos);

    in

      ("ok", ([(Tactic.input_from_T tac_, tac_, (pos, ic))], c, (pt, pos')))

    end

(*find_next_step from program, by_tactic will update Ctree*)

and do_next (ptp as (pt, pos as (p, p_))) =

    if MethodC.id_empty = get_obj g_metID pt (par_pblobj pt p) then

      ("helpless", ([], [], (pt, (p, p_))))

    else 

      let 

        val thy' = get_obj g_domID pt (par_pblobj pt p);

	      val ((ist, ctxt), sc) = LItool.resume_prog (p,p_) pt;

      in

        case find_next_step sc (pt, pos) ist ctxt of

           Next_Step (ist, ctxt, tac) =>

             by_tactic tac (ist, Tactic.insert_assumptions tac ctxt) ptp

         | End_Program (ist, tac) => (*TODO RM ..*)

             (case tac of

               Tactic.End_Detail' res =>

                 ("ok", ([(Tactic.End_Detail, 

                   Tactic.End_Detail' res, (pos, (ist, ctxt)))], [], ptp))

             | _ => (*.. RM*) by_tactic tac (ist, ctxt) ptp

             )

         | Helpless => ("helpless", Calc.state_empty_post)

      end;

(*

  compare inform with ctree.form at current pos by nrls;

  if found, embed the derivation generated during comparison

  if not, let the mat-engine compute the next Calc.result

  TODO: find code in common with complete_solve

*)

fun compare_step (tacis, c, ptp as (pt, pos as (p, _))) ifo =

  let

    val fo = Calc.current_formula ptp

    val ctxt = Ctree.get_ctxt pt pos

	  val {nrls, ...} = MethodC.from_store ctxt (Ctree.get_obj Ctree.g_metID pt (Ctree.par_pblobj pt p))

	  val {rew_ord, erls, rules, ...} = Rule_Set.rep nrls

	  val (found, der) = Derive.steps (Ctree.get_ctxt pt pos) rew_ord erls rules fo ifo; (*<---------------*)

  in

    if found

    then

       let

         val tacis' = map (State_Steps.make_single rew_ord erls) der;

		     val (c', ptp) = Derive.embed tacis' ptp;

	     in ("ok", (tacis (*@ tacis'?WN050408*), c @ c', ptp)) end

     else 

	     if pos = ([], Pos.Res) (*TODO: we should stop earlier with trying subproblems *)

	     then ("no derivation found", (tacis, c, ptp): Calc.state_post) 

	     else

         let

           val msg_cs' as (_, (tacis, c', ptp)) = (*LI.*)do_next ptp; (*<---------------------*)

		       val (_, (tacis, c'', ptp)) = case tacis of

			       ((Tactic.Subproblem _, _, _) :: _) => 

			         let

                 val ptp as (pt, pos as (p, _)) = Specify.do_all ptp (*<--------------------*)

				         val mI = Ctree.get_obj Ctree.g_metID pt p 

                 val (ist, ctxt) = (Istate.empty, Ctree.get_ctxt pt pos)

			         in

			           by_tactic (Tactic.Apply_Method' (mI, NONE, ist, ctxt)) (ist, ctxt) ptp

               end

			     | _ => msg_cs';

		     in compare_step (tacis, c @ c' @ c'', ptp) ifo end

  end

(* Locate a step in a program, which has been determined by input of a term *)

fun locate_input_term (pt, pos) tm =

     let                                                          

   		val pos_pred = Pos.lev_back' pos (*f_pred ---"step pos cs"---> f_succ in appendFormula*)

   		val _(*f_pred*) = Ctree.get_curr_formula (pt, pos_pred)

     in

   		case compare_step ([], [], (pt, pos_pred)) tm of

   		   ("no derivation found", _) => Not_Derivable

       | ("ok", (_, _, cstate)) => 

           Found_Step cstate

       | _ => raise ERROR "compare_step: uncovered case"

     end

(**)end(**)