src/Tools/isac/Specify/calchead.sml
author Walther Neuper <walther.neuper@jku.at>
Thu, 14 May 2020 13:33:47 +0200
changeset 59977 e635534c5f63
parent 59976 950922a768ca
permissions -rw-r--r--
rename Specification -> References, contiued
wneuper@59540
     1
(* Title: calchead.sml
wneuper@59540
     2
          Specify-phase: specifying and modeling a problem or a subproblem. The
wneuper@59540
     3
          most important types are declared in Selem and Stool (mstools.sml).
wneuper@59540
     4
          TODO: allocate elements of structure Selem and of structure Stool appropriately.
e0726734@41962
     5
   Author: Walther Neuper 991122, Mathias Lehnfeld
neuper@37906
     6
   (c) due to copyright terms
wneuper@59265
     7
*)
wneuper@59540
     8
(* Survey on type fmz_ .. type ori .. type itm (in probl, meth) .. formal args of root-/SubProblem
wneuper@59540
     9
   and relations between respective list elements:                                       #1#
wneuper@59540
    10
                  fmz      =             [ dsc $ v......................................(dsc $ v)..]
wneuper@59540
    11
root problem on pos = ([], _)            
wneuper@59540
    12
                  fmz_     =             [(dsc, v).......................................(dsc, v)..]
wneuper@59540
    13
                  \<down>                                                                       
wneuper@59540
    14
                  oris     =             [(dsc, v)..(dsc, v),(dsc, v),(dsc, v)...........(dsc, v)..]
wneuper@59540
    15
                  \<down>                       #Given,..,#Relate  #Find     #undef............#undef   \<down>
wneuper@59540
    16
                  \<down>                                                     \<down>                 \<down>       \<down>
wneuper@59540
    17
  Specify_Problem + pbl.ppc=             [(dsc,id)..(dsc,id),(dsc,id)]  \<down>                 \<down>       \<down>
wneuper@59540
    18
                  \<down>                                                     \<down>                 \<down>       \<down>
wneuper@59540
    19
                  itms     =             [(dsc, v)..(dsc, v),(dsc, v)]  \<down>                 \<down>       \<down>
wneuper@59540
    20
  int.modelling                           +Cor ++++++++++Cor +Cor       \<down>                 \<down>       \<down>
wneuper@59540
    21
                  \<down>                                                     \<down>                 \<down>       \<down>
wneuper@59540
    22
  Specify_Method  + met.ppc=             [(dsc,id)..(dsc,id),(dsc,id)]  \<down>                 \<down>       \<down>
wneuper@59540
    23
                  \<down>                                                     \<down>                 \<down>       \<down>
wneuper@59540
    24
                  itms     =             [(dsc, v)..(dsc, v),(dsc, v),(dsc, v)..(dsc, v)] \<down>       \<down>
wneuper@59540
    25
  int.modelling                                                       +Cor ++++++Cor      \<down>       \<down>
wneuper@59540
    26
                  form.args=             [ id ..... id      , ///////  id ....... id    ] \<down>       \<down>
wneuper@59540
    27
                  env =                  [(id, v)..(id, v)  , /////// (id, v)....(id, v)] \<down>       \<down>
walther@59718
    28
  interpret code env = [(id, v)..(id, v),(id, v)..(id, v)  , /////// (id, v)....(id, v)] \<down>       \<down>
wneuper@59540
    29
    ..extends env       ^^^^^^^^^^^^^^^^   \<down>                           \<down>   \<down>              \<down>       \<down>
wneuper@59540
    30
                                   \<down>       \<down>                           \<down>   \<down>              \<down>       \<down>
wneuper@59540
    31
SubProblem on pos = ([2], _)       \<down>       \<down>                           \<down>   \<down>              \<down>       \<down>
wneuper@59540
    32
                  form.args=      [id ................................ id ]\<down>              \<down>       \<down>
wneuper@59540
    33
                  \<down>                REAL..BOOL..                            \<down>              \<down>       \<down>
wneuper@59540
    34
                  \<down>                                                        \<down>              \<down>       \<down>
wneuper@59540
    35
                  + met.ppc=      [(dsc,id).......................(dsc,id)]\<down>              \<down>       \<down>
wneuper@59540
    36
                                    \<down>                               \<down>      \<down>              \<down>       \<down>
wneuper@59540
    37
                  oris     =      [(dsc, v)...................... (dsc,   v) ........... (dsc, v)]\<down>
walther@59718
    38
  Specify_Problem, int.modelling, Specify_Method, interpret code as above                 #1#    \<down>
wneuper@59540
    39
                                                                                                  \<down>
wneuper@59540
    40
SubProblem on pos = ([3, 4], _)                                                                   \<down>
wneuper@59540
    41
                  form.args=              [id ...................... id ]                         \<down>
wneuper@59540
    42
                  \<down>                        REAL..BOOL..                                           \<down>
wneuper@59540
    43
                  + met.ppc=              [(dsc,id).............(dsc,id)]                         \<down>
wneuper@59540
    44
                  oris     =              [(dsc, v).............(dsc, v)...................(dsc, v)] 
walther@59718
    45
  Specify_Problem, int.modelling, Specify_Method, interpret code as above                    #1#
wneuper@59540
    46
wneuper@59540
    47
Notes:
wneuper@59540
    48
(1) SubProblem implements sub-function calls such, that the arguments (+ pre- + post-condition)
wneuper@59540
    49
    of the functions become concern of interactive modelling.
wneuper@59540
    50
(2) In Isac-terms, the above concerns the phases of modelling and 
wneuper@59540
    51
    and of specifying (Specify_Problem, Specify_Method),
wneuper@59540
    52
    while stepwise construction of solutions is called solving.
wneuper@59540
    53
    The latter is supported by Lucas-Interpretation of the functions' body.
wneuper@59540
    54
(3) ori list is determined by fmz_ (in root-pbl) or by args of SubProblem;
wneuper@59540
    55
    it is as complete as possible (this has been different up to now).
wneuper@59540
    56
(4) itm list is initialised by pbl-ppc | met-pps and completed (Cor) by stepwise user input.
wneuper@59550
    57
(5) model-pattern of pbl can omit technical items, e.g. boundVariable or functionName,
wneuper@59550
    58
    add them to the model-pattern of met and let this input be done automatically;
wneuper@59550
    59
    respective items must be in fmz.
wneuper@59540
    60
#1# fmz contains items, which are stored in oris of the root(!)-problem.
wneuper@59540
    61
    This allows to specify methods, which require more input as anticipated
wneuper@59540
    62
    in writing partial_functions: such an item can be fetched from the root-problem's oris.
wneuper@59540
    63
    A candidate for this situation is "errorBound" in case an equation cannot be solved symbolically
wneuper@59540
    64
    and thus is solved numerically.
wneuper@59540
    65
#2# TODO
wneuper@59540
    66
*)
walther@59977
    67
signature SPECIFICATION =
wneuper@59265
    68
sig
wneuper@59265
    69
  type calcstate
wneuper@59265
    70
  type calcstate'
walther@59735
    71
walther@59977
    72
  type T = Specification_Def.T
walther@59976
    73
  val nxt_spec : Pos.pos_ -> bool -> O_Model.T -> References.T -> I_Model.T * I_Model.T ->
walther@59976
    74
    (string * (term * 'a)) list * (string * (term * 'b)) list -> References.T -> Pos.pos_ * Tactic.input
neuper@37906
    75
walther@59775
    76
  val reset_calchead : Calc.T -> Calc.T
walther@59977
    77
  val get_ocalhd : Calc.T -> T
walther@59963
    78
  val ocalhd_complete : I_Model.T -> Pre_Conds.T -> ThyC.id * Problem.id * Method.id -> bool
walther@59775
    79
  val all_modspec : Calc.T -> Calc.T 
neuper@37906
    80
walther@59945
    81
  val complete_metitms : O_Model.T -> I_Model.T -> I_Model.T -> Model_Pattern.T -> I_Model.T
walther@59939
    82
  val insert_ppc' : I_Model.single -> I_Model.T -> I_Model.T
neuper@37906
    83
walther@59775
    84
  val complete_mod : Calc.T -> Calc.T
walther@59775
    85
  val is_complete_mod : Calc.T -> bool
walther@59775
    86
  val complete_spec : Calc.T -> Calc.T
walther@59775
    87
  val is_complete_spec : Calc.T -> bool
walther@59976
    88
  val some_spec : References.T -> References.T -> References.T
wneuper@59265
    89
  (* these could go to Ctree ..*)
wneuper@59279
    90
  val show_pt : Ctree.ctree -> unit
wneuper@59517
    91
  val show_pt_tac : Ctree.ctree -> unit
walther@59775
    92
  val pt_extract : Calc.T -> Ctree.ptform * Tactic.input option * term list 
walther@59846
    93
  val get_interval : Pos.pos' -> Pos.pos' -> int -> Ctree.ctree -> (Pos.pos' * term * Tactic.input option) list
neuper@37906
    94
walther@59945
    95
  val match_ags : theory -> Model_Pattern.T -> term list -> O_Model.T
walther@59903
    96
  val match_ags_msg : Problem.id -> term -> term list -> unit
walther@59939
    97
  val oris2fmz_vals : O_Model.T -> string list * term list
walther@59960
    98
  val vars_of_pbl_' : Model_Pattern.T -> term list
walther@59956
    99
walther@59959
   100
  val ppc2list : 'a P_Model.ppc -> 'a list
walther@59974
   101
walther@59974
   102
  val itm_out : theory -> I_Model.feedback -> string
walther@59943
   103
  val mk_delete: theory -> string -> I_Model.feedback -> Tactic.input
walther@59865
   104
  val mk_additem: string -> TermC.as_string -> Tactic.input
walther@59960
   105
  val nxt_add: theory -> O_Model.T -> Model_Pattern.T -> I_Model.T -> (string * string) option
walther@59943
   106
  val is_error: I_Model.feedback -> bool
walther@59977
   107
  val complete_mod_: O_Model.T * Model_Pattern.T * Model_Pattern.T * I_Model.T ->
walther@59977
   108
    I_Model.T * I_Model.T
walther@59865
   109
  val nxt_specif_additem: string -> TermC.as_string -> Calc.T -> calcstate'
walther@59865
   110
  val specify_additem: string -> TermC.as_string -> Calc.T -> string * calcstate'
wneuper@59310
   111
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
walther@59908
   112
  val e_calcstate : Calc.T * State_Steps.T
wneuper@59265
   113
  val e_calcstate' : calcstate'
walther@59886
   114
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
walther@59957
   115
  val posterms2str: (Pos.pos' * term * 'a) list -> string
walther@59957
   116
  val postermtacs2str: (Pos.pos' * term * Tactic.input option) list -> string
walther@59957
   117
  val is_copy_named_idstr: string -> bool
walther@59957
   118
  val is_copy_named_generating_idstr: string -> bool
walther@59960
   119
  val is_copy_named_generating: Model_Pattern.single -> bool
walther@59960
   120
  val is_copy_named: Model_Pattern.single -> bool
walther@59957
   121
  val ori2Coritm: Model_Pattern.T -> O_Model.single -> I_Model.single
walther@59960
   122
  val matc: theory -> Model_Pattern.T -> term list -> O_Model.preori list -> O_Model.preori list
walther@59957
   123
  val mtc: theory -> Model_Pattern.single -> term -> O_Model.preori option
walther@59957
   124
  val cpy_nam: Model_Pattern.T -> O_Model.preori list -> Model_Pattern.single -> O_Model.preori
walther@59976
   125
  val get: Calc.T -> I_Model.T * O_Model.T * ThyC.id * References.id * References.id *
walther@59976
   126
        I_Model.T * ThyC.id * References.id * References.id * Proof.context
walther@59957
   127
  val make: I_Model.m_field -> TermC.as_string * I_Model.T -> Tactic.T
walther@59886
   128
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
wneuper@59310
   129
wneuper@59307
   130
(*----- kept as hints to initial design ideas; NOT in src/, NOT in test ------------------------*)
wneuper@59307
   131
  val variants_in : term list -> int
walther@59939
   132
  val is_untouched : I_Model.single -> bool
wneuper@59307
   133
  val is_list_type : typ -> bool
walther@59943
   134
  val parse_ok : I_Model.feedback list -> bool
walther@59943
   135
  val all_dsc_in : I_Model.feedback list -> term list
wneuper@59307
   136
  val chktyps : theory -> term list * term list -> term list (* only in old tests*)
walther@59775
   137
  val is_complete_modspec : Calc.T -> bool
walther@59846
   138
  val get_formress : (string * Pos.pos' * term) list list -> Pos.pos -> Ctree.ctree list ->
walther@59846
   139
    (string * Pos.pos' * term) list
walther@59846
   140
  val get_forms : (string * Pos.pos' * term) list list -> Pos.pos -> Ctree.ctree list ->
walther@59846
   141
    (string * Pos.pos' * term) list
wneuper@59265
   142
end
neuper@37906
   143
walther@59763
   144
(**)
walther@59977
   145
structure Specification(**): SPECIFICATION(**) =
neuper@37906
   146
struct
walther@59763
   147
(**)
walther@59957
   148
walther@59957
   149
(** datatypes **)
neuper@37906
   150
wneuper@59265
   151
(* the state wich is stored after each step of calculation; it contains
neuper@38065
   152
   the calc-state and a list of [tac,istate](="tacis") to be applied next.
neuper@37906
   153
   the last_elem tacis is the first to apply to the calc-state and
neuper@37906
   154
   the (only) one shown to the front-end as the 'proposed tac'.
neuper@37906
   155
   the calc-state resulting from the application of tacis is not stored,
neuper@38065
   156
   because the tacis hold enough information for efficiently rebuilding
wneuper@59265
   157
   this state just by "fun generate "
wneuper@59265
   158
*)
neuper@37906
   159
type calcstate = 
walther@59946
   160
  Calc.T *      (* the calc-state to which the tacis could be applied *)
walther@59946
   161
  State_Steps.T (* ev. several (hidden) steps; 
walther@59946
   162
                   in REVERSE order: first tac_ to apply is last_elem *)
walther@59957
   163
val e_calcstate = ((Ctree.EmptyPtree, Pos.e_pos'), [State_Steps.single_empty]);
neuper@37906
   164
neuper@37906
   165
(*the state used during one calculation within the mathengine; it contains
neuper@37906
   166
  a list of [tac,istate](="tacis") which generated the the calc-state;
neuper@37906
   167
  while this state's tacis are extended by each (internal) step,
neuper@37906
   168
  the calc-state is used for creating new nodes in the calc-tree
neuper@37906
   169
  (eg. applicable_in requires several particular nodes of the calc-tree)
neuper@37906
   170
  and then replaced by the the newly created;
neuper@37906
   171
  on leave of the mathengine the resuing calc-state is dropped anyway,
neuper@37906
   172
  because the tacis hold enought information for efficiently rebuilding
neuper@37906
   173
  this state just by "fun generate ".*)
neuper@37906
   174
type calcstate' = 
walther@59908
   175
  State_Steps.T * (* cas. several (hidden) steps;
walther@59946
   176
                       in REVERSE order: first tac_ to apply is last_elem                 *)
walther@59957
   177
  Pos.pos' list *     (* a "continuous" sequence of pos', deleted by application of taci list *)     
walther@59946
   178
  Calc.T          (* the calc-state resulting from the application of tacis               *)
walther@59957
   179
val e_calcstate' = ([State_Steps.single_empty], [Pos.e_pos'], (Ctree.EmptyPtree, Pos.e_pos')) : calcstate';
neuper@37906
   180
walther@59977
   181
type T = Specification_Def.T;
walther@59977
   182
wneuper@59265
   183
(* is the calchead complete ? *)
wneuper@59265
   184
fun ocalhd_complete its pre (dI, pI, mI) = 
walther@59939
   185
  foldl and_ (true, map #3 (its: I_Model.T)) andalso 
walther@59963
   186
  foldl and_ (true, map #1 (pre: Pre_Conds.T)) andalso 
walther@59903
   187
  dI <> ThyC.id_empty andalso pI <> Problem.id_empty andalso mI <> Method.id_empty
neuper@37906
   188
wneuper@59265
   189
(* ["BOOL (1+x=2)","REAL x"] --match_ags--> oris 
wneuper@59265
   190
   --oris2fmz_vals--> ["equality (1+x=2)","boundVariable x","solutions L"] *)
neuper@42092
   191
fun oris2fmz_vals oris =
wneuper@59308
   192
  let fun ori2fmz_vals (_, _, _, dsc, ts) = 
walther@59953
   193
	  ((UnparseC.term o Input_Descript.join') (dsc, ts), last_elem ts) 
walther@59962
   194
	  handle _ => raise ERROR ("ori2fmz_env called with " ^ UnparseC.terms ts)
wneuper@59265
   195
  in (split_list o (map ori2fmz_vals)) oris end
neuper@37906
   196
wneuper@59308
   197
fun ppc2list {Given = gis, Where = whs, Find = fis, With = wis, Relate = res} =
wneuper@59265
   198
  gis @ whs @ fis @ wis @ res
neuper@37906
   199
neuper@37906
   200
(* get the number of variants in a problem in 'original',
neuper@37906
   201
   assumes equal descriptions in immediate sequence    *)
neuper@37906
   202
fun variants_in ts =
wneuper@59265
   203
  let
wneuper@59265
   204
    fun eq (x, y) = head_of x = head_of y
wneuper@59265
   205
    fun cnt _ [] _ n = ([n], [])
wneuper@59265
   206
      | cnt eq (x :: xs) y n = if eq (x, y) then cnt eq xs y (n + 1) else ([n], x :: xs)
wneuper@59265
   207
    fun coll _  xs [] = xs
wneuper@59265
   208
      | coll eq  xs (y :: ys) = 
wneuper@59265
   209
        let val (n, ys') = cnt eq (y :: ys) y 0
wneuper@59265
   210
        in if ys' = [] then xs @ n else coll eq  (xs @ n) ys' end
wneuper@59265
   211
    val vts = subtract op = [1] (distinct (coll eq [] ts))
wneuper@59265
   212
  in
wneuper@59265
   213
    case vts of 
wneuper@59265
   214
      [] => 1
wneuper@59265
   215
    | [n] => n
walther@59962
   216
    | _ => raise ERROR "different variants in formalization"
wneuper@59265
   217
  end
neuper@37906
   218
wneuper@59265
   219
fun is_list_type (Type ("List.list", _)) = true
wneuper@59265
   220
  | is_list_type _ = false
walther@59943
   221
fun is_parsed (I_Model.Syn _) = false
wneuper@59265
   222
  | is_parsed _ = true
wneuper@59265
   223
fun parse_ok its = foldl and_ (true, map is_parsed its)
neuper@37906
   224
neuper@37906
   225
fun all_dsc_in itm_s =
neuper@37906
   226
  let    
walther@59943
   227
    fun d_in (I_Model.Cor ((d, _), _)) = [d]
walther@59943
   228
      | d_in (I_Model.Syn _) = []
walther@59943
   229
      | d_in (I_Model.Typ _) = []
walther@59943
   230
      | d_in (I_Model.Inc ((d,_),_)) = [d]
walther@59943
   231
      | d_in (I_Model.Sup (d,_)) = [d]
walther@59943
   232
      | d_in (I_Model.Mis (d,_)) = [d]
walther@59946
   233
      | d_in i = raise ERROR ("all_dsc_in: uncovered case with " ^ I_Model.feedback_to_string' i)
wneuper@59265
   234
  in (flat o (map d_in)) itm_s end; 
neuper@37906
   235
walther@59943
   236
fun is_error (I_Model.Cor _) = false
walther@59943
   237
  | is_error (I_Model.Sup _) = false
walther@59943
   238
  | is_error (I_Model.Inc _) = false
walther@59943
   239
  | is_error (I_Model.Mis _) = false
wneuper@59265
   240
  | is_error _ = true
neuper@37906
   241
wneuper@59265
   242
(* get the first term in ts from ori *)
wneuper@59308
   243
fun getr_ct thy (_, _, fd, d, ts) =
walther@59953
   244
  (fd, ((UnparseC.term_in_thy thy) o Input_Descript.join) (d,[hd ts]))
neuper@37906
   245
neuper@38051
   246
(* get a term from ori, notyet input in itm.
neuper@38051
   247
   the term from ori is thrown back to a string in order to reuse
neuper@38051
   248
   machinery for immediate input by the user. *)
wneuper@59308
   249
fun geti_ct thy (_, _, _, d, ts) (_, _, _, fd, itm_) =
walther@59953
   250
  (fd, ((UnparseC.term_in_thy thy) o Input_Descript.join) (d, subtract op = (I_Model.ts_in itm_) ts))
neuper@37906
   251
neuper@37906
   252
(* in FE dsc, not dat: this is in itms ...*)
walther@59943
   253
fun is_untouched (_, _, false, _, I_Model.Inc ((_, []), _)) = true
wneuper@59265
   254
  | is_untouched _ = false
neuper@37906
   255
neuper@37906
   256
(* select an item in oris, notyet input in itms 
walther@59943
   257
   (precondition: in itms are only I_Model.Cor, I_Model.Sup, I_Model.Inc) *)
wneuper@59235
   258
(*args of nxt_add
wneuper@59235
   259
  thy : for?
wneuper@59235
   260
  oris: from formalization 'type fmz', structured for efficient access 
wneuper@59235
   261
  pbt : the problem-pattern to be matched with oris in order to get itms
wneuper@59235
   262
  itms: already input items
wneuper@59235
   263
*)
wneuper@59308
   264
fun nxt_add thy [] pbt itms = (*root (only) ori...fmz=[]*)
wneuper@59265
   265
    let
walther@59943
   266
      fun test_d d (i, _, _, _, itm_) = (d = (I_Model.d_in itm_)) andalso i <> 0
wneuper@59265
   267
      fun is_elem itms (_, (d, _)) = 
wneuper@59265
   268
        case find_first (test_d d) itms of SOME _ => true | NONE => false
wneuper@59265
   269
    in
wneuper@59265
   270
      case filter_out (is_elem itms) pbt of
walther@59953
   271
        (f, (d, _)) :: _ => SOME (f, ((UnparseC.term_in_thy thy) o Input_Descript.join) (d, []))
wneuper@59265
   272
      | _ => NONE
wneuper@59265
   273
    end
wneuper@59265
   274
  | nxt_add thy oris _ itms =
wneuper@59265
   275
    let
walther@59939
   276
      fun testr_vt v ori = member op= (#2 (ori : O_Model.single)) v andalso (#3 ori) <> "#undef"
walther@59939
   277
      fun testi_vt v itm = member op= (#2 (itm : I_Model.single)) v
walther@59939
   278
      fun test_id ids r = member op= ids (#1 (r : O_Model.single))
wneuper@59426
   279
      fun test_subset itm (_, _, _, d, ts) = 
walther@59943
   280
        (I_Model.d_in (#5 (itm: I_Model.single))) = d andalso subset op = (I_Model.ts_in (#5 itm), ts)
walther@59943
   281
      fun false_and_not_Sup (_, _, false, _, I_Model.Sup _) = false
wneuper@59265
   282
        | false_and_not_Sup (_, _, false, _, _) = true
wneuper@59265
   283
        | false_and_not_Sup _ = false
walther@59943
   284
      val v = if itms = [] then 1 else I_Model.max_vt itms
wneuper@59265
   285
      val vors = if v = 0 then oris else filter (testr_vt v) oris  (* oris..vat *)
wneuper@59265
   286
      val vits =
wneuper@59265
   287
        if v = 0
wneuper@59265
   288
        then itms                                 (* because of dsc without dat *)
wneuper@59265
   289
  	    else filter (testi_vt v) itms;                             (* itms..vat *)
wneuper@59265
   290
      val icl = filter false_and_not_Sup vits;                    (* incomplete *)
wneuper@59265
   291
    in
wneuper@59265
   292
      if icl = [] 
wneuper@59265
   293
      then case filter_out (test_id (map #1 vits)) vors of
wneuper@59265
   294
  	    [] => NONE
wneuper@59265
   295
  	  | miss => SOME (getr_ct thy (hd miss))
wneuper@59265
   296
      else
wneuper@59265
   297
        case find_first (test_subset (hd icl)) vors of
walther@59962
   298
          NONE => raise ERROR "nxt_add: types or dsc DO NOT MATCH BETWEEN fmz --- pbt"
wneuper@59265
   299
        | SOME ori => SOME (geti_ct thy ori (hd icl))
wneuper@59265
   300
    end
neuper@37906
   301
walther@59974
   302
(*create output-string for itm_*)
walther@59974
   303
fun itm_out _ (I_Model.Cor ((d, ts), _)) = UnparseC.term (Input_Descript.join (d, ts))
walther@59974
   304
  | itm_out _ (I_Model.Syn c) = c
walther@59974
   305
  | itm_out _ (I_Model.Typ c) = c
walther@59974
   306
  | itm_out _ (I_Model.Inc ((d, ts), _)) = UnparseC.term (Input_Descript.join (d, ts))
walther@59974
   307
  | itm_out _ (I_Model.Sup (d, ts)) = UnparseC.term (Input_Descript.join (d, ts))
walther@59974
   308
  | itm_out _ (I_Model.Mis (d, pid)) = UnparseC.term d ^ " " ^ UnparseC.term pid
walther@59974
   309
  | itm_out _ _ = raise ERROR "itm_out: uncovered definition"
walther@59974
   310
walther@59974
   311
fun mk_delete thy "#Given" itm_ = Tactic.Del_Given (itm_out thy itm_)
walther@59974
   312
  | mk_delete thy "#Find" itm_ = Tactic.Del_Find (itm_out thy itm_)
walther@59974
   313
  | mk_delete thy "#Relate" itm_ = Tactic.Del_Relation (itm_out thy itm_)
walther@59962
   314
  | mk_delete _ str _ = raise ERROR ("mk_delete: called with field \"" ^ str ^ "\"")
wneuper@59571
   315
fun mk_additem "#Given" ct = Tactic.Add_Given ct
wneuper@59571
   316
  | mk_additem "#Find" ct = Tactic.Add_Find ct    
wneuper@59571
   317
  | mk_additem "#Relate"ct = Tactic.Add_Relation ct
walther@59962
   318
  | mk_additem str _ = raise ERROR ("mk_additem: called with field \"" ^ str ^ "\"")
neuper@37906
   319
neuper@38051
   320
(* determine the next step of specification;
neuper@38051
   321
   not done here: Refine_Tacitly (otherwise *** unknown method: (..., no_met))
neuper@38051
   322
   eg. in rootpbl 'no_met': 
neuper@37906
   323
args:
neuper@38051
   324
  preok          predicates are _all_ ok (and problem matches completely)
neuper@37906
   325
  oris           immediately from formalization 
neuper@37906
   326
  (dI',pI',mI')  specification coming from author/parent-problem
neuper@37906
   327
  (pbl,          item lists specified by user
neuper@37906
   328
   met)          -"-, tacitly completed by copy_probl
neuper@37906
   329
  (dI,pI,mI)     specification explicitly done by the user
neuper@37906
   330
  (pbt, mpc)     problem type, guard of method
neuper@38051
   331
*)
walther@59969
   332
fun nxt_spec Pos.Pbl preok oris (dI', pI', mI') (pbl, met) (pbt, mpc) (dI, pI, mI) = 
walther@59969
   333
    (if dI' = ThyC.id_empty andalso dI = ThyC.id_empty then (Pos.Pbl, Tactic.Specify_Theory dI')
walther@59969
   334
     else if pI' = Problem.id_empty andalso pI = Problem.id_empty then (Pos.Pbl, Tactic.Specify_Problem pI')
wneuper@59265
   335
     else
wneuper@59308
   336
       case find_first (is_error o #5) pbl of
wneuper@59265
   337
	       SOME (_, _, _, fd, itm_) =>
walther@59969
   338
	         (Pos.Pbl, mk_delete (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) fd itm_)
wneuper@59265
   339
	     | NONE => 
walther@59881
   340
	       (case nxt_add (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) oris pbt pbl of
walther@59969
   341
	          SOME (fd, ct') => (Pos.Pbl, mk_additem fd ct')
wneuper@59265
   342
	        | NONE => (*pbl-items complete*)
walther@59969
   343
	          if not preok then (Pos.Pbl, Tactic.Refine_Problem pI')
walther@59969
   344
	          else if dI = ThyC.id_empty then (Pos.Pbl, Tactic.Specify_Theory dI')
walther@59969
   345
		        else if pI = Problem.id_empty then (Pos.Pbl, Tactic.Specify_Problem pI')
walther@59969
   346
		        else if mI = Method.id_empty then (Pos.Pbl, Tactic.Specify_Method mI')
wneuper@59265
   347
		        else
wneuper@59265
   348
			        case find_first (is_error o #5) met of
walther@59957
   349
			          SOME (_, _, _, fd, itm_) => (Pos.Met, mk_delete (ThyC.get_theory dI) fd itm_)
wneuper@59265
   350
			        | NONE => 
walther@59881
   351
			          (case nxt_add (ThyC.get_theory dI) oris mpc met of
walther@59957
   352
				          SOME (fd, ct') => (Pos.Met, mk_additem fd ct') (*30.8.01: pre?!?*)
walther@59957
   353
				        | NONE => (Pos.Met, Tactic.Apply_Method mI))))
walther@59969
   354
  | nxt_spec Pos.Met preok oris (dI', pI', _) (_, met) (_ ,mpc) (dI, pI, mI) = 
wneuper@59265
   355
    (case find_first (is_error o #5) met of
walther@59969
   356
      SOME (_,_,_,fd,itm_) => (Pos.Met, mk_delete (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) fd itm_)
wneuper@59265
   357
    | NONE => 
walther@59881
   358
      case nxt_add (ThyC.get_theory (if dI = ThyC.id_empty then dI' else dI)) oris mpc met of
walther@59969
   359
	      SOME (fd,ct') => (Pos.Met, mk_additem fd ct')
wneuper@59265
   360
      | NONE => 
walther@59969
   361
	      (if dI = ThyC.id_empty then (Pos.Met, Tactic.Specify_Theory dI')
walther@59969
   362
	       else if pI = Problem.id_empty then (Pos.Met, Tactic.Specify_Problem pI')
walther@59969
   363
		     else if not preok then (Pos.Met, Tactic.Specify_Method mI)
walther@59969
   364
		     else (Pos.Met, Tactic.Apply_Method mI)))
walther@59962
   365
  | nxt_spec p _ _ _ _ _ _ = raise ERROR ("nxt_spec: uncovered case with " ^ Pos.pos_2str p)
neuper@37906
   366
wneuper@59265
   367
(* make oris from args of the stac SubProblem and from pbt.
wneuper@59265
   368
   can this formal argument (of a model-pattern) be omitted in the arg-list
wneuper@59265
   369
   of a SubProblem ? see calcelems.sml 'type met '                        *)
wneuper@59265
   370
fun is_copy_named_idstr str =
wneuper@59265
   371
  case (rev o Symbol.explode) str of
wneuper@59540
   372
	  "'" :: _ :: "'" :: _ => true
wneuper@59540
   373
  | _ => false
wneuper@59389
   374
fun is_copy_named (_, (_, t)) = (is_copy_named_idstr o TermC.free2str) t
neuper@41973
   375
wneuper@59265
   376
(* should this formal argument (of a model-pattern) create a new identifier? *)
wneuper@59265
   377
fun is_copy_named_generating_idstr str =
wneuper@59265
   378
  if is_copy_named_idstr str
wneuper@59265
   379
  then
wneuper@59265
   380
    case (rev o Symbol.explode) str of
wneuper@59265
   381
	    "'" :: "'" :: "'" :: _ => false
wneuper@59265
   382
    | _ => true
wneuper@59265
   383
  else false
wneuper@59389
   384
fun is_copy_named_generating (_, (_, t)) = (is_copy_named_generating_idstr o TermC.free2str) t
neuper@37906
   385
wneuper@59265
   386
(* split type-wrapper from scr-arg and build part of an ori;
wneuper@59265
   387
   an type-error is reported immediately, raises an exn, 
wneuper@59265
   388
   subsequent handling of exn provides 2nd part of error message *)
wneuper@59405
   389
fun mtc thy (str, (dsc, _)) (ty $ var) =
wneuper@59265
   390
    ((Thm.global_cterm_of thy (dsc $ var);(*type check*)
wneuper@59308
   391
      SOME (([1], str, dsc, (*[var]*)
walther@59953
   392
	    Input_Descript.split' (dsc, var))) (*:ori without leading #*))
wneuper@59265
   393
      handle e as TYPE _ => 
wneuper@59265
   394
	      (tracing (dashs 70 ^ "\n"
wneuper@59265
   395
	        ^ "*** ERROR while creating the items for the model of the ->problem\n"
wneuper@59265
   396
	        ^ "*** from the ->stac with ->typeconstructor in arglist:\n"
walther@59868
   397
	        ^ "*** item (->description ->value): " ^ UnparseC.term dsc ^ " " ^ UnparseC.term var ^ "\n"
wneuper@59389
   398
	        ^ "*** description: " ^ TermC.term_detail2str dsc
wneuper@59389
   399
	        ^ "*** value: " ^ TermC.term_detail2str var
wneuper@59389
   400
	        ^ "*** typeconstructor in script: " ^ TermC.term_detail2str ty
walther@59880
   401
	        ^ "*** checked by theory: " ^ Context.theory_name thy ^ "\n"
wneuper@59265
   402
	        ^ "*** " ^ dots 66);
wneuper@59337
   403
          writeln (@{make_string} e);
wneuper@59338
   404
          Exn.reraise e; (*raise ERROR "actual args do not match formal args";FIXXXME.WN100916*)
wneuper@59265
   405
      NONE))
walther@59962
   406
  | mtc _ _ t = raise ERROR ("mtc: uncovered case with" ^ UnparseC.term t)
neuper@38010
   407
wneuper@59265
   408
(* match each pat of the model-pattern with an actual argument;
wneuper@59265
   409
   precondition: copy-named vars are filtered out            *)
wneuper@59405
   410
fun matc _ [] _ oris = oris
wneuper@59265
   411
  | matc _ pbt [] _ =
neuper@38015
   412
    (tracing (dashs 70);
walther@59962
   413
     raise ERROR ("actual arg(s) missing for '" ^ Model_Pattern.to_string pbt ^ "' i.e. should be 'copy-named' by '*_._'"))
wneuper@59265
   414
  | matc thy ((p as (_, (_, t))) :: pbt) (a :: ags) oris =
wneuper@59389
   415
    (*del?..*)if (is_copy_named_idstr o TermC.free2str) t then oris
wneuper@59265
   416
    else(*..del?*)
wneuper@59265
   417
      let val opt = mtc thy p a
wneuper@59265
   418
      in
wneuper@59265
   419
        case opt of
wneuper@59265
   420
          SOME ori => matc thy pbt ags (oris @ [ori])
neuper@37926
   421
	      | NONE => [](*WN050903 skipped by exn handled in match_ags*)
wneuper@59265
   422
	 end
neuper@38011
   423
neuper@38011
   424
(* generate a new variable "x_i" name from a related given one "x"
neuper@38011
   425
   by use of oris relating "v_v'i'" (is_copy_named!) to "v_v"
neuper@38012
   426
   e.g. (v_v, x) & (v_v'i', ?) --> (v_v'i', x_i),
neuper@38012
   427
   but leave is_copy_named_generating as is, e.t. ss''' *)
wneuper@59405
   428
fun cpy_nam pbt oris (p as (field, (dsc, t))) =
neuper@37906
   429
  (if is_copy_named_generating p
neuper@37906
   430
   then (*WN051014 kept strange old code ...*)
walther@59953
   431
     let fun sel (_,_,d,ts) = Input_Descript.join'''' (d, ts) 
wneuper@59389
   432
       val cy' = (implode o (drop_last_n 3) o Symbol.explode o TermC.free2str) t
wneuper@59389
   433
       val ext = (last_elem o drop_last o Symbol.explode o TermC.free2str) t
wneuper@59513
   434
       val vars' = map (Term.term_name o snd o snd) pbt (*cpy-nam filtered_out*)
wneuper@59265
   435
       val vals = map sel oris
wneuper@59513
   436
       val cy_ext = (Term.term_name o the) (assoc (vars' ~~ vals, cy')) ^ "_" ^ ext
wneuper@59389
   437
     in ([1], field, dsc, [TermC.mk_free (type_of t) cy_ext]) end
neuper@37906
   438
   else ([1], field, dsc, [t])
walther@59962
   439
	) handle _ => raise ERROR ("cpy_nam: for "^ UnparseC.term t)
neuper@37906
   440
wneuper@59265
   441
(* match the actual arguments of a SubProblem with a model-pattern
neuper@37906
   442
   and create an ori list (in root-pbl created from formalization).
neuper@37906
   443
   expects ags:pats = 1:1, while copy-named are filtered out of pats;
wneuper@59540
   444
   if no 1:1 then exn raised by matc/mtc and handled at call.
wneuper@59265
   445
   copy-named pats are appended in order to get them into the model-items *)
wneuper@59405
   446
fun match_ags thy pbt ags =
wneuper@59540
   447
  let
wneuper@59540
   448
    fun flattup (i, (var, bool, str, itm_)) = (i, var, bool, str, itm_)
wneuper@59265
   449
    val pbt' = filter_out is_copy_named pbt
wneuper@59540
   450
    val cy = filter is_copy_named pbt  (* cy is NOT a (formal) argument, but the fun's result *)
wneuper@59265
   451
    val oris' = matc thy pbt' ags []
wneuper@59265
   452
    val cy' = map (cpy_nam pbt' oris') cy
walther@59947
   453
    val ors = O_Model.add_id (oris' @ cy') (*...appended in order to get into the model-items *)
wneuper@59308
   454
  in (map flattup ors) end
neuper@37906
   455
wneuper@59265
   456
(* report part of the error-msg which is not available in match_args *)
neuper@37906
   457
fun match_ags_msg pI stac ags =
wneuper@59265
   458
  let
walther@59970
   459
    val pats = (#ppc o Problem.from_store) pI
wneuper@59405
   460
    val msg = (dots 70 ^ "\n"
wneuper@59405
   461
       ^ "*** problem " ^ strs2str pI ^ " has the ...\n"
walther@59945
   462
       ^ "*** model-pattern " ^ Model_Pattern.to_string pats ^ "\n"
walther@59868
   463
       ^ "*** stac   '" ^ UnparseC.term stac ^ "' has the ...\n"
walther@59868
   464
       ^ "*** arg-list " ^ UnparseC.terms ags ^ "\n"
wneuper@59265
   465
       ^ dashs 70)
wneuper@59265
   466
	  (*WN100921 ^^^^ expect TYPE errormsg below; lost with Isa09*)
wneuper@59265
   467
  in tracing msg end
neuper@37906
   468
wneuper@59265
   469
(* get the variables out of a pbl_; FIXME.WN.0311: is_copy_named ...obscure!!! *)
neuper@37906
   470
fun vars_of_pbl_' pbl_ = 
wneuper@59265
   471
  let
wneuper@59265
   472
    fun var_of_pbl_ (_, (_, t)) = t: term
wneuper@59265
   473
  in ((map var_of_pbl_)(* o (filter_out is_copy_named)*)) pbl_ end
neuper@37906
   474
walther@59943
   475
fun eq_dsc ((_, _, _, _, itm_), (_, _, _, _, iitm_)) = (I_Model.d_in itm_ = I_Model.d_in iitm_)
neuper@37906
   476
wneuper@59265
   477
(* insert_ppc = insert_ppc' for appl_add', input_icalhd 11.03,
wneuper@59265
   478
   handles superfluous items carelessly                       *)
wneuper@59265
   479
fun insert_ppc' itm itms = if member eq_dsc itms itm then itms else itms @ [itm] (* @ new itm *)
neuper@37906
   480
wneuper@59265
   481
(* output the headline to a ppc *)
wneuper@59265
   482
fun header p_ pI mI =
walther@59969
   483
  case p_ of
walther@59969
   484
    Pos.Pbl => Test_Out.Problem (if pI = Problem.id_empty then [] else pI) 
walther@59969
   485
	| Pos.Met => Test_Out.Method mI
walther@59969
   486
	| pos => raise ERROR ("header called with "^ Pos.pos_2str pos)
neuper@37906
   487
walther@59957
   488
fun make m_field (term_as_string, i_model) =
walther@59957
   489
  case m_field of
walther@59957
   490
    "#Given" => Tactic.Add_Given' (term_as_string, i_model)
walther@59957
   491
  | "#Find" => Tactic.Add_Find' (term_as_string, i_model)
walther@59957
   492
  | "#Relate" => Tactic.Add_Relation'(term_as_string, i_model)
walther@59957
   493
  | str => raise ERROR ("specify_additem Frm, Pbl: uncovered case with " ^ str);
walther@59957
   494
fun get (pt, (p, _)) =
walther@59957
   495
  case Ctree.get_obj I pt p of
walther@59957
   496
    (Ctree.PblObj {meth, origin = (oris, (dI', pI', mI'), _), probl, spec = (dI, pI, mI), ctxt, ...})
walther@59957
   497
      => (meth, oris, dI', pI', mI', probl, dI, pI, mI, ctxt)
walther@59957
   498
  | _ => raise ERROR "specify_additem: uncovered case of get_obj I pt p";
walther@59969
   499
fun specify_additem sel ct (pt, pos as (p, Pos.Met)) = 
neuper@41993
   500
      let
walther@59957
   501
        val (met, oris, dI', pI', mI', pbl, dI, pI, mI, ctxt) = get (pt, pos)
walther@59957
   502
        val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI
walther@59957
   503
        val cpI = if pI = Problem.id_empty then pI' else pI
walther@59957
   504
        val cmI = if mI = Method.id_empty then mI' else mI
walther@59970
   505
        val {ppc, pre, prls, ...} = Method.from_store cmI
walther@59957
   506
      in 
walther@59958
   507
        case I_Model.check_single ctxt sel oris met ppc ct of
walther@59957
   508
          I_Model.Add itm =>  (*..union old input *)
walther@59957
   509
    	      let
walther@59958
   510
              val met' = I_Model.add_single thy itm met
walther@59957
   511
    	        val (p, pt') =
walther@59969
   512
    	         case Specify_Step.add (make sel (ct, met')) (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Met)) of
walther@59969
   513
    	          ((p, Pos.Met), _, _, pt') => (p, pt')
walther@59962
   514
    	        | _ => raise ERROR "specify_additem: uncovered case of generate1"
walther@59965
   515
    	        val pre' = Pre_Conds.check' thy prls pre met'
walther@59957
   516
    	        val pb = foldl and_ (true, map fst pre')
walther@59957
   517
    	        val (p_, _) =
walther@59969
   518
    	          nxt_spec Pos.Met pb oris (dI',pI',mI') (pbl,met') 
walther@59970
   519
    	            ((#ppc o Problem.from_store) cpI,ppc) (dI,pI,mI);
walther@59957
   520
    	      in 
walther@59957
   521
              ("ok", ([], [], (pt', (p, p_))))
walther@59957
   522
            end
walther@59957
   523
        | I_Model.Err msg =>
walther@59957
   524
    	      let
walther@59965
   525
              val pre' = Pre_Conds.check' thy prls pre met
walther@59957
   526
    	        val pb = foldl and_ (true, map fst pre')
walther@59957
   527
    	        val (p_, _) =
walther@59969
   528
    	          nxt_spec Pos.Met pb oris (dI',pI',mI') (pbl,met) 
walther@59970
   529
    	            ((#ppc o Problem.from_store) cpI,(#ppc o Method.from_store) cmI) (dI,pI,mI);
walther@59957
   530
    	      in
walther@59957
   531
              (msg, ([], [], (pt, (p, p_))))
walther@59957
   532
    	      end
walther@59957
   533
      end
walther@59957
   534
  | specify_additem sel ct (pt, pos as (p, _(*Frm, Pbl*))) =
walther@59957
   535
      let
walther@59957
   536
        val (met, oris, dI', pI', mI', pbl, dI, pI, mI, ctxt) = get (pt, pos)
walther@59881
   537
        val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI
walther@59903
   538
        val cpI = if pI = Problem.id_empty then pI' else pI
walther@59903
   539
        val cmI = if mI = Method.id_empty then mI' else mI
walther@59970
   540
        val {ppc, where_, prls, ...} = Problem.from_store cpI
neuper@41993
   541
      in
walther@59958
   542
        case I_Model.check_single ctxt sel oris pbl ppc ct of
walther@59956
   543
          I_Model.Add itm => (*..union old input *)
neuper@41993
   544
	          let
walther@59958
   545
	            val pbl' = I_Model.add_single thy itm pbl
walther@59810
   546
	            val (p, pt') =
walther@59957
   547
	              case Specify_Step.add (make sel (ct, pbl')) (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Pbl)) of
walther@59969
   548
  	              ((p, Pos.Pbl), _, _, pt') => (p, pt')
walther@59957
   549
  	            | _ => raise ERROR "specify_additem: uncovered case of Specify_Step.add"
walther@59957
   550
(* only for getting final p_ ..*)
walther@59965
   551
	            val pre = Pre_Conds.check' thy prls where_ pbl';
walther@59957
   552
	            val pb = foldl and_ (true, map fst pre);
walther@59957
   553
	            val (p_, _) =
walther@59970
   554
	              nxt_spec Pos.Pbl pb oris (dI',pI',mI') (pbl',met) (ppc, (#ppc o Method.from_store) cmI) (dI, pI, mI);
wneuper@59265
   555
	          in
walther@59806
   556
              ("ok", ([], [], (pt', (p, p_))))
neuper@41993
   557
            end
walther@59956
   558
        | I_Model.Err msg =>
neuper@41993
   559
	          let
walther@59965
   560
              val pre = Pre_Conds.check' thy prls where_ pbl
neuper@41993
   561
	            val pb = foldl and_ (true, map fst pre)
walther@59957
   562
	            val (p_, _(*Tactic.input*)) =
walther@59957
   563
	              nxt_spec Pos.Pbl pb oris (dI', pI', mI') (pbl, met) 
walther@59970
   564
	                (ppc, (#ppc o Method.from_store) cmI) (dI, pI, mI)
walther@59806
   565
	          in
walther@59806
   566
            (msg, ([], [], (pt, (p, p_))))
walther@59806
   567
	          end
wneuper@59265
   568
      end
neuper@37906
   569
neuper@41994
   570
(*FIXME.WN110515 declare_constraints for ct (without dsc) into PblObj{ctxt, ...}
neuper@41994
   571
  -- for input from scratch*)
walther@59969
   572
fun nxt_specif_additem sel ct (ptp as (pt, (p, Pos.Pbl))) = 
wneuper@59265
   573
    let
walther@59957
   574
      val (oris, dI', pI', dI, pI, pbl, ctxt) = case Ctree.get_obj I pt p of
walther@59957
   575
        Ctree.PblObj {origin = (oris, (dI', pI', _), _), spec = (dI, pI, _), probl = pbl, ctxt, ...} =>
wneuper@59265
   576
           (oris, dI', pI', dI, pI, pbl, ctxt)
walther@59962
   577
      | _ => raise ERROR "specify (Specify_Theory': uncovered case get_obj"
walther@59881
   578
      val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI;
walther@59903
   579
      val cpI = if pI = Problem.id_empty then pI' else pI;
wneuper@59265
   580
    in
walther@59970
   581
      case I_Model.check_single ctxt sel oris pbl ((#ppc o Problem.from_store) cpI) ct of
walther@59956
   582
	      I_Model.Add itm (*..union old input *) =>
wneuper@59265
   583
	        let
walther@59958
   584
	          val pbl' = I_Model.add_single thy itm pbl
wneuper@59265
   585
	          val (tac, tac_) = case sel of
wneuper@59571
   586
		          "#Given" => (Tactic.Add_Given    ct, Tactic.Add_Given'   (ct, pbl'))
wneuper@59571
   587
		        | "#Find"  => (Tactic.Add_Find     ct, Tactic.Add_Find'    (ct, pbl'))
wneuper@59571
   588
		        | "#Relate"=> (Tactic.Add_Relation ct, Tactic.Add_Relation'(ct, pbl'))
walther@59962
   589
		        | sel => raise ERROR ("nxt_specif_additem: uncovered case of" ^ sel)
walther@59810
   590
		        val (p, c, pt') =
walther@59969
   591
		          case Specify_Step.add tac_ (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Pbl)) of
walther@59969
   592
  		          ((p, Pos.Pbl), c, _, pt') =>  (p, c, pt')
walther@59962
   593
  		        | _ => raise ERROR "nxt_specif_additem: uncovered case generate1"
wneuper@59265
   594
	        in
walther@59969
   595
	          ([(tac, tac_, ((p, Pos.Pbl), (Istate_Def.Uistate, ctxt)))], c, (pt', (p, Pos.Pbl)))
wneuper@59265
   596
          end	       
walther@59956
   597
	    | I_Model.Err msg => (*TODO.WN03 pass error-msgs to the frontend..
wneuper@59265
   598
                     FIXME ..and dont abuse a tactic for that purpose*)
walther@59879
   599
	        ([(Tactic.Tac msg, Tactic.Tac_ (ThyC.get_theory "Isac_Knowledge", msg,msg,msg),
walther@59957
   600
	          (Pos.e_pos', (Istate_Def.empty, ContextC.empty)))], [], ptp) 
wneuper@59265
   601
    end
walther@59969
   602
  | nxt_specif_additem sel ct (ptp as (pt, (p, Pos.Met))) = 
wneuper@59265
   603
    let
walther@59957
   604
      val (oris, dI', mI', dI, mI, met, ctxt) = case Ctree.get_obj I pt p of
walther@59957
   605
        Ctree.PblObj {origin = (oris, (dI', _, mI'), _), spec = (dI, _, mI), meth = met,ctxt, ...} =>
wneuper@59265
   606
           (oris, dI', mI', dI, mI, met, ctxt)
walther@59962
   607
      | _ => raise ERROR "nxt_specif_additem Met: uncovered case get_obj"
walther@59881
   608
      val thy = if dI = ThyC.id_empty then ThyC.get_theory dI' else ThyC.get_theory dI;
walther@59903
   609
      val cmI = if mI = Method.id_empty then mI' else mI;
wneuper@59265
   610
    in 
walther@59970
   611
      case I_Model.check_single ctxt sel oris met ((#ppc o Method.from_store) cmI) ct of
walther@59956
   612
        I_Model.Add itm (*..union old input *) =>
wneuper@59265
   613
	        let
walther@59958
   614
	          val met' = I_Model.add_single thy itm met;
wneuper@59265
   615
	          val (tac,tac_) = case sel of
wneuper@59571
   616
		          "#Given" => (Tactic.Add_Given    ct, Tactic.Add_Given'   (ct, met'))
wneuper@59571
   617
		        | "#Find"  => (Tactic.Add_Find     ct, Tactic.Add_Find'    (ct, met'))
wneuper@59571
   618
		        | "#Relate"=> (Tactic.Add_Relation ct, Tactic.Add_Relation'(ct, met'))
walther@59962
   619
		        | sel => raise ERROR ("nxt_specif_additem Met: uncovered case of" ^ sel)
walther@59810
   620
	          val (p, c, pt') =
walther@59969
   621
	            case Specify_Step.add tac_ (Istate_Def.Uistate, ctxt) (pt, (p, Pos.Met)) of
walther@59969
   622
  	            ((p, Pos.Met), c, _, pt') => (p, c, pt')
walther@59962
   623
  		        | _ => raise ERROR "nxt_specif_additem: uncovered case generate1 (WARNING WHY ?)"
wneuper@59265
   624
	        in
walther@59969
   625
	          ([(tac, tac_, ((p, Pos.Met), (Istate_Def.Uistate, ctxt)))], c, (pt', (p, Pos.Met)))
wneuper@59265
   626
	        end
walther@59956
   627
      | I_Model.Err _ => ([(*tacis*)], [], ptp) (*nxt_me collects tacis until not hide; here just no progress*)
wneuper@59265
   628
    end
walther@59962
   629
  | nxt_specif_additem _ _ (_, p) = raise ERROR ("nxt_specif_additem not impl. for" ^ Pos.pos'2str p)
neuper@41994
   630
wneuper@59405
   631
fun ori2Coritm pbt (i, v, f, d, ts) =
walther@59969
   632
  (i, v, true, f, I_Model.Cor ((d, ts), ((snd o snd o the o (find_first (I_Model.eq1 d))) pbt, ts)))
walther@59943
   633
    handle _ => (i, v, true, f, I_Model.Cor ((d, ts), (d, ts)))
wneuper@59265
   634
      (*dsc in oris, but not in pbl pat list: keep this dsc*)
neuper@37906
   635
wneuper@59265
   636
(* filter out oris which have same description in itms *)
neuper@37906
   637
fun filter_outs oris [] = oris
neuper@37906
   638
  | filter_outs oris (i::itms) = 
wneuper@59265
   639
    let
walther@59943
   640
      val ors = filter_out ((curry op = ((I_Model.d_in o #5) i)) o (#4)) oris
wneuper@59265
   641
    in
wneuper@59265
   642
      filter_outs ors itms
wneuper@59265
   643
    end
neuper@37906
   644
wneuper@59265
   645
(* filter oris which are in pbt, too *)
neuper@37906
   646
fun filter_pbt oris pbt =
wneuper@59265
   647
  let
wneuper@59265
   648
    val dscs = map (fst o snd) pbt
wneuper@59265
   649
  in
wneuper@59308
   650
    filter ((member op= dscs) o (#4)) oris
wneuper@59265
   651
  end
neuper@37906
   652
wneuper@59265
   653
(* combine itms from pbl + met and complete them wrt. pbt *)
wneuper@59265
   654
(* FIXXXME.WN031205 complete_metitms doesnt handle incorrect itms !*)
wneuper@59308
   655
fun complete_metitms oris pits mits met = 
wneuper@59265
   656
  let
walther@59943
   657
    val vat = I_Model.max_vt pits;
wneuper@59308
   658
    val itms = pits @ (filter ((member_swap op = vat) o (#2 )) mits)
wneuper@59308
   659
    val ors = filter ((member_swap op= vat) o (#2)) oris
wneuper@59265
   660
    val os = filter_outs ors itms (*WN.12.03?: does _NOT_ add itms from met ?!*)
wneuper@59265
   661
  in
wneuper@59265
   662
    itms @ (map (ori2Coritm met) os)
wneuper@59265
   663
  end
neuper@37906
   664
wneuper@59265
   665
(* complete model and guard of a calc-head *)
wneuper@59265
   666
fun complete_mod_ (oris, mpc, ppc, probl) =
wneuper@59265
   667
  let
wneuper@59308
   668
    val pits = filter_out ((curry op= false) o (#3)) probl
walther@59943
   669
    val vat = if probl = [] then 1 else I_Model.max_vt probl
wneuper@59308
   670
    val pors = filter ((member_swap op = vat) o (#2)) oris
wneuper@59265
   671
    val pors = filter_outs pors pits (*which are in pbl already*)
wneuper@59265
   672
    val pors = (filter_pbt pors ppc) (*which are in pbt, too*)
wneuper@59265
   673
    val pits = pits @ (map (ori2Coritm ppc) pors)
wneuper@59265
   674
    val mits = complete_metitms oris pits [] mpc
wneuper@59265
   675
  in (pits, mits) end
neuper@37906
   676
wneuper@59405
   677
fun some_spec (odI, opI, omI) (dI, pI, mI) =
walther@59879
   678
  (if dI = ThyC.id_empty then odI else dI,
walther@59903
   679
   if pI = Problem.id_empty then opI else pI,
walther@59903
   680
   if mI = Method.id_empty then omI else mI)
neuper@37906
   681
wneuper@59265
   682
(* fun tag_form thy (formal, given) = Thm.global_cterm_of thy
wneuper@59265
   683
	 (((head_of o Thm.term_of) given) $ (Thm.term_of formal)); WN100819 *)
neuper@37934
   684
fun tag_form thy (formal, given) =
neuper@52070
   685
 (let
neuper@52070
   686
    val gf = (head_of given) $ formal;
wneuper@59184
   687
    val _ = Thm.global_cterm_of thy gf
neuper@52070
   688
  in gf end)
walther@59962
   689
  handle _ => raise ERROR ("calchead.tag_form: " ^ UnparseC.term_in_thy thy given ^
walther@59870
   690
    " .. " ^ UnparseC.term_in_thy thy formal ^ " ..types do not match")
neuper@38053
   691
wneuper@59265
   692
fun chktyps thy (fs, gs) = map (tag_form thy) (fs ~~ gs)
neuper@37906
   693
wneuper@59265
   694
(* complete _NON_empty calc-head for autocalc (sub-)pbl from oris
wneuper@59265
   695
  + met from fmz; assumes pos on PblObj, meth = []                    *)
walther@59957
   696
fun complete_mod (pt, pos as (p, p_)) =
wneuper@59265
   697
  let
walther@59957
   698
    val _ = if p_ <> Pos.Pbl 
walther@59962
   699
	    then raise ERROR ("###complete_mod: only impl.for Pbl, called with " ^ Pos.pos'2str pos)
wneuper@59265
   700
	    else ()
walther@59957
   701
	  val (oris, ospec, probl, spec) = case Ctree.get_obj I pt p of
walther@59957
   702
	    Ctree.PblObj {origin = (oris, ospec, _), probl, spec, ...} => (oris, ospec, probl, spec)
walther@59962
   703
	  | _ => raise ERROR "complete_mod: unvered case get_obj"
wneuper@59265
   704
  	val (_, pI, mI) = some_spec ospec spec
walther@59970
   705
  	val mpc = (#ppc o Method.from_store) mI
walther@59970
   706
  	val ppc = (#ppc o Problem.from_store) pI
wneuper@59265
   707
  	val (pits, mits) = complete_mod_ (oris, mpc, ppc, probl)
walther@59957
   708
    val pt = Ctree.update_pblppc pt p pits
walther@59957
   709
	  val pt = Ctree.update_metppc pt p mits
walther@59957
   710
  in (pt, (p, Pos.Met)) end
neuper@37906
   711
walther@59820
   712
(* do all specification in one single step:
walther@59820
   713
   complete calc-head for autocalc (sub-)pbl from oris (+ met from fmz);
walther@59820
   714
   oris and spec (incl. pbl-refinement) given from init_calc or SubProblem
walther@59820
   715
*)
walther@59671
   716
fun all_modspec (pt, (p, _)) =
wneuper@59265
   717
  let
walther@59957
   718
    val (pors, dI, pI, mI) = case Ctree.get_obj I pt p of
walther@59957
   719
      Ctree.PblObj {origin = (pors, (dI, pI, mI), _), ...}
walther@59820
   720
        => (pors, dI, pI, mI)
walther@59820
   721
    | _ => raise ERROR "all_modspec: uncovered case get_obj"
walther@59970
   722
	  val {ppc, ...} = Method.from_store mI
wneuper@59265
   723
    val (_, vals) = oris2fmz_vals pors
wneuper@59582
   724
	  val ctxt = ContextC.initialise dI vals
walther@59957
   725
    val (pt, _) = Ctree.cupdate_problem pt p ((dI, pI, mI),
walther@59820
   726
      map (ori2Coritm ppc) pors, map (ori2Coritm ppc) pors, ctxt)
wneuper@59265
   727
  in
walther@59957
   728
    (pt, (p, Pos.Met))
wneuper@59265
   729
  end
neuper@37906
   730
wneuper@59265
   731
(* WN0312: use in nxt_spec, too ? what about variants ??? *)
wneuper@59308
   732
fun is_complete_mod_ [] = false
wneuper@59265
   733
  | is_complete_mod_ itms = foldl and_ (true, (map #3 itms))
neuper@41976
   734
walther@59969
   735
fun is_complete_mod (pt, pos as (p, Pos.Pbl)) =
walther@59957
   736
    if (Ctree.is_pblobj o (Ctree.get_obj I pt)) p 
walther@59957
   737
    then (is_complete_mod_ o (Ctree.get_obj Ctree.g_pbl pt)) p
walther@59962
   738
    else raise ERROR ("is_complete_mod: called by PrfObj at " ^ Pos.pos'2str pos)
walther@59969
   739
  | is_complete_mod (pt, pos as (p, Pos.Met)) = 
walther@59957
   740
    if (Ctree.is_pblobj o (Ctree.get_obj I pt)) p 
walther@59957
   741
    then (is_complete_mod_ o (Ctree.get_obj Ctree.g_met pt)) p
walther@59962
   742
    else raise ERROR ("is_complete_mod: called by PrfObj at " ^ Pos.pos'2str pos)
neuper@37906
   743
  | is_complete_mod (_, pos) =
walther@59962
   744
    raise ERROR ("is_complete_mod called by " ^ Pos.pos'2str pos ^ " (should be Pbl or Met)")
neuper@37906
   745
wneuper@59265
   746
(* have (thy, pbl, met) _all_ been specified explicitly ? *)
walther@59957
   747
fun is_complete_spec (pt, pos as (p, _)) = 
walther@59957
   748
  if (not o Ctree.is_pblobj o (Ctree.get_obj I pt)) p 
walther@59962
   749
  then raise ERROR ("is_complete_spec: called by PrfObj at " ^ Pos.pos'2str pos)
wneuper@59265
   750
  else
walther@59957
   751
    let val (dI,pI,mI) = Ctree.get_obj Ctree.g_spec pt p
walther@59903
   752
    in dI <> ThyC.id_empty andalso pI <> Problem.id_empty andalso mI <> Method.id_empty end
neuper@37906
   753
wneuper@59265
   754
(* complete empty items in specification from origin (pbl, met ev.refined);
wneuper@59265
   755
   assumes 'is_complete_mod' *)
walther@59957
   756
fun complete_spec (pt, pos as (p, _)) = 
wneuper@59265
   757
  let
walther@59957
   758
    val (ospec, spec) = case Ctree.get_obj I pt p of
walther@59957
   759
      Ctree.PblObj {origin = (_,ospec,_), spec,...} => (ospec, spec)
walther@59962
   760
    | _ => raise ERROR "complete_spec: uncovered case get_obj"
walther@59957
   761
    val pt = Ctree.update_spec pt p (some_spec ospec spec)
wneuper@59265
   762
  in
wneuper@59265
   763
    (pt, pos)
wneuper@59265
   764
  end
neuper@37906
   765
wneuper@59265
   766
fun is_complete_modspec ptp = is_complete_mod ptp andalso is_complete_spec ptp
neuper@37906
   767
walther@59969
   768
fun pt_model (Ctree.PblObj {meth, spec, origin = (_, spec', hdl), ...}) Pos.Met =
wneuper@59265
   769
    let
walther@59957
   770
      val (_, _, metID) = Ctree.get_somespec' spec spec'
walther@59903
   771
	    val pre = if metID = Method.id_empty then []
wneuper@59265
   772
	      else
wneuper@59265
   773
	        let
walther@59970
   774
	          val {prls, pre= where_, ...} = Method.from_store metID
walther@59960
   775
	          val pre = Pre_Conds.check prls where_ meth 0
wneuper@59265
   776
		      in pre end
wneuper@59265
   777
	    val allcorrect = is_complete_mod_ meth andalso foldl and_ (true, (map #1 pre))
wneuper@59265
   778
    in
walther@59969
   779
      Ctree.ModSpec (allcorrect, Pos.Met, hdl, meth, pre, spec)
wneuper@59265
   780
    end
walther@59957
   781
  | pt_model (Ctree.PblObj {probl, spec, origin = (_, spec', hdl), ...}) _(*Frm,Pbl*) =
wneuper@59265
   782
    let
walther@59957
   783
      val (_, pI, _) = Ctree.get_somespec' spec spec'
walther@59903
   784
      val pre = if pI = Problem.id_empty then []
wneuper@59265
   785
	      else
wneuper@59265
   786
	        let
walther@59970
   787
	          val {prls, where_, ...} = Problem.from_store pI
walther@59960
   788
	          val pre = Pre_Conds.check prls where_ probl 0
wneuper@59265
   789
	        in pre end
wneuper@59265
   790
	    val allcorrect = is_complete_mod_ probl andalso foldl and_ (true, (map #1 pre))
wneuper@59265
   791
    in
walther@59957
   792
      Ctree.ModSpec (allcorrect, Pos.Pbl, hdl, probl, pre, spec)
wneuper@59265
   793
    end
walther@59962
   794
  | pt_model _ _ = raise ERROR "pt_model: uncovered definition"
neuper@37906
   795
walther@59957
   796
fun pt_form (Ctree.PrfObj {form, ...}) = Ctree.Form form
walther@59957
   797
  | pt_form (Ctree.PblObj {probl, spec, origin = (_, spec', _), ...}) =
wneuper@59265
   798
    let
walther@59957
   799
      val (dI, pI, _) = Ctree.get_somespec' spec spec'
walther@59970
   800
      val {cas, ...} = Problem.from_store pI
wneuper@59265
   801
    in case cas of
walther@59957
   802
      NONE => Ctree.Form (Auto_Prog.pblterm dI pI)
walther@59957
   803
    | SOME t => Ctree.Form (subst_atomic (I_Model.mk_env probl) t)
wneuper@59265
   804
    end
neuper@37906
   805
wneuper@59265
   806
(* pt_extract returns
neuper@37906
   807
      # the formula at pos
neuper@37906
   808
      # the tactic applied to this formula
neuper@37906
   809
      # the list of assumptions generated at this formula
neuper@37906
   810
	(by application of another tac to the preceding formula !)
wneuper@59265
   811
   pos is assumed to come from the frontend, ie. generated by moveDown.
wneuper@59265
   812
   Notes: cannot be in ctree.sml, because ModSpec has to be calculated. 
wneuper@59265
   813
   TODO 110417 get assumptions from ctxt !?
wneuper@59265
   814
*)
walther@59969
   815
fun pt_extract (pt, ([], Pos.Res)) =
wneuper@59265
   816
    (* WN120512: returns Check_Postcondition WRONGLY see --- build fun is_exactly_equal *)
wneuper@59265
   817
    let
walther@59957
   818
      val (f, asm) = Ctree.get_obj Ctree.g_result pt []
walther@59957
   819
    in (Ctree.Form f, NONE, asm) end
walther@59969
   820
  | pt_extract (pt, (p, Pos.Res)) =
wneuper@59265
   821
    let
walther@59957
   822
      val (f, asm) = Ctree.get_obj Ctree.g_result pt p
wneuper@59265
   823
      val tac =
walther@59957
   824
        if Ctree.last_onlev pt p
wneuper@59265
   825
        then
walther@59957
   826
          if Ctree.is_pblobj' pt (Pos.lev_up p)
neuper@42437
   827
          then
wneuper@59265
   828
            let
walther@59957
   829
              val pI = case Ctree.get_obj I pt (Pos.lev_up p) of
walther@59957
   830
                Ctree.PblObj{spec = (_, pI, _), ...} => pI
walther@59962
   831
              | _ => raise ERROR "pt_extract last_onlev: uncovered case get_obj"
walther@59903
   832
            in if pI = Problem.id_empty then NONE else SOME (Tactic.Check_Postcond pI) end
wneuper@59571
   833
		      else SOME Tactic.End_Trans (* WN0502 TODO for other branches *)
wneuper@59265
   834
		    else
walther@59957
   835
		      let val p' = Pos.lev_on p
wneuper@59265
   836
		      in
walther@59957
   837
		        if Ctree.is_pblobj' pt p'
wneuper@59265
   838
		        then
wneuper@59265
   839
		          let
walther@59957
   840
		            val (dI , pI) = case Ctree.get_obj I pt p' of
walther@59957
   841
		              Ctree.PblObj{origin = (_, (dI, pI, _), _), ...} => (dI ,pI)
walther@59962
   842
		            | _ => raise ERROR "pt_extract \<not>last_onlev: uncovered case get_obj"
wneuper@59571
   843
		          in SOME (Tactic.Subproblem (dI, pI)) end
wneuper@59265
   844
		        else
walther@59957
   845
		          if f = Ctree.get_obj Ctree.g_form pt p'
walther@59957
   846
		          then SOME (Ctree.get_obj Ctree.g_tac pt p') (*because this Frm ~~~is not on worksheet*)
walther@59957
   847
		          else SOME (Tactic.Take (UnparseC.term (Ctree.get_obj Ctree.g_form pt p')))
wneuper@59265
   848
		      end
walther@59957
   849
    in (Ctree.Form f, tac, asm) end
walther@59969
   850
  | pt_extract (pt, (p, p_(*Frm,Pbl*))) =
neuper@42437
   851
      let
walther@59957
   852
        val ppobj = Ctree.get_obj I pt p
walther@59957
   853
        val f = if Ctree.is_pblobj ppobj then pt_model ppobj p_ else Ctree.get_obj pt_form pt p
walther@59957
   854
        val tac = Ctree.g_tac ppobj
wneuper@59265
   855
      in (f, SOME tac, []) end
neuper@37906
   856
walther@59969
   857
walther@59969
   858
(** get the formula from a ctree-node **)
walther@59969
   859
(*
wneuper@59265
   860
  take form+res from PblObj and 1.PrfObj and (PrfObj after PblObj)
wneuper@59265
   861
  take res from all other PrfObj's
walther@59969
   862
  Designed for interSteps, outcommented 04 in favour of calcChangedEvent
walther@59969
   863
*)
walther@59957
   864
fun formres p (Ctree.Nd (Ctree.PblObj {origin = (_, _, h), result = (r, _), ...}, _)) =
walther@59957
   865
    [("headline", (p, Pos.Frm), h), ("stepform", (p, Pos.Res), r)]
walther@59957
   866
  | formres p (Ctree.Nd (Ctree.PrfObj {form, result = (r, _), ...}, _)) = 
walther@59957
   867
    [("stepform", (p, Pos.Frm), form), ("stepform", (p, Pos.Res), r)]
walther@59962
   868
  | formres _ _ = raise ERROR "formres: uncovered definition" 
walther@59957
   869
fun form p (Ctree.Nd (Ctree.PrfObj {result = (r, _), ...}, _)) = 
walther@59957
   870
    [("stepform", (p, Pos.Res), r)]
walther@59962
   871
  | form _ _ = raise ERROR "form: uncovered definition" 
neuper@37906
   872
wneuper@59265
   873
(* assumes to take whole level, in particular hd -- for use in interSteps *)
wneuper@59265
   874
fun get_formress fs _ [] = flat fs
neuper@37906
   875
  | get_formress fs p (nd::nds) =
neuper@37906
   876
    (* start with   'form+res'       and continue with trying 'res' only*)
walther@59957
   877
    get_forms (fs @ [formres p nd]) (Pos.lev_on p) nds
wneuper@59265
   878
and get_forms fs _ [] = flat fs
neuper@37906
   879
  | get_forms fs p (nd::nds) =
walther@59957
   880
    if Ctree.is_pblnd nd
neuper@37906
   881
    (* start again with      'form+res' ///ugly repeat with Check_elementwise
neuper@37906
   882
    then get_formress (fs @ [formres p nd]) (lev_on p) nds                   *)
walther@59957
   883
    then get_forms    (fs @ [formres p nd]) (Pos.lev_on p) nds
neuper@37906
   884
    (* continue with trying 'res' only*)
walther@59957
   885
    else get_forms    (fs @ [form    p nd]) (Pos.lev_on p) nds;
neuper@37906
   886
walther@59969
   887
wneuper@59279
   888
(** get an 'interval' 'from' 'to' of formulae from a ctree **)
walther@59969
   889
wneuper@59265
   890
(* WN0401 this functionality belongs to ctree.sml *)
walther@59969
   891
fun eq_pos' (p1, Pos.Frm) (p2, Pos.Frm) = p1 = p2
walther@59969
   892
  | eq_pos' (p1, Pos.Res) (p2, Pos.Res) = p1 = p2
walther@59969
   893
  | eq_pos' (p1, Pos.Pbl) (p2, p2_) =
walther@59969
   894
    p1 = p2 andalso (case p2_ of Pos.Pbl => true | Pos.Met => true | _ => false)
walther@59969
   895
  | eq_pos' (p1, Pos.Met) (p2, p2_) =
walther@59969
   896
    p1 = p2 andalso (case p2_ of Pos.Pbl => true | Pos.Met => true | _ => false)
neuper@37906
   897
  | eq_pos' _ _ = false;
neuper@37906
   898
wneuper@59265
   899
(* get an 'interval' from the ctree; 'interval' is w.r.t. the 
neuper@37906
   900
   total ordering Position#compareTo(Position p) in the java-code
wneuper@59516
   901
val get_interval = fn :
wneuper@59516
   902
      pos' ->     : from is "move_up 1st-element" to return
neuper@37906
   903
      pos' -> 	  : to the last element to be returned; from < to
wneuper@59516
   904
      int -> 	    : level: 0 gets the flattest sub-tree possible, 999 the deepest
wneuper@59279
   905
      ctree -> 	  : 
neuper@37906
   906
      (pos' * 	  : of the formula
neuper@37906
   907
       Term.term) : the formula
wneuper@59265
   908
	  list                                                           *)
neuper@37906
   909
fun get_interval from to level pt =
neuper@42432
   910
  let
walther@59957
   911
    fun get_inter c (from) (to) lev pt =
walther@59957
   912
	    if eq_pos' from to orelse from = ([], Pos.Res)
neuper@42432
   913
	    then
wneuper@59516
   914
	      let val (f, tacopt, _) = pt_extract (pt, from)
wneuper@59265
   915
	      in case f of
walther@59957
   916
	        Ctree.ModSpec (_, _, headline, _, _, _) => c @ [(from, headline, NONE)] 
walther@59957
   917
	      | Ctree.Form t => c @ [(from, t, tacopt)]
neuper@42432
   918
	      end
neuper@37906
   919
	    else 
walther@59957
   920
	      if lev < Pos.lev_of from
walther@59957
   921
	      then (get_inter c (Ctree.move_dn [] pt from) to lev pt)
walther@59957
   922
		      handle (Ctree.PTREE _(*from move_dn too far*)) => c
neuper@42432
   923
		    else
neuper@42432
   924
		      let
wneuper@59516
   925
		        val (f, tacopt, _) = pt_extract (pt, from)
neuper@42432
   926
		        val term = case f of
walther@59957
   927
		          Ctree.ModSpec (_,_,headline,_,_,_) => headline
walther@59957
   928
				    | Ctree.Form t => t
walther@59957
   929
		      in (get_inter (c @ [(from, term, tacopt)]) (Ctree.move_dn [] pt from) to lev pt)
walther@59957
   930
		        handle (Ctree.PTREE _(*from move_dn too far*)) => c @ [(from, term, tacopt)]
neuper@42432
   931
		      end
wneuper@59265
   932
  in get_inter [] from to level pt end
neuper@37906
   933
walther@59957
   934
fun posterm2str (pos, t, _) = "(" ^ Pos.pos'2str pos ^ ", " ^ UnparseC.term t ^ ")"
wneuper@59265
   935
fun posterms2str pfs = (strs2str' o (map (curry op ^ "\n")) o (map posterm2str)) pfs
neuper@37906
   936
wneuper@59516
   937
fun postermtac2str (pos, t, SOME tac) =
walther@59957
   938
      Pos.pos'2str pos ^ ", " ^ UnparseC.term t ^ "\n" ^ indent 10 ^ Tactic.input_to_string tac
wneuper@59516
   939
  | postermtac2str (pos, t, NONE) =
walther@59957
   940
      Pos.pos'2str pos ^ ", " ^ UnparseC.term t
wneuper@59516
   941
fun postermtacs2str pfts = (strs2str' o (map (curry op ^ "\n")) o (map postermtac2str)) pfts
wneuper@59516
   942
wneuper@59265
   943
(* WN050225 omits the last step, if pt is incomplete *)
walther@59957
   944
fun show_pt pt = tracing (posterms2str (get_interval ([], Pos.Frm) ([], Pos.Res) 99999 pt))
walther@59957
   945
fun show_pt_tac pt = tracing (postermtacs2str (get_interval ([], Pos.Frm) ([], Pos.Res) 99999 pt))
neuper@37906
   946
wneuper@59265
   947
(* get a calchead from a PblObj-node in the ctree; preconditions must be calculated *)
walther@59969
   948
fun get_ocalhd (pt, (p, Pos.Pbl)) = 
wneuper@59265
   949
    let
walther@59957
   950
	    val (ospec, hdf', spec, probl) = case Ctree.get_obj I pt p of
walther@59957
   951
	      Ctree.PblObj {origin = (_, ospec, hdf'), spec, probl,...} => (ospec, hdf', spec, probl)
walther@59962
   952
	    | _ => raise ERROR "get_ocalhd Pbl: uncovered case get_obj"
walther@59970
   953
      val {prls, where_, ...} = Problem.from_store (#2 (some_spec ospec spec))
walther@59965
   954
      val pre = Pre_Conds.check' (ThyC.get_theory "Isac_Knowledge") prls where_ probl
wneuper@59265
   955
    in
walther@59969
   956
      (ocalhd_complete probl pre spec, Pos.Pbl, hdf', probl, pre, spec)
wneuper@59265
   957
    end
walther@59969
   958
  | get_ocalhd (pt, (p, Pos.Met)) = 
wneuper@59265
   959
    let
walther@59957
   960
		  val (ospec, hdf', spec, meth) = case Ctree.get_obj I pt p of
walther@59957
   961
		    Ctree.PblObj {origin = (_, ospec, hdf'), spec, meth, ...} => (ospec, hdf', spec, meth)
walther@59962
   962
		  | _ => raise ERROR "get_ocalhd Met: uncovered case get_obj"
walther@59970
   963
      val {prls, pre, ...} = Method.from_store (#3 (some_spec ospec spec))
walther@59965
   964
      val pre = Pre_Conds.check' (ThyC.get_theory "Isac_Knowledge") prls pre meth
wneuper@59265
   965
    in
walther@59969
   966
      (ocalhd_complete meth pre spec, Pos.Met, hdf', meth, pre, spec)
wneuper@59265
   967
    end
walther@59962
   968
  | get_ocalhd _ = raise ERROR "get_ocalhd: uncovered definition"
neuper@37906
   969
walther@59977
   970
(* at the activeFormula set the Specification 
wneuper@59265
   971
   to empty and return a CalcHead;
wneuper@59265
   972
   the 'origin' remains (for reconstructing all that) *)
walther@59957
   973
fun reset_calchead (pt, (p,_)) = 
wneuper@59265
   974
  let
walther@59957
   975
    val () = case Ctree.get_obj I pt p of
walther@59957
   976
      Ctree.PblObj _ => ()
walther@59962
   977
    | _ => raise ERROR "reset_calchead: uncovered case get_obj"
walther@59957
   978
    val pt = Ctree.update_pbl pt p []
walther@59957
   979
    val pt = Ctree.update_met pt p []
walther@59976
   980
    val pt = Ctree.update_spec pt p References.empty
walther@59957
   981
  in (pt, (p, Pos.Pbl)) end
neuper@37906
   982
walther@59763
   983
(**)end(**)