src/Tools/isac/MathEngBasic/state-steps.sml
author Walther Neuper <walther.neuper@jku.at>
Mon, 11 May 2020 11:38:52 +0200
changeset 59962 6a59d252345d
parent 59931 cc5b51681c4b
child 59981 dc34eff67648
permissions -rw-r--r--
error -> raise ERROR
     1 (* Title: TODO/state-step.sml
     2    Author: Walther Neuper
     3    (c) due to copyright terms
     4 
     5 Deprecated; the idea was to hold steps complete such, that they can be replayed.
     6 *)
     7 
     8 signature STATE_STEPS =
     9 sig
    10   type single
    11   val single_empty : single
    12   type T
    13   val to_string : T -> string
    14   val result : single -> (term * term list)
    15   val make_single: Rewrite_Ord.rew_ord' * 'a -> Rule_Set.T -> term * Rule.rule * (term * term list) ->
    16     single
    17   val insert_pos : Pos.pos -> T -> T
    18 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
    19   (* NONE *)
    20 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
    21   (* NONE *)
    22 ( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
    23 end
    24 
    25 (**)
    26 structure State_Steps(**): STATE_STEPS(**) =
    27 struct
    28 (**)
    29 
    30 (* a single holds alle information required to build a node in the calc-tree;
    31    a single is assumed to be used efficiently such that the calc-tree
    32    resulting from applying a single need not be stored separately;
    33    see "type calcstate" *)
    34 (*TODO.WN0504 redesign ??? or redesign generate ?? see "fun generate"
    35   TODO.WN0512 ? redesign this _list_:
    36   # only used for [Apply_Method + (Take or Subproblem)], i.e. for initacs
    37   # the latter problem may be resolved automatically if "fun autocalc" is 
    38     not any more used for the specify-phase and for changing the phases*)
    39 type single = 
    40   (Tactic.input *                     (* for comparison with input tac             *)      
    41    Tactic.T *                         (* for ctree generation                      *)
    42    (Pos.pos' *                            (* after applying tac_, for ctree generation *)
    43     (Istate_Def.T * Proof.context)))  (* after applying tac_, for ctree generation *)
    44 val single_empty = (Tactic.Empty_Tac, Tactic.Empty_Tac_, (Pos.e_pos', (Istate_Def.empty, ContextC.empty))): single
    45 fun taci2str ((tac, tac_, (pos', (istate, _))):single) =
    46   "( " ^ Tactic.input_to_string tac ^ ", " ^ Tactic.string_of tac_ ^ ", ( " ^ Pos.pos'2str pos' ^ ", " ^
    47   Istate_Def.string_of istate ^ " ))"
    48 
    49 type T = single list;
    50 
    51 fun to_string tacis = (strs2str o (map (linefeed o taci2str))) tacis
    52 fun result (_, Tactic.Rewrite' (_, _, _, _, _, _,(res, asm)), _) = (res, asm)
    53   | result (_, Tactic.Rewrite_Set' (_, _, _, _, (res, asm)), _) = (res, asm)
    54   | result (_, tac_, _) = raise ERROR ("result: called with" ^ Tactic.string_of tac_)
    55 
    56 fun make_single ro erls (t, r as Rule.Thm (id, thm), (t', a)) = 
    57       (Tactic.Rewrite (id, thm), 
    58         Tactic.Rewrite' ("Isac_Knowledge", fst ro, erls, false, ThmC.from_rule r, t, (t', a)),
    59        (Pos.e_pos'(*to be updated before generate tacis!!!*), (Istate_Def.Uistate, ContextC.empty)))
    60   | make_single _ _ (t, r as Rule.Rls_ rls, (t', a)) = 
    61       (Tactic.Rewrite_Set (Rule_Set.id_from_rule r), 
    62         Tactic.Rewrite_Set' ("Isac_Knowledge", false, rls, t, (t', a)),
    63        (Pos.e_pos'(*to be updated before generate tacis!!!*), (Istate_Def.Uistate, ContextC.empty)))
    64   | make_single _ _ (t, r, _) = raise ERROR ("make_single: not impl. for " ^ Rule.to_string r ^ " at " ^ UnparseC.term t)
    65 
    66 (* update pos in tacis for embedding by generate *)
    67 fun insert_pos (_: Pos.pos) [] = []
    68   | insert_pos (p: Pos.pos) (((tac, tac_, (_, ist)): single) :: tacis) = 
    69     ((tac, tac_, ((p, Pos.Res), ist)): single) :: (insert_pos (Pos.lev_on p) tacis)
    70 
    71 (**)end(**)
    72