(* Title:  Specify/step-specify.sml

   Author: Walther Neuper 2019

   (c) due to copyright terms

*)

signature STEP_SPECIFY =

sig

(*val do_next: Step.specify_do_next requires LI.by_tactic, which is not yet known in Step_Specify*)

  val by_tactic_input: Tactic.input -> Calc.T -> string * Calc.state_post

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

  val initialise: theory -> Formalise.T ->

    term * term * References.T * O_Model.T * Proof.context

  val initialise': theory -> Formalise.T -> Calc.T * State_Steps.T

end

(**)

structure Step_Specify(**): STEP_SPECIFY(**) =

struct

(**)

open Pos

open Ctree

open Specification

fun by_tactic_input (tac as Tactic.Model_Problem) (pt, pos as (p, _)) =

    let

      val (oris, ospec, probl, spec, ctxt, meth) = case get_obj I pt p of

        PblObj {origin = (oris, ospec, _), probl, spec, ctxt, meth, ...} => (oris, ospec, probl, spec, ctxt, meth)

      | _ => raise ERROR "by_tactic_input Model_Problem; uncovered case get_obj"

      val (_, pI, mI) = References.select_input ospec spec

      val {cas, model, ...} = Problem.from_store (Ctree.get_ctxt pt pos) pI

      val pbl = I_Model.init ctxt oris model (* fill in descriptions *)

      val (pbl, met) = case cas of

        NONE => (pbl, [])

      | _ => I_Model.s_make_complete ctxt oris (probl, meth) (pI, mI)

      val tac_ = Tactic.Model_Problem' (pI, pbl, met)

      val (pos,c,_,pt) = Specify_Step.add tac_ (Istate_Def.Uistate, ctxt) (pt, pos)

    in

      ("ok",([(tac, tac_, (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt,pos)))

    end

  | by_tactic_input (Tactic.Add_Given ct) ptp = Specify.by_Add_ "#Given" ct ptp

  | by_tactic_input (Tactic.Add_Find  ct) ptp = Specify.by_Add_ "#Find"  ct ptp

  | by_tactic_input (Tactic.Add_Relation ct) ptp = Specify.by_Add_"#Relate" ct ptp

    (* called with MethodC.id_empty *)     

  | by_tactic_input (Tactic.Refine_Tacitly pI) (ptp as (pt, pos as (p, _))) =

    let 

      val (oris, dI, ctxt) = case get_obj I pt p of

        (PblObj {origin = (oris, (dI, _, _), _), ctxt, ...}) => (oris, dI, ctxt)

      | _ => raise ERROR "by_tactic_input Refine_Tacitly: uncovered case get_obj"

      val opt = Refine.by_o_model ctxt oris pI

    in 

      case opt of

	      SOME pI' => 

	        let

            val {solve_mets, ...} = Problem.from_store (Ctree.get_ctxt pt pos) pI'

	          (*val pt = update_pbl pt p pbl ..done by Model_Problem*)

	          val mI = if length solve_mets = 0 then MethodC.id_empty else hd solve_mets

	          val (pos, c, _, pt) = 

		          Specify_Step.add (Tactic.Refine_Tacitly' (pI, pI', dI, mI,(*pbl*)[])) (Istate_Def.Uistate, ctxt) (pt, pos)

	        in

	          ("ok", ([(Tactic.Refine_Tacitly pI, Tactic.Refine_Tacitly' (pI,pI',dI,mI,(*pbl*)[]),

	              (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt,pos)))

          end

	    | NONE => ("failure", ([], [], ptp))

    end

  | by_tactic_input (Tactic.Refine_Problem pI) (ptp as (pt, pos as (p,_))) =

    let

      val (dI, dI', probl, ctxt) = case get_obj I pt p of

        PblObj {origin= (_, (dI, _, _), _), spec = (dI', _, _), probl, ctxt, ...} =>

          (dI, dI', probl, ctxt)

      | _ => raise ERROR "by_tactic_input Refine_Problem: uncovered case get_obj"

	    val thy = if dI' = ThyC.id_empty then dI else dI'

    in 

      case Refine.problem (ThyC.get_theory ctxt thy) pI probl of

	      NONE => ("failure", ([], [], ptp))

	    | SOME (pI, (i_model, prec)) => 

	      let 

          val (pos,c,_,pt) = Specify_Step.add (Tactic.Refine_Problem' (pI, (i_model, prec)) )

            (Istate_Def.Uistate, ctxt) (pt, pos)

	      in

	        ("ok", ([(Tactic.Refine_Problem pI, Tactic.Refine_Problem' (pI, (i_model, prec)),

            (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt, pos)))

        end

    end

  | by_tactic_input (Tactic.Specify_Problem pI) (pt, pos as (p, _)) =

    let

      val (oris, pI', probl, meth, ctxt) = case get_obj I pt p of

        PblObj {origin = (oris, _, _), spec = (_ ,pI',_), probl, meth, ctxt, ...} =>

          (oris, pI', probl, meth, ctxt)

      | _ => raise ERROR ""

      val {model, where_, where_rls,...} = Problem.from_store (Ctree.get_ctxt pt pos) pI

	    val (check, (i_model, preconds)) = 

	      if pI' = Problem.id_empty andalso pI = Problem.id_empty

	      then (false, (I_Model.init ctxt oris model, []))

	      else M_Match.by_i_models ctxt oris (probl, meth) (model, where_, where_rls)

	    val (c, pt) =

	      case Specify_Step.add (Tactic.Specify_Problem' (pI, (check, (i_model, preconds)))) (Istate_Def.Uistate, ctxt) (pt, pos) of

  	      ((_, Pbl), c, _, pt) => (c, pt)

  	    | _ => raise ERROR ""

    in

      ("ok", ([(Tactic.Specify_Problem pI, Tactic.Specify_Problem' (pI, (check, ( i_model, preconds))),

        (pos, (Istate_Def.Uistate, ContextC.empty)))], c, (pt, pos)))

    end

  | by_tactic_input (Tactic.Specify_Method id) (pt, pos) =

    let

      val (o_model, ctxt, i_model) = Specify_Step.complete_for id (pt, pos)

      val (pos, _, _, pt) = Specify_Step.add (Tactic.Specify_Method' (id, o_model, i_model))

        (Istate_Def.Uistate, ctxt) (pt, pos)

    in

      ("ok", ([(Tactic.Specify_Method id, Tactic.Specify_Method' (id, o_model, i_model),

        (pos, (Istate_Def.Uistate, ContextC.empty)))], [], (pt, pos)))

    end    

  | by_tactic_input (Tactic.Specify_Theory dI) (pt, pos as (_, Pbl)) =

    let

      val ctxt = get_ctxt pt pos

	    val (pos, c, _, pt) =            

	      Specify_Step.add (Tactic.Specify_Theory' dI)  (Istate_Def.Uistate, ctxt) (pt, pos)

    in (*FIXXXME: check if pbl can still be parsed*)

	    ("ok", ([(Tactic.Specify_Theory dI, Tactic.Specify_Theory' dI,

        (pos, (Istate_Def.Uistate, ctxt)))], c, (pt, pos)))

    end

  | by_tactic_input (Tactic.Specify_Theory dI) (pt, pos as (_, Met)) =

    let

      val ctxt = get_ctxt pt pos

	    val (pos, c, _, pt) = Specify_Step.add (Tactic.Specify_Theory' dI) (Istate_Def.Uistate, ctxt) (pt, pos)

    in  (*FIXXXME: check if met can still be parsed*)

	    ("ok", ([(Tactic.Specify_Theory dI, Tactic.Specify_Theory' dI,

        (pos, (Istate_Def.Uistate, ctxt)))], c, (pt, pos)))

    end

  | by_tactic_input m' (ctree, pos) =

    let

      val ctxt = Ctree.get_ctxt ctree pos

    in

      raise ERROR ("by_tactic_input: not impl. for " ^ Tactic.input_to_string ctxt m')

    end

(**)

fun by_tactic (Tactic.Model_Problem' (id, pbl, met)) (pt, pos)  =

    let 

      val ((p, _), _, _, pt) = Specify_Step.add (Tactic.Model_Problem'(id, pbl, met))

        (Istate_Def.Uistate, ContextC.empty) (pt, pos)

(* deprecated^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *)

    in

      ("ok", ([], [], (pt, (p, Pbl))))

    end

    (* called only if no_met is specified *)     

  | by_tactic (Tactic.Refine_Tacitly' (pI, pIre, _, _, _)) (pt, pos) =

      let

        val {solve_mets, thy,...} = Problem.from_store (Ctree.get_ctxt pt pos) pIre

        val (domID, metID) = (Context.theory_name thy, 

          if length solve_mets = 0 then MethodC.id_empty 

          else hd solve_mets)

        val ((p,_), _, _, pt) = 

	        Specify_Step.add (Tactic.Refine_Tacitly' (pI, pIre, domID, metID, [(*pbl*)]))

            (Istate_Def.Uistate, ContextC.empty) (pt, pos)

(* deprecated^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ *)

      in 

        ("ok", ([], [], (pt,(p, Pbl))))

      end

  | by_tactic (Tactic.Refine_Problem' (rfd as (id, _))) (pt, pos)  =

      let

        val ctxt = get_ctxt pt pos

        val (pos, _, _, pt) =

          Specify_Step.add (Tactic.Refine_Problem' rfd) (Istate_Def.Uistate, ctxt) (pt, pos)

      in

        ("ok", ([(Tactic.Refine_Problem id, Tactic.Refine_Problem' rfd,

            (pos, (Istate_Def.Uistate,ctxt)))], [], (pt, pos)))

      end

  | by_tactic (Tactic.Specify_Problem' (pI, (ok, (itms, where_)))) (pt, pos as (p, _)) =

      let

        val (_, _, _, _, _, _, ctxt, _) = case get_obj I pt p of

          PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, _, mI), ctxt, meth = met, ...} =>

            (oris, dI', pI', mI', dI, mI, ctxt, met)

        | _ => raise ERROR "Step_Solve.by_tactic (Specify_Problem': uncovered case get_obj"

        val (p, pt) =

          case  Specify_Step.add (Tactic.Specify_Problem' (pI, (ok, (itms, where_)))) (Istate_Def.Uistate, ctxt) (pt, pos) of

            ((p, Pbl), _, _, pt) => (p, pt)

          | _ => raise ERROR "Step_Solve.by_tactic (Specify_Problem': uncovered case generate1 (WARNING WHY ?)"

      in

        ("ok", ([], [], (pt, (p, Pbl))))

      end    

  | by_tactic (Tactic.Specify_Method' (id, _, _)) (pt, pos) =

      let

        val (o_model, ctxt, i_model) = Specify_Step.complete_for id (pt, pos)

        val (pos, _, _, pt) = Specify_Step.add (Tactic.Specify_Method' (id, o_model, i_model))

          (Istate_Def.Uistate, ctxt) (pt, pos)

      in

        ("ok", ([], [], (pt, pos)))

      end

  | by_tactic (Tactic.Add_Given' (ct, _)) (pt, p)  = Specify.by_Add_ "#Given" ct (pt, p)

  | by_tactic (Tactic.Add_Find'  (ct, _)) (pt, p) = Specify.by_Add_ "#Find" ct (pt, p)

  | by_tactic (Tactic.Add_Relation' (ct, _)) (pt, p) = Specify.by_Add_"#Relate" ct (pt, p)

    (*strange old code, redes*)

  | by_tactic (Tactic.Specify_Theory' domID) (pt, (p, p_)) =

      let

        val p_ = case p_ of Met => Met | _ => Pbl

        val {spec = (dI, _, _), ctxt, ...} = Calc.specify_data (pt, (p, p_))

      in

        if domID = dI then

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

        else (*FIXME: check model wrt. (new!) domID ..? still parsable?*)

	        let 

	          val ((p, p_), _, _, pt) = Specify_Step.add (Tactic.Specify_Theory' domID)

	            (Istate_Def.Uistate, ctxt) (pt, (p, p_))

	        in

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

          end                

      end

  | by_tactic _ _ = raise ERROR "Step_Specify.by_tactic uncovered pattern in fun.def"

(* create a calc-tree with oris via a cas.refined pbl *)

(*  initialise <-?-> initialise' *)

fun initialise thy (fmz, (_, pI, mI)) = 

    let

	    val ctxt = Proof_Context.init_global thy (* ctxt restricted to Formalise *)

	    val (pI, (pors, pctxt), mI) = 

	      if mI = ["no_met"] 

	      then 

          let 

            val (pors, pctxt) = Problem.from_store ctxt pI |> #model |> O_Model.init thy fmz;

            val pI' = Refine.by_o_model' pctxt pors pI;

          in (pI', (pors (*refinement over models with diff.precond only*), pctxt),

            (hd o #solve_mets o Problem.from_store ctxt) pI')

          end

	      else

	        let

            val (pors, pctxt) = Problem.from_store ctxt pI |> #model |> O_Model.init thy fmz;

          in (pI, (pors, pctxt), mI) end;

	    val {cas, model, thy = thy', ...} = Problem.from_store ctxt pI (*take dI from _refined_ pbl*)

	    val dI = Context.theory_name (Sub_Problem.common_sub_thy (thy, thy'))

	    val hdl = case cas of

		    NONE => Auto_Prog.pblterm dI pI

		  | SOME t => subst_atomic ((Model_Pattern.variables model) ~~~ O_Model.values pors) t

	    val hdlPIDE = case cas of

		    NONE => Auto_Prog.pblterm dI pI

		  | SOME t => subst_atomic ((Model_Pattern.variables model) ~~~ O_Model.values pors) t

    in

      (hdlPIDE, hdl, (dI, pI, mI), pors, pctxt)

    end;

(*TODO: HOW RELATES initialise' \<longleftrightarrow> initialise *)

fun initialise' thy ([], (dI, pI, mI)) = (*this will probably be dropped with PIDE*)

    if pI <> []

    then (* from pbl-browser or from CAS cmd with pI=[e_pblID] *)

	    let

        val {cas, solve_mets, model, thy, ...} = Problem.from_store (Proof_Context.init_global thy) pI

	      val dI = if dI = "" then Context.theory_name thy else dI

	      val mI = if mI = [] then hd solve_mets else mI

	      val hdl = case cas of NONE => Auto_Prog.pblterm dI pI | SOME t => t

	      val (pt, _) = cappend_problem e_ctree [] (Istate_Def.Uistate, ContextC.empty) ([], (dI, pI, mI))

				  ([], (dI,pI,mI), hdl, ContextC.empty)

	      val pt = update_spec pt [] (dI, pI, mI)

	      val pits = I_Model.init (Proof_Context.init_global thy) [(*o_model*)] model

	      val pt = update_pbl pt [] pits

	    in ((pt, ([] , Pbl)), []) end

    else 

      if mI <> [] 

      then (* from met-browser *)

	      let

          val {model, ...} = MethodC.from_store (Proof_Context.init_global thy) mI

	        val dI = if dI = "" then "Isac_Knowledge" else dI

	        val (pt, _) = cappend_problem e_ctree [] (Istate_Def.empty, ContextC.empty)

	          ([], (dI, pI, mI)) ([], (dI, pI, mI), TermC.empty, ContextC.empty)

	        val pt = update_spec pt [] (dI, pI, mI)

	        val mits = I_Model.init (Proof_Context.init_global thy) [(*o_model*)] model

	        val pt = update_met pt [] mits

	      in ((pt, ([], Met)), []) end

      else (* new example, pepare for interactive modeling *)

	      let

	        val (pt, _) = cappend_problem e_ctree [] (Istate_Def.empty, ContextC.empty) 

	          ([], References.empty) ([], References.empty, TermC.empty, ContextC.empty)

	      in ((pt, ([], Pbl)), []) end

  | initialise' thy (model, refs) = 

    let            (* both          ^^^^^  ^^^^^^^^^^^^  are either empty or complete *)

	    val (_, hdl, refs, pors, pctxt) = initialise thy (model, refs)

      val (pt, _) = cappend_problem e_ctree [] (Istate_Def.empty, pctxt)

        (model, refs) (pors, refs, hdl, pctxt)

    in

      ((pt, ([], Pbl)), (fst3 o snd) (by_tactic_input Tactic.Model_Problem (pt, ([], Pbl))))

    end

(**)end(**)