src/Tools/isac/Interpret/inform.sml
author Mathias Lehnfeld <bonzai@inode.at>
Fri, 08 Apr 2011 15:16:08 +0200
branchdecompose-isar
changeset 41952 0e76e17a430a
parent 41951 50bc995aa45b
child 41976 792c59bf54d4
permissions -rw-r--r--
intermed. context integration: parse replaced in some cases

- seek_oridts cleanup
- appl_add update
- appl_add' update
- prep_ori cleanup
- Equation.thy update
     1 (* Handle user-input during the specify- and the solve-phase. 
     2    author: Walther Neuper
     3    0603
     4    (c) due to copyright terms
     5 
     6 use"ME/inform.sml";
     7 use"inform.sml";
     8 *)
     9 
    10 signature INFORM =
    11   sig 
    12 
    13     type castab
    14     type icalhd
    15 
    16    (* type iitem *)
    17     datatype
    18       iitem =
    19           Find of cterm' list
    20         | Given of cterm' list
    21         | Relate of cterm' list
    22     type imodel
    23     val imodel2fstr : iitem list -> (string * cterm') list
    24 
    25     
    26     val Isac : 'a -> theory
    27     val appl_add' :
    28        theory' ->
    29        SpecifyTools.ori list ->
    30        SpecifyTools.itm list ->
    31        ('a * (Term.term * Term.term)) list ->
    32        string * cterm' -> SpecifyTools.itm
    33   (*  val appl_adds :
    34        theory' ->
    35        SpecifyTools.ori list ->
    36        SpecifyTools.itm list ->
    37        (string * (Term.term * Term.term)) list ->
    38        (string * string) list -> SpecifyTools.itm list *)
    39    (* val cas_input : string -> ptree * ocalhd *)
    40    (* val cas_input_ :
    41        spec ->
    42        (Term.term * Term.term list) list ->
    43        pblID * SpecifyTools.itm list * metID * SpecifyTools.itm list *
    44        (bool * Term.term) list  *)
    45     val castab : castab Unsynchronized.ref
    46     val compare_step :
    47        calcstate' -> Term.term -> string * calcstate'
    48    (* val concat_deriv :
    49        'a * ((Term.term * Term.term) list -> Term.term * Term.term -> bool)
    50        ->
    51        rls ->
    52        rule list ->
    53        Term.term ->
    54        Term.term ->
    55        bool * (Term.term * rule * (Term.term * Term.term list)) list *)
    56     val dropwhile' :   (* systest/auto-inform.sml *)
    57        ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list
    58    (* val dtss2itm_ :
    59        pbt_ list ->
    60        Term.term * Term.term list ->
    61        int list * bool * string * SpecifyTools.itm_ *)
    62    (* val e_icalhd : icalhd *)
    63     val eq7 : ''a * ''b -> ''a * (''b * 'c) -> bool
    64     val equal : ''a -> ''a -> bool
    65    (* val filter_dsc :
    66        SpecifyTools.ori list -> SpecifyTools.itm -> SpecifyTools.ori list *)
    67    (* val filter_sep : ('a -> bool) -> 'a list -> 'a list * 'a list *)
    68    (* val flattup2 : 'a * ('b * 'c * 'd * 'e) -> 'a * 'b * 'c * 'd * 'e *)
    69    (* val fstr2itm_ :
    70        theory ->
    71        (''a * (Term.term * Term.term)) list ->
    72        ''a * string -> int list * bool * ''a * SpecifyTools.itm_ *)
    73     val inform :
    74        calcstate' -> cterm' -> string * calcstate'   
    75     val input_icalhd : ptree -> icalhd -> ptree * ocalhd
    76    (* val is_Par : SpecifyTools.itm -> bool *)
    77    (* val is_casinput : cterm' -> fmz -> bool *)
    78    (* val is_e_ts : Term.term list -> bool *)
    79    (* val itms2fstr : SpecifyTools.itm -> string * string *)
    80    (* val mk_tacis :
    81        rew_ord' * 'a ->
    82        rls ->
    83        Term.term * rule * (Term.term * Term.term list) ->
    84        tac * tac_ * (pos' * istate)      *)
    85     val oris2itms :
    86        'a -> int -> SpecifyTools.ori list -> SpecifyTools.itm list
    87    (* val par2fstr : SpecifyTools.itm -> string * cterm' *)
    88    (* val parsitm : theory -> SpecifyTools.itm -> SpecifyTools.itm *)
    89     val rev_deriv' : 'a * rule * ('b * 'c) -> 'b * rule * ('a * 'c)
    90    (* val unknown_expl :
    91        theory' ->
    92        (string * (Term.term * Term.term)) list ->
    93        (string * string) list -> SpecifyTools.itm list *)
    94   end
    95 
    96 
    97 
    98 
    99 
   100 
   101 (***. handle an input calc-head .***)
   102 
   103 (*------------------------------------------------------------------(**)
   104 structure inform :INFORM =
   105 struct
   106 (**)------------------------------------------------------------------*)
   107 
   108 datatype iitem = 
   109   Given of cterm' list
   110 (*Where is never input*) 
   111 | Find  of cterm' list
   112 | Relate  of cterm' list;
   113 
   114 type imodel = iitem list;
   115 
   116 (*calc-head as input*)
   117 type icalhd =
   118      pos' *     (*the position of the calc-head in the calc-tree
   119 		 pos' as (p,p_) where p_ is neglected due to pos_ below*) 
   120      cterm' *   (*the headline*)
   121      imodel *   (*the model (without Find) of the calc-head*)
   122      pos_ *     (*model belongs to Pbl or Met*)
   123      spec;      (*specification: domID, pblID, metID*)
   124 val e_icalhd = (e_pos', "", [Given [""]], Pbl, e_spec): icalhd;
   125 
   126 fun is_casinput (hdf: cterm') ((fmz_, spec): fmz) =
   127     hdf <> "" andalso fmz_ = [] andalso spec = e_spec;
   128 
   129 (*.handle an input as into an algebra system.*)
   130 fun dtss2itm_ ppc (d, ts) =
   131     let val (f, (d, id)) = the (find_first ((curry op= d) o 
   132 					    (#1: (term * term) -> term) o
   133 					    (#2: pbt_ -> (term * term))) ppc)
   134     in ([1], true, f, Cor ((d, ts), (id, ts))) end;
   135 
   136 fun flattup2 (a,(b,c,d,e)) = (a,b,c,d,e);
   137 
   138 
   139 
   140 (*.association list with cas-commands, for generating a complete calc-head.*)
   141 type castab = 
   142      (term *         (*cas-command, eg. 'solve'*)
   143       (spec * 	     (*theory, problem, method*)
   144 
   145        		     (*the function generating a kind of formalization*)
   146        (term list -> (*the arguments of the cas-command, eg. (x+1=2, x)*)
   147 	(term *      (*description of an element*)
   148 	 term list)  (*value of the element (always put into a list)*)
   149 	    list)))  (*of elements in the formalization*)
   150 	 list;       (*of cas-entries in the association list*)
   151 
   152 val castab = Unsynchronized.ref ([]: castab);
   153 
   154 
   155 (*..*)
   156 (* val (dI,pI,mI) = spec;
   157    *)
   158 (*fun cas_input_ ((dI,pI,mI): spec) dtss =
   159     let val thy = assoc_thy dI
   160 	val {ppc,...} = get_pbt pI
   161 	val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
   162 	val its = add_id its_
   163 	val pits = map flattup2 its
   164 	val (pI, mI) = if mI <> ["no_met"] then (pI, mI)
   165 		   else let val SOME (pI,_) = refine_pbl thy pI pits
   166 			in (pI, (hd o #met o get_pbt) pI) end
   167 	val {ppc,pre,prls,...} = get_met mI
   168 	val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
   169 	val its = add_id its_
   170 	val mits = map flattup2 its
   171 	val pre = check_preconds thy prls pre mits
   172 in (pI, pits: itm list, mI, mits: itm list, pre) end;*)
   173 
   174 (* val (dI,pI,mI) = spec;
   175    *)
   176 fun cas_input_ ((dI,pI,mI): spec) dtss =
   177     let val thy = assoc_thy dI
   178 	val {ppc,...} = get_pbt pI
   179 	val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
   180 	val its = add_id its_
   181 	val pits = map flattup2 its
   182 	val (pI, mI) = if mI <> ["no_met"] then (pI, mI)
   183 		   else case refine_pbl thy pI pits of
   184 			    SOME (pI,_) => (pI, (hd o #met o get_pbt) pI)
   185 			  | NONE => (pI, (hd o #met o get_pbt) pI)
   186 	val {ppc,pre,prls,...} = get_met mI
   187 	val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
   188 	val its = add_id its_
   189 	val mits = map flattup2 its
   190 	val pre = check_preconds thy prls pre mits
   191 in (pI, pits: itm list, mI, mits: itm list, pre) end;
   192 
   193 
   194 (*.check if the input term is a CAScmd and return a ptree with 
   195    a _complete_ calchead.*)
   196 (* val hdt = ifo;
   197    *)
   198 fun cas_input hdt =
   199     let val (h,argl) = strip_comb hdt
   200     in case assoc (!castab, h) of
   201 	   NONE => NONE
   202 	 (*let val (pt,_) = 
   203 		   cappend_problem e_ptree [] e_istate 
   204 				   ([], e_spec) ([], e_spec, e_term)
   205 	   in (pt, (false, Pbl, e_term(*FIXXME031:'not found'*),
   206 		    [], [], e_spec)) end*)
   207 	 | SOME (spec as (dI,_,_), argl2dtss) =>
   208 	   (* val SOME (spec as (dI,_,_), argl2dtss ) = assoc (!castab, h);
   209 	    *)
   210 	   let val dtss = argl2dtss argl
   211 	       val (pI, pits, mI, mits, pre) = cas_input_ spec dtss
   212 	       val spec = (dI, pI, mI)
   213 	       val (pt,_) = 
   214 		   cappend_problem e_ptree [] (e_istate, e_ctxt) ([], e_spec) 
   215 				   ([], e_spec, hdt)
   216 	       val pt = update_spec pt [] spec
   217 	       val pt = update_pbl pt [] pits
   218 	       val pt = update_met pt [] mits
   219 	   in SOME (pt, (true, Met, hdt, mits, pre, spec):ocalhd) end
   220     end;
   221 
   222 (*lazy evaluation for (Thy_Info.get_theory "Isac")*)
   223 fun Isac _  = assoc_thy "Isac";
   224 
   225 (*re-parse itms with a new thy and prepare for checking with ori list*)
   226 fun parsitm dI (itm as (i,v,b,f, Cor ((d,ts),_)):itm) =
   227 (* val itm as (i,v,b,f, Cor ((d,ts),_)) = hd probl;
   228    *)
   229     (let val t = comp_dts (d,ts);
   230 	 val s = Print_Mode.setmp [] (Syntax.string_of_term (thy2ctxt dI)) t;
   231      (*this    ^ should raise the exn on unability of re-parsing dts*)
   232      in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
   233   | parsitm dI (itm as (i,v,b,f, Syn str)) =
   234     (let val t = (term_of o the o (parse dI)) str
   235      in (i,v,b,f, Par str) end handle _ => (i,v,b,f, Syn str))
   236   | parsitm dI (itm as (i,v,b,f, Typ str)) =
   237     (let val t = (term_of o the o (parse dI)) str
   238      in (i,v,b,f, Par str) end handle _ => (i,v,b,f, Syn str))
   239   | parsitm dI (itm as (i,v,_,f, Inc ((d,ts),_))) =
   240     (let val t = comp_dts (d,ts);
   241 	 val s = Print_Mode.setmp [] (Syntax.string_of_term (thy2ctxt dI)) t;
   242      (*this    ^ should raise the exn on unability of re-parsing dts*)
   243      in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
   244   | parsitm dI (itm as (i,v,_,f, Sup (d,ts))) =
   245     (let val t = comp_dts (d,ts);
   246 	 val s = Print_Mode.setmp [] (Syntax.string_of_term (thy2ctxt dI)) t;
   247      (*this    ^ should raise the exn on unability of re-parsing dts*)
   248      in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
   249   | parsitm dI (itm as (i,v,_,f, Mis (d,t'))) =
   250     (let val t = d $ t';
   251 	 val s = Print_Mode.setmp [] (Syntax.string_of_term (thy2ctxt dI)) t;
   252      (*this    ^ should raise the exn on unability of re-parsing dts*)
   253      in itm end handle _ => ((i,v,false,f, Syn (term2str t)):itm))
   254   | parsitm dI (itm as (i,v,_,f, Par _)) = 
   255     error ("parsitm (" ^ itm2str_ (thy2ctxt dI) itm^
   256 		 "): Par should be internal");
   257 
   258 (*separate a list to a pair of elements that do NOT satisfy the predicate,
   259  and of elements that satisfy the predicate, i.e. (false, true)*)
   260 fun filter_sep pred xs =
   261   let fun filt ab [] = ab
   262         | filt (a,b) (x :: xs) = if pred x 
   263 				 then filt (a,b@[x]) xs 
   264 				 else filt (a@[x],b) xs
   265   in filt ([],[]) xs end;
   266 fun is_Par ((_,_,_,_,Par _):itm) = true
   267   | is_Par _ = false;
   268 
   269 fun is_e_ts [] = true
   270   | is_e_ts [Const ("List.list.Nil", _)] = true
   271   | is_e_ts _ = false;
   272 
   273 (*WN.9.11.03 copied from fun appl_add (in modspec.sml)*)
   274 (* val (sel,ct) = selct;
   275    val (dI, oris, ppc, pbt, (sel, ct))=
   276        (#1 (some_spec ospec spec), oris, []:itm list,
   277 	((#ppc o get_pbt) (#2 (some_spec ospec spec))),
   278 	hd (imodel2fstr imodel));
   279    *)
   280 fun appl_add' dI oris ppc pbt (sel, ct) = 
   281     let 
   282       val ctxt = assoc_thy dI |> thy2ctxt;
   283     in case parseNEW ctxt ct of
   284 	   NONE => (0,[],false,sel, Syn ct):itm
   285 	 | SOME t => (case is_known ctxt sel oris t of
   286          ("", ori', all) =>
   287            (case is_notyet_input ctxt ppc all ori' pbt of
   288 	         ("",itm)  => itm
   289 	       | (msg,_) => error ("appl_add': " ^ msg))
   290      | (_, (i, v, _, d, ts), _) => if is_e_ts ts then
   291          (i, v, false, sel, Inc ((d, ts), (e_term, []))) else
   292          (i, v, false, sel, Sup (d, ts)))
   293     end;
   294 
   295 (*.generate preliminary itm_ from a strin (with field "#Given" etc.).*)
   296 (* val (f, str) = hd selcts;
   297    *)
   298 fun eq7 (f, d) (f', (d', _)) = f=f' andalso d=d';
   299 fun fstr2itm_ thy pbt (f, str) =
   300     let val topt = parse thy str
   301     in case topt of
   302 	   NONE => ([], false, f, Syn str)
   303 	 | SOME ct => 
   304 (* val SOME ct = parse thy str;
   305    *)
   306 	   let val (d,ts) = (split_dts o term_of) ct
   307 	       val popt = find_first (eq7 (f,d)) pbt
   308 	   in case popt of
   309 		  NONE => ([1](*??*), true(*??*), f, Sup (d,ts))
   310 		| SOME (f, (d, id)) => ([1], true, f, Cor ((d,ts), (id, ts))) 
   311 	   end
   312     end; 
   313 
   314 
   315 (*.input into empty PblObj, i.e. empty fmz+origin (unknown example).*)
   316 fun unknown_expl dI pbt selcts =
   317   let
   318     val thy = assoc_thy dI
   319     val its_ = map (fstr2itm_ thy pbt) selcts (*([1],true,"#Given",Cor (...))*)
   320     val its = add_id its_ 
   321 in (map flattup2 its): itm list end;
   322 
   323 
   324 
   325 
   326 (*WN.11.03 for input_icalhd, ~ specify_additem for Add_Given/_Find/_Relation
   327  appl_add': generate 1 item 
   328  appl_add' . is_known: parse, get data from oris (vats, all (elems if list)..)
   329  appl_add' . is_notyet_input: compare with items in model already input
   330  insert_ppc': insert this 1 item*)
   331 (* val (dI,oris,ppc,pbt,selcts) =((#1 (some_spec ospec spec)),oris,[(*!!*)],
   332 			       ((#ppc o get_pbt) (#2 (some_spec ospec spec))),
   333 			       (imodel2fstr imodel));
   334    *)
   335 fun appl_adds dI [] _ pbt selcts = unknown_expl dI pbt selcts
   336   (*already present itms in model are being overwritten*)
   337   | appl_adds dI oris ppc pbt [] = ppc
   338   | appl_adds dI oris ppc pbt (selct::ss) =
   339     (* val selct = (sel, string_of_cterm ct);
   340        *)
   341     let val itm = appl_add' dI oris ppc pbt selct;
   342     in appl_adds dI oris (insert_ppc' itm ppc) pbt ss end;
   343 (* val (dI, oris, ppc, pbt, selct::ss) = 
   344        (dI, pors, probl, ppc, map itms2fstr probl);
   345    ...vvv
   346    *)
   347 (* val (dI, oris, ppc, pbt, (selct::ss))=
   348        (#1 (some_spec ospec spec), oris, []:itm list,
   349 	((#ppc o get_pbt) (#2 (some_spec ospec spec))),(imodel2fstr imodel));
   350    val iii = appl_adds dI oris ppc pbt (selct::ss); 
   351    tracing(itms2str_ thy iii);
   352 
   353  val itm = appl_add' dI oris ppc pbt selct;
   354  val ppc = insert_ppc' itm ppc;
   355 
   356  val _::selct::ss = (selct::ss);
   357  val itm = appl_add' dI oris ppc pbt selct;
   358  val ppc = insert_ppc' itm ppc;
   359 
   360  val _::selct::ss = (selct::ss);
   361  val itm = appl_add' dI oris ppc pbt selct;
   362  val ppc = insert_ppc' itm ppc;
   363  tracing(itms2str_ thy ppc);
   364 
   365  val _::selct::ss = (selct::ss);
   366  val itm = appl_add' dI oris ppc pbt selct;
   367  val ppc = insert_ppc' itm ppc;
   368    *)
   369 
   370 
   371 fun oris2itms _ _ ([]:ori list) = ([]:itm list)
   372   | oris2itms pbt vat ((i,v,f,d,ts)::(os: ori list)) =
   373     if member op = vat v 
   374     then (i,v,true,f,Cor ((d,ts),(e_term,[])))::(oris2itms pbt vat os)
   375     else oris2itms pbt vat os;
   376 
   377 fun filter_dsc oris itm = 
   378     filter_out ((curry op= ((d_in o #5) (itm:itm))) o 
   379 		(#4:ori -> term)) oris;
   380 
   381 
   382 
   383 
   384 fun par2fstr ((_,_,_,f, Par s):itm) = (f, s)
   385   | par2fstr itm = error ("par2fstr: called with " ^
   386 			      itm2str_ (thy2ctxt' "Isac") itm);
   387 fun itms2fstr ((_,_,_,f, Cor ((d,ts),_)):itm) = (f, comp_dts'' (d,ts))
   388   | itms2fstr (_,_,_,f, Syn str) = (f, str)
   389   | itms2fstr (_,_,_,f, Typ str) = (f, str)
   390   | itms2fstr (_,_,_,f, Inc ((d,ts),_)) = (f, comp_dts'' (d,ts))
   391   | itms2fstr (_,_,_,f, Sup (d,ts)) = (f, comp_dts'' (d,ts))
   392   | itms2fstr (_,_,_,f, Mis (d,t)) = (f, term2str (d $ t))
   393   | itms2fstr (itm as (_,_,_,f, Par _)) = 
   394     error ("parsitm ("^itm2str_ (thy2ctxt' "Isac") itm ^
   395 		 "): Par should be internal");
   396 
   397 fun imodel2fstr iitems = 
   398     let fun xxx is [] = is
   399 	  | xxx is ((Given strs)::iis) = 
   400 	    xxx (is @ (map (pair "#Given") strs)) iis
   401 	  | xxx is ((Find strs)::iis) = 
   402 	    xxx (is @ (map (pair "#Find") strs)) iis
   403 	  | xxx is ((Relate strs)::iis) = 
   404 	    xxx (is @ (map (pair "#Relate") strs)) iis
   405     in xxx [] iitems end;
   406 
   407 (*.input a CAS-command via a whole calchead;
   408    dWN0602 ropped due to change of design in the front-end.*)
   409 (*since previous calc-head _only_ has changed:
   410   EITHER _1_ part of the specification OR some items in the model;
   411   the hdform is left as is except in cas_input .*)
   412 (*FIXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX___Met___XXXXXXXXXXXME.TODO.WN:11.03*)
   413 (*   val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) = 
   414        (p, "xxx", empty_model, Pbl, e_spec);
   415    val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) = 
   416        (p,"", [Given ["fixedValues [r=Arbfix]"],
   417 	       Find ["maximum A", "valuesFor [a,b]"],
   418 	       Relate ["relations [A=a*b, a/2=r*sin alpha, \
   419 		       \b/2=r*cos alpha]"]], Pbl, e_spec);   
   420    val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) = 
   421        (([],Pbl), "not used here",
   422 	[Given ["fixedValues [r=Arbfix]"],
   423 	 Find ["maximum A", "valuesFor [a,b]"(*new input*)], 
   424 	 Relate ["relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]"]], Pbl, 
   425         ("DiffApp", ["e_pblID"], ["e_metID"]));
   426    val ((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)) = ichd;
   427    *)
   428 fun input_icalhd pt (((p,_), hdf, imodel, Pbl, spec as (dI,pI,mI)):icalhd) =
   429     let val PblObj {fmz = fmz as (fmz_,_), origin = (oris, ospec, hdf'), 
   430 		    spec = sspec as (sdI,spI,smI), probl, meth,...} = 
   431 	    get_obj I pt p;
   432     in if is_casinput hdf fmz then the (cas_input (str2term hdf)) 
   433        else        (*hacked WN0602 ~~~            ~~~~~~~~~,   ..dropped !*)
   434        let val (pos_, pits, mits) = 
   435 	       if dI <> sdI
   436 	       then let val its = map (parsitm (assoc_thy dI)) probl;
   437 			val (its, trms) = filter_sep is_Par its;
   438 			val pbt = (#ppc o get_pbt) (#2(some_spec ospec sspec));
   439 		    in (Pbl, appl_adds dI oris its pbt 
   440 				       (map par2fstr trms), meth) end else
   441 	       if pI <> spI 
   442 	       then if pI = snd3 ospec then (Pbl, probl, meth) else
   443 		    let val pbt = (#ppc o get_pbt) pI
   444 			val dI' = #1 (some_spec ospec spec)
   445 			val oris = if pI = #2 ospec then oris 
   446 				   else prep_ori fmz_(assoc_thy"Isac") pbt |> #1;
   447 		    in (Pbl, appl_adds dI' oris probl pbt 
   448 				       (map itms2fstr probl), meth) end else
   449 	       if mI <> smI (*FIXME.WN0311: what if probl is incomplete?!*)
   450 	       then let val met = (#ppc o get_met) mI
   451 		        val mits = complete_metitms oris probl meth met
   452 		    in if foldl and_ (true, map #3 mits)
   453 		       then (Pbl, probl, mits) else (Met, probl, mits) 
   454 		    end else
   455 	       (Pbl, appl_adds (#1 (some_spec ospec spec)) oris [(*!!!*)]
   456 			       ((#ppc o get_pbt) (#2 (some_spec ospec spec)))
   457 			       (imodel2fstr imodel), meth);
   458 	   val pt = update_spec pt p spec;
   459        in if pos_ = Pbl
   460 	  then let val {prls,where_,...} = get_pbt (#2 (some_spec ospec spec))
   461 		   val pre =check_preconds(assoc_thy"Isac")prls where_ pits
   462 	       in (update_pbl pt p pits,
   463 		   (ocalhd_complete pits pre spec, 
   464 		    Pbl, hdf', pits, pre, spec):ocalhd) end
   465 	  else let val {prls,pre,...} = get_met (#3 (some_spec ospec spec))
   466 		   val pre = check_preconds (assoc_thy"Isac") prls pre mits
   467 	       in (update_met pt p mits,
   468 		   (ocalhd_complete mits pre spec, 
   469 		    Met, hdf', mits, pre, spec):ocalhd) end
   470        end end
   471   | input_icalhd pt ((p,_), hdf, imodel, _(*Met*), spec as (dI,pI,mI)) =
   472     error "input_icalhd Met not impl.";
   473 
   474 
   475 (***. handle an input formula .***)
   476 (*
   477 Untersuchung zur Formeleingabe (appendFormula, replaceFormla) zu einer Anregung von Alan Krempler:
   478 Welche RICHTIGEN Formeln koennen NICHT abgeleitet werden, 
   479 wenn Abteilungen nur auf gleichem Level gesucht werden ?
   480 WN.040216 
   481 
   482 Beispiele zum Equationsolver von Richard Lang aus /src/sml/kbtest/rlang.sml
   483 
   484 ------------------------------------------------------------------------------
   485 "Schalk I s.87 Bsp 52a ((5*x)/(x - 2) - x/(x+2)=4)";
   486 ------------------------------------------------------------------------------
   487 1. "5 * x / (x - 2) - x / (x + 2) = 4"
   488 ...
   489 4. "12 * x + 4 * x ^^^ 2 = 4 * (-4 + x ^^^ 2)",Subproblem["normalize", "poly"..
   490 ...
   491 4.3. "16 + 12 * x = 0", Subproblem["degree_1", "polynomial", "univariate"..
   492 ...
   493 4.3.3. "[x = -4 / 3]")), Check_elementwise "Assumptions"
   494 ...
   495 "[x = -4 / 3]"
   496 ------------------------------------------------------------------------------
   497 (1)..(6): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 4.3.n]
   498 
   499 (4.1)..(4.3): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 4.3.n]
   500 ------------------------------------------------------------------------------
   501 
   502 
   503 ------------------------------------------------------------------------------
   504 "Schalk I s.87 Bsp 55b (x/(x^^^2 - 6*x+9) - 1/(x^^^2 - 3*x) =1/x)";
   505 ------------------------------------------------------------------------------
   506 1. "x / (x ^^^ 2 - 6 * x + 9) - 1 / (x ^^^ 2 - 3 * x) = 1 / x"
   507 ...
   508 4. "(3 + (-1 * x + x ^^^ 2)) * x = 1 * (9 * x + (x ^^^ 3 + -6 * x ^^^ 2))"
   509                          Subproblem["normalize", "polynomial", "univariate"..
   510 ...
   511 4.4. "-6 * x + 5 * x ^^^ 2 = 0", Subproblem["bdv_only", "degree_2", "poly"..
   512 ...
   513 4.4.4. "[x = 0, x = 6 / 5]", Check_elementwise "Assumptions"
   514 4.4.5. "[x = 0, x = 6 / 5]"
   515 ...
   516 5. "[x = 0, x = 6 / 5]", Check_elementwise "Assumptions"
   517    "[x = 6 / 5]"
   518 ------------------------------------------------------------------------------
   519 (1)..(4): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite schiebt [Ableitung waere in 4.4.x]
   520 
   521 (4.1)..(4.4.5): keine 'richtige' Eingabe kann abgeleitet werden, die dem Ergebnis "[x = 6 / 5]" aequivalent ist [Ableitung waere in 5.]
   522 ------------------------------------------------------------------------------
   523 
   524 
   525 ------------------------------------------------------------------------------
   526 "Schalk II s.56 Bsp 73b (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))";
   527 ------------------------------------------------------------------------------
   528 1. "sqrt (x + 1) + sqrt (4 * x + 4) = sqrt (9 * x + 9)"
   529 ...
   530 6. "13 + 13 * x + -2 * sqrt ((4 + 4 * x) * (9 + 9 * x)) = 1 + x"
   531                              Subproblem["sq", "root'", "univariate", "equation"]
   532 ...
   533 6.6. "144 + 288 * x + 144 * x ^^^ 2 = 144 + x ^^^ 2 + 288 * x + 143 * x ^^^ 2"
   534                 Subproblem["normalize", "polynomial", "univariate", "equation"]
   535 ...
   536 6.6.3 "0 = 0"    Subproblem["degree_0", "polynomial", "univariate", "equation"]
   537 ...                                       Or_to_List
   538 6.6.3.2 "UniversalList"
   539 ------------------------------------------------------------------------------
   540 (1)..(6): keine 'richtige' Eingabe kann abgeleitet werden, die eine der Wurzeln auf die andere Seite verschieb [Ableitung ware in 6.6.n]
   541 
   542 (6.1)..(6.3): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 6.6.n]
   543 ------------------------------------------------------------------------------
   544 *)
   545 (*sh. comments auf 498*)
   546 
   547 fun equal a b = a=b;
   548 
   549 (*the lists contain eq-al elem-pairs at the beginning;
   550   return first list reverted (again) - ie. in order as required subsequently*)
   551 fun dropwhile' equal (f1::f2::fs) (i1::i2::is) =
   552     if equal f1 i1 then
   553 	 if equal f2 i2 then dropwhile' equal (f2::fs) (i2::is)
   554 	 else (rev (f1::f2::fs), i1::i2::is)
   555     else error "dropwhile': did not start with equal elements"
   556   | dropwhile' equal (f::fs) [i] =
   557     if equal f i then (rev (f::fs), [i])
   558     else error "dropwhile': did not start with equal elements"
   559   | dropwhile' equal [f] (i::is) =
   560     if equal f i then ([f], i::is)
   561     else error "dropwhile': did not start with equal elements";
   562 (*
   563  fun equal a b = a=b;
   564  val foder = [0,1,2,3,4,5]; val ifoder = [11,12,3,4,5];
   565  val r_foder = rev foder;  val r_ifoder = rev ifoder;
   566  dropwhile' equal r_foder r_ifoder;
   567 > vval it = ([0, 1, 2, 3], [3, 12, 11]) : int list * int list
   568 
   569  val foder = [3,4,5]; val ifoder = [11,12,3,4,5];
   570  val r_foder = rev foder;  val r_ifoder = rev ifoder;
   571  dropwhile' equal r_foder r_ifoder;
   572 > val it = ([3], [3, 12, 11]) : int list * int list
   573 
   574  val foder = [5]; val ifoder = [11,12,3,4,5];
   575  val r_foder = rev foder;  val r_ifoder = rev ifoder;
   576  dropwhile' equal r_foder r_ifoder;
   577 > val it = ([5], [5, 4, 3, 12, 11]) : int list * int list
   578 
   579  val foder = [10,11,12,13,14,15]; val ifoder = [11,12,3,4,5];
   580  val r_foder = rev foder;  val r_ifoder = rev ifoder;
   581  dropwhile' equal r_foder r_ifoder;
   582 > *** dropwhile': did not start with equal elements*)
   583 
   584 (*040214: version for concat_deriv*)
   585 fun rev_deriv' (t, r, (t', a)) = (t', sym_Thm r, (t, a));
   586 
   587 fun mk_tacis ro erls (t, r as Thm _, (t', a)) = 
   588     (Rewrite (rule2thm' r), 
   589      Rewrite' ("Isac", fst ro, erls, false, 
   590 	       rule2thm' r, t, (t', a)),
   591      (e_pos'(*to be updated before generate tacis!!!*), (Uistate, e_ctxt)))
   592   | mk_tacis ro erls (t, r as Rls_ rls, (t', a)) = 
   593     (Rewrite_Set (rule2rls' r), 
   594      Rewrite_Set' ("Isac", false, rls, t, (t', a)),
   595      (e_pos'(*to be updated before generate tacis!!!*), (Uistate, e_ctxt)));
   596 
   597 (*fo = ifo excluded already in inform*)
   598 fun concat_deriv rew_ord erls rules fo ifo =
   599     let fun derivat ([]:(term * rule * (term * term list)) list) = e_term
   600 	  | derivat dt = (#1 o #3 o last_elem) dt
   601         fun equal (_,_,(t1, _)) (_,_,(t2, _)) = t1=t2
   602 	val  fod = make_deriv (Isac"") erls rules (snd rew_ord) NONE  fo
   603 	val ifod = make_deriv (Isac"") erls rules (snd rew_ord) NONE ifo
   604     in case (fod, ifod) of
   605 	   ([], []) => if fo = ifo then (true, [])
   606 		       else (false, [])
   607 	 | (fod, []) => if derivat fod = ifo 
   608 			then (true, fod) (*ifo is normal form*)
   609 			else (false, [])
   610 	 | ([], ifod) => if fo = derivat ifod 
   611 			 then (true, ((map rev_deriv') o rev) ifod)
   612 			 else (false, [])
   613 	 | (fod, ifod) =>
   614 	   if derivat fod = derivat ifod (*common normal form found*)
   615 	   then let val (fod', rifod') = 
   616 			dropwhile' equal (rev fod) (rev ifod)
   617 		in (true, fod' @ (map rev_deriv' rifod')) end
   618 	   else (false, [])
   619     end;
   620 (*
   621  val ({rew_ord, erls, rules,...}, fo, ifo) = 
   622      (rep_rls Test_simplify, str2term "x+1+ -1*2=0", str2term "-2*1+(x+1)=0");
   623  (tracing o trtas2str) fod';
   624 > ["
   625 (x + 1 + -1 * 2 = 0, Thm ("radd_commute","?m + ?n = ?n + ?m"), (-1 * 2 + (x + 1) = 0, []))","
   626 (-1 * 2 + (x + 1) = 0, Thm ("radd_commute","?m + ?n = ?n + ?m"), (-1 * 2 + (1 + x) = 0, []))","
   627 (-1 * 2 + (1 + x) = 0, Thm ("radd_left_commute","?x + (?y + ?z) = ?y + (?x + ?z)"), (1 + (-1 * 2 + x) = 0, []))","
   628 (1 + (-1 * 2 + x) = 0, Thm ("#mult_Float ((~1,0), (0,0)) __ ((2,0), (0,0))","-1 * 2 = -2"), (1 + (-2 + x) = 0, []))"]
   629 val it = () : unit
   630  (tracing o trtas2str) (map rev_deriv' rifod');
   631 > ["
   632 (1 + (-2 + x) = 0, Thm ("sym_#mult_Float ((~2,0), (0,0)) __ ((1,0), (0,0))","-2 = -2 * 1"), (1 + (-2 * 1 + x) = 0, []))","
   633 (1 + (-2 * 1 + x) = 0, Thm ("sym_radd_left_commute","?y + (?x + ?z) = ?x + (?y + ?z)"), (-2 * 1 + (1 + x) = 0, []))","
   634 (-2 * 1 + (1 + x) = 0, Thm ("sym_radd_commute","?n + ?m = ?m + ?n"), (-2 * 1 + (x + 1) = 0, []))"]
   635 val it = () : unit
   636 *)
   637 
   638 
   639 (*.compare inform with ctree.form at current pos by nrls;
   640    if found, embed the derivation generated during comparison
   641    if not, let the mat-engine compute the next ctree.form.*)
   642 (*structure copied from complete_solve
   643   CAUTION: tacis in returned calcstate' do NOT construct resulting ptp --
   644            all_modspec etc. has to be inserted at Subproblem'*)
   645 (* val (tacis, c, ptp as (pt, pos as (p,p_))) = (tacis, ptp);
   646    val (tacis, c, ptp as (pt, pos as (p,p_))) = cs';
   647 
   648    val (tacis, c, ptp as (pt, pos as (p,p_))) = ([],[],(pt, lev_back pos));
   649    -----rec.call:
   650    val (tacis, c, ptp as (pt, pos as (p,p_))) = cs';
   651    *)
   652 fun compare_step ((tacis, c, ptp as (pt, pos as (p,p_))): calcstate') ifo =
   653     let val fo = case p_ of Frm => get_obj g_form pt p
   654 			  | Res => (fst o (get_obj g_result pt)) p
   655 			  | _ => e_term (*on PblObj is fo <> ifo*);
   656 	val {nrls,...} = get_met (get_obj g_metID pt (par_pblobj pt p))
   657 	val {rew_ord, erls, rules,...} = rep_rls nrls
   658 	val (found, der) = concat_deriv rew_ord erls rules fo ifo;
   659     in if found
   660        then let val tacis' = map (mk_tacis rew_ord erls) der;
   661 		val (c', ptp) = embed_deriv tacis' ptp;
   662 	    in ("ok", (tacis (*@ tacis'?WN050408*), c @ c', ptp)) end
   663        else 
   664 	   if pos = ([], Res) 
   665 	   then ("no derivation found", (tacis, c, ptp): calcstate') 
   666 	   else let val cs' as (tacis, c', ptp) = nxt_solve_ ptp;
   667 		    val cs' as (tacis, c'', ptp) = 
   668 			case tacis of
   669 			    ((Subproblem _, _, _)::_) => 
   670 			    let val ptp as (pt, (p,_)) = all_modspec ptp
   671 				val mI = get_obj g_metID pt p
   672 			    in nxt_solv (Apply_Method' (mI, NONE, e_istate, e_ctxt)) 
   673 					(e_istate, e_ctxt) ptp end
   674 			  | _ => cs';
   675 		in compare_step (tacis, c @ c' @ c'', ptp) ifo end
   676     end;
   677 (* tracing (trtas2str der);
   678    *)
   679 
   680 (*.handle a user-input formula, which may be a CAS-command, too.
   681 CAS-command:
   682    create a calchead, and do 1 step
   683    TOOODO.WN0602 works only for the root-problem !!!
   684 formula, which is no CAS-command:
   685    compare iform with calc-tree.form at pos by equ_nrls and all subsequent pos;
   686    collect all the tacs applied by the way.*)
   687 (*structure copied from autocalc*)
   688 (* val (cs as (_,  _, (pt, pos as (p, p_))): calcstate') = cs';
   689    val ifo = str2term ifo;
   690 
   691    val ((cs as (_, _, ptp as (pt, pos as (p, p_))): calcstate'), istr) =
   692        (cs', encode ifo);
   693    val ((cs as (_, _, ptp as (pt, pos as (p, p_)))), istr)=(cs', (encode ifo));
   694    val ((cs as (_, _, ptp as (pt, pos as (p, p_))): calcstate'), istr) =
   695        (([],[],(pt,p)), (encode ifo));
   696    *)
   697 fun inform (cs as (_, _, ptp as (pt, pos as (p, p_))): calcstate') istr =
   698     case parse (assoc_thy "Isac") istr of
   699 (* val SOME ifo = parse (assoc_thy "Isac") istr;
   700    *)
   701 	SOME ifo =>
   702 	let val ifo = term_of ifo
   703 	    val fo = case p_ of Frm => get_obj g_form pt p
   704 			      | Res => (fst o (get_obj g_result pt)) p
   705 			      | _ => #3 (get_obj g_origin pt p)
   706 	in if fo = ifo
   707 	   then ("same-formula", cs)
   708 	   (*thus ctree not cut with replaceFormula!*)
   709 	   else case cas_input ifo of
   710 (* val SOME (pt, _) = cas_input ifo;
   711    *)
   712 		    SOME (pt, _) => ("ok",([],[],(pt, (p, Met))))
   713 		  | NONE =>
   714 		    compare_step ([],[],(pt,
   715 				     (*last step re-calc in compare_step TODO*)
   716 					 lev_back pos)) ifo
   717 	end
   718       | NONE => ("syntax error in '"^istr^"'", e_calcstate');
   719 
   720 
   721 (*------------------------------------------------------------------(**)
   722 end
   723 open inform; 
   724 (**)------------------------------------------------------------------*)