src/Tools/isac/calcelems.sml
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 05 Oct 2010 09:01:30 +0200
branchisac-update-Isa09-2
changeset 38042 26f3832d96b2
parent 38036 02a9b2540eb7
child 38050 4c52ad406c20
permissions -rw-r--r--
repaired assoc_thy

such that assoc_thy "Rational" works.
There are related TODOs: fun theory'2thyID, ??
     1 (* elements of calculations.
     2    they are partially held in association lists as ref's for
     3    switching language levels (meta-string, object-values).
     4    in order to keep these ref's during re-evaluation of code,
     5    they are defined here at the beginning of the code.
     6    author: Walther Neuper
     7    (c) isac-team 2003
     8  
     9 use"calcelems.sml";
    10 *)
    11 
    12 val linefeed = (curry op^) "\n";
    13 type authors = string list;
    14 
    15 type cterm' = string;
    16 val empty_cterm' = "empty_cterm'";
    17 type thmID = string;
    18 type thm' = thmID * cterm';(*WN060610 deprecated in favour of thm''*)
    19 type thm'' = thmID * term;
    20 type rls' = string;
    21 (*.a 'guh'='globally unique handle' is a string unique for each element 
    22    of isac's KEStore and persistent over time
    23    (in particular under shifts within the respective hierarchy);
    24    specialty for thys: 
    25    # guh NOT resistant agains shifts from one thy to another
    26    (which is the price for Isabelle's design: thy's overwrite ids of subthy's)
    27    # requirement for matchTheory: induce guh from tac + current thy
    28    (see 'fun thy_containing_thm', 'fun thy_containing_rls' etc.)
    29    TODO: introduce to pbl, met.*) 
    30 type guh = string;
    31 val e_guh = "e_guh":guh;
    32 
    33 type xml = string;
    34 
    35 (*. eval function calling sml code during rewriting.*)
    36 type eval_fn = (string -> term -> theory -> (string * term) option);
    37 fun e_evalfn (_:'a) (_:term) (_:theory) = NONE:(string * term) option;
    38 (*. op in isa-term 'Const(op,_)' .*)
    39 type calID = string;
    40 type cal = (calID * eval_fn);
    41 (*. fun calculate_ fetches the evaluation-function via this list. *)
    42 type calcID = string;
    43 type calc = (calcID * cal);
    44 
    45 type subs' = (cterm' * cterm') list; (*16.11.00 for FE-KE*)
    46 type subst = (term * term) list; (*here for ets2str*)
    47 val e_subst = []:(term * term) list;
    48 
    49 (*TODO.WN060610 make use of "type rew_ord" total*)
    50 type rew_ord' = string;
    51 val e_rew_ord' = "e_rew_ord" : rew_ord';
    52 type rew_ord_ = subst -> Term.term * Term.term -> bool;
    53 fun dummy_ord (_:subst) (_:term,_:term) = true;
    54 val e_rew_ord_ = dummy_ord;
    55 type rew_ord = rew_ord' * rew_ord_;
    56 val e_rew_ord = dummy_ord; (* TODO.WN071231 clarify identifiers..e_rew_ordX*)
    57 val e_rew_ordX = (e_rew_ord', e_rew_ord_) : rew_ord;
    58 
    59 
    60 datatype rule = 
    61   Erule                (*.the empty rule                     .*)
    62 | Thm of (string * thm)(*.a theorem, ie (identifier, Thm.thm).*)
    63 | Calc of string *     (*.sml-code manipulating a (sub)term  .*)
    64 	  (string -> term -> theory -> (string * term) option)
    65 | Cal1 of string *     (*.sml-code applied only to whole term
    66                           or left/right-hand-side of eqality .*)
    67 	  (string -> term -> theory -> (string * term) option)
    68 | Rls_ of rls          (*.ie. rule sets may be nested.*)
    69 and scr = 
    70     EmptyScr 
    71   | Script of term (*for met*)
    72   | Rfuns of {init_state : term -> 
    73      (term *          (*the current formula: 
    74                         goes locate_gen -> next_tac via istate*)
    75       term *          (*the final formula*)
    76       rule list       (*of reverse rewrite set (#1#)*)
    77 	    list *    (*may be serveral, eg. in norm_rational*)
    78       (rule *         (*Thm (+ Thm generated from Calc) resulting in ...*)
    79        (term *        (*... rewrite with ...*)
    80 	term list))   (*... assumptions*)
    81 	  list),      (*derivation from given term to normalform
    82 		       in reverse order with sym_thm; 
    83                        (#1#) could be extracted from here #1*)
    84 
    85 	      normal_form: term -> (term * term list) option,
    86 	      locate_rule: rule list list -> term -> rule 
    87 			   -> (rule * (term * term list)) list,
    88 	      next_rule  : rule list list -> term -> rule option,
    89 	      attach_form: rule list list -> term -> term 
    90 			   -> (rule * (term * term list)) list}
    91 and rls =
    92     Erls                          (*for init e_rls*)
    93   
    94   | Rls of (*a confluent and terminating ruleset, in general         *)
    95     {id : string,          (*for trace_rewrite:=true                 *)
    96      preconds : term list, (*unused WN020820                         *)
    97      (*WN060616 for efficiency...
    98       bdvs    : false,       (*set in prep_rls for get_bdvs *)*)
    99      rew_ord  : rew_ord,   (*for rules*)
   100      erls     : rls,       (*for the conditions in rules             *)
   101      srls     : rls,       (*for evaluation of list_fns in script    *)
   102      calc     : calc list, (*for Calculate in scr, set by prep_rls   *)
   103      rules    : rule list,
   104      scr      : scr}       (*Script term: generating intermed.steps  *)
   105   | Seq of (*a sequence of rules to be tried only once               *)
   106     {id : string,          (*for trace_rewrite:=true                 *)
   107      preconds : term list, (*unused 20.8.02                          *)
   108      (*WN060616 for efficiency...
   109       bdvs    : false,       (*set in prep_rls for get_bdvs *)*)
   110      rew_ord  : rew_ord,   (*for rules                               *)
   111      erls     : rls,       (*for the conditions in rules             *)
   112      srls     : rls,       (*for evaluation of list_fns in script    *)
   113      calc     : calc list, (*for Calculate in scr, set by prep_rls   *) 
   114      rules    : rule list,
   115      scr      : scr}  (*Script term  (how to restrict type ???)*)
   116   (*Rrls call SML-code and simulate an rls
   117     difference: there is always _ONE_ redex rewritten in 1 call,
   118     thus wrap Rrls by: Rls (Rls_ ...)*)
   119   
   120   | Rrls of (* for 'reverse rewriting' by SML-functions instead Script        *)
   121     {id : string,          (* for trace_rewrite := true                       *)
   122      prepat  : (term list *(* preconds, eval with subst from pattern;  
   123                               if [HOLogic.true_const], match decides alone    *)
   124 		term )     (* pattern matched with current (sub)term          *)
   125 		   list,   (* meta-conjunction is or                          *)
   126      rew_ord  : rew_ord,   (* for rules                                       *)
   127      erls     : rls,       (* for the conditions in rules and preconds        *)
   128      calc     : calc list, (* for Calculate in scr, set automatic.in prep_rls *)
   129      scr      : scr};      (* Rfuns {...}  (how to restrict type ???)         *)
   130 (*1.8.02 ad (how to restrict type ???): scr should be usable indepentently
   131   from rls, and then contain both Script _AND_ Rfuns !!!*)
   132 
   133 fun thy2ctxt' thy' = ProofContext.init_global (theory thy');(*FIXXXME thy-ctxt*)
   134 fun thy2ctxt thy = ProofContext.init_global thy;(*FIXXXME thy-ctxt*)
   135 
   136 (*ctxt for retrieval of all thms in HOL; FIXME make this local?*)
   137 (*val ctxt_HOL = ProofContext.init_global (theory "Complex_Main");*)
   138 (*val ctxt_HOL = thy2ctxt' "Complex_Main";*)
   139 (*lazy ctxt for retrieval of all thms used in isac; FIXME make this local?*)
   140 (*fun ctxt_Isac _  = thy2ctxt' "Isac";*)
   141 fun Isac _ = ProofContext.theory_of (thy2ctxt' "Isac");
   142 
   143 val e_rule = 
   144     Thm ("refl", ProofContext.get_thm (thy2ctxt' "Complex_Main") "refl" );
   145 fun id_of_thm (Thm (id, _)) = id
   146   | id_of_thm _ = error "id_of_thm";
   147 fun thm_of_thm (Thm (_, thm)) = thm
   148   | thm_of_thm _ = error "thm_of_thm";
   149 fun rep_thm_G' (Thm (thmid, thm)) = (thmid, thm);
   150 fun eq_thmI ((thmid1 : thmID, _ : thm), (thmid2 : thmID, _ : thm)) =
   151     (strip_thy thmid1) = (strip_thy thmid2);
   152 (*version typed weaker WN100910*)
   153 fun eq_thmI' ((thmid1, _), (thmid2, _)) =
   154     (strip_thy thmid1) = (strip_thy thmid2);
   155 
   156 
   157 val string_of_thm =  Thm.get_name_hint; (*FIXME.2009*)
   158 (*check for [.] as caused by "fun assoc_thm'"*)
   159 fun string_of_thmI thm =
   160     let val ct' = (de_quote o string_of_thm) thm
   161 	val (a, b) = split_nlast (5, explode ct')
   162     in case b of 
   163 	   [" ", " ","[", ".", "]"] => implode a
   164 	 | _ => ct'
   165     end;
   166 
   167 (*.id requested for all, Rls,Seq,Rrls.*)
   168 fun id_rls Erls = "e_rls" (*WN060714 quick and dirty: recursive defs!*)
   169   | id_rls (Rls {id,...}) = id
   170   | id_rls (Seq {id,...}) = id
   171   | id_rls (Rrls {id,...}) = id;
   172 val rls2str = id_rls;
   173 fun id_rule (Thm (id, _)) = id
   174   | id_rule (Calc (id, _)) = id
   175   | id_rule (Rls_ rls) = id_rls rls;
   176 
   177 fun get_rules (Rls {rules,...}) = rules
   178   | get_rules (Seq {rules,...}) = rules
   179   | get_rules (Rrls _) = [];
   180 
   181 fun rule2str Erule = "Erule"
   182   | rule2str (Thm (str, thm)) = "Thm (\""^str^"\","^(string_of_thmI thm)^")"
   183   | rule2str (Calc (str,f))  = "Calc (\""^str^"\",fn)"
   184   | rule2str (Cal1 (str,f))  = "Cal1 (\""^str^"\",fn)"
   185   | rule2str (Rls_ rls) = "Rls_ (\""^id_rls rls^"\")";
   186 fun rule2str' Erule = "Erule"
   187   | rule2str' (Thm (str, thm)) = "Thm (\""^str^"\",\"\")"
   188   | rule2str' (Calc (str,f))  = "Calc (\""^str^"\",fn)"
   189   | rule2str' (Cal1 (str,f))  = "Cal1 (\""^str^"\",fn)"
   190   | rule2str' (Rls_ rls) = "Rls_ (\""^id_rls rls^"\")";
   191 
   192 (*WN080102 compare eq_rule ?!?*)
   193 fun eqrule (Thm (id1,_), Thm (id2,_)) = id1 = id2
   194   | eqrule (Calc (id1,_), Calc (id2,_)) = id1 = id2
   195   | eqrule (Cal1 (id1,_), Cal1 (id2,_)) = id1 = id2
   196   | eqrule (Rls_ _, Rls_ _) = false (*{id=id1}{id=id2} = id1 = id2 FIXXME*)
   197   | eqrule _ = false;
   198 
   199 
   200 type rrlsstate =      (*state for reverse rewriting*)
   201      (term *          (*the current formula: 
   202                         goes locate_gen -> next_tac via istate*)
   203       term *          (*the final formula*)
   204       rule list       (*of reverse rewrite set (#1#)*)
   205 	    list *    (*may be serveral, eg. in norm_rational*)
   206       (rule *         (*Thm (+ Thm generated from Calc) resulting in ...*)
   207        (term *        (*... rewrite with ...*)
   208 	term list))   (*... assumptions*)
   209 	  list);      (*derivation from given term to normalform
   210 		       in reverse order with sym_thm; 
   211                        (#1#) could be extracted from here #1*)
   212 val e_type = Type("empty",[]);
   213 val a_type = TFree("'a",[]);
   214 val e_term = Const("empty",e_type);
   215 val a_term = Free("empty",a_type);
   216 val e_rrlsstate = (e_term,e_term,[[e_rule]],[(e_rule,(e_term,[]))]):rrlsstate;
   217 
   218 
   219 
   220 
   221 (*22.2.02: ging auf Linux nicht (Stefan)
   222 val e_scr = Script ((term_of o the o (parse thy)) "e_script");*)
   223 val e_term = Const("empty", Type("'a", []));
   224 val e_scr = Script e_term;
   225 
   226 
   227 (*ad thm':
   228    there are two kinds of theorems ...
   229    (1) known by isabelle
   230    (2) not known, eg. calc_thm, instantiated rls
   231        the latter have a thmid "#..."
   232    and thus outside isa we ALWAYS transport both (thmid,string_of_thmI)
   233    and have a special assoc_thm / assoc_rls in this interface      *)
   234 type theory' = string; (* = domID ^".thy" *)
   235 type domID = string;   (* domID ^".thy" = theory' TODO.11.03replace by thyID*)
   236 type thyID = string;    (*WN.3.11.03 TODO: replace domID with thyID*)
   237 
   238 fun string_of_thy thy = Context.theory_name thy: theory';
   239 val theory2domID = string_of_thy;
   240 val theory2thyID = (get_thy o string_of_thy) : theory -> thyID;
   241 val theory2theory' = string_of_thy;
   242 val theory2str = string_of_thy; (*WN050903 ..most consistent naming*)
   243 val theory2str' = implode o (drop_last_n 4) o explode o string_of_thy;
   244 (*> theory2str' Isac.thy;
   245 al it = "Isac" : string
   246 *)
   247 
   248 fun thyID2theory' (thyID:thyID) =
   249     let val ss = explode thyID
   250 	val ext = implode (takelast (4, ss))
   251     in if ext = ".thy" then thyID : theory' (*disarm abuse of thyID*)
   252        else thyID ^ ".thy"
   253     end;
   254 (* thyID2theory' "Isac" (*ok*);
   255 val it = "Isac.thy" : theory'
   256  > thyID2theory' "Isac.thy" (*abuse, goes ok...*);
   257 val it = "Isac.thy" : theory'
   258 *)
   259 
   260 fun theory'2thyID (theory':theory') =
   261     let val ss = explode theory'
   262 	val ext = implode (takelast (4, ss))
   263     in if ext = ".thy" then ((implode o (drop_last_n 4)) ss) : thyID
   264        else theory' (*disarm abuse of theory'*)
   265     end;
   266 (* theory'2thyID "Isac.thy";
   267 val it = "Isac" : thyID
   268 > theory'2thyID "Isac";
   269 val it = "Isac" : thyID*)
   270 
   271 
   272 (*. WN0509 discussion:
   273 #############################################################################
   274 #   How to manage theorys in subproblems wrt. the requirement,              #
   275 #   that scripts should be re-usable ?                                      #
   276 #############################################################################
   277 
   278     eg. 'Script Solve_rat_equation' calls 'SubProblem (RatEq',..'
   279     which would not allow to 'solve (y'' = -M_b / EI, M_b)' by this script
   280     because Biegelinie.thy is subthy of RatEq.thy and thus Biegelinie.M_b 
   281     is unknown in RatEq.thy and M_b cannot be parsed into the scripts guard
   282     (see match_ags).
   283 
   284     Preliminary solution:
   285     # the thy in 'SubProblem (thy', pbl, arglist)' is not taken automatically,
   286     # instead the 'maxthy (rootthy pt) thy' is taken for each subpbl
   287     # however, a thy specified by the user in the rootpbl may lead to 
   288       errors in far-off subpbls (which are not yet reported properly !!!) 
   289       and interactively specifiying thys in subpbl is not very relevant.
   290 
   291     Other solutions possible:
   292     # always parse and type-check with theory "Isac"
   293       (rejected tue to the vague idea eg. to re-use equations for R in C etc.)
   294     # regard the subthy-relation in specifying thys of subpbls
   295     # specifically handle 'SubProblem (undefined, pbl, arglist)'
   296     # ???
   297 .*)
   298 (*WN0509 TODO "ProtoPure" ... would be more consistent 
   299   with assoc_thy <--> theory2theory' +FIXME assoc_thy "e_domID" -> Script.thy*)
   300 val e_domID = "e_domID":domID;
   301 
   302 (*the key into the hierarchy ob theory elements*)
   303 type theID = string list;
   304 val e_theID = ["e_theID"];
   305 val theID2str = strs2str;
   306 (*theID eg. is ["IsacKnowledge", "Test", "Rulesets", "ac_plus_times"]*)
   307 fun theID2thyID (theID:theID) =
   308     if length theID >= 3 then (last_elem o (drop_last_n 2)) theID : thyID
   309     else error ("theID2thyID called with "^ theID2str theID);
   310 
   311 (*the key into the hierarchy ob problems*)
   312 type pblID = string list; (* domID::...*)
   313 val e_pblID = ["e_pblID"]:pblID;
   314 val pblID2str = strs2str;
   315 
   316 (*the key into the hierarchy ob methods*)
   317 type metID = string list;
   318 val e_metID = ["e_metID"]:metID;
   319 val metID2str = strs2str;
   320 
   321 (*either theID or pblID or metID*)
   322 type kestoreID = string list;
   323 val e_kestoreID = ["e_kestoreID"];
   324 val kestoreID2str = strs2str;
   325 
   326 (*for distinction of contexts*)
   327 datatype ketype = Exp_ | Thy_ | Pbl_ | Met_;
   328 fun ketype2str Exp_ = "Exp_"
   329   | ketype2str Thy_ = "Thy_" 
   330   | ketype2str Pbl_ = "Pbl_" 
   331   | ketype2str Met_ = "Met_";
   332 fun ketype2str' Exp_ = "Example"
   333   | ketype2str' Thy_ = "Theory" 
   334   | ketype2str' Pbl_ = "Problem" 
   335   | ketype2str' Met_ = "Method";
   336 
   337 (*see 'How to manage theorys in subproblems' at 'type thyID'*)
   338 val theory'  = Unsynchronized.ref ([]:(theory' * theory) list);
   339 
   340 (*.all theories defined for Scripts, recorded in Scripts/Script.ML; 
   341    in order to distinguish them from general IsacKnowledge defined later on.*)
   342 val script_thys = Unsynchronized.ref ([] : (theory' * theory) list);
   343 
   344 
   345 (*rewrite orders, also stored in 'type met' and type 'and rls'
   346   The association list is required for 'rewrite.."rew_ord"..'
   347   WN0509 tests not well-organized: see smltest/Knowledge/termorder.sml*)
   348 val rew_ord' =
   349     Unsynchronized.ref
   350         ([]:(rew_ord' *        (*the key for the association list         *)
   351 	     (subst 	       (*the bound variables - they get high order*)
   352 	      -> (term * term) (*(t1, t2) to be compared                  *)
   353 	      -> bool))        (*if t1 <= t2 then true else false         *)
   354 		list);         (*association list                         *)
   355 rew_ord' := overwritel (!rew_ord', [("e_rew_ord", e_rew_ord),
   356 				    ("dummy_ord", dummy_ord)]);
   357 
   358 
   359 (*WN060120 a hack to get alltogether run again with minimal effort:
   360   theory' is inserted for creating thy_hierarchy; calls for assoc_rls
   361   need not be called*)
   362 val ruleset' = Unsynchronized.ref ([]:(rls' * (theory' * rls)) list);
   363 
   364 (*FIXME.040207 calclist': used by prep_rls, NOT in met*)
   365 val calclist'= Unsynchronized.ref ([]: calc list);
   366 
   367 (*.the hierarchy of thydata.*)
   368 
   369 (*.'a is for pbt | met.*)
   370 (*WN.24.4.03 -"- ... type parameters; afterwards naming inconsistent*)
   371 datatype 'a ptyp = 
   372 	 Ptyp of string *   (*element within pblID*)
   373 		 'a list *  (*several pbts with different domIDs/thy
   374 			      TODO: select by subthy (isaref.p.69)
   375 			      presently only _ONE_ elem*)
   376 		 ('a ptyp) list;   (*the children nodes*)
   377 
   378 (*.datatype for collecting thydata for hierarchy.*)
   379 (*WN060720 more consistent naming would be 'type thyelem' or 'thelem'*)
   380 (*WN0606 Htxt contains html which does not belong to the sml-kernel*)
   381 datatype thydata = Html of {guh: guh,
   382 			    coursedesign: authors,
   383 			    mathauthors: authors,
   384 			    html: string} (*html; for demos before database*)
   385 		 | Hthm of {guh: guh,
   386 			    coursedesign: authors,
   387 			    mathauthors: authors,
   388 			    thm: term}
   389 		 | Hrls of {guh: guh,
   390 			    coursedesign: authors,
   391 			    mathauthors: authors,
   392 			    (*like   vvvvvvvvvvvvv val ruleset'
   393 			     WN060711 redesign together !*)
   394 			    thy_rls: (thyID * rls)}
   395 		 | Hcal of {guh: guh,
   396 			    coursedesign: authors,
   397 			    mathauthors: authors,
   398 			    calc: calc}
   399 		 | Hord of {guh: guh,
   400 			    coursedesign: authors,
   401 			    mathauthors: authors,
   402 			    ord: (subst -> (term * term) -> bool)};
   403 val e_thydata = Html {guh="e_guh", coursedesign=[], mathauthors=[], html=""};
   404 
   405 type thehier = (thydata ptyp) list;
   406 val thehier = Unsynchronized.ref ([] : thehier);
   407 
   408 (*.an association list, gets the value once in Isac.ML.*)
   409 val isab_thm_thy = Unsynchronized.ref ([] : (thmID * (thyID * term)) list);
   410 
   411 
   412 type path = string;
   413 type filename = string;
   414 
   415 (*val xxx = fn: a b => (a,b);   ??? fun-definition ???*)
   416 local
   417     fun ii (_:term) = e_rrlsstate;
   418     fun no (_:term) = SOME (e_term,[e_term]);
   419     fun lo (_:rule list list) (_:term) (_:rule) = [(e_rule,(e_term,[e_term]))];
   420     fun ne (_:rule list list) (_:term) = SOME e_rule;
   421     fun fo (_:rule list list) (_:term) (_:term) = [(e_rule,(e_term,[e_term]))];
   422 in
   423 val e_rfuns = Rfuns {init_state=ii,normal_form=no,locate_rule=lo,
   424 		     next_rule=ne,attach_form=fo};
   425 end;
   426 
   427 val e_rls = 
   428   Rls{id = "e_rls",
   429       preconds = [], 
   430       rew_ord = ("dummy_ord", dummy_ord),
   431       erls = Erls,srls = Erls,
   432       calc = [],
   433       rules = [], scr = EmptyScr}:rls;
   434 val e_rrls = Rrls {id = "e_rrls",
   435 		   prepat = [],
   436 		   rew_ord = ("dummy_ord", dummy_ord),
   437 		   erls = Erls,
   438 		   calc = [],
   439 		   (*asm_thm=[],*)
   440 		   scr=e_rfuns}:rls;
   441 ruleset' := overwritel (!ruleset', [("e_rls",("Tools",e_rls)),
   442 				    ("e_rrls",("Tools",e_rrls))
   443 				    ]);
   444 
   445 fun rep_rls (Rls {id,preconds,rew_ord,erls,srls,calc,(*asm_thm,*)rules,scr}) =
   446   {id=id,preconds=preconds,rew_ord=rew_ord,erls=erls,srls=srls,calc=calc,
   447    (*asm_thm=asm_thm,*)rules=rules,scr=scr}
   448   | rep_rls (Seq {id,preconds,rew_ord,erls,srls,calc,(*asm_thm,*)rules,scr}) =
   449   {id=id,preconds=preconds,rew_ord=rew_ord,erls=erls,srls=srls,calc=calc,
   450    (*asm_thm=asm_thm,*)rules=rules,scr=scr}
   451   | rep_rls Erls = rep_rls e_rls
   452   | rep_rls (Rrls {id,...})  = rep_rls e_rls
   453     (*error("rep_rls doesn't take apart reverse-rewrite-rule-sets: "^id)*);
   454 (*| rep_rls (Seq {id,...})  = 
   455     error("rep_rls doesn't take apart reverse-rewrite-rule-sets: "^id);
   456 --1.7.03*)
   457 fun rep_rrls 
   458 	(Rrls {id,(*asm_thm,*) calc, erls, prepat, rew_ord, 
   459 	       scr=Rfuns
   460 		       {attach_form,init_state,locate_rule,
   461 			next_rule,normal_form}}) =
   462     {id=id,(*asm_thm=asm_thm,*) calc=calc, erls=erls, prepat=prepat, 
   463      rew_ord=rew_ord, attach_form=attach_form, init_state=init_state, 
   464      locate_rule=locate_rule, next_rule=next_rule, normal_form=normal_form}
   465   | rep_rrls (Rls {id,...}) = 
   466     error ("rep_rrls doesn't take apart (normal) rule-sets: "^id)
   467   | rep_rrls (Seq {id,...}) = 
   468     error ("rep_rrls doesn't take apart (normal) rule-sets: "^id);
   469 
   470 fun append_rls id (Rls {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   471 			rules =rs,scr=sc}) r =
   472     (Rls{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   473 	 rules = rs @ r,scr=sc}:rls)
   474   | append_rls id (Seq {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   475 			rules =rs,scr=sc}) r =
   476     (Seq{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   477 	 rules = rs @ r,scr=sc}:rls)
   478   | append_rls id (Rrls _) _ = 
   479     error ("append_rls: not for reverse-rewrite-rule-set "^id);
   480 
   481 (*. are _atomic_ rules equal ?.*)
   482 (*WN080102 compare eqrule ?!?*)
   483 fun eq_rule (Thm (thm1,_), Thm (thm2,_)) = thm1 = thm2
   484   | eq_rule (Calc (id1,_), Calc (id2,_)) = id1 = id2
   485   | eq_rule (Rls_ rls1, Rls_ rls2) = id_rls rls1 = id_rls rls2
   486   (*id_rls checks for Rls, Seq, Rrls*)
   487   | eq_rule _ = false;
   488 
   489 fun merge_rls _ Erls rls = rls
   490   | merge_rls _ rls Erls = rls
   491   | merge_rls id
   492 	(Rls {id=id1,preconds=pc1,rew_ord=ro1,erls=er1,srls=sr1,calc=ca1,
   493 	      (*asm_thm=at1,*)rules =rs1,scr=sc1}) 
   494 	(r2 as Rls {id=id2,preconds=pc2,rew_ord=ro2,erls=er2,srls=sr2,calc=ca2,
   495 	      (*asm_thm=at2,*)rules =rs2,scr=sc2}) =
   496 	(Rls {id=id,preconds=pc1 @ ((#preconds o rep_rls) r2),
   497 	      rew_ord=ro1,erls=merge_rls "" er1 er2(*er1*),
   498 	      srls=merge_rls ("merged_"^id1^"_"^((#id o rep_rls) r2)) sr1 
   499 			     ((#srls o rep_rls) r2),
   500 	      calc=ca1 @ ((#calc o rep_rls) r2),
   501 	      (*asm_thm=at1 @ ((#asm_thm o rep_rls) r2),*)
   502 	      rules = gen_union eq_rule rule2str (rs1, (#rules o rep_rls) r2),
   503 	      scr=sc1}:rls)
   504   | merge_rls id
   505 	(Seq {id=id1,preconds=pc1,rew_ord=ro1,erls=er1,srls=sr1,calc=ca1,
   506 	      (*asm_thm=at1,*)rules =rs1,scr=sc1}) 
   507 	(r2 as Seq {id=id2,preconds=pc2,rew_ord=ro2,erls=er2,srls=sr2,calc=ca2,
   508 	      (*asm_thm=at2,*)rules =rs2,scr=sc2}) =
   509 	(Seq {id=id,preconds=pc1 @ ((#preconds o rep_rls) r2),
   510 	      rew_ord=ro1,erls=merge_rls "" er1 er2(*er1*),
   511 	      srls=merge_rls ("merged_"^id1^"_"^((#id o rep_rls) r2)) sr1 
   512 			     ((#srls o rep_rls) r2),
   513 	      calc=ca1 @ ((#calc o rep_rls) r2),
   514 	      (*asm_thm=at1 @ ((#asm_thm o rep_rls) r2),*)
   515 	      rules = gen_union eq_rule rule2str (rs1, (#rules o rep_rls) r2),
   516 	      scr=sc1}:rls)
   517   | merge_rls _ _ _ = 
   518     error "merge_rls: not for reverse-rewrite-rule-sets\
   519 		\and not for mixed Rls -- Seq";
   520 fun remove_rls id (Rls {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   521 		     (*asm_thm=at,*)rules =rs,scr=sc}) r =
   522     (Rls{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   523 	 (*asm_thm=at,*)rules = gen_rems eq_rule (rs, r),
   524 	 scr=sc}:rls)
   525   | remove_rls id (Seq {id=_,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   526 		     (*asm_thm=at,*)rules =rs,scr=sc}) r =
   527     (Seq{id=id,preconds=pc,rew_ord=ro,erls=er,srls=sr,calc=ca,
   528 	 (*asm_thm=at,*)rules = gen_rems eq_rule (rs, r),
   529 	 scr=sc}:rls)
   530   | remove_rls id (Rrls _) _ = error 
   531                    ("remove_rls: not for reverse-rewrite-rule-set "^id);
   532 
   533 (*!!!> gen_rems (op=) ([1,2,3,4], [3,4,5]);
   534 val it = [1, 2] : int list*)
   535 
   536 (*elder version: migrated 3 calls in smtest to memrls
   537 fun mem_rls id rls = 
   538     case find_first ((curry op=) id) (map id_rule ((#rules o rep_rls) rls)) of
   539 	SOME _ => true | NONE => false;*)
   540 fun memrls r (Rls {rules,...}) = gen_mem eqrule (r, rules)
   541   | memrls r (Seq {rules,...}) = gen_mem eqrule (r, rules)
   542   | memrls r _ = error ("memrls: incomplete impl. r= "^(rule2str r));
   543 fun rls_get_thm rls (id: xstring) =
   544     case find_first (curry eq_rule e_rule) 
   545 		    ((#rules o rep_rls) rls) of
   546 	SOME thm => SOME thm | NONE => NONE;
   547 
   548 fun assoc' ([], key) = error ("ME_Isa: '"^key^"' not known")
   549   | assoc' ((keyi, xi) :: pairs, key) =
   550       if key = keyi then SOME xi else assoc' (pairs, key);
   551 
   552 (*100818 fun assoc_thy (thy:theory') = ((the o assoc')(!theory',thy))
   553   handle _ => error ("ME_Isa: thy '"^thy^"' not in system");*)
   554 fun assoc_thy (thy:theory') = (*FIXME100818 abolish*)
   555     (theory  thy) handle _ => error ("ME_Isa: thy '" ^ thy ^ "' not in system");
   556     
   557 (*.associate an rls-identifier with an rls; related to 'fun assoc_rls';
   558    these are NOT compatible to "fun assoc_thm'" in that they do NOT handle
   559    overlays by re-using an identifier in different thys.*)
   560 fun assoc_rls (rls:rls') = ((#2 o the o assoc')(!ruleset',rls))
   561   handle _ => error ("ME_Isa: '"^rls^"' not in system");
   562 (*fun assoc_rls (rls:rls') = ((the o assoc')(!ruleset',rls))
   563   handle _ => error ("ME_Isa: '"^rls^"' not in system");*)
   564 
   565 (*.overwrite an element in an association list and pair it with a thyID
   566    in order to create the thy_hierarchy;
   567    overwrites existing rls' even if they are defined in a different thy;
   568    this is related to assoc_rls, TODO.WN060120: assoc_rew_ord, assoc_calc;.*)
   569 (*WN060120 ...these are NOT compatible to "fun assoc_thm'" in that 
   570    they do NOT handle overlays by re-using an identifier in different thys;
   571    "thyID.rlsID" would be a good solution, if the "." would be possible
   572    in scripts...
   573    actually a hack to get alltogether run again with minimal effort*)
   574 fun insthy thy' (rls', rls) = (rls', (thy', rls));
   575 fun overwritelthy thy (al, bl:(rls' * rls) list) =
   576     let val bl' = map (insthy ((get_thy o theory2theory') thy)) bl
   577     in overwritel (al, bl') end;
   578 
   579 fun assoc_rew_ord ro = ((the o assoc') (!rew_ord',ro))
   580   handle _ => error ("ME_Isa: rew_ord '"^ro^"' not in system");
   581 (*get the string for stac from rule*)
   582 fun assoc_calc ([], key) = error ("assoc_calc: '"^ key ^"' not found")
   583   | assoc_calc ((calc, (keyi, xi)) :: pairs, key) =
   584       if key = keyi then calc else assoc_calc (pairs, key);
   585 (*only used for !calclist'...*)
   586 fun assoc1 ([], key) = error ("assoc1 (for met.calc=): '"^ key 
   587 				    ^"' not found")
   588   | assoc1 ((all as (keyi, _)) :: pairs, key) =
   589       if key = keyi then all else assoc1 (pairs, key);
   590 
   591 (*TODO.WN080102 clarify usage of type cal and type calc..*)
   592 fun calID2calcID (calID : calID) = 
   593     let fun ass [] = error ("calID2calcID: "^calID^"not in calclist'")
   594 	  | ass ((calci, (cali, eval_fn))::ids) =
   595 	    if calID = cali then calci
   596 	    else ass ids
   597     in ass (!calclist') : calcID end;
   598 
   599 fun termopt2str (SOME t) = 
   600     "SOME " ^ (Syntax.string_of_term (thy2ctxt' "Isac") t)
   601   | termopt2str NONE = "NONE";
   602 (*fun term2str t = Syntax.string_of_term (thy2ctxt' "Isac") t; Isa2002*)
   603 (*Florian1009: 'val' would ensure static lookup, i.e. only at compile time;
   604   however, dynamic lookup is required, since "Isac" is not yet built here.*)
   605 fun term2str t = Print_Mode.setmp [] (Syntax.string_of_term
   606 (ProofContext.init_global (Thy_Info.get_theory "Isac"))) t;
   607 fun terms2str ts = (strs2str o (map term2str )) ts;
   608 (*terms2str [t1,t2] = "[\"1 + 2\",\"abc\"]";*)
   609 fun terms2str' ts = (strs2str' o (map term2str )) ts;
   610 (*terms2str' [t1,t2] = "[1 + 2,abc]";*)
   611 fun terms2strs ts = (map term2str) ts;
   612 (*terms2strs [t1,t2] = ["1 + 2", "abc"];*)
   613 
   614 fun type2str typ = Syntax.string_of_typ (thy2ctxt' "Isac") typ;
   615 val string_of_typ = type2str;
   616 
   617 fun subst2str (s:subst) = 
   618     (strs2str o 
   619      (map (linefeed o pair2str o
   620 	   (apsnd term2str) o 
   621 	   (apfst term2str)))) s;
   622 fun subst2str' (s:subst) = 
   623     (strs2str' o 
   624      (map (pair2str o
   625 	   (apsnd term2str) o 
   626 	   (apfst term2str)))) s;
   627 (*> subst2str' [(str2term "bdv", str2term "x"),
   628 		(str2term "bdv_2", str2term "y")];
   629 val it = "[(bdv, x)]" : string
   630 *)
   631 val env2str = subst2str;
   632 
   633 
   634 (*recursive defs:*)
   635 fun scr2str (Script s) = "Script "^(term2str s)
   636   | scr2str (Rfuns _)  = "Rfuns";
   637 
   638 
   639 fun maxthy thy1 thy2 = if Theory.subthy (thy1, thy2) then thy2 else thy1;
   640 
   641 
   642 (*.trace internal steps of isac's rewriter*)
   643 val trace_rewrite = Unsynchronized.ref false;
   644 (*.depth of recursion in traces of the rewriter, if trace_rewrite:=true.*)
   645 val depth = Unsynchronized.ref 99999;
   646 (*.no of rewrites exceeding this int -> NO rewrite.*)
   647 (*WN060829 still unused...*)
   648 val lim_rewrite = Unsynchronized.ref 99999;
   649 (*.no of derivation-elements exceeding this int -> SOME derivation-elements.*)
   650 val lim_deriv = Unsynchronized.ref 100;
   651 (*.switch for checking guhs unique before storing a pbl or met;
   652    set true at startup (done at begin of ROOT.ML)
   653    set false for editing IsacKnowledge (done at end of ROOT.ML).*)
   654 val check_guhs_unique = Unsynchronized.ref false;
   655 
   656 
   657 datatype lrd = (*elements of a path (=loc_) into an Isabelle term*)
   658 	 L     (*go left at $*) 
   659        | R     (*go right at $*)
   660        | D;     (*go down at Abs*)
   661 type loc_ = lrd list;
   662 fun ldr2str L = "L"
   663   | ldr2str R = "R"
   664   | ldr2str D = "D";
   665 fun loc_2str (k:loc_) = (strs2str' o (map ldr2str)) k;
   666