src/Tools/isac/Specify/calchead.sml
author Walther Neuper <walther.neuper@jku.at>
Mon, 23 Dec 2019 16:38:09 +0100
changeset 59764 afe82aeeea9a
parent 59763 1f2b170f1cc7
child 59775 3f2ec35c0cc5
permissions -rw-r--r--
rm code replaced in previous change set
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
*)
wneuper@59265
    67
signature CALC_HEAD =
wneuper@59265
    68
sig
wneuper@59265
    69
  type calcstate
wneuper@59265
    70
  type calcstate'
walther@59735
    71
wneuper@59571
    72
  val specify : Tactic.T -> Ctree.pos' -> Ctree.cid -> Ctree.ctree ->
walther@59737
    73
    Ctree.pos' * (Ctree.pos' * Istate_Def.T) * Generate.mout * Tactic.input * Telem.safe * Ctree.ctree
wneuper@59405
    74
  val nxt_spec : Ctree.pos_ -> bool -> Model.ori list -> Celem.spec -> Model.itm list * Model.itm list ->
wneuper@59571
    75
    (string * (term * 'a)) list * (string * (term * 'b)) list -> Celem.spec -> Ctree.pos_ * Tactic.input
neuper@37906
    76
wneuper@59281
    77
  val reset_calchead : Ctree.state -> Ctree.state
wneuper@59281
    78
  val get_ocalhd : Ctree.state -> Ctree.ocalhd
wneuper@59416
    79
  val ocalhd_complete : Model.itm list -> (bool * term) list -> Rule.domID * Celem.pblID * Celem.metID -> bool
wneuper@59281
    80
  val all_modspec : Ctree.state -> Ctree.state 
neuper@37906
    81
wneuper@59405
    82
  val complete_metitms : Model.ori list -> Model.itm list -> Model.itm list -> Celem.pat list -> Model.itm list
wneuper@59316
    83
  val insert_ppc' : Model.itm -> Model.itm list -> Model.itm list
neuper@37906
    84
wneuper@59281
    85
  val complete_mod : Ctree.state -> Ctree.state
wneuper@59281
    86
  val is_complete_mod : Ctree.state -> bool
wneuper@59281
    87
  val complete_spec : Ctree.state -> Ctree.state
wneuper@59281
    88
  val is_complete_spec : Ctree.state -> bool
wneuper@59405
    89
  val some_spec : Celem.spec -> Celem.spec -> Celem.spec
wneuper@59265
    90
  (* these could go to Ctree ..*)
wneuper@59279
    91
  val show_pt : Ctree.ctree -> unit
wneuper@59517
    92
  val show_pt_tac : Ctree.ctree -> unit
wneuper@59571
    93
  val pt_extract : Ctree.state -> Ctree.ptform * Tactic.input option * term list 
