src/Tools/isac/Specify/specify.sml
author Walther Neuper <walther.neuper@jku.at>
Thu, 07 May 2020 12:15:37 +0200
changeset 59946 c7546066881a
parent 59944 487954805988
child 59962 6a59d252345d
permissions -rw-r--r--
remove double code
walther@59763
     1
signature SPECIFY_NEW =
walther@59763
     2
sig
walther@59775
     3
  val find_next_step: Calc.T -> string * (Pos.pos_ * Tactic.input)
walther@59806
     4
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
walther@59806
     5
  (*NONE*)
walther@59886
     6
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
walther@59806
     7
  (*NONE*)
walther@59886
     8
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
walther@59763
     9
end
walther@59763
    10
walther@59763
    11
(**)
walther@59763
    12
structure SpecifyNEW(**): SPECIFY_NEW(**) =
walther@59763
    13
struct
walther@59763
    14
(**)
walther@59763
    15
open Pos
walther@59764
    16
open Ctree
walther@59763
    17
open Chead
walther@59763
    18
walther@59763
    19
(* was Chead.nxt_spec *)
walther@59772
    20
fun find_next_step (pt, (p, p_)) =
walther@59763
    21
  let
walther@59763
    22
    val (pblobj, met, origin, oris, dI', pI', mI', pbl, dI, pI, mI) = 
walther@59763
    23
  	  case Ctree.get_obj I pt p of
walther@59763
    24
  	    pblobj as (Ctree.PblObj {meth, origin = origin as (oris, (dI', pI', mI'), _),
walther@59763
    25
  		  probl, spec = (dI, pI, mI), ...}) => (pblobj, meth, origin, oris, dI', pI', mI', probl, dI, pI, mI)
walther@59763
    26
      | Ctree.PrfObj _ => error "nxt_specify_: not on PrfObj"
walther@59763
    27
  in
walther@59763
    28
    if Ctree.just_created_ pblobj (*by Subproblem*) andalso origin <> Ctree.e_origin
walther@59763
    29
    then 
walther@59763
    30
      case mI' of
walther@59763
    31
        ["no_met"] => ("ok", (Pbl, Tactic.Refine_Tacitly pI'))
walther@59763
    32
      | _ => ("ok", (Pbl, Tactic.Model_Problem))
walther@59763
    33
    else
walther@59763
    34
      let 
walther@59903
    35
        val cpI = if pI = Problem.id_empty then pI' else pI;
walther@59903
    36
  	    val cmI = if mI = Method.id_empty then mI' else mI;
walther@59763
    37
  	    val {ppc = pbt, prls, where_, ...} = Specify.get_pbt cpI;
walther@59763
    38
  	    val pre = Stool.check_preconds "thy 100820" prls where_ pbl;
walther@59763
    39
  	    val preok = foldl and_ (true, map fst pre);
walther@59763
    40
  	    (*FIXME.WN0308:    ~~~~~: just check true in itms of pbl/met?*)
walther@59763
    41
        val mpc = (#ppc o Specify.get_met) cmI
walther@59763
    42
      in
walther@59763
    43
        case p_ of
walther@59763
    44
          Pbl =>
walther@59879
    45
          (if dI' = ThyC.id_empty andalso dI = ThyC.id_empty then ("dummy", (Pbl, Tactic.Specify_Theory dI'))
walther@59903
    46
           else if pI' = Problem.id_empty andalso pI = Problem.id_empty then ("dummy", (Pbl, Tactic.Specify_Problem pI'))
walther@59763
    47
           else
walther@59763
    48
             case find_first (is_error o #5) pbl of
walther@59763
    49
      	       SOME (_, _, _, fd, itm_) =>
walther@59881
    50
      	         ("dummy", (Pbl, mk_delete (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) fd itm_))
walther@59763
    51
      	     | NONE => 
walther@59881
    52
      	       (case nxt_add (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) oris pbt pbl of
walther@59763
    53
      	          SOME (fd, ct') => ("dummy", (Pbl, mk_additem fd ct'))
walther@59763
    54
      	        | NONE => (*pbl-items complete*)
walther@59763
    55
      	          if not preok then ("dummy", (Pbl, Tactic.Refine_Problem pI'))
walther@59879
    56
      	          else if dI = ThyC.id_empty then ("dummy", (Pbl, Tactic.Specify_Theory dI'))
walther@59903
    57
      		        else if pI = Problem.id_empty then ("dummy", (Pbl, Tactic.Specify_Problem pI'))
walther@59903
    58
      		        else if mI = Method.id_empty then ("dummy", (Pbl, Tactic.Specify_Method mI'))
walther@59763
    59
      		        else
walther@59763
    60
      			        case find_first (is_error o #5) met of
walther@59881
    61
      			          SOME (_, _, _, fd, itm_) => ("dummy", (Met, mk_delete (ThyC.get_theory dI) fd itm_))
walther@59763
    62
      			        | NONE => 
walther@59881
    63
      			          (case nxt_add (ThyC.get_theory dI) oris mpc met of
walther@59763
    64
      				          SOME (fd, ct') => ("dummy", (Met, mk_additem fd ct')) (*30.8.01: pre?!?*)
walther@59763
    65
      				        | NONE => ("dummy", (Met, Tactic.Apply_Method mI)))))
walther@59763
    66
        | Met =>
walther@59763
    67
          (case find_first (is_error o #5) met of
walther@59881
    68
            SOME (_,_,_,fd,itm_) => ("dummy", (Met, mk_delete (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) fd itm_))
walther@59763
    69
          | NONE => 
walther@59881
    70
            case nxt_add (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) oris mpc met of
walther@59763
    71
      	      SOME (fd,ct') => ("dummy", (Met, mk_additem fd ct'))
walther@59763
    72
            | NONE => 
walther@59879
    73
      	      (if dI = ThyC.id_empty then ("dummy", (Met, Tactic.Specify_Theory dI'))
walther@59903
    74
      	       else if pI = Problem.id_empty then ("dummy", (Met, Tactic.Specify_Problem pI'))
walther@59763
    75
      		     else if not preok then ("dummy", (Met, Tactic.Specify_Method mI))
walther@59763
    76
      		     else ("dummy", (Met, Tactic.Apply_Method mI))))
walther@59772
    77
        | p_ => raise ERROR ("Specify.find_next_step called with " ^ Pos.pos_2str p_)
walther@59763
    78
      end
walther@59763
    79
  end
walther@59763
    80
walther@59946
    81
(**)end(**)