wneuper@59571
    94
  val get_interval : Ctree.pos' -> Ctree.pos' -> int -> Ctree.ctree -> (Ctree.pos' * term * Tactic.input option) list
neuper@37906
    95
wneuper@59405
    96
  val match_ags : theory -> Celem.pat list -> term list -> Model.ori list
wneuper@59405
    97
  val match_ags_msg : Celem.pblID -> term -> term list -> unit
wneuper@59316
    98
  val oris2fmz_vals : Model.ori list -> string list * term list
wneuper@59265
    99
  val vars_of_pbl_' : ('a * ('b * term)) list -> term list
wneuper@59316
   100
  val is_known : Proof.context -> string -> Model.ori list -> term -> string * Model.ori * term list
wneuper@59316
   101
  val is_notyet_input : Proof.context -> Model.itm list -> term list -> Model.ori -> ('a * (term * term)) list
wneuper@59316
   102
    -> string * Model.itm
wneuper@59316
   103
  val ppc2list : 'a Model.ppc -> 'a list
walther@59763
   104
  val mk_delete: theory -> string -> Model.itm_ -> Tactic.input
walther@59763
   105
  val mk_additem: string -> Rule.cterm' -> Tactic.input
walther@59763
   106
  val nxt_add: theory -> Model.ori list -> (string * (term * 'a)) list -> (int * Model.vats * bool * string * Model.itm_) list -> (string * string) option
walther@59763
   107
  val is_error: Model.itm_ -> bool
walther@59763
   108
  val complete_mod_: (int * int list * string * term * term list) list * ('a * (term * term)) list * ('b * (term * term)) list * Model.itm list -> Model.itm list * Model.itm list
walther@59763
   109
  val nxt_specif_additem: string -> Rule.cterm' -> Ctree.state -> calcstate'
walther@59764
   110
  val vals_of_oris : Model.ori list -> term list
wneuper@59310
   111
(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
wneuper@59307
   112
  val e_calcstate : Ctree.state * Generate.taci list
wneuper@59265
   113
  val e_calcstate' : calcstate'
walther@59702
   114
(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
wneuper@59521
   115
  val posterms2str : (pos' * term * 'a) list -> string
wneuper@59571
   116
  val postermtacs2str : (pos' * term * Tactic.input option) list -> string
wneuper@59513
   117
  val is_copy_named_idstr : string -> bool
wneuper@59513
   118
  val is_copy_named_generating_idstr : string -> bool
wneuper@59513
   119
  val is_copy_named_generating : 'a * ('b * term) -> bool
wneuper@59310
   120
  val is_copy_named : 'a * ('b * term) -> bool
wneuper@59409
   121
  val ori2Coritm : Celem.pat list -> Model.ori -> Model.itm
wneuper@59316
   122
  val matc : theory -> (string * (term * term)) list -> term list -> Model.preori list -> Model.preori list
wneuper@59409
   123
  val mtc : theory -> Celem.pat -> term -> Model.preori option
wneuper@59409
   124
  val cpy_nam : Celem.pat list -> Model.preori list -> Celem.pat -> Model.preori
wneuper@59395
   125
  datatype additm = Add of Model.itm | Err of string
wneuper@59426
   126
  val appl_add: Proof.context -> string -> Model.ori list ->
wneuper@59426
   127
    Model.itm list -> (string * (term * term)) list -> Rule.cterm' -> additm
wneuper@59550
   128
  val seek_oridts: Proof.context -> ''a -> term * term list -> (int * 'b list * ''a * term * term list) list -> string * (int * 'b list * ''a * term * term list) * term list
walther@59702
   129
( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
wneuper@59310
   130
wneuper@59307
   131
(*----- kept as hints to initial design ideas; NOT in src/, NOT in test ------------------------*)
wneuper@59307
   132
  val variants_in : term list -> int
wneuper@59316
   133
  val is_untouched : Model.itm -> bool
wneuper@59307
   134
  val is_list_type : typ -> bool
wneuper@59316
   135
  val parse_ok : Model.itm_ list -> bool
wneuper@59316
   136
  val all_dsc_in : Model.itm_ list -> term list
wneuper@59307
   137
  val chktyps : theory -> term list * term list -> term list (* only in old tests*)
wneuper@59316
   138
  val chk_vars : term Model.ppc -> string * term list
wneuper@59316
   139
  val unbound_ppc : term Model.ppc -> term list
wneuper@59307
   140
  val is_complete_modspec : Ctree.state -> bool
wneuper@59307
   141
  val get_formress : (string * Ctree.pos' * term) list list -> Ctree.pos -> Ctree.ctree list ->
wneuper@59307
   142
    (string * Ctree.pos' * term) list
wneuper@59307
   143
  val get_forms : (string * Ctree.pos' * term) list list -> Ctree.pos -> Ctree.ctree list ->
wneuper@59307
   144
    (string * Ctree.pos' * term) list
wneuper@59265
   145
end
neuper@37906
   146
walther@59763
   147
(**)
wneuper@59265
   148
structure Chead(**): CALC_HEAD(**) =
neuper@37906
   149
struct
walther@59763
   150
(**)
wneuper@59276
   151
open Ctree
walther@59695
   152
open Pos
neuper@37906
   153
(* datatypes *)
neuper@37906
   154
wneuper@59265
   155
(* the state wich is stored after each step of calculation; it contains
neuper@38065
   156
   the calc-state and a list of [tac,istate](="tacis") to be applied next.
neuper@37906
   157
   the last_elem tacis is the first to apply to the calc-state and
neuper@37906
   158
   the (only) one shown to the front-end as the 'proposed tac'.
neuper@37906
   159
   the calc-state resulting from the application of tacis is not stored,
neuper@38065
   160
   because the tacis hold enough information for efficiently rebuilding
wneuper@59265
   161
   this state just by "fun generate "
wneuper@59265
   162
*)
neuper@37906
   163
type calcstate = 
wneuper@59279
   164
  (ctree * pos') *    (* the calc-state to which the tacis could be applied *)
wneuper@59271
   165
  (Generate.taci list)   (* ev. several (hidden) steps; 
wneuper@59265
   166
                         in REVERSE order: first tac_ to apply is last_elem *)
wneuper@59306
   167
val e_calcstate = ((EmptyPtree, e_pos'), [Generate.e_taci]);
neuper@37906
   168
neuper@37906
   169
(*the state used during one calculation within the mathengine; it contains
neuper@37906
   170
  a list of [tac,istate](="tacis") which generated the the calc-state;
neuper@37906
   171
  while this state's tacis are extended by each (internal) step,
neuper@37906
   172
  the calc-state is used for creating new nodes in the calc-tree
neuper@37906
   173
  (eg. applicable_in requires several particular nodes of the calc-tree)
neuper@37906
   174
  and then replaced by the the newly created;
neuper@37906
   175
  on leave of the mathengine the resuing calc-state is dropped anyway,
neuper@37906
   176
  because the tacis hold enought information for efficiently rebuilding
neuper@37906
   177
  this state just by "fun generate ".*)
neuper@37906
   178
type calcstate' = 
wneuper@59271
   179
  Generate.taci list * (* cas. several (hidden) steps;
wneuper@59266
   180
                       in REVERSE order: first tac_ to apply is last_elem                   *)
wneuper@59266
   181
  pos' list *       (* a "continuous" sequence of pos', deleted by application of taci list *)     
wneuper@59279
   182
  (ctree * pos')    (* the calc-state resulting from the application of tacis               *)
wneuper@59565
   183
val e_calcstate' = ([Generate.e_taci], [e_pos'], (EmptyPtree, e_pos')) : calcstate';
neuper@37906
   184
wneuper@59265
   185
(* is the calchead complete ? *)
wneuper@59265
   186
fun ocalhd_complete its pre (dI, pI, mI) = 
wneuper@59426
   187
  foldl and_ (true, map #3 (its: Model.itm list)) andalso 
wneuper@59426
   188
  foldl and_ (true, map #1 (pre: (bool * term) list)) andalso 
wneuper@59416
   189
  dI <> Rule.e_domID andalso pI <> Celem.e_pblID andalso mI <> Celem.e_metID
neuper@37906
   190
wneuper@59265
   191
(* ["BOOL (1+x=2)","REAL x"] --match_ags--> oris 
wneuper@59265
   192
   --oris2fmz_vals--> ["equality (1+x=2)","boundVariable x","solutions L"] *)
neuper@42092
   193
fun oris2fmz_vals oris =
wneuper@59308
   194
  let fun ori2fmz_vals (_, _, _, dsc, ts) = 
wneuper@59416
   195
	  ((Rule.term2str o Model.comp_dts') (dsc, ts), last_elem ts) 
wneuper@59416
   196
	  handle _ => error ("ori2fmz_env called with " ^ Rule.terms2str ts)
wneuper@59265
   197
  in (split_list o (map ori2fmz_vals)) oris end
neuper@37906
   198
neuper@37906
   199
(* make a term 'typeless' for comparing with another 'typeless' term;
neuper@37906
   200
   'type-less' usually is illtyped                                  *)
wneuper@59416
   201
fun typeless (Const (s, _)) = (Const (s,Rule.e_type)) 
wneuper@59416
   202
  | typeless (Free (s, _)) = (Free (s,Rule.e_type))
wneuper@59416
   203
  | typeless (Var (n, _)) = (Var (n,Rule.e_type))
neuper@37906
   204
  | typeless (Bound i) = (Bound i)
wneuper@59416
   205
  | typeless (Abs (s, _,t)) = Abs(s,Rule.e_type, typeless t)
wneuper@59265
   206
  | typeless (t1 $ t2) = (typeless t1) $ (typeless t2)
neuper@37906
   207
wneuper@59265
   208
(* to an input (d,ts) find the according ori and insert the ts)
wneuper@59265
   209
  WN.11.03: + dont take first inter<>[]                       *)
wneuper@59265
   210
fun seek_oridts ctxt sel (d, ts) [] =
bonzai@41952
   211
    ("seek_oridts: input ('" ^
wneuper@59416
   212
        (Rule.term_to_string' ctxt (Model.comp_dts (d, ts))) ^ "') not found in oris (typed)",
bonzai@41952
   213
      (0, [], sel, d, ts),
bonzai@41952
   214
      [])
wneuper@59265
   215
  | seek_oridts ctxt sel (d, ts) ((id, vat, sel', d', ts') :: oris) =
wneuper@59265
   216
    if sel = sel' andalso d = d' andalso (inter op = ts ts') <> []
wneuper@59265
   217
    then ("", (id, vat, sel, d, inter op = ts ts'), ts')
wneuper@59265
   218
    else seek_oridts ctxt sel (d, ts) oris
neuper@37906
   219
wneuper@59265
   220
(* to an input (_,ts) find the according ori and insert the ts *)
wneuper@59265
   221
fun seek_orits ctxt _ ts [] = 
wneuper@59416
   222
    ("seek_orits: input (_, '" ^ strs2str (map (Rule.term_to_string' ctxt) ts) ^
wneuper@59316
   223
    "') not found in oris (typed)", Model.e_ori, [])
wneuper@59308
   224
  | seek_orits ctxt sel ts ((id, vat, sel', d, ts') :: oris) =
neuper@37934
   225
    if sel = sel' andalso (inter op = ts ts') <> [] 
wneuper@59265
   226
    then
wneuper@59265
   227
      if sel = sel' 
wneuper@59308
   228
      then ("", (id, vat, sel, d, inter op = ts ts'), ts')
wneuper@59416
   229
      else (((strs2str' o map (Rule.term_to_string' ctxt)) ts) ^ " not for " ^ sel, Model.e_ori, [])
wneuper@59265
   230
    else seek_orits ctxt sel ts oris
neuper@37906
   231
wneuper@59265
   232
(* find_first item with #1 equal to id *)
wneuper@59265
   233
fun seek_ppc _ [] = NONE
wneuper@59426
   234
  | seek_ppc id (p :: ppc) = if id = #1 (p: Model.itm) then SOME p else seek_ppc id ppc
neuper@37906
   235
wneuper@59308
   236
fun ppc2list {Given = gis, Where = whs, Find = fis, With = wis, Relate = res} =
wneuper@59265
   237
  gis @ whs @ fis @ wis @ res
neuper@37906
   238
neuper@37906
   239
(* get the number of variants in a problem in 'original',
neuper@37906
   240
   assumes equal descriptions in immediate sequence    *)
neuper@37906
   241
fun variants_in ts =
wneuper@59265
   242
  let
wneuper@59265
   243
    fun eq (x, y) = head_of x = head_of y
wneuper@59265
   244
    fun cnt _ [] _ n = ([n], [])
wneuper@59265
   245
      | cnt eq (x :: xs) y n = if eq (x, y) then cnt eq xs y (n + 1) else ([n], x :: xs)
wneuper@59265
   246
    fun coll _  xs [] = xs
wneuper@59265
   247
      | coll eq  xs (y :: ys) = 
wneuper@59265
   248
        let val (n, ys') = cnt eq (y :: ys) y 0
wneuper@59265
   249
        in if ys' = [] then xs @ n else coll eq  (xs @ n) ys' end
wneuper@59265
   250
    val vts = subtract op = [1] (distinct (coll eq [] ts))
wneuper@59265
   251
  in
wneuper@59265
   252
    case vts of 
wneuper@59265
   253
      [] => 1
wneuper@59265
   254
    | [n] => n
wneuper@59265
   255
    | _ => error "different variants in formalization"
wneuper@59265
   256
  end
neuper@37906
   257
wneuper@59265
   258
fun is_list_type (Type ("List.list", _)) = true
wneuper@59265
   259
  | is_list_type _ = false
wneuper@59316
   260
fun is_parsed (Model.Syn _) = false
wneuper@59265
   261
  | is_parsed _ = true
wneuper@59265
   262
fun parse_ok its = foldl and_ (true, map is_parsed its)
neuper@37906
   263
neuper@37906
   264
fun all_dsc_in itm_s =
neuper@37906
   265
  let    
wneuper@59316
   266
    fun d_in (Model.Cor ((d, _), _)) = [d]
wneuper@59316
   267
      | d_in (Model.Syn _) = []
wneuper@59316
   268
      | d_in (Model.Typ _) = []
wneuper@59316
   269
      | d_in (Model.Inc ((d,_),_)) = [d]
wneuper@59316
   270
      | d_in (Model.Sup (d,_)) = [d]
wneuper@59316
   271
      | d_in (Model.Mis (d,_)) = [d]
wneuper@59316
   272
      | d_in i = error ("all_dsc_in: uncovered case with " ^ Model.itm_2str i)
wneuper@59265
   273
  in (flat o (map d_in)) itm_s end; 
neuper@37906
   274
wneuper@59316
   275
fun is_error (Model.Cor _) = false
wneuper@59316
   276
  | is_error (Model.Sup _) = false
wneuper@59316
   277
  | is_error (Model.Inc _) = false
wneuper@59316
   278
  | is_error (Model.Mis _) = false
wneuper@59265
   279
  | is_error _ = true
neuper@37906
   280
wneuper@59265
   281
(* get the first term in ts from ori *)
wneuper@59308
   282
fun getr_ct thy (_, _, fd, d, ts) =
wneuper@59416
   283
  (fd, ((Rule.term_to_string''' thy) o Model.comp_dts) (d,[hd ts]))
neuper@37906
   284
neuper@38051
   285
(* get a term from ori, notyet input in itm.
neuper@38051
   286
   the term from ori is thrown back to a string in order to reuse
neuper@38051
   287
   machinery for immediate input by the user. *)
wneuper@59308
   288
fun geti_ct thy (_, _, _, d, ts) (_, _, _, fd, itm_) =
wneuper@59416
   289
  (fd, ((Rule.term_to_string''' thy) o Model.comp_dts) (d, subtract op = (Model.ts_in itm_) ts))
neuper@37906
   290
neuper@37906
   291
(* in FE dsc, not dat: this is in itms ...*)
wneuper@59316
   292
fun is_untouched (_, _, false, _, Model.Inc ((_, []), _)) = true
wneuper@59265
   293
  | is_untouched _ = false
neuper@37906
   294
neuper@37906
   295
(* select an item in oris, notyet input in itms 
wneuper@59316
   296
   (precondition: in itms are only Model.Cor, Model.Sup, Model.Inc) *)
wneuper@59235
   297
(*args of nxt_add
wneuper@59235
   298
  thy : for?
wneuper@59235
   299
  oris: from formalization 'type fmz', structured for efficient access 
wneuper@59235
   300
  pbt : the problem-pattern to be matched with oris in order to get itms
wneuper@59235
   301
  itms: already input items
wneuper@59235
   302
*)
wneuper@59308
   303
fun nxt_add thy [] pbt itms = (*root (only) ori...fmz=[]*)
wneuper@59265
   304
    let
wneuper@59316
   305
      fun test_d d (i, _, _, _, itm_) = (d = (Model.d_in itm_)) andalso i <> 0
wneuper@59265
   306
      fun is_elem itms (_, (d, _)) = 
wneuper@59265
   307
        case find_first (test_d d) itms of SOME _ => true | NONE => false
wneuper@59265
   308
    in
wneuper@59265
   309
      case filter_out (is_elem itms) pbt of
wneuper@59416
   310
        (f, (d, _)) :: _ => SOME (f, ((Rule.term_to_string''' thy) o Model.comp_dts) (d, []))
wneuper@59265
   311
      | _ => NONE
wneuper@59265
   312
    end
wneuper@59265
   313
  | nxt_add thy oris _ itms =
wneuper@59265
   314
    let
wneuper@59513
   315
      fun testr_vt v ori = member op= (#2 (ori : Model.ori)) v andalso (#3 ori) <> "#undef"
wneuper@59513
   316
      fun testi_vt v itm = member op= (#2 (itm : Model.itm)) v
wneuper@59513
   317
      fun test_id ids r = member op= ids (#1 (r : Model.ori))
wneuper@59426
   318
      fun test_subset itm (_, _, _, d, ts) = 
wneuper@59426
   319
        (Model.d_in (#5 (itm: Model.itm))) = d andalso subset op = (Model.ts_in (#5 itm), ts)
wneuper@59316
   320
      fun false_and_not_Sup (_, _, false, _, Model.Sup _) = false
wneuper@59265
   321
        | false_and_not_Sup (_, _, false, _, _) = true
wneuper@59265
   322
        | false_and_not_Sup _ = false
wneuper@59316
   323
      val v = if itms = [] then 1 else Model.max_vt itms
wneuper@59265
   324
      val vors = if v = 0 then oris else filter (testr_vt v) oris  (* oris..vat *)
wneuper@59265
   325
      val vits =
wneuper@59265
   326
        if v = 0
wneuper@59265
   327
        then itms                                 (* because of dsc without dat *)
wneuper@59265
   328
  	    else filter (testi_vt v) itms;                             (* itms..vat *)
wneuper@59265
   329
      val icl = filter false_and_not_Sup vits;                    (* incomplete *)
wneuper@59265
   330
    in
wneuper@59265
   331
      if icl = [] 
wneuper@59265
   332
      then case filter_out (test_id (map #1 vits)) vors of
wneuper@59265
   333
  	    [] => NONE
wneuper@59265
   334
  	  | miss => SOME (getr_ct thy (hd miss))
wneuper@59265
   335
      else
wneuper@59265
   336
        case find_first (test_subset (hd icl)) vors of
wneuper@59265
   337
          NONE => error "nxt_add: types or dsc DO NOT MATCH BETWEEN fmz --- pbt"
wneuper@59265
   338
        | SOME ori => SOME (geti_ct thy ori (hd icl))
wneuper@59265
   339
    end
neuper@37906
   340
wneuper@59571
   341
fun mk_delete thy "#Given" itm_ = Tactic.Del_Given (Specify.itm_out thy itm_)
wneuper@59571
   342
  | mk_delete thy "#Find" itm_ = Tactic.Del_Find (Specify.itm_out thy itm_)
wneuper@59571
   343
  | mk_delete thy "#Relate" itm_ = Tactic.Del_Relation (Specify.itm_out thy itm_)
wneuper@59265
   344
  | mk_delete _ str _ = error ("mk_delete: called with field \"" ^ str ^ "\"")
wneuper@59571
   345
fun mk_additem "#Given" ct = Tactic.Add_Given ct
wneuper@59571
   346
  | mk_additem "#Find" ct = Tactic.Add_Find ct    
wneuper@59571
   347
  | mk_additem "#Relate"ct = Tactic.Add_Relation ct
wneuper@59265
   348
  | mk_additem str _ = error ("mk_additem: called with field \"" ^ str ^ "\"")
neuper@37906
   349
neuper@38051
   350
(* determine the next step of specification;
neuper@38051
   351
   not done here: Refine_Tacitly (otherwise *** unknown method: (..., no_met))
neuper@38051
   352
   eg. in rootpbl 'no_met': 
neuper@37906
   353
args:
neuper@38051
   354
  preok          predicates are _all_ ok (and problem matches completely)
neuper@37906
   355
  oris           immediately from formalization 
neuper@37906
   356
  (dI',pI',mI')  specification coming from author/parent-problem
neuper@37906
   357
  (pbl,          item lists specified by user
neuper@37906
   358
   met)          -"-, tacitly completed by copy_probl
neuper@37906
   359
  (dI,pI,mI)     specification explicitly done by the user
neuper@37906
   360
  (pbt, mpc)     problem type, guard of method
neuper@38051
   361
*)
wneuper@59308
   362
fun nxt_spec Pbl preok oris (dI', pI', mI') (pbl, met) (pbt, mpc) (dI, pI, mI) = 
wneuper@59571
   363
    (if dI' = Rule.e_domID andalso dI = Rule.e_domID then (Pbl, Tactic.Specify_Theory dI')
wneuper@59571
   364
     else if pI' = Celem.e_pblID andalso pI = Celem.e_pblID then (Pbl, Tactic.Specify_Problem pI')
wneuper@59265
   365
     else
wneuper@59308
   366
       case find_first (is_error o #5) pbl of
wneuper@59265
   367
	       SOME (_, _, _, fd, itm_) =>
wneuper@59416
   368
	         (Pbl, mk_delete (Celem.assoc_thy (if dI = Rule.e_domID then dI' else dI)) fd itm_)
wneuper@59265
   369
	     | NONE => 
wneuper@59416
   370
	       (case nxt_add (Celem.assoc_thy (if dI = Rule.e_domID then dI' else dI)) oris pbt pbl of
walther@59762
   371
	          SOME (fd, ct') => (Pbl, mk_additem fd ct')
wneuper@59265
   372
	        | NONE => (*pbl-items complete*)
wneuper@59571
   373
	          if not preok then (Pbl, Tactic.Refine_Problem pI')
wneuper@59571
   374
	          else if dI = Rule.e_domID then (Pbl, Tactic.Specify_Theory dI')
wneuper@59571
   375
		        else if pI = Celem.e_pblID then (Pbl, Tactic.Specify_Problem pI')
wneuper@59571
   376
		        else if mI = Celem.e_metID then (Pbl, Tactic.Specify_Method mI')
wneuper@59265
   377
		        else
wneuper@59265
   378
			        case find_first (is_error o #5) met of
wneuper@59405
   379
			          SOME (_, _, _, fd, itm_) => (Met, mk_delete (Celem.assoc_thy dI) fd itm_)
wneuper@59265
   380
			        | NONE => 
wneuper@59405
   381
			          (case nxt_add (Celem.assoc_thy dI) oris mpc met of
wneuper@59265
   382
				          SOME (fd, ct') => (Met, mk_additem fd ct') (*30.8.01: pre?!?*)
wneuper@59571
   383
				        | NONE => (Met, Tactic.Apply_Method mI))))
wneuper@59265
   384
  | nxt_spec Met preok oris (dI', pI', _) (_, met) (_ ,mpc) (dI, pI, mI) = 
wneuper@59265
   385
    (case find_first (is_error o #5) met of
wneuper@59416
   386
      SOME (_,_,_,fd,itm_) => (Met, mk_delete (Celem.assoc_thy (if dI = Rule.e_domID then dI' else dI)) fd itm_)
wneuper@59265
   387
    | NONE => 
wneuper@59416
   388
      case nxt_add (Celem.assoc_thy (if dI = Rule.e_domID then dI' else dI)) oris mpc met of
wneuper@59265
   389
	      SOME (fd,ct') => (Met, mk_additem fd ct')
wneuper@59265
   390
      | NONE => 
wneuper@59571
   391
	      (if dI = Rule.e_domID then (Met, Tactic.Specify_Theory dI')
wneuper@59571
   392
	       else if pI = Celem.e_pblID then (Met, Tactic.Specify_Problem pI')
wneuper@59571
   393
		     else if not preok then (Met, Tactic.Specify_Method mI)
wneuper@59571
   394
		     else (Met, Tactic.Apply_Method mI)))
wneuper@59265
   395
  | nxt_spec p _ _ _ _ _ _ = error ("nxt_spec: uncovered case with " ^ pos_2str p)
neuper@37906
   396
wneuper@59265
   397
(* update the itm_ already input, all..from ori *)
wneuper@59308
   398
fun ori_2itm itm_ pid all (id, vt, fd, d, ts) = 
neuper@37906
   399
  let 
wneuper@59316
   400
    val ts' = union op = (Model.ts_in itm_) ts;
wneuper@59316
   401
    val pval = Model.pbl_ids' d ts'
wneuper@59265
   402
	  (* WN.9.5.03: FIXXXME [#0, epsilon] here would upd_penv be called for [#0, epsilon] etc *)
wneuper@59265
   403
    val complete = if eq_set op = (ts', all) then true else false
wneuper@59265
   404
  in
wneuper@59265
   405
    case itm_ of
wneuper@59316
   406
      (Model.Cor _) => 
wneuper@59316
   407
        (if fd = "#undef" then (id, vt, complete, fd, Model.Sup (d, ts')) 
wneuper@59316
   408
	       else (id, vt, complete, fd, Model.Cor ((d, ts'), (pid, pval))))
wneuper@59316
   409
    | (Model.Syn c) => error ("ori_2itm wants to overwrite " ^ c)
wneuper@59316
   410
    | (Model.Typ c) => error ("ori_2itm wants to overwrite " ^ c)
wneuper@59316
   411
    | (Model.Inc _) =>
wneuper@59265
   412
      if complete
wneuper@59316
   413
  	  then (id, vt, true, fd, Model.Cor ((d, ts'), (pid, pval)))
wneuper@59316
   414
  	  else (id, vt, false, fd, Model.Inc ((d, ts'), (pid, pval)))
wneuper@59316
   415
    | (Model.Sup (d,ts')) => (*4.9.01 lost env*)
wneuper@59316
   416
  	  (*if fd = "#undef" then*) (id,vt,complete,fd,Model.Sup(d,ts'))
wneuper@59316
   417
  	  (*else (id,vt,complete,fd,Model.Cor((d,ts'),e))*)
wneuper@59265
   418
      (* 28.1.00: not completely clear ---^^^ etc.*)
wneuper@59316
   419
    | (Model.Mis _) => (* 4.9.01: Model.Mis just copied *)
wneuper@59265
   420
       if complete
wneuper@59316
   421
  		 then (id, vt, true, fd, Model.Cor ((d,ts'), (pid, pval)))
wneuper@59316
   422
  		 else (id, vt, false, fd, Model.Inc ((d,ts'), (pid, pval)))
wneuper@59316
   423
    | i => error ("ori_2itm: uncovered case of "^ Model.itm_2str i)
wneuper@59265
   424
  end
neuper@37906
   425
wneuper@59265
   426
fun eq1 d (_, (d', _)) = (d = d')
wneuper@59316
   427
fun eq3 f d (_, _, _, f', itm_) = f = f' andalso d = (Model.d_in itm_) 
neuper@37906
   428
neuper@37906
   429
(* 'all' ts from ori; ts is the input; (ori carries rest of info)
neuper@37906
   430
   9.01: this + ori_2itm is _VERY UNCLEAR_ ? overhead ?
neuper@37906
   431
   pval: value for problem-environment _NOT_ checked for 'inter' --
neuper@37906
   432
   -- FIXXME.WN.11.03 the generation of penv has to go to insert_ppc
neuper@37906
   433
  (as it has been done for input_icalhd+insert_ppc' in 11.03)*)
neuper@37906
   434
(*. is_input ori itms <=> 
neuper@37906
   435
    EX itm. (1) ori(field,dsc) = itm(field,dsc) & (2..4)
neuper@37906
   436
            (2) ori(ts) subset itm(ts)        --- Err "already input"       
neuper@37906
   437
	    (3) ori(ts) inter itm(ts) = empty --- new: ori(ts)
neuper@37906
   438
	    (4) -"- <> empty                  --- new: ori(ts) \\ inter .*)
wneuper@59308
   439
fun is_notyet_input ctxt itms all (i, v, f, d, ts) pbt =
neuper@37906
   440
  case find_first (eq1 d) pbt of
wneuper@59265
   441
    SOME (_, (_, pid)) =>
neuper@37906
   442
      (case find_first (eq3 f d) itms of
neuper@52070
   443
        SOME (_,_,_,_,itm_) =>
wneuper@59316
   444
          let val ts' = inter op = (Model.ts_in itm_) ts
wneuper@59265
   445
          in 
wneuper@59265
   446
            if subset op = (ts, ts') 
wneuper@59416
   447
            then (((strs2str' o map (Rule.term_to_string' ctxt)) ts') ^ " already input", Model.e_itm) (*2*)
wneuper@59265
   448
	          else ("", ori_2itm itm_ pid all (i,v,f,d, subtract op = ts' ts))              (*3,4*)
neuper@52070
   449
	          end
wneuper@59416
   450
	    | NONE => ("", ori_2itm (Model.Inc ((Rule.e_term, []), (pid, []))) pid all (i, v, f, d, ts)))    (*1*)
wneuper@59416
   451
  | NONE => ("", ori_2itm (Model.Sup (d, ts)) Rule.e_term all (i, v, f, d, ts))
neuper@37906
   452
bonzai@41949
   453
fun test_types ctxt (d,ts) =
neuper@37906
   454
  let 
wneuper@59316
   455
    val opt = (try Model.comp_dts) (d, ts)
neuper@37906
   456
    val msg = case opt of 
neuper@37926
   457
      SOME _ => "" 
wneuper@59416
   458
    | NONE => (Rule.term_to_string' ctxt d ^ " " ^
wneuper@59416
   459
	    (strs2str' o map (Rule.term_to_string' ctxt)) ts ^ " is illtyped")
wneuper@59265
   460
  in msg end
neuper@37906
   461
wneuper@59533
   462
(* is the term t input (or taken from fmz) known in oris ?
wneuper@59265
   463
   give feedback on all(?) strange input;
wneuper@59265
   464
   return _all_ terms already input to this item (e.g. valuesFor a,b) *)
bonzai@41949
   465
fun is_known ctxt sel ori t =
neuper@37906
   466
  let
wneuper@59308
   467
    val ots = (distinct o flat o (map #5)) ori
wneuper@59389
   468
    val oids = ((map (fst o dest_Free)) o distinct o flat o (map TermC.vars)) ots
wneuper@59316
   469
    val (d, ts) = Model.split_dts t
wneuper@59389
   470
    val ids = map (fst o dest_Free) ((distinct o (flat o (map TermC.vars))) ts)
wneuper@59265
   471
  in
wneuper@59265
   472
    if (subtract op = oids ids) <> []
wneuper@59533
   473
    then ("identifiers " ^ strs2str' (subtract op = oids ids) ^ " not in example", Model.e_ori, [])
wneuper@59265
   474
    else 
wneuper@59416
   475
	    if d = Rule.e_term 
wneuper@59265
   476
	    then 
wneuper@59265
   477
	      if not (subset op = (map typeless ts, map typeless ots))
wneuper@59416
   478
	      then ("terms '" ^ (strs2str' o (map (Rule.term_to_string' ctxt))) ts ^
wneuper@59316
   479
		      "' not in example (typeless)", Model.e_ori, [])
wneuper@59265
   480
	      else 
wneuper@59265
   481
          (case seek_orits ctxt sel ts ori of
wneuper@59265
   482
		         ("", ori_ as (_,_,_,d,ts), all) =>
wneuper@59265
   483
		            (case test_types ctxt (d,ts) of
wneuper@59265
   484
		              "" => ("", ori_, all)
wneuper@59316
   485
		            | msg => (msg, Model.e_ori, []))
wneuper@59533
   486
		       | (msg, _, _) => (msg, Model.e_ori, []))
wneuper@59265
   487
	    else 
wneuper@59265
   488
	      if member op = (map #4 ori) d
wneuper@59265
   489
	      then seek_oridts ctxt sel (d, ts) ori
wneuper@59416
   490
	      else (Rule.term_to_string' ctxt d ^ " not in example", (0, [], sel, d, ts), [])
wneuper@59265
   491
  end
neuper@37906
   492
wneuper@59265
   493
neuper@37906
   494
datatype additm =
wneuper@59316
   495
	Add of Model.itm   (* return-value of appl_add *)
wneuper@59308
   496
| Err of string       (* error-message            *)
neuper@37906
   497
wneuper@59265
   498
(* add an item to the model; check wrt. oris and pbt.
wneuper@59265
   499
   in contrary to oris<>[] below, this part handles user-input
wneuper@59265
   500
   extremely acceptive, i.e. accept input instead error-msg  *)
wneuper@59265
   501
fun appl_add ctxt sel [] ppc pbt ct =
wneuper@59265
   502
    let
wneuper@59265
   503
      val i = 1 + (if ppc = [] then 0 else map #1 ppc |> maxl)
wneuper@59265
   504
      in 
wneuper@59389
   505
        case TermC.parseNEW ctxt ct of
wneuper@59316
   506
          NONE => Add (i, [], false, sel, Model.Syn ct)
wneuper@59265
   507
        | SOME t =>
wneuper@59316
   508
            let val (d, ts) = Model.split_dts t
wneuper@59265
   509
            in 
wneuper@59416
   510
              if d = Rule.e_term 
wneuper@59316
   511
              then Add (i, [], false, sel, Model.Mis (Specify.dsc_unknown, hd ts)) 
wneuper@59265
   512
              else
wneuper@59265
   513
                (case find_first (eq1 d) pbt of
wneuper@59316
   514
                   NONE => Add (i, [], true, sel, Model.Sup (d,ts))
wneuper@59265
   515
                 | SOME (f, (_, id)) =>
wneuper@59316
   516
                     let fun eq2 d (i, _, _, _, itm_) = d = (Model.d_in itm_) andalso i <> 0
wneuper@59265
   517
                     in case find_first (eq2 d) ppc of
wneuper@59316
   518
                       NONE => Add (i, [], true, f,Model.Cor ((d, ts), (id, Model.pbl_ids' d ts)))
wneuper@59265
   519
                     | SOME (i', _, _, _, itm_) => 
wneuper@59595
   520
                         if Input_Descript.is_list_dsc d 
wneuper@59265
   521
                         then 
wneuper@59265
   522
                           let
wneuper@59316
   523
                             val in_itm = Model.ts_in itm_
wneuper@59265
   524
                             val ts' = union op = ts in_itm
wneuper@59265
   525
                             val i'' = if in_itm = [] then i else i'
wneuper@59316
   526
                           in Add (i'', [], true, f, Model.Cor ((d, ts'), (id, Model.pbl_ids' d ts')))end
wneuper@59316
   527
                         else Add (i', [], true, f, Model.Cor ((d, ts), (id, Model.pbl_ids' d ts)))
wneuper@59265
   528
                     end)
wneuper@59265
   529
            end
wneuper@59265
   530
    end
wneuper@59265
   531
  | appl_add ctxt sel oris ppc pbt str =
wneuper@59389
   532
    case TermC.parseNEW ctxt str of
wneuper@59265
   533
      NONE => Err ("appl_add: syntax error in '" ^ str ^ "'")
wneuper@59265
   534
    | SOME t => 
wneuper@59265
   535
        case is_known ctxt sel oris t of
wneuper@59265
   536
          ("", ori', all) => 
wneuper@59265
   537
            (case is_notyet_input ctxt ppc all ori' pbt of
wneuper@59265
   538
               ("", itm) => Add itm
wneuper@59265
   539
             | (msg, _) => Err ("[error] appl_add: is_notyet_input: " ^ msg))
wneuper@59265
   540
        | (msg, _, _) => Err ("[error] appl_add: is_known: " ^ msg);
neuper@37906
   541
wneuper@59265
   542
(* make oris from args of the stac SubProblem and from pbt.
wneuper@59265
   543
   can this formal argument (of a model-pattern) be omitted in the arg-list
wneuper@59265
   544
   of a SubProblem ? see calcelems.sml 'type met '                        *)
wneuper@59265
   545
fun is_copy_named_idstr str =
wneuper@59265
   546
  case (rev o Symbol.explode) str of
wneuper@59540
   547
	  "'" :: _ :: "'" :: _ => true
wneuper@59540
   548
  | _ => false
wneuper@59389
   549
fun is_copy_named (_, (_, t)) = (is_copy_named_idstr o TermC.free2str) t
neuper@41973
   550
wneuper@59265
   551
(* should this formal argument (of a model-pattern) create a new identifier? *)
wneuper@59265
   552
fun is_copy_named_generating_idstr str =
wneuper@59265
   553
  if is_copy_named_idstr str
wneuper@59265
   554
  then
wneuper@59265
   555
    case (rev o Symbol.explode) str of
wneuper@59265
   556
	    "'" :: "'" :: "'" :: _ => false
wneuper@59265
   557
    | _ => true
wneuper@59265
   558
  else false
wneuper@59389
   559
fun is_copy_named_generating (_, (_, t)) = (is_copy_named_generating_idstr o TermC.free2str) t
neuper@37906
   560
wneuper@59265
   561
(* split type-wrapper from scr-arg and build part of an ori;
wneuper@59265
   562
   an type-error is reported immediately, raises an exn, 
wneuper@59265
   563
   subsequent handling of exn provides 2nd part of error message *)
wneuper@59405
   564
fun mtc thy (str, (dsc, _)) (ty $ var) =
wneuper@59265
   565
    ((Thm.global_cterm_of thy (dsc $ var);(*type check*)
wneuper@59308
   566
      SOME (([1], str, dsc, (*[var]*)
wneuper@59316
   567
	    Model.split_dts' (dsc, var))) (*:ori without leading #*))
wneuper@59265
   568
      handle e as TYPE _ => 
wneuper@59265
   569
	      (tracing (dashs 70 ^ "\n"
wneuper@59265
   570
	        ^ "*** ERROR while creating the items for the model of the ->problem\n"
wneuper@59265
   571
	        ^ "*** from the ->stac with ->typeconstructor in arglist:\n"
wneuper@59416
   572
	        ^ "*** item (->description ->value): " ^ Rule.term2str dsc ^ " " ^ Rule.term2str var ^ "\n"
wneuper@59389
   573
	        ^ "*** description: " ^ TermC.term_detail2str dsc
wneuper@59389
   574
	        ^ "*** value: " ^ TermC.term_detail2str var
wneuper@59389
   575
	        ^ "*** typeconstructor in script: " ^ TermC.term_detail2str ty
wneuper@59416
   576
	        ^ "*** checked by theory: " ^ Rule.theory2str thy ^ "\n"
wneuper@59265
   577
	        ^ "*** " ^ dots 66);
wneuper@59337
   578
          writeln (@{make_string} e);
wneuper@59338
   579
          Exn.reraise e; (*raise ERROR "actual args do not match formal args";FIXXXME.WN100916*)
wneuper@59265
   580
      NONE))
wneuper@59416
   581
  | mtc _ _ t = error ("mtc: uncovered case with" ^ Rule.term2str t)
neuper@38010
   582
wneuper@59265
   583
(* match each pat of the model-pattern with an actual argument;
wneuper@59265
   584
   precondition: copy-named vars are filtered out            *)
wneuper@59405
   585
fun matc _ [] _ oris = oris
wneuper@59265
   586
  | matc _ pbt [] _ =
neuper@38015
   587
    (tracing (dashs 70);
wneuper@59405
   588
     error ("actual arg(s) missing for '" ^ Celem.pats2str pbt ^ "' i.e. should be 'copy-named' by '*_._'"))
wneuper@59265
   589
  | matc thy ((p as (_, (_, t))) :: pbt) (a :: ags) oris =
wneuper@59389
   590
    (*del?..*)if (is_copy_named_idstr o TermC.free2str) t then oris
wneuper@59265
   591
    else(*..del?*)
wneuper@59265
   592
      let val opt = mtc thy p a
wneuper@59265
   593
      in
wneuper@59265
   594
        case opt of
wneuper@59265
   595
          SOME ori => matc thy pbt ags (oris @ [ori])
neuper@37926
   596
	      | NONE => [](*WN050903 skipped by exn handled in match_ags*)
wneuper@59265
   597
	 end
neuper@38011
   598
neuper@38011
   599
(* generate a new variable "x_i" name from a related given one "x"
neuper@38011
   600
   by use of oris relating "v_v'i'" (is_copy_named!) to "v_v"
neuper@38012
   601
   e.g. (v_v, x) & (v_v'i', ?) --> (v_v'i', x_i),
neuper@38012
   602
   but leave is_copy_named_generating as is, e.t. ss''' *)
wneuper@59405
   603
fun cpy_nam pbt oris (p as (field, (dsc, t))) =
neuper@37906
   604
  (if is_copy_named_generating p
neuper@37906
   605
   then (*WN051014 kept strange old code ...*)
wneuper@59316
   606
     let fun sel (_,_,d,ts) = Model.comp_ts (d, ts) 
wneuper@59389
   607
       val cy' = (implode o (drop_last_n 3) o Symbol.explode o TermC.free2str) t
wneuper@59389
   608
       val ext = (last_elem o drop_last o Symbol.explode o TermC.free2str) t
wneuper@59513
   609
       val vars' = map (Term.term_name o snd o snd) pbt (*cpy-nam filtered_out*)
wneuper@59265
   610
       val vals = map sel oris
wneuper@59513
   611
       val cy_ext = (Term.term_name o the) (assoc (vars' ~~ vals, cy')) ^ "_" ^ ext
wneuper@59389
   612
     in ([1], field, dsc, [TermC.mk_free (type_of t) cy_ext]) end
neuper@37906
   613
   else ([1], field, dsc, [t])
wneuper@59416
   614
	) handle _ => error ("cpy_nam: for "^ Rule.term2str t)
neuper@37906
   615
wneuper@59265
   616
(* match the actual arguments of a SubProblem with a model-pattern
neuper@37906
   617
   and create an ori list (in root-pbl created from formalization).
neuper@37906
   618
   expects ags:pats = 1:1, while copy-named are filtered out of pats;
wneuper@59540
   619
   if no 1:1 then exn raised by matc/mtc and handled at call.
wneuper@59265
   620
   copy-named pats are appended in order to get them into the model-items *)
wneuper@59405
   621
fun match_ags thy pbt ags =
wneuper@59540
   622
  let
wneuper@59540
   623
    fun flattup (i, (var, bool, str, itm_)) = (i, var, bool, str, itm_)
wneuper@59265
   624
    val pbt' = filter_out is_copy_named pbt
wneuper@59540
   625
    val cy = filter is_copy_named pbt  (* cy is NOT a (formal) argument, but the fun's result *)
wneuper@59265
   626
    val oris' = matc thy pbt' ags []
wneuper@59265
   627
    val cy' = map (cpy_nam pbt' oris') cy
wneuper@59269
   628
    val ors = Specify.add_id (oris' @ cy') (*...appended in order to get into the model-items *)
wneuper@59308
   629
  in (map flattup ors) end
neuper@37906
   630
wneuper@59265
   631
(* report part of the error-msg which is not available in match_args *)
neuper@37906
   632
fun match_ags_msg pI stac ags =
wneuper@59265
   633
  let
wneuper@59269
   634
    val pats = (#ppc o Specify.get_pbt) pI
wneuper@59405
   635
    val msg = (dots 70 ^ "\n"
wneuper@59405
   636
       ^ "*** problem " ^ strs2str pI ^ " has the ...\n"
wneuper@59405
   637
       ^ "*** model-pattern " ^ Celem.pats2str pats ^ "\n"
wneuper@59416
   638
       ^ "*** stac   '" ^ Rule.term2str stac ^ "' has the ...\n"
wneuper@59416
   639
       ^ "*** arg-list " ^ Rule.terms2str ags ^ "\n"
wneuper@59265
   640
       ^ dashs 70)
wneuper@59265
   641
	  (*WN100921 ^^^^ expect TYPE errormsg below; lost with Isa09*)
wneuper@59265
   642
  in tracing msg end
neuper@37906
   643
wneuper@59265
   644
(* get the variables out of a pbl_; FIXME.WN.0311: is_copy_named ...obscure!!! *)
neuper@37906
   645
fun vars_of_pbl_' pbl_ = 
wneuper@59265
   646
  let
wneuper@59265
   647
    fun var_of_pbl_ (_, (_, t)) = t: term
wneuper@59265
   648
  in ((map var_of_pbl_)(* o (filter_out is_copy_named)*)) pbl_ end
neuper@37906
   649
neuper@37906
   650
fun overwrite_ppc thy itm ppc =
neuper@37906
   651
  let 
wneuper@59265
   652
    fun repl _ (_, _, _, _, itm_) [] =
wneuper@59416
   653
        error ("overwrite_ppc: " ^ (Model.itm_2str_ (Rule.thy2ctxt thy) itm_) ^ " not found")
wneuper@59265
   654
      | repl ppc' itm (p :: ppc) =
wneuper@59308
   655
	      if (#1 itm) = (#1 p)
wneuper@59265
   656
	      then ppc' @ [itm] @ ppc
wneuper@59265
   657
	      else repl (ppc' @ [p]) itm ppc
wneuper@59265
   658
  in repl [] itm ppc end
neuper@37906
   659
wneuper@59265
   660
(* 10.3.00: insert the already compiled itm into model;
neuper@37906
   661
   ev. filter_out  untouched (in FE: (0,...)) item related to insert-item *)
neuper@37906
   662
fun insert_ppc thy itm ppc =
wneuper@59265
   663
  let 
wneuper@59316
   664
    fun eq_untouched d (0, _, _, _, itm_) = (d = Model.d_in itm_)
wneuper@59265
   665
      | eq_untouched _ _ = false
wneuper@59265
   666
    val ppc' = case seek_ppc (#1 itm) ppc of
wneuper@59265
   667
      SOME _ => overwrite_ppc thy itm ppc (*itm updated in is_notyet_input WN.11.03*)
wneuper@59265
   668
    | NONE => (ppc @ [itm])
wneuper@59316
   669
  in filter_out (eq_untouched ((Model.d_in o #5) itm)) ppc' end
neuper@37906
   670
wneuper@59316
   671
fun eq_dsc ((_, _, _, _, itm_), (_, _, _, _, iitm_)) = (Model.d_in itm_ = Model.d_in iitm_)
neuper@37906
   672
wneuper@59265
   673
(* insert_ppc = insert_ppc' for appl_add', input_icalhd 11.03,
wneuper@59265
   674
   handles superfluous items carelessly                       *)
wneuper@59265
   675
fun insert_ppc' itm itms = if member eq_dsc itms itm then itms else itms @ [itm] (* @ new itm *)
neuper@37906
   676
wneuper@59265
   677
(* output the headline to a ppc *)
wneuper@59265
   678
fun header p_ pI mI =
wneuper@59405
   679
  case p_ of Pbl => Generate.Problem (if pI = Celem.e_pblID then [] else pI) 
wneuper@59271
   680
	   | Met => Generate.Method mI
wneuper@59265
   681
	   | pos => error ("header called with "^ pos_2str pos)
neuper@37906
   682
wneuper@59265
   683
fun specify_additem sel (ct, _) (p, Met) _ pt = 
wneuper@59265
   684
    let
wneuper@59265
   685
      val (met, oris, dI', pI', mI', pbl, dI ,pI, mI, ctxt) = case get_obj I pt p of
wneuper@59265
   686
        (PblObj {meth = met, origin = (oris, (dI', pI', mI'),_), probl = pbl, spec = (dI, pI, mI), ctxt, ...})
wneuper@59265
   687
          => (met, oris, dI', pI', mI', pbl, dI ,pI, mI, ctxt)
wneuper@59265
   688
  	  | _ => error "specify_additem: uncovered case of get_obj I pt p"
wneuper@59416
   689
      val thy = if dI = Rule.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI
wneuper@59405
   690
      val cpI = if pI = Celem.e_pblID then pI' else pI
wneuper@59405
   691
      val cmI = if mI = Celem.e_metID then mI' else mI
wneuper@59269
   692
      val {ppc, pre, prls, ...} = Specify.get_met cmI
wneuper@59265
   693
    in 
wneuper@59265
   694
      case appl_add ctxt sel oris met ppc ct of
wneuper@59265
   695
        Add itm =>  (*..union old input *)
wneuper@59265
   696
  	      let
wneuper@59265
   697
            val met' = insert_ppc thy itm met
wneuper@59265
   698
            val arg = case sel of
wneuper@59571
   699
  			      "#Given" => Tactic.Add_Given'   (ct, met')
wneuper@59571
   700
  		      | "#Find"  => Tactic.Add_Find'    (ct, met')
wneuper@59571
   701
  		      | "#Relate"=> Tactic.Add_Relation'(ct, met')
wneuper@59265
   702
  		      | str => error ("specify_additem: uncovered case with " ^ str)
walther@59737
   703
  	        val (p, pt') = case Generate.generate1 thy arg (Istate_Def.Uistate, ctxt) (p, Met) pt of
wneuper@59306
   704
  	          ((p, Met), _, _, pt') => (p, pt')
wneuper@59306
   705
  	        | _ => error "specify_additem: uncovered case of generate1"
wneuper@59308
   706
  	        val pre' = Stool.check_preconds thy prls pre met'
wneuper@59265
   707
  	        val pb = foldl and_ (true, map fst pre')
wneuper@59265
   708
  	        val (p_, nxt) =
wneuper@59265
   709
  	          nxt_spec Met pb oris (dI',pI',mI') (pbl,met') 
wneuper@59269
   710
  	            ((#ppc o Specify.get_pbt) cpI,ppc) (dI,pI,mI);
walther@59737
   711
  	      in ((p, p_), ((p, p_), Istate_Def.Uistate),
walther@59675
   712
  	        Generate.PpcKF (Generate.Method cmI, Specify.itms2itemppc thy met' pre'), nxt, Telem.Safe, pt')
wneuper@59265
   713
          end
wneuper@59265
   714
      | Err msg =>
wneuper@59265
   715
  	      let
wneuper@59308
   716
            val pre' = Stool.check_preconds thy prls pre met
wneuper@59265
   717
  	        val pb = foldl and_ (true, map fst pre')
wneuper@59265
   718
  	        val (p_, nxt) =
wneuper@59265
   719
  	          nxt_spec Met pb oris (dI',pI',mI') (pbl,met) 
wneuper@59269
   720
  	            ((#ppc o Specify.get_pbt) cpI,(#ppc o Specify.get_met) cmI) (dI,pI,mI);
walther@59737
   721
  	      in ((p,p_), ((p,p_),Istate_Def.Uistate), Generate.Error' msg, nxt, Telem.Safe, pt) end
wneuper@59265
   722
    end
wneuper@59265
   723
  | specify_additem sel (ct, _) (p,_(*Frm, Pbl*)) _ pt = 
neuper@41993
   724
      let
wneuper@59265
   725
        val (met, oris, dI', pI', mI', pbl, dI ,pI, mI, ctxt) = case get_obj I pt p of
wneuper@59265
   726
          (PblObj {meth = met, origin = (oris, (dI', pI', mI'),_), probl = pbl, spec = (dI, pI, mI), ctxt, ...})
wneuper@59265
   727
            => (met, oris, dI', pI', mI', pbl, dI ,pI, mI, ctxt)
wneuper@59265
   728
  	    | _ => error "specify_additem Frm, Pbl: uncovered case of get_obj I pt p"
wneuper@59416
   729
        val thy = if dI = Rule.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI
wneuper@59405
   730
        val cpI = if pI = Celem.e_pblID then pI' else pI
wneuper@59405
   731
        val cmI = if mI = Celem.e_metID then mI' else mI
wneuper@59269
   732
        val {ppc, where_, prls, ...} = Specify.get_pbt cpI
neuper@41993
   733
      in
neuper@41993
   734
        case appl_add ctxt sel oris pbl ppc ct of
wneuper@59265
   735
          Add itm => (*..union old input *)
neuper@41993
   736
	          let
neuper@41993
   737
	            val pbl' = insert_ppc thy itm pbl
wneuper@59265
   738
              val arg = case sel of
wneuper@59571
   739
  			        "#Given" => Tactic.Add_Given'   (ct, pbl')
wneuper@59571
   740
  		        | "#Find"  => Tactic.Add_Find'    (ct, pbl')
wneuper@59571
   741
  		        | "#Relate"=> Tactic.Add_Relation'(ct, pbl')
wneuper@59265
   742
  		        | str => error ("specify_additem Frm, Pbl: uncovered case with " ^ str)
walther@59737
   743
	            val (p, pt') = case Generate.generate1 thy arg (Istate_Def.Uistate, ctxt) (p,Pbl) pt of
wneuper@59306
   744
	              ((p, Pbl), _, _, pt') => (p, pt')
wneuper@59306
   745
	            | _ => error "specify_additem: uncovered case of Generate.generate1"
wneuper@59308
   746
	            val pre = Stool.check_preconds thy prls where_ pbl'
neuper@41993
   747
	            val pb = foldl and_ (true, map fst pre)
neuper@41993
   748
	            val (p_, nxt) =
wneuper@59269
   749
	              nxt_spec Pbl pb oris (dI',pI',mI') (pbl',met) (ppc, (#ppc o Specify.get_met) cmI) (dI, pI, mI)
wneuper@59265
   750
	            val ppc = if p_= Pbl then pbl' else met
wneuper@59265
   751
	          in
walther@59737
   752
	            ((p, p_), ((p, p_), Istate_Def.Uistate),
walther@59675
   753
	              Generate.PpcKF (header p_ pI cmI, Specify.itms2itemppc thy ppc pre), nxt, Telem.Safe, pt')
neuper@41993
   754
            end
neuper@41993
   755
        | Err msg =>
neuper@41993
   756
	          let
wneuper@59308
   757
              val pre = Stool.check_preconds thy prls where_ pbl
neuper@41993
   758
	            val pb = foldl and_ (true, map fst pre)
neuper@41993
   759
	            val (p_, nxt) =
wneuper@59265
   760
	              nxt_spec Pbl pb oris (dI', pI', mI') (pbl, met) 
wneuper@59269
   761
	                (ppc, (#ppc o Specify.get_met) cmI) (dI, pI, mI)
walther@59737
   762
	          in ((p, p_), ((p, p_), Istate_Def.Uistate), Generate.Error' msg, nxt, Telem.Safe,pt) end
wneuper@59265
   763
      end
neuper@37906
   764
wneuper@59571
   765
fun specify (Tactic.Init_Proof' (fmz, spec' as (dI', pI', mI'))) _ _ _ = 
neuper@41994
   766
    let          (* either """"""""""""""" all empty or complete *)
wneuper@59405
   767
      val thy = Celem.assoc_thy dI'
neuper@41994
   768
      val (oris, ctxt) = 
wneuper@59416
   769
        if dI' = Rule.e_domID orelse pI' = Celem.e_pblID  (*andalso? WN110511*)
wneuper@59581
   770
        then ([], ContextC.e_ctxt)
wneuper@59269
   771
  	    else pI' |> #ppc o Specify.get_pbt |> Specify.prep_ori fmz thy
walther@59737
   772
      val (pt, _) = cappend_problem e_ctree [] (Istate_Def.e_istate, ctxt) (fmz, spec')
wneuper@59416
   773
  			(oris, (dI',pI',mI'), Rule.e_term)
neuper@41994
   774
      val pt = update_ctxt pt [] ctxt
wneuper@59265
   775
      val (pbl, pre) = ([], [])
neuper@41994
   776
    in 
neuper@41994
   777
      case mI' of
neuper@41994
   778
  	    ["no_met"] => 
walther@59737
   779
  	      (([], Pbl), (([], Pbl), Istate_Def.Uistate),
wneuper@59405
   780
  	        Generate.PpcKF (Generate.Problem [], Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
walther@59675
   781
  	        Tactic.Refine_Tacitly pI', Telem.Safe, pt)
neuper@41994
   782
       | _ => 
walther@59737
   783
  	      (([], Pbl), (([], Pbl), Istate_Def.Uistate),
wneuper@59405
   784
  	        Generate.PpcKF (Generate.Problem [], Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
walther@59675
   785
  	        Tactic.Model_Problem, Telem.Safe, pt)
wneuper@59265
   786
    end
wneuper@59265
   787
    (* ONLY for STARTING modeling phase *)
wneuper@59571
   788
  | specify (Tactic.Model_Problem' (_, pbl, met)) (pos as (p, p_)) _ pt =
wneuper@59265
   789
    let 
wneuper@59265
   790
      val (oris, dI',pI',mI', dI, ctxt) = case get_obj I pt p of
wneuper@59265
   791
        PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, _, _), ctxt, ...} =>
wneuper@59265
   792
          (oris, dI',pI',mI', dI, ctxt)
wneuper@59265
   793
      | _ => error "specify (Model_Problem': uncovered case get_obj"
wneuper@59416
   794
      val thy' = if dI = Rule.e_domID then dI' else dI
wneuper@59405
   795
      val thy = Celem.assoc_thy thy'
wneuper@59269
   796
      val {ppc, prls, where_, ...} = Specify.get_pbt pI'
wneuper@59308
   797
      val pre = Stool.check_preconds thy prls where_ pbl
wneuper@59265
   798
      val pb = foldl and_ (true, map fst pre)
wneuper@59265
   799
      val ((p, _), _, _, pt) =
walther@59737
   800
        Generate.generate1 thy (Tactic.Model_Problem'([],pbl,met)) (Istate_Def.Uistate, ctxt) pos pt
wneuper@59265
   801
      val (_, nxt) = nxt_spec Pbl pb oris (dI', pI', mI') (pbl, met) 
wneuper@59269
   802
		    (ppc,(#ppc o Specify.get_met) mI') (dI',pI',mI');
wneuper@59265
   803
    in
walther@59737
   804
      ((p, Pbl), ((p, p_), Istate_Def.Uistate), 
wneuper@59405
   805
      Generate.PpcKF (Generate.Problem pI', Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
walther@59675
   806
      nxt, Telem.Safe, pt)
wneuper@59265
   807
    end
wneuper@59265
   808
    (* called only if no_met is specified *)     
wneuper@59571
   809
  | specify (Tactic.Refine_Tacitly' (pI, pIre, _, _, _)) (pos as (p, _)) _ pt =
neuper@41980
   810
      let
wneuper@59265
   811
        val (dI', ctxt) = case get_obj I pt p of
wneuper@59265
   812
          PblObj {origin= (_, (dI', _, _), _), ctxt, ...} => (dI', ctxt)
wneuper@59265
   813
        | _ => error "specify (Refine_Tacitly': uncovered case get_obj"
wneuper@59269
   814
        val {met, thy,...} = Specify.get_pbt pIre
wneuper@59416
   815
        val (domID, metID) = (Rule.string_of_thy thy, if length met = 0 then Celem.e_metID else hd met)
wneuper@59265
   816
        val ((p,_), _, _, pt) = 
walther@59737
   817
	        Generate.generate1 thy (Tactic.Refine_Tacitly' (pI, pIre, domID, metID, [(*pbl*)])) (Istate_Def.Uistate, ctxt) pos pt
wneuper@59265
   818
        val (pbl, pre, _) = ([], [], false)
walther@59737
   819
      in ((p, Pbl), (pos, Istate_Def.Uistate),
wneuper@59405
   820
        Generate.PpcKF (Generate.Problem pIre, Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
walther@59675
   821
        Tactic.Model_Problem, Telem.Safe, pt)
neuper@41980
   822
      end
wneuper@59571
   823
  | specify (Tactic.Refine_Problem' rfd) pos _ pt =
neuper@42005
   824
      let
neuper@42005
   825
        val ctxt = get_ctxt pt pos
wneuper@59265
   826
        val (pos, _, _, pt) =
walther@59737
   827
          Generate.generate1 (Celem.assoc_thy "Isac_Knowledge") (Tactic.Refine_Problem' rfd) (Istate_Def.Uistate, ctxt) pos pt
wneuper@59265
   828
      in
walther@59737
   829
        (pos(*p,Pbl*), (pos(*p,Pbl*), Istate_Def.Uistate), Generate.RefinedKF rfd, Tactic.Model_Problem, Telem.Safe, pt)
neuper@41980
   830
      end
neuper@41994
   831
    (*WN110515 initialise ctxt again from itms and add preconds*)
wneuper@59571
   832
  | specify (Tactic.Specify_Problem' (pI, (ok, (itms, pre)))) (pos as (p,_)) _ pt =
neuper@41994
   833
      let
wneuper@59265
   834
        val (oris, dI', pI', mI', dI, mI, ctxt, met) = case get_obj I pt p of
wneuper@59265
   835
          PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, _, mI), ctxt, meth = met, ...} =>
wneuper@59265
   836
            (oris, dI', pI', mI', dI, mI, ctxt, met)
wneuper@59265
   837
        | _ => error "specify (Specify_Problem': uncovered case get_obj"
wneuper@59405
   838
        val thy = Celem.assoc_thy dI
wneuper@59306
   839
        val (p, pt) =
walther@59737
   840
          case  Generate.generate1 thy (Tactic.Specify_Problem' (pI, (ok, (itms, pre)))) (Istate_Def.Uistate, ctxt) pos pt of
wneuper@59306
   841
            ((p, Pbl), _, _, pt) => (p, pt)
wneuper@59265
   842
          | _ => error "specify (Specify_Problem': uncovered case generate1 (WARNING WHY ?)"
wneuper@59416
   843
        val dI'' = Celem.assoc_thy (if dI = Rule.e_domID then dI' else dI)
wneuper@59405
   844
        val mI'' = if mI = Celem.e_metID then mI' else mI
wneuper@59269
   845
        val (_, nxt) = nxt_spec Pbl ok oris (dI', pI', mI') (itms, met) ((#ppc o Specify.get_pbt) pI,
wneuper@59269
   846
          (#ppc o Specify.get_met) mI'') (dI, pI, mI);
wneuper@59265
   847
      in
walther@59737
   848
        ((p,Pbl), (pos,Istate_Def.Uistate),
wneuper@59271
   849
        Generate.PpcKF (Generate.Problem pI, Specify.itms2itemppc dI'' itms pre),
walther@59675
   850
        nxt, Telem.Safe, pt)
neuper@41994
   851
      end    
neuper@41994
   852
    (*WN110515 initialise ctxt again from itms and add preconds*)
wneuper@59571
   853
  | specify (Tactic.Specify_Method' (mID, _, _)) (pos as (p, _)) _ pt =
neuper@41994
   854
      let
wneuper@59265
   855
        val (oris, dI', pI', mI', dI, pI, pbl, met, ctxt) = case get_obj I pt p of
wneuper@59265
   856
          PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, pI, _), probl = pbl, meth = met, ctxt, ...} =>
wneuper@59265
   857
             (oris, dI', pI', mI', dI, pI, pbl, met, ctxt)
wneuper@59265
   858
        | _ => error "specify (Specify_Problem': uncovered case get_obj"
wneuper@59540
   859
        val {ppc, pre, prls,...} = Specify.get_met mID
wneuper@59405
   860
        val thy = Celem.assoc_thy dI
wneuper@59416
   861
        val dI'' = if dI = Rule.e_domID then dI' else dI
wneuper@59405
   862
        val pI'' = if pI = Celem.e_pblID then pI' else pI
wneuper@59540
   863
        val oris = Specify.add_field' thy ppc oris
wneuper@59265
   864
        val met = if met = [] then pbl else met
wneuper@59540
   865
        val (_, (itms, pre')) = Specify.match_itms_oris thy met (ppc, pre, prls) oris
walther@59742
   866
        val itms = Specify.hack_until_review_Specify_1 mI' itms
neuper@41994
   867
        val (pos, _, _, pt) = 
walther@59737
   868
	        Generate.generate1 thy (Tactic.Specify_Method' (mID, oris, itms)) (Istate_Def.Uistate, ctxt) pos pt
wneuper@59265
   869
        val (_, nxt) = nxt_spec Met true oris (dI', pI',mI') (pbl, itms) 
wneuper@59269
   870
		      ((#ppc o Specify.get_pbt) pI'', ppc) (dI'', pI'', mID)
wneuper@59265
   871
      in
walther@59737
   872
        (pos, (pos,Istate_Def.Uistate),
wneuper@59405
   873
        Generate.PpcKF (Generate.Method mID, Specify.itms2itemppc (Celem.assoc_thy dI'') itms pre'),
walther@59675
   874
        nxt, Telem.Safe, pt)
neuper@41994
   875
      end    
wneuper@59571
   876
  | specify (Tactic.Add_Given' ct) p c pt = specify_additem "#Given" ct p c pt
wneuper@59571
   877
  | specify (Tactic.Add_Find'  ct) p c pt = specify_additem "#Find"  ct p c pt
wneuper@59571
   878
  | specify (Tactic.Add_Relation' ct) p c pt=specify_additem"#Relate"ct p c pt
wneuper@59571
   879
  | specify (Tactic.Specify_Theory' domID) (pos as (p,p_)) _ pt =
neuper@41994
   880
      let
neuper@41994
   881
        val p_ = case p_ of Met => Met | _ => Pbl
wneuper@59405
   882
        val thy = Celem.assoc_thy domID
wneuper@59265
   883
        val (oris, dI', pI', mI', dI, pI, mI, pbl, met, ctxt) = case get_obj I pt p of
wneuper@59265
   884
          PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, pI, mI), probl = pbl, meth = met, ctxt, ...} =>
wneuper@59265
   885
             (oris, dI', pI', mI', dI, pI, mI, pbl, met, ctxt)
wneuper@59265
   886
        | _ => error "specify (Specify_Theory': uncovered case get_obj"
wneuper@59265
   887
        val mppc = case p_ of Met => met | _ => pbl
wneuper@59405
   888
        val cpI = if pI = Celem.e_pblID then pI' else pI
wneuper@59269
   889
        val {prls = per, ppc, where_ = pwh, ...} = Specify.get_pbt cpI
wneuper@59405
   890
        val cmI = if mI = Celem.e_metID then mI' else mI
wneuper@59269
   891
        val {prls = mer, ppc = mpc, pre= mwh, ...} = Specify.get_met cmI
wneuper@59265
   892
        val pre = case p_ of
wneuper@59308
   893
          Met => (Stool.check_preconds thy mer mwh met)
wneuper@59308
   894
        | _ => (Stool.check_preconds thy per pwh pbl)
neuper@41994
   895
        val pb = foldl and_ (true, map fst pre)
neuper@41994
   896
      in
neuper@41994
   897
        if domID = dI
neuper@41994
   898
        then
wneuper@59265
   899
          let val (p_, nxt) = nxt_spec p_ pb oris (dI', pI', mI') (pbl, met) (ppc, mpc) (dI, pI, mI)
wneuper@59265
   900
	        in
walther@59737
   901
	          ((p, p_), (pos, Istate_Def.Uistate), 
wneuper@59271
   902
		        Generate.PpcKF (header p_ pI cmI, Specify.itms2itemppc thy mppc pre),
walther@59675
   903
		        nxt, Telem.Safe, pt)
neuper@41994
   904
          end
neuper@41994
   905
        else (*FIXME: check ppc wrt. (new!) domID ..? still parsable?*)
neuper@41994
   906
	        let 
walther@59737
   907
	          val ((p, p_), _, _, pt) = Generate.generate1 thy (Tactic.Specify_Theory' domID) (Istate_Def.Uistate, ctxt) (p,p_) pt
wneuper@59265
   908
	          val (p_,nxt) = nxt_spec p_ pb oris (dI', pI', mI') (pbl, met) (ppc, mpc) (domID, pI, mI)
wneuper@59265
   909
	        in
walther@59737
   910
	          ((p,p_), (pos,Istate_Def.Uistate), 
wneuper@59271
   911
	          Generate.PpcKF (header p_ pI cmI, Specify.itms2itemppc thy mppc pre),
walther@59675
   912
	          nxt, Telem.Safe, pt)
neuper@41994
   913
          end
neuper@41994
   914
      end
walther@59728
   915
  | specify m' _ _ _ = error ("specify: not impl. for " ^ Tactic.string_of m')
neuper@37906
   916
neuper@41994
   917
(*FIXME.WN110515 declare_constraints for ct (without dsc) into PblObj{ctxt, ...}
neuper@41994
   918
  -- for input from scratch*)
neuper@38051
   919
fun nxt_specif_additem sel ct (ptp as (pt, (p, Pbl))) = 
wneuper@59265
   920
    let
wneuper@59265
   921
      val (oris, dI', pI', dI, pI, pbl, ctxt) = case get_obj I pt p of
wneuper@59265
   922
        PblObj {origin = (oris, (dI', pI', _), _), spec = (dI, pI, _), probl = pbl, ctxt, ...} =>
wneuper@59265
   923
           (oris, dI', pI', dI, pI, pbl, ctxt)
wneuper@59265
   924
      | _ => error "specify (Specify_Theory': uncovered case get_obj"
wneuper@59416
   925
      val thy = if dI = Rule.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI;
wneuper@59405
   926
      val cpI = if pI = Celem.e_pblID then pI' else pI;
wneuper@59265
   927
    in
wneuper@59269
   928
      case appl_add ctxt sel oris pbl ((#ppc o Specify.get_pbt) cpI) ct of
wneuper@59265
   929
	      Add itm (*..union old input *) =>
wneuper@59265
   930
	        let
wneuper@59265
   931
	          val pbl' = insert_ppc thy itm pbl
wneuper@59265
   932
	          val (tac, tac_) = case sel of
wneuper@59571
   933
		          "#Given" => (Tactic.Add_Given    ct, Tactic.Add_Given'   (ct, pbl'))
wneuper@59571
   934
		        | "#Find"  => (Tactic.Add_Find     ct, Tactic.Add_Find'    (ct, pbl'))
wneuper@59571
   935
		        | "#Relate"=> (Tactic.Add_Relation ct, Tactic.Add_Relation'(ct, pbl'))
wneuper@59265
   936
		        | sel => error ("nxt_specif_additem: uncovered case of" ^ sel)
walther@59737
   937
		        val (p, c, pt') = case Generate.generate1 thy tac_ (Istate_Def.Uistate, ctxt) (p,Pbl) pt of
wneuper@59306
   938
		          ((p, Pbl), c, _, pt') =>  (p, c, pt')
wneuper@59306
   939
		        | _ => error "nxt_specif_additem: uncovered case generate1"
wneuper@59265
   940
	        in
walther@59737
   941
	          ([(tac, tac_, ((p, Pbl), (Istate_Def.Uistate, ctxt)))], c, (pt', (p, Pbl)))
wneuper@59265
   942
          end	       
wneuper@59265
   943
	    | Err msg => (*TODO.WN03 pass error-msgs to the frontend..
wneuper@59265
   944
                     FIXME ..and dont abuse a tactic for that purpose*)
wneuper@59592
   945
	        ([(Tactic.Tac msg, Tactic.Tac_ (Rule.Thy_Info_get_theory "Isac_Knowledge", msg,msg,msg),
walther@59737
   946
	          (e_pos', (Istate_Def.e_istate, ContextC.e_ctxt)))], [], ptp) 
wneuper@59265
   947
    end
wneuper@59265
   948
  | nxt_specif_additem sel ct (ptp as (pt, (p, Met))) = 
wneuper@59265
   949
    let
wneuper@59265
   950
      val (oris, dI', mI', dI, mI, met, ctxt) = case get_obj I pt p of
wneuper@59265
   951
        PblObj {origin = (oris, (dI', _, mI'), _), spec = (dI, _, mI), meth = met,ctxt, ...} =>
wneuper@59265
   952
           (oris, dI', mI', dI, mI, met, ctxt)
wneuper@59265
   953
      | _ => error "nxt_specif_additem Met: uncovered case get_obj"
wneuper@59416
   954
      val thy = if dI = Rule.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI;
wneuper@59405
   955
      val cmI = if mI = Celem.e_metID then mI' else mI;
wneuper@59265
   956
    in 
wneuper@59269
   957
      case appl_add ctxt sel oris met ((#ppc o Specify.get_met) cmI) ct of
wneuper@59265
   958
        Add itm (*..union old input *) =>
wneuper@59265
   959
	        let
wneuper@59265
   960
	          val met' = insert_ppc thy itm met;
wneuper@59265
   961
	          val (tac,tac_) = case sel of
wneuper@59571
   962
		          "#Given" => (Tactic.Add_Given    ct, Tactic.Add_Given'   (ct, met'))
wneuper@59571
   963
		        | "#Find"  => (Tactic.Add_Find     ct, Tactic.Add_Find'    (ct, met'))
wneuper@59571
   964
		        | "#Relate"=> (Tactic.Add_Relation ct, Tactic.Add_Relation'(ct, met'))
wneuper@59265
   965
		        | sel => error ("nxt_specif_additem Met: uncovered case of" ^ sel)
walther@59737
   966
	          val (p, c, pt') = case Generate.generate1 thy tac_ (Istate_Def.Uistate, ctxt) (p, Met) pt of
wneuper@59306
   967
	            ((p, Met), c, _, pt') => (p, c, pt')
wneuper@59265
   968
		        | _ => error "nxt_specif_additem: uncovered case generate1 (WARNING WHY ?)"
wneuper@59265
   969
	        in
walther@59737
   970
	          ([(tac, tac_, ((p, Met), (Istate_Def.Uistate, ctxt)))], c, (pt', (p, Met)))
wneuper@59265
   971
	        end
wneuper@59265
   972
      | Err _ => ([(*tacis*)], [], ptp) (*nxt_me collects tacis until not hide; here just no progress*)
wneuper@59265
   973
    end
wneuper@59265
   974
  | nxt_specif_additem _ _ (_, p) = error ("nxt_specif_additem not impl. for" ^ pos'2str p)
neuper@41994
   975
wneuper@59405
   976
fun ori2Coritm pbt (i, v, f, d, ts) =
wneuper@59316
   977
  (i, v, true, f, Model.Cor ((d,ts),((snd o snd o the o (find_first (eq1 d))) pbt,ts)))
wneuper@59316
   978
    handle _ => (i, v, true, f, Model.Cor ((d, ts), (d, ts)))
wneuper@59265
   979
      (*dsc in oris, but not in pbl pat list: keep this dsc*)
neuper@37906
   980
wneuper@59265
   981
(* filter out oris which have same description in itms *)
neuper@37906
   982
fun filter_outs oris [] = oris
neuper@37906
   983
  | filter_outs oris (i::itms) = 
wneuper@59265
   984
    let
wneuper@59316
   985
      val ors = filter_out ((curry op = ((Model.d_in o #5) i)) o (#4)) oris
wneuper@59265
   986
    in
wneuper@59265
   987
      filter_outs ors itms
wneuper@59265
   988
    end
neuper@37906
   989
wneuper@59265
   990
(* filter oris which are in pbt, too *)
neuper@37906
   991
fun filter_pbt oris pbt =
wneuper@59265
   992
  let
wneuper@59265
   993
    val dscs = map (fst o snd) pbt
wneuper@59265
   994
  in
wneuper@59308
   995
    filter ((member op= dscs) o (#4)) oris
wneuper@59265
   996
  end
neuper@37906
   997
wneuper@59265
   998
(* combine itms from pbl + met and complete them wrt. pbt *)
wneuper@59265
   999
(* FIXXXME.WN031205 complete_metitms doesnt handle incorrect itms !*)
wneuper@59308
  1000
fun complete_metitms oris pits mits met = 
wneuper@59265
  1001
  let
wneuper@59316
  1002
    val vat = Model.max_vt pits;
wneuper@59308
  1003
    val itms = pits @ (filter ((member_swap op = vat) o (#2 )) mits)
wneuper@59308
  1004
    val ors = filter ((member_swap op= vat) o (#2)) oris
wneuper@59265
  1005
    val os = filter_outs ors itms (*WN.12.03?: does _NOT_ add itms from met ?!*)
wneuper@59265
  1006
  in
wneuper@59265
  1007
    itms @ (map (ori2Coritm met) os)
wneuper@59265
  1008
  end
neuper@37906
  1009
wneuper@59265
  1010
(* complete model and guard of a calc-head *)
wneuper@59265
  1011
fun complete_mod_ (oris, mpc, ppc, probl) =
wneuper@59265
  1012
  let
wneuper@59308
  1013
    val pits = filter_out ((curry op= false) o (#3)) probl
wneuper@59316
  1014
    val vat = if probl = [] then 1 else Model.max_vt probl
wneuper@59308
  1015
    val pors = filter ((member_swap op = vat) o (#2)) oris
wneuper@59265
  1016
    val pors = filter_outs pors pits (*which are in pbl already*)
wneuper@59265
  1017
    val pors = (filter_pbt pors ppc) (*which are in pbt, too*)
wneuper@59265
  1018
    val pits = pits @ (map (ori2Coritm ppc) pors)
wneuper@59265
  1019
    val mits = complete_metitms oris pits [] mpc
wneuper@59265
  1020
  in (pits, mits) end
neuper@37906
  1021
wneuper@59405
  1022
fun some_spec (odI, opI, omI) (dI, pI, mI) =
wneuper@59416
  1023
  (if dI = Rule.e_domID then odI else dI,
wneuper@59405
  1024
   if pI = Celem.e_pblID then opI else pI,
wneuper@59405
  1025
   if mI = Celem.e_metID then omI else mI)
neuper@37906
  1026
neuper@41982
  1027
(* get the values from oris; handle the term list w.r.t. penv *)
walther@59764
  1028
fun vals_of_oris (oris: Model.ori list) =
wneuper@59316
  1029
  ((map (Model.mkval' o (#5))) o 
wneuper@59308
  1030
    (filter ((member_swap op= 1) o (#2)))) oris
neuper@37906
  1031
wneuper@59265
  1032
(* fun tag_form thy (formal, given) = Thm.global_cterm_of thy
wneuper@59265
  1033
	 (((head_of o Thm.term_of) given) $ (Thm.term_of formal)); WN100819 *)
neuper@37934
  1034
fun tag_form thy (formal, given) =
neuper@52070
  1035
 (let
neuper@52070
  1036
    val gf = (head_of given) $ formal;
wneuper@59184
  1037
    val _ = Thm.global_cterm_of thy gf
neuper@52070
  1038
  in gf end)
wneuper@59416
  1039
  handle _ => error ("calchead.tag_form: " ^ Rule.term_to_string''' thy given ^
wneuper@59416
  1040
    " .. " ^ Rule.term_to_string''' thy formal ^ " ..types do not match")
neuper@38053
  1041
wneuper@59265
  1042
fun chktyps thy (fs, gs) = map (tag_form thy) (fs ~~ gs)
neuper@37906
  1043
neuper@37906
  1044
(* check pbltypes, announces one failure a time *)
neuper@37930
  1045
fun chk_vars ctppc = 
wneuper@59265
  1046
  let
wneuper@59389
  1047
    val {Given = gi, Where = wh, Find = fi, Relate = re, ...} = Specify.appc flat (Specify.mappc TermC.vars ctppc)
wneuper@59265
  1048
    val chked = subtract op = gi wh
wneuper@59265
  1049
  in
wneuper@59265
  1050
    if chked <> [] then ("wh\\gi", chked)
wneuper@59265
  1051
    else
wneuper@59265
  1052
      let val chked = subtract op = (union op = gi fi) re
wneuper@59265
  1053
      in
wneuper@59265
  1054
        if chked  <> []
wneuper@59265
  1055
	      then ("re\\(gi union fi)", chked)
wneuper@59265
  1056
	      else ("ok", []) 
wneuper@59265
  1057
      end
wneuper@59265
  1058
  end
neuper@37906
  1059
neuper@37906
  1060
(* check a new pbltype: variables (Free) unbound by given, find*) 
neuper@37906
  1061
fun unbound_ppc ctppc =
wneuper@59265
  1062
  let
wneuper@59389
  1063
    val {Given = gi, Find = fi, Relate = re, ...} = Specify.appc flat (Specify.mappc TermC.vars ctppc)
wneuper@59265
  1064
  in
wneuper@59265
  1065
    distinct (subtract op = (union op = gi fi) re)
wneuper@59265
  1066
  end
neuper@37906
  1067
wneuper@59265
  1068
(* complete _NON_empty calc-head for autocalc (sub-)pbl from oris
wneuper@59265
  1069
  + met from fmz; assumes pos on PblObj, meth = []                    *)
wneuper@59265
  1070
fun complete_mod (pt, pos as (p, p_) : pos') =
wneuper@59265
  1071
  let
wneuper@59265
  1072
    val _ = if p_ <> Pbl 
wneuper@59265
  1073
	    then error ("###complete_mod: only impl.for Pbl, called with " ^ pos'2str pos)
wneuper@59265
  1074
	    else ()
wneuper@59265
  1075
	  val (oris, ospec, probl, spec) = case get_obj I pt p of
wneuper@59265
  1076
	    PblObj {origin = (oris, ospec, _), probl, spec, ...} => (oris, ospec, probl, spec)
wneuper@59265
  1077
	  | _ => error "complete_mod: unvered case get_obj"
wneuper@59265
  1078
  	val (_, pI, mI) = some_spec ospec spec
wneuper@59269
  1079
  	val mpc = (#ppc o Specify.get_met) mI
wneuper@59269
  1080
  	val ppc = (#ppc o Specify.get_pbt) pI
wneuper@59265
  1081
  	val (pits, mits) = complete_mod_ (oris, mpc, ppc, probl)
wneuper@59265
  1082
    val pt = update_pblppc pt p pits
wneuper@59265
  1083
	  val pt = update_metppc pt p mits
wneuper@59265
  1084
  in (pt, (p, Met) : pos') end
neuper@37906
  1085
neuper@37906
  1086
(*.complete _EMPTY_ calc-head for autocalc (sub-)pbl from oris(+met from fmz);
neuper@37906
  1087
   oris and spec (incl. pbl-refinement) given from init_calc or SubProblem .*)
walther@59671
  1088
fun all_modspec (pt, (p, _)) =
wneuper@59265
  1089
  let
wneuper@59265
  1090
    val (pors, dI, pI, mI) = case get_obj I pt p of
wneuper@59265
  1091
      PblObj {origin = (pors, (dI, pI, mI), _), ...} => (pors, dI, pI, mI)
wneuper@59265
  1092
    | _ => error "all_modspec: uncovered case get_obj"
wneuper@59269
  1093
	  val {ppc, ...} = Specify.get_met mI
wneuper@59265
  1094
    val (_, vals) = oris2fmz_vals pors
wneuper@59582
  1095
	  val ctxt = ContextC.initialise dI vals
wneuper@59265
  1096
    val pt = update_pblppc pt p (map (ori2Coritm ppc) pors)
wneuper@59265
  1097
	  val pt = update_metppc pt p (map (ori2Coritm ppc) pors) (*WN110716 = _pblppc ?!?*)
wneuper@59265
  1098
	  val pt = update_spec pt p (dI, pI, mI)
neuper@42092
  1099
    val pt = update_ctxt pt p ctxt
wneuper@59265
  1100
  in
wneuper@59265
  1101
    (pt, (p, Met) : pos')
wneuper@59265
  1102
  end
neuper@37906
  1103
wneuper@59265
  1104
(* WN0312: use in nxt_spec, too ? what about variants ??? *)
wneuper@59308
  1105
fun is_complete_mod_ [] = false
wneuper@59265
  1106
  | is_complete_mod_ itms = foldl and_ (true, (map #3 itms))
neuper@41976
  1107
wneuper@59265
  1108
fun is_complete_mod (pt, pos as (p, Pbl) : pos') =
wneuper@59265
  1109
    if (is_pblobj o (get_obj I pt)) p 
wneuper@59265
  1110
    then (is_complete_mod_ o (get_obj g_pbl pt)) p
wneuper@59265
  1111
    else error ("is_complete_mod: called by PrfObj at "^pos'2str pos)
neuper@37906
  1112
  | is_complete_mod (pt, pos as (p, Met)) = 
wneuper@59265
  1113
    if (is_pblobj o (get_obj I pt)) p 
wneuper@59265
  1114
    then (is_complete_mod_ o (get_obj g_met pt)) p
wneuper@59265
  1115
    else error ("is_complete_mod: called by PrfObj at "^pos'2str pos)
neuper@37906
  1116
  | is_complete_mod (_, pos) =
wneuper@59265
  1117
    error ("is_complete_mod called by " ^ pos'2str pos ^ " (should be Pbl or Met)")
neuper@37906
  1118
wneuper@59265
  1119
(* have (thy, pbl, met) _all_ been specified explicitly ? *)
wneuper@59265
  1120
fun is_complete_spec (pt, pos as (p, _) : pos') = 
wneuper@59265
  1121
  if (not o is_pblobj o (get_obj I pt)) p 
wneuper@59265
  1122
  then error ("is_complete_spec: called by PrfObj at "^pos'2str pos)
wneuper@59265
  1123
  else
wneuper@59265
  1124
    let val (dI,pI,mI) = get_obj g_spec pt p
wneuper@59416
  1125
    in dI <> Rule.e_domID andalso pI <> Celem.e_pblID andalso mI <> Celem.e_metID end
neuper@37906
  1126
wneuper@59265
  1127
(* complete empty items in specification from origin (pbl, met ev.refined);
wneuper@59265
  1128
   assumes 'is_complete_mod' *)
wneuper@59265
  1129
fun complete_spec (pt, pos as (p, _) : pos') = 
wneuper@59265
  1130
  let
wneuper@59265
  1131
    val (ospec, spec) = case get_obj I pt p of
wneuper@59265
  1132
      PblObj {origin = (_,ospec,_), spec,...} => (ospec, spec)
wneuper@59265
  1133
    | _ => error "complete_spec: uncovered case get_obj"
wneuper@59265
  1134
    val pt = update_spec pt p (some_spec ospec spec)
wneuper@59265
  1135
  in
wneuper@59265
  1136
    (pt, pos)
wneuper@59265
  1137
  end
neuper@37906
  1138
wneuper@59265
  1139
fun is_complete_modspec ptp = is_complete_mod ptp andalso is_complete_spec ptp
neuper@37906
  1140
wneuper@59265
  1141
fun pt_model (PblObj {meth, spec, origin = (_, spec', hdl), ...}) Met =
wneuper@59265
  1142
    let
wneuper@59265
  1143
      val (_, _, metID) = get_somespec' spec spec'
wneuper@59405
  1144
	    val pre = if metID = Celem.e_metID then []
wneuper@59265
  1145
	      else
wneuper@59265
  1146
	        let
wneuper@59269
  1147
	          val {prls, pre= where_, ...} = Specify.get_met metID
wneuper@59308
  1148
	          val pre = Stool.check_preconds' prls where_ meth 0
wneuper@59265
  1149
		      in pre end
wneuper@59265
  1150
	    val allcorrect = is_complete_mod_ meth andalso foldl and_ (true, (map #1 pre))
wneuper@59265
  1151
    in
wneuper@59265
  1152
      ModSpec (allcorrect, Met, hdl, meth, pre, spec)
wneuper@59265
  1153
    end
wneuper@59265
  1154
  | pt_model (PblObj {probl, spec, origin = (_, spec', hdl), ...}) _(*Frm,Pbl*) =
wneuper@59265
  1155
    let
wneuper@59265
  1156
      val (_, pI, _) = get_somespec' spec spec'
wneuper@59405
  1157
      val pre = if pI = Celem.e_pblID then []
wneuper@59265
  1158
	      else
wneuper@59265
  1159
	        let
wneuper@59269
  1160
	          val {prls, where_, ...} = Specify.get_pbt pI
wneuper@59308
  1161
	          val pre = Stool.check_preconds' prls where_ probl 0
wneuper@59265
  1162
	        in pre end
wneuper@59265
  1163
	    val allcorrect = is_complete_mod_ probl andalso foldl and_ (true, (map #1 pre))
wneuper@59265
  1164
    in
wneuper@59265
  1165
      ModSpec (allcorrect, Pbl, hdl, probl, pre, spec)
wneuper@59265
  1166
    end
wneuper@59265
  1167
  | pt_model _ _ = error "pt_model: uncovered definition"
neuper@37906
  1168
wneuper@59265
  1169
fun pt_form (PrfObj {form, ...}) = Form form
wneuper@59265
  1170
  | pt_form (PblObj {probl, spec, origin = (_, spec', _), ...}) =
wneuper@59265
  1171
    let
wneuper@59265
  1172
      val (dI, pI, _) = get_somespec' spec spec'
wneuper@59269
  1173
      val {cas, ...} = Specify.get_pbt pI
wneuper@59265
  1174
    in case cas of
walther@59618
  1175
      NONE => Form (Auto_Prog.pblterm dI pI)
wneuper@59316
  1176
    | SOME t => Form (subst_atomic (Model.mk_env probl) t)
wneuper@59265
  1177
    end
neuper@37906
  1178
wneuper@59265
  1179
(* pt_extract returns
neuper@37906
  1180
      # the formula at pos
neuper@37906
  1181
      # the tactic applied to this formula
neuper@37906
  1182
      # the list of assumptions generated at this formula
neuper@37906
  1183
	(by application of another tac to the preceding formula !)
wneuper@59265
  1184
   pos is assumed to come from the frontend, ie. generated by moveDown.
wneuper@59265
  1185
   Notes: cannot be in ctree.sml, because ModSpec has to be calculated. 
wneuper@59265
  1186
   TODO 110417 get assumptions from ctxt !?
wneuper@59265
  1187
*)
wneuper@59265
  1188
fun pt_extract (pt, ([], Res)) =
wneuper@59265
  1189
    (* WN120512: returns Check_Postcondition WRONGLY see --- build fun is_exactly_equal *)
wneuper@59265
  1190
    let
wneuper@59265
  1191
      val (f, asm) = get_obj g_result pt []
wneuper@59265
  1192
    in (Form f, NONE, asm) end
neuper@37906
  1193
  | pt_extract (pt,(p,Res)) =
wneuper@59265
  1194
    let
wneuper@59265
  1195
      val (f, asm) = get_obj g_result pt p
wneuper@59265
  1196
      val tac =
wneuper@59265
  1197
        if last_onlev pt p
wneuper@59265
  1198
        then
wneuper@59265
  1199
          if is_pblobj' pt (lev_up p)
neuper@42437
  1200
          then
wneuper@59265
  1201
            let
wneuper@59265
  1202
              val pI = case get_obj I pt (lev_up p) of
wneuper@59265
  1203
                PblObj{spec = (_, pI, _), ...} => pI
wneuper@59265
  1204
              | _ => error "pt_extract last_onlev: uncovered case get_obj"
wneuper@59571
  1205
            in if pI = Celem.e_pblID then NONE else SOME (Tactic.Check_Postcond pI) end
wneuper@59571
  1206
		      else SOME Tactic.End_Trans (* WN0502 TODO for other branches *)
wneuper@59265
  1207
		    else
wneuper@59265
  1208
		      let val p' = lev_on p
wneuper@59265
  1209
		      in
wneuper@59265
  1210
		        if is_pblobj' pt p'
wneuper@59265
  1211
		        then
wneuper@59265
  1212
		          let
wneuper@59265
  1213
		            val (dI ,pI) = case get_obj I pt p' of
wneuper@59265
  1214
		              PblObj{origin = (_, (dI, pI, _), _), ...} => (dI ,pI)
wneuper@59265
  1215
		            | _ => error "pt_extract \<not>last_onlev: uncovered case get_obj"
wneuper@59571
  1216
		          in SOME (Tactic.Subproblem (dI, pI)) end
wneuper@59265
  1217
		        else
wneuper@59265
  1218
		          if f = get_obj g_form pt p'
wneuper@59265
  1219
		          then SOME (get_obj g_tac pt p') (*because this Frm ~~~is not on worksheet*)
wneuper@59571
  1220
		          else SOME (Tactic.Take (Rule.term2str (get_obj g_form pt p')))
wneuper@59265
  1221
		      end
wneuper@59265
  1222
    in (Form f, tac, asm) end
wneuper@59265
  1223
  | pt_extract (pt, (p,p_(*Frm,Pbl*))) =
neuper@42437
  1224
      let
neuper@42437
  1225
        val ppobj = get_obj I pt p
neuper@42437
  1226
        val f = if is_pblobj ppobj then pt_model ppobj p_ else get_obj pt_form pt p
neuper@42437
  1227
        val tac = g_tac ppobj
wneuper@59265
  1228
      in (f, SOME tac, []) end
neuper@37906
  1229
wneuper@59265
  1230
(** get the formula from a ctree-node:
wneuper@59265
  1231
  take form+res from PblObj and 1.PrfObj and (PrfObj after PblObj)
wneuper@59265
  1232
  take res from all other PrfObj's
wneuper@59265
  1233
  Designed for interSteps, outcommented 04 in favour of calcChangedEvent **)
wneuper@59265
  1234
fun formres p (Nd (PblObj {origin = (_, _, h), result = (r, _), ...}, _)) =
wneuper@59265
  1235
    [("headline", (p, Frm), h), ("stepform", (p, Res), r)]
wneuper@59265
  1236
  | formres p (Nd (PrfObj {form, result = (r, _), ...}, _)) = 
wneuper@59265
  1237
    [("stepform", (p, Frm), form), ("stepform", (p, Res), r)]
wneuper@59265
  1238
  | formres _ _ = error "formres: uncovered definition" 
wneuper@59265
  1239
fun form p (Nd (PrfObj {result = (r, _), ...}, _)) = 
wneuper@59265
  1240
    [("stepform", (p, Res), r)]
wneuper@59265
  1241
  | form _ _ = error "form: uncovered definition" 
neuper@37906
  1242
wneuper@59265
  1243
(* assumes to take whole level, in particular hd -- for use in interSteps *)
wneuper@59265
  1244
fun get_formress fs _ [] = flat fs
neuper@37906
  1245
  | get_formress fs p (nd::nds) =
neuper@37906
  1246
    (* start with   'form+res'       and continue with trying 'res' only*)
neuper@37906
  1247
    get_forms (fs @ [formres p nd]) (lev_on p) nds
wneuper@59265
  1248
and get_forms fs _ [] = flat fs
neuper@37906
  1249
  | get_forms fs p (nd::nds) =
neuper@37906
  1250
    if is_pblnd nd
neuper@37906
  1251
    (* start again with      'form+res' ///ugly repeat with Check_elementwise
neuper@37906
  1252
    then get_formress (fs @ [formres p nd]) (lev_on p) nds                   *)
neuper@37906
  1253
    then get_forms    (fs @ [formres p nd]) (lev_on p) nds
neuper@37906
  1254
    (* continue with trying 'res' only*)
neuper@37906
  1255
    else get_forms    (fs @ [form    p nd]) (lev_on p) nds;
neuper@37906
  1256
wneuper@59279
  1257
(** get an 'interval' 'from' 'to' of formulae from a ctree **)
wneuper@59265
  1258
(* WN0401 this functionality belongs to ctree.sml *)
wneuper@59265
  1259
fun eq_pos' (p1, Frm) (p2, Frm) = p1 = p2
wneuper@59265
  1260
  | eq_pos' (p1, Res) (p2, Res) = p1 = p2
wneuper@59265
  1261
  | eq_pos' (p1, Pbl) (p2, p2_) =
wneuper@59265
  1262
    p1 = p2 andalso (case p2_ of Pbl => true | Met => true | _ => false)
wneuper@59265
  1263
  | eq_pos' (p1, Met) (p2, p2_) =
wneuper@59265
  1264
    p1 = p2 andalso (case p2_ of Pbl => true | Met => true | _ => false)
neuper@37906
  1265
  | eq_pos' _ _ = false;
neuper@37906
  1266
wneuper@59265
  1267
(* get an 'interval' from the ctree; 'interval' is w.r.t. the 
neuper@37906
  1268
   total ordering Position#compareTo(Position p) in the java-code
wneuper@59516
  1269
val get_interval = fn :
wneuper@59516
  1270
      pos' ->     : from is "move_up 1st-element" to return
neuper@37906
  1271
      pos' -> 	  : to the last element to be returned; from < to
wneuper@59516
  1272
      int -> 	    : level: 0 gets the flattest sub-tree possible, 999 the deepest
wneuper@59279
  1273
      ctree -> 	  : 
neuper@37906
  1274
      (pos' * 	  : of the formula
neuper@37906
  1275
       Term.term) : the formula
wneuper@59265
  1276
	  list                                                           *)
neuper@37906
  1277
fun get_interval from to level pt =
neuper@42432
  1278
  let
wneuper@59265
  1279
    fun get_inter c (from : pos') (to : pos') lev pt =
wneuper@59265
  1280
	    if eq_pos' from to orelse from = ([], Res)
neuper@42432
  1281
	    then
wneuper@59516
  1282
	      let val (f, tacopt, _) = pt_extract (pt, from)
wneuper@59265
  1283
	      in case f of
wneuper@59516
  1284
	        ModSpec (_, _, headline, _, _, _) => c @ [(from, headline, NONE)] 
wneuper@59516
  1285
	      | Form t => c @ [(from, t, tacopt)]
neuper@42432
  1286
	      end
neuper@37906
  1287
	    else 
neuper@42432
  1288
	      if lev < lev_of from
neuper@42432
  1289
	      then (get_inter c (move_dn [] pt from) to lev pt)
neuper@42432
  1290
		      handle (PTREE _(*from move_dn too far*)) => c
neuper@42432
  1291
		    else
neuper@42432
  1292
		      let
wneuper@59516
  1293
		        val (f, tacopt, _) = pt_extract (pt, from)
neuper@42432
  1294
		        val term = case f of
neuper@42432
  1295
		          ModSpec (_,_,headline,_,_,_) => headline
neuper@42432
  1296
				    | Form t => t
wneuper@59516
  1297
		      in (get_inter (c @ [(from, term, tacopt)]) (move_dn [] pt from) to lev pt)
wneuper@59516
  1298
		        handle (PTREE _(*from move_dn too far*)) => c @ [(from, term, tacopt)]
neuper@42432
  1299
		      end
wneuper@59265
  1300
  in get_inter [] from to level pt end
neuper@37906
  1301
wneuper@59516
  1302
fun posterm2str (pos, t, _) = "(" ^ pos'2str pos ^ ", " ^ Rule.term2str t ^ ")"
wneuper@59265
  1303
fun posterms2str pfs = (strs2str' o (map (curry op ^ "\n")) o (map posterm2str)) pfs
neuper@37906
  1304
wneuper@59516
  1305
fun postermtac2str (pos, t, SOME tac) =
wneuper@59571
  1306
    pos'2str pos ^ ", " ^ Rule.term2str t ^ "\n" ^ indent 10 ^ Tactic.tac2str tac
wneuper@59516
  1307
  | postermtac2str (pos, t, NONE) =
wneuper@59516
  1308
    pos'2str pos ^ ", " ^ Rule.term2str t
wneuper@59516
  1309
fun postermtacs2str pfts = (strs2str' o (map (curry op ^ "\n")) o (map postermtac2str)) pfts
wneuper@59516
  1310
wneuper@59265
  1311
(* WN050225 omits the last step, if pt is incomplete *)
wneuper@59265
  1312
fun show_pt pt = tracing (posterms2str (get_interval ([], Frm) ([], Res) 99999 pt))
wneuper@59516
  1313
fun show_pt_tac pt = tracing (postermtacs2str (get_interval ([], Frm) ([], Res) 99999 pt))
neuper@37906
  1314
wneuper@59265
  1315
(* get a calchead from a PblObj-node in the ctree; preconditions must be calculated *)
wneuper@59265
  1316
fun get_ocalhd (pt, (p, Pbl) : pos') = 
wneuper@59265
  1317
    let
wneuper@59265
  1318
	    val (ospec, hdf', spec, probl) = case get_obj I pt p of
wneuper@59265
  1319
	      PblObj {origin = (_, ospec, hdf'), spec, probl,...} => (ospec, hdf', spec, probl)
wneuper@59265
  1320
	    | _ => error "get_ocalhd Pbl: uncovered case get_obj"
wneuper@59269
  1321
      val {prls, where_, ...} = Specify.get_pbt (#2 (some_spec ospec spec))
wneuper@59592
  1322
      val pre = Stool.check_preconds (Celem.assoc_thy "Isac_Knowledge") prls where_ probl
wneuper@59265
  1323
    in
wneuper@59265
  1324
      (ocalhd_complete probl pre spec, Pbl, hdf', probl, pre, spec) : ocalhd
wneuper@59265
  1325
    end
wneuper@59265
  1326
  | get_ocalhd (pt, (p, Met)) = 
wneuper@59265
  1327
    let
wneuper@59265
  1328
		  val (ospec, hdf', spec, meth) = case get_obj I pt p of
wneuper@59265
  1329
		    PblObj {origin = (_, ospec, hdf'), spec, meth, ...} => (ospec, hdf', spec, meth)
wneuper@59265
  1330
		  | _ => error "get_ocalhd Met: uncovered case get_obj"
wneuper@59269
  1331
      val {prls, pre, ...} = Specify.get_met (#3 (some_spec ospec spec))
wneuper@59592
  1332
      val pre = Stool.check_preconds (Celem.assoc_thy "Isac_Knowledge") prls pre meth
wneuper@59265
  1333
    in
wneuper@59265
  1334
      (ocalhd_complete meth pre spec, Met, hdf', meth, pre, spec)
wneuper@59265
  1335
    end
wneuper@59265
  1336
  | get_ocalhd _ = error "get_ocalhd: uncovered definition"
neuper@37906
  1337
wneuper@59265
  1338
(* at the activeFormula set the Model, the Guard and the Specification 
wneuper@59265
  1339
   to empty and return a CalcHead;
wneuper@59265
  1340
   the 'origin' remains (for reconstructing all that) *)
wneuper@59265
  1341
fun reset_calchead (pt, (p,_) : pos') = 
wneuper@59265
  1342
  let
wneuper@59265
  1343
    val () = case get_obj I pt p of
wneuper@59265
  1344
      PblObj _ => ()
wneuper@59265
  1345
    | _ => error "reset_calchead: uncovered case get_obj"
wneuper@59265
  1346
    val pt = update_pbl pt p []
wneuper@59265
  1347
    val pt = update_met pt p []
wneuper@59405
  1348
    val pt = update_spec pt p Celem.e_spec
wneuper@59265
  1349
  in (pt, (p, Pbl) : pos') end
neuper@37906
  1350
walther@59763
  1351
(**)end(**)