src/Tools/isac/BridgeLibisabelle/datatypes.sml
author Walther Neuper <walther.neuper@jku.at>
Thu, 07 May 2020 14:11:03 +0200
changeset 59947 3df8a1d00a24
parent 59943 4816df44437f
child 59952 3d1c6f17edac
permissions -rw-r--r--
collect code for O_Model (+ old locations)
     1 (* convert sml-datatypes to xml for libisabelle and for kbase.
     2    authors: Walther Neuper 2003, 2016
     3    (c) due to copyright terms
     4 *)
     5 
     6 signature DATATYPES = (*TODO: redo with xml_of/to *)
     7   sig
     8     val authors2xml : int -> string -> string list -> xml
     9     val calc2xml : int -> ThyC.id * Rule_Def.calc -> xml
    10     val calcrefs2xml : int -> ThyC.id * Rule_Def.calc list -> xml
    11     val contthy2xml : int -> Thy_Present.contthy -> xml
    12     val extref2xml : int -> string -> string -> xml
    13     val filterpbl :
    14        ''a -> (''a * (Term.term * Term.term)) list -> Term.term list
    15     val formula2xml : int -> Term.term -> xml
    16     val formulae2xml : int -> Term.term list -> xml
    17     val i : int
    18     val id2xml : int -> string list -> string
    19     val ints2xml : int -> int list -> string
    20     val itm_2xml : int -> I_Model.feedback -> xml
    21     val itms2xml : int -> (int * Model_Def.variants * bool * string * I_Model.feedback) list ->
    22       string
    23     val keref2xml : int -> Specify.ketype -> Specify.kestoreID -> xml
    24     val model2xml :
    25        int -> I_Model.T -> (bool * Term.term) list -> xml
    26     val modspec2xml : int -> Ctree.ocalhd -> xml
    27     val pattern2xml :
    28        int ->
    29        (string * (Term.term * Term.term)) list -> Term.term list -> string
    30     val pos'2xml : int -> string * (int list * Pos.pos_) -> string
    31     val pos'calchead2xml : int -> Pos.pos' * Ctree.ocalhd -> xml
    32     val pos_2xml : int -> Pos.pos_ -> string
    33     val posform2xml : int -> Pos.pos' * Term.term -> xml
    34     val posformhead2xml : int -> Pos.pos' * Ctree.ptform -> string
    35     val posformheads2xml : int -> (Pos.pos' * Ctree.ptform) list -> xml
    36     val posforms2xml : int -> (Pos.pos' * Term.term) list -> xml
    37     val posterms2xml : int -> (Pos.pos' * term) list -> xml
    38     val precond2xml : int -> bool * Term.term -> xml
    39     val preconds2xml : int -> (bool * Term.term) list -> xml
    40     val rls2xml : int -> ThyC.id * Rule_Set.T -> xml
    41     val rule2xml : int -> Check_Unique.id -> Rule.rule -> xml
    42     val rules2xml : int -> Check_Unique.id -> Rule.rule list -> xml
    43     val scr2xml : int -> Program.T -> xml
    44     val spec2xml : int -> Spec.T -> xml
    45     val sub2xml : int -> Term.term * Term.term -> xml
    46     val subs2xml : int -> Subst.input -> xml
    47     val subst2xml : int -> subst -> xml
    48     val tac2xml : int -> Tactic.input -> xml
    49     val tacs2xml : int -> Tactic.input list -> xml
    50     val theref2xml : int -> ThyC.id -> string -> xstring -> string
    51     val thm''2xml : int -> thm -> xml
    52     val thmstr2xml : int -> string -> xml
    53   end
    54 
    55 (*------------------------------------------------------------------
    56 structure datatypes:DATATYPES =
    57 (*structure datatypes =*)
    58 struct
    59 ------------------------------------------------------------------*)
    60 
    61 (*** convert sml-datatypes to xml for kbase ***)
    62 (* NOTE: funs with siblings in xml_of_* are together with them in 'xml for libisabelle' *)
    63 
    64 val i = indentation;
    65 
    66 fun id2xml j ids =
    67     let fun id2x _ [] = ""
    68 	  | id2x j (s::ss) = (indt j) ^ "<STRING> " ^ s ^ " </STRING>\n" ^ 
    69 			     (id2x j ss)
    70     in (indt j) ^ "<STRINGLIST>\n" ^ 
    71        (id2x (j + indentation) ids) ^ 
    72        (indt j) ^ "</STRINGLIST>\n" end;
    73 (* writeln(id2xml 8 ["linear","univariate","equation"]);
    74         <STRINGLIST>
    75           <STRING>linear</STRING>
    76           <STRING>univariate</STRING>
    77           <STRING>equation</STRING>
    78         </STRINGLIST>*)
    79 fun calc2xml j (thyID, (scrop, (rewop, _))) =
    80     indt j ^ "<CALC>\n" ^
    81     indt (j+i) ^ "<STRING>\n" ^ scrop ^ "</STRING>\n" ^
    82     indt (j+i) ^ "<GUH>\n" ^ Thy_Write.cal2guh ("IsacKnowledge", 
    83 				      thyID) scrop  ^ "</GUH>\n" ^
    84     indt (j+i) ^ "<TERMOP>\n" ^ rewop ^ "</TERMOP>\n" ^
    85     indt j ^ "</CALC>\n";
    86 (*replace by 'fun calc2xml' as developed for thy in 0607*)
    87 fun calc2xmlOLD _ (scr_op, (isa_op, _)) =
    88     indt i ^ "<CALCULATE> (" ^ scr_op ^ ", (" ^ isa_op ^ ")) </CALCULATE>\n";
    89 fun calcs2xmlOLD _ [] = "" (*TODO replace with 'strs2xml'*)
    90   | calcs2xmlOLD j (r::rs) = calc2xmlOLD j r ^ calcs2xmlOLD j rs;
    91 
    92 (*.for creating a href for a rule within an rls's rule list;
    93    the guh points to the thy of definition of the rule, NOT of use in rls.*)
    94 fun rule2xml _ _  Rule.Erule =
    95       error "rule2xml called with 'Erule'"
    96   | rule2xml j _ (Rule.Thm (thmDeriv, _)) =
    97       indt j ^ "<RULE>\n" ^
    98       indt (j+i) ^ "<TAG> Theorem </TAG>\n" ^
    99       indt (j+i) ^ "<STRING> " ^ ThmC.cut_id thmDeriv ^ " </STRING>\n" ^
   100       indt (j+i) ^ "<GUH> " ^ 
   101         Thy_Write.thm2guh (Thy_Read.thy_containing_thm thmDeriv) (ThmC.cut_id thmDeriv) ^ " </GUH>\n" ^
   102         indt j ^ "</RULE>\n"
   103   | rule2xml _ _ (Rule.Eval (_(*termop*), _)) = ""
   104 (*FIXXXXXXXME.WN060714 in rls make Eval : calc -> rule [add scriptop!]
   105   see smltest/../datatypes.sml !
   106     indt j ^ "<RULE>\n" ^
   107     indt (j+i) ^ "<STRING> " ^ termop ^ " </STRING>\n" ^
   108     indt (j+i) ^ "<GUH> " ^ cal2guh (thy_containing_cal thyID termop) 
   109 				    termop ^ " </GUH>\n" ^
   110     indt j ^ "</RULE>\n"
   111 *)
   112   | rule2xml _ _ (Rule.Cal1 (_(*termop*), _)) = ""
   113   | rule2xml j thyID (Rule.Rls_ rls) =
   114       let val rls' = (#id o Rule_Set.rep) rls
   115       in
   116         indt j ^ "<RULE>\n" ^
   117         indt (j+i) ^ "<TAG> Ruleset </TAG>\n" ^
   118         indt (j+i) ^ "<STRING> " ^ rls' ^ " </STRING>\n" ^
   119         indt (j+i) ^ "<GUH> " ^ Thy_Write.rls2guh (Thy_Read.thy_containing_rls thyID rls') rls' ^ " </GUH>\n" ^
   120         indt j ^ "</RULE>\n"
   121       end;
   122 fun rules2xml _ _ [] = ""
   123   | rules2xml j thyID (r::rs) = rule2xml j thyID r ^ rules2xml j thyID rs;
   124 
   125 fun filterpbl str =
   126   let fun filt [] = []
   127         | filt ((s, (t1, t2)) :: ps) = 
   128 	  if str = s then (t1 $ t2) :: filt ps else filt ps
   129   in filt end;
   130 fun pattern2xml j p where_ =
   131     (case filterpbl "#Given" p of
   132 	[] =>  (indt j) ^ "<GIVEN>  </GIVEN>\n"
   133 (* val gis = filterpbl "#Given" p;
   134    *)
   135       | gis => (indt j) ^ "<GIVEN>\n" ^ terms2xml' j gis ^
   136 	       (indt j) ^ "</GIVEN>\n")
   137     ^ 
   138     (case where_ of
   139 	 [] =>  (indt j) ^ "<WHERE>  </WHERE>\n"
   140        | whs => (indt j) ^ "<WHERE>\n" ^ terms2xml' j whs ^
   141 		(indt j) ^ "</WHERE>\n")
   142     ^ 
   143     (case filterpbl "#Find" p of
   144 	 [] =>  (indt j) ^ "<FIND>  </FIND>\n"
   145        | fis => (indt j) ^ "<FIND>\n" ^ terms2xml' j fis ^
   146 		(indt j) ^ "</FIND>\n")
   147     ^ 
   148     (case filterpbl "#Relate" p of
   149 	 [] =>  (indt j) ^ "<RELATE>  </RELATE>\n"
   150        | res => (indt j) ^ "<RELATE>\n" ^ terms2xml' j res ^
   151 		(indt j) ^ "</RELATE>\n");
   152 (*
   153 writeln(pattern2xml 3 ((#ppc o get_pbt)
   154 			 ["squareroot","univariate","equation","test"]) []);
   155   *)
   156 
   157 (*url to a source external to isac*)
   158 fun extref2xml j linktext url =
   159     indt j ^ "<EXTREF>\n" ^
   160     indt (j+i) ^ "<TEXT> " ^ linktext ^ " </TEXT>\n" ^
   161     indt (j+i) ^ "<URL> " ^ url ^ " </URL>\n" ^
   162     indt j ^ "</EXTREF>\n";
   163 fun theref2xml j thyID typ xstring =
   164     let val guh = Thy_Write.theID2guh ["IsacKnowledge", thyID, typ, xstring]
   165 	val typ' = (implode o (drop_last_n 1) o Symbol.explode) typ
   166     in indt j ^ "<KESTOREREF>\n" ^
   167        indt (j+i) ^ "<TAG> " ^ typ' ^ " </TAG>\n" ^
   168        indt (j+i) ^ "<ID> " ^ xstring ^ " </ID>\n" ^
   169        indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
   170        indt j ^ "</KESTOREREF>\n"
   171     end;
   172 fun keref2xml j typ kestoreID =
   173     let val id = strs2str' kestoreID
   174 	val guh = Specify.kestoreID2guh typ kestoreID
   175     in indt j ^ "<KESTOREREF>\n" ^
   176        indt (j+i) ^ "<TAG> " ^ Specify.ketype2str' typ ^ "</TAG>\n" ^
   177        indt (j+i) ^ "<ID> " ^ id ^ " </ID>\n" ^
   178        indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
   179        indt j ^ "</KESTOREREF>\n"
   180     end;
   181 fun authors2xml j str auts = 
   182     let fun autx _ [] = ""
   183 	  | autx j (s::ss) = (indt j) ^ "<STRING> " ^ s ^ " </STRING>\n" ^ 
   184 			     (autx j ss)
   185     in indt j ^ "<"^str^">\n" ^
   186        autx (j + i) auts ^ 
   187        indt j ^ "</"^str^">\n"
   188     end;
   189 (* writeln(authors2xml 2 "MATHAUTHORS" []);
   190    writeln(authors2xml 2 "MATHAUTHORS" 
   191 		       ["isac-team 2001", "Richard Lang 2003"]);
   192    *)
   193 fun scr2xml j Rule.Empty_Prog =
   194     indt j ^"<SCRIPT>  </SCRIPT>\n"
   195   | scr2xml j (Rule.Prog term) =
   196     if term = TermC.empty 
   197     then indt j ^"<SCRIPT>  </SCRIPT>\n"
   198     else indt j ^"<SCRIPT>\n"^ 
   199 	 term2xml j (TermC.inst_abs term) ^ "\n" ^
   200 	 indt j ^"</SCRIPT>\n"
   201   | scr2xml j (Rule.Rfuns _) =
   202     indt j ^"<REVERSREWRITE> reverse rewrite functions </REVERSREWRITE>\n";
   203 
   204 fun calcref2xml j (thyID, (scrop, (_(*rewop*), _))) =
   205     indt j ^ "<CALCREF>\n" ^
   206     indt (j+i) ^ "<STRING> " ^ scrop ^ "</STRING>\n" ^
   207     indt (j+i) ^ "<GUH> " ^ Thy_Write.cal2guh ("IsacKnowledge", 
   208 				      thyID) scrop  ^ " </GUH>\n" ^
   209     indt j ^ "</CALCREF>\n";
   210 fun calcrefs2xml _ (_,[]) = ""
   211   | calcrefs2xml j (thyID, cal::cs) = 
   212     calcref2xml j (thyID, cal) ^ calcrefs2xml j (thyID, cs);
   213 
   214 fun prepa12xml j (terms, term) =
   215     indt j ^"<PREPAT>\n"^
   216     indt (j+i) ^"<PRECONDS>\n"^
   217     terms2xml (j+2*i) terms ^
   218     indt (j+i) ^"</PRECONDS>\n"^
   219     indt (j+i) ^"<PATTERN>\n"^
   220     term2xml (j+2*i) term ^
   221     indt (j+i) ^"</PATTERN>\n"^
   222     indt j ^"</PREPAT>\n";
   223 fun prepat2xml _ [] = ""
   224   | prepat2xml j (p::ps) = prepa12xml j p ^ prepat2xml j ps;
   225 
   226 fun rls2xm j (thyID, seqrls, {id, preconds, rew_ord=(ord,_), erls,
   227 		      srls, calc, rules, errpatts, scr}) =
   228     indt j ^"<RULESET>\n"^
   229     indt (j+i) ^"<ID> "^ id ^" </ID>\n"^
   230     indt (j+i) ^"<TYPE> "^ seqrls ^" </TYPE>\n"^
   231     indt (j+i) ^"<RULES>\n" ^
   232     rules2xml (j+2*i) thyID rules ^
   233     indt (j+i) ^"</RULES>\n" ^
   234     indt (j+i) ^"<PRECONDS> " ^
   235     terms2xml' (j+2*i) preconds ^
   236     indt (j+i) ^"</PRECONDS>\n" ^
   237     indt (j+i) ^"<ORDER>\n" ^
   238     indt (j+2*i) ^ "<STRING> " ^ ord ^ " </STRING>\n" ^
   239 (*WN060714 thy_isac_*-ord-*.xml not yet generated ................
   240     indt (j+2*i) ^ "<GUH> " ^ ord2guh ("IsacKnowledge", 
   241 				      thyID) ord ^ " </GUH>\n" ^
   242 ..................................................................*)
   243     indt (j+i) ^"</ORDER>\n" ^
   244     indt (j+i) ^"<ERLS>\n" ^
   245     indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
   246     indt (j+2*i) ^ "<STRING> " ^ Rule_Set.id erls ^ " </STRING>\n" ^
   247     indt (j+2*i) ^ "<GUH> " ^ Thy_Write.rls2guh ("IsacKnowledge", thyID) 
   248 				     (Rule_Set.id erls) ^ " </GUH>\n" ^
   249     indt (j+i) ^"</ERLS>\n" ^
   250     indt (j+i) ^"<SRLS>\n" ^
   251     indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
   252     indt (j+2*i) ^ "<STRING> " ^ Rule_Set.id erls ^ " </STRING>\n" ^
   253     indt (j+2*i) ^ "<GUH> " ^ Thy_Write.rls2guh ("IsacKnowledge", thyID) 
   254 				     (Rule_Set.id srls) ^ " </GUH>\n" ^
   255     indt (j+i) ^"</SRLS>\n" ^
   256     calcrefs2xml (j+i) (thyID, calc) ^
   257     scr2xml (j+i) scr ^
   258     indt j ^"</RULESET>\n";
   259 fun rls2xml j (thyID, Rule_Set.Empty) = rls2xml j (thyID, Rule_Set.empty)
   260   | rls2xml j (thyID, Rule_Def.Repeat data) = rls2xm j (thyID, "Rls", data)
   261   | rls2xml j (thyID, Rule_Set.Sequence data) = rls2xm j (thyID, "Seq", data)
   262   | rls2xml j (thyID, Rule_Set.Rrls {id, prepat, rew_ord=(ord,_), erls, calc, errpatts, scr}) = 
   263     indt j ^"<RULESET>\n"^
   264     indt (j+i) ^"<ID> "^ id ^" </ID>\n"^
   265     indt (j+i) ^"<TYPE> Rrls </TYPE>\n"^
   266     prepat2xml (j+i) prepat ^
   267     indt (j+i) ^"<ORDER> " ^
   268     indt (j+2*i) ^ "<TAG> Rewrite order </TAG>\n" ^
   269     indt (j+2*i) ^ "<STRING> " ^ ord ^ " </STRING>\n" ^
   270 (*WN060714 thy_isac_*-ord-*.xml not yet generated ................
   271     indt (j+2*i) ^ "<GUH> " ^ ord2guh ("IsacKnowledge", 
   272 				      thyID) ord ^ " </GUH>\n" ^
   273 .................................................................*)
   274     indt (j+i) ^"</ORDER>\n" ^
   275     indt (j+i) ^"<ERLS> " ^
   276     indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
   277     indt (j+2*i) ^ "<STRING> " ^ Rule_Set.id erls ^ " </STRING>\n" ^
   278     indt (j+2*i) ^ "<GUH> " ^ Thy_Write.rls2guh ("IsacKnowledge", thyID) (Rule_Set.id erls) ^ " </GUH>\n" ^
   279     indt (j+i) ^"</ERLS>\n" ^
   280     calcrefs2xml (j+i) (thyID, calc) ^
   281     indt (j+i) ^"<SCRIPT>\n"^ 
   282     scr2xml (j+2*i) scr ^
   283     indt (j+i) ^" </SCRIPT>\n"^
   284     indt j ^"</RULESET>\n";
   285 
   286 (*** convert sml-datatypes to xml for libisabelle ***)
   287 
   288 (** general types: lists,  **)
   289 
   290 fun xml_of_bool b = XML.Elem (("BOOL", []), [XML.Text (bool2str b)])
   291 fun xml_to_bool (XML.Elem (("BOOL", []), [XML.Text b])) = string_to_bool b
   292   | xml_to_bool tree = raise ERROR ("xml_to_bool: wrong XML.tree \n" ^ xmlstr 0 tree)
   293 
   294 fun xml_to_ketype (XML.Elem (("KETYPE", []), [XML.Text str])) = Specify.str2ketype' str
   295   | xml_to_ketype tree = raise ERROR ("xml_to_ketype: wrong XML.tree \n" ^ xmlstr 0 tree)
   296 
   297 fun xml_of_str str = XML.Elem (("STRING", []), [XML.Text str])
   298 fun xml_of_strs strs = XML.Elem (("STRINGLIST", []), map xml_of_str strs)
   299 
   300 fun xml_to_str (XML.Elem (("STRING", []), [XML.Text str])) = str
   301   | xml_to_str tree = raise ERROR ("xml_to_str: wrong XML.tree \n" ^ xmlstr 0 tree)
   302 fun xml_to_strs (XML.Elem (("STRINGLIST", []), strs)) = map xml_to_str strs
   303   | xml_to_strs tree = raise ERROR ("xml_to_strs: wrong XML.tree \n" ^ xmlstr 0 tree)
   304 
   305 fun xml_of_int i = XML.Elem (("INT", []), [XML.Text (string_of_int i)])
   306 fun xml_of_ints is =
   307   XML.Elem (("INTLIST", []), map xml_of_int is)
   308 
   309 fun xml_to_int (XML.Elem (("INT", []), [XML.Text i])) = 
   310       (case TermC.int_opt_of_string i of SOME i => i | _ => error "xml_to_int: int_of_str \<Rightarrow> NONE")
   311   | xml_to_int tree = raise ERROR ("xml_to_int: wrong XML.tree \n" ^ xmlstr 0 tree)
   312 fun xml_to_ints (XML.Elem (("INTLIST", []), is)) = map xml_to_int is
   313   | xml_to_ints tree = raise ERROR ("xml_to_ints: wrong XML.tree \n" ^ xmlstr 0 tree)
   314 
   315 (** isac datatypes **)
   316 fun xml_of_pos tag (is, pp) =
   317   XML.Elem ((tag, []), [
   318     xml_of_ints is,
   319     XML.Elem (("POS", []), [XML.Text (Pos.pos_2str pp)])])
   320 fun xml_to_pos_ (XML.Elem (("POS", []), [XML.Text pp])) = Pos.str2pos_ pp
   321   | xml_to_pos_ tree = raise ERROR ("xml_to_pos_: wrong XML.tree \n" ^ xmlstr 0 tree)
   322 fun xml_to_pos (XML.Elem (("POSITION", []), [is, pp])) = (xml_to_ints is, xml_to_pos_ pp) (*: pos'*)
   323   | xml_to_pos tree = raise ERROR ("xml_to_pos: wrong XML.tree \n" ^ xmlstr 0 tree)
   324 
   325 fun xml_of_auto (Solve.Steps i) = 
   326       XML.Elem (("AUTO", []), [XML.Text "Step", XML.Text (string_of_int i)])
   327   | xml_of_auto CompleteModel = XML.Elem (("AUTO", []), [XML.Text "CompleteModel"])
   328   | xml_of_auto CompleteCalcHead = XML.Elem (("AUTO", []), [XML.Text "CompleteCalcHead"])
   329   | xml_of_auto CompleteToSubpbl = XML.Elem (("AUTO", []), [XML.Text "CompleteToSubpbl"])
   330   | xml_of_auto CompleteSubpbl = XML.Elem (("AUTO", []), [XML.Text "CompleteSubpbl"])
   331   | xml_of_auto CompleteCalc = XML.Elem (("AUTO", []), [XML.Text "CompleteCalc"])
   332 fun xml_to_auto (XML.Elem (("AUTO", []), [
   333       XML.Elem (("STEP", []), [XML.Text i])])) = Solve.Steps (TermC.int_opt_of_string i |> the)
   334   | xml_to_auto (XML.Elem (("AUTO", []), [XML.Text "CompleteModel"])) = Solve.CompleteModel
   335   | xml_to_auto (XML.Elem (("AUTO", []), [XML.Text "CompleteCalcHead"])) = Solve.CompleteCalcHead
   336   | xml_to_auto (XML.Elem (("AUTO", []), [XML.Text "CompleteToSubpbl"])) = Solve.CompleteToSubpbl
   337   | xml_to_auto (XML.Elem (("AUTO", []), [XML.Text "CompleteSubpbl"])) = Solve.CompleteSubpbl
   338   | xml_to_auto (XML.Elem (("AUTO", []), [XML.Text "CompleteCalc"])) = Solve.CompleteCalc
   339   | xml_to_auto tree = raise ERROR ("xml_to_auto: wrong XML.tree \n" ^ xmlstr 0 tree)
   340 
   341 fun filterpbl str =
   342   let fun filt [] = []
   343         | filt ((s, (t1, t2)) :: ps) = 
   344 	  if str = s then (t1 $ t2) :: filt ps else filt ps
   345   in filt end;
   346 
   347 fun xml_of_itm_ (I_Model.Cor (dts, _)) =
   348     XML.Elem (("ITEM", [("status", "correct")]), [xml_of_term (O_Model.comp_dts' dts)])
   349   | xml_of_itm_ (I_Model.Syn c) =
   350     XML.Elem (("ITEM", [("status", "syntaxerror")]), [XML.Text c])
   351   | xml_of_itm_ (I_Model.Typ c) =
   352     XML.Elem (("ITEM", [("status", "typeerror")]), [XML.Text c])
   353   (*type item also has 'False of cterm' set in preconds2xml WN 050618*)
   354   | xml_of_itm_ (I_Model.Inc (dts, _)) = 
   355     XML.Elem (("ITEM", [("status", "incomplete")]), [xml_of_term (O_Model.comp_dts' dts)])
   356   | xml_of_itm_ (I_Model.Sup dts) = 
   357     XML.Elem (("ITEM", [("status", "superfluous")]), [xml_of_term (O_Model.comp_dts' dts)])
   358   | xml_of_itm_ (I_Model.Mis (d, pid)) = 
   359     XML.Elem (("ITEM", [("status", "missing")]), [xml_of_term (d $ pid)])
   360   | xml_of_itm_ _ = error "xml_of_itm_: wrong argument"
   361 fun xml_of_itms itms =
   362   let 
   363     fun extract (_, _, _, _, itm_) = itm_
   364       | extract _ = error "xml_of_itms.extract: wrong argument" 
   365   in map (xml_of_itm_ o extract) itms end
   366 
   367 fun xml_of_precond (status, term) =
   368     XML.Elem (("ITEM", [("status", if status then "correct" else "false")]), [xml_of_term term])
   369 fun xml_of_preconds ps = map xml_of_precond ps
   370 
   371 fun xml_of_model itms where_ =
   372   let
   373     fun eq str (_, _, _,field, _) = str = field
   374   in 
   375     XML.Elem (("MODEL", []), [
   376       XML.Elem (("GIVEN", []), 
   377         filter (eq "#Given") itms |> xml_of_itms),
   378       XML.Elem (("WHERE", []), 
   379         xml_of_preconds where_),
   380       XML.Elem (("FIND", []), 
   381         filter (eq "#Find") itms |> xml_of_itms),
   382       XML.Elem (("RELATE", []), 
   383         filter (eq "#Relate") itms |> xml_of_itms)])
   384   end 
   385 
   386 fun xml_of_spec (thyID, pblID, metID) =
   387   XML.Elem (("SPECIFICATION", []), [
   388     XML.Elem (("THEORYID", []), [XML.Text thyID]),
   389     XML.Elem (("PROBLEMID", []), [xml_of_strs pblID]),
   390     XML.Elem (("METHODID", []), [xml_of_strs metID])])
   391 fun xml_to_spec (XML.Elem (("SPECIFICATION", []), [
   392       XML.Elem (("THEORYID", []), [XML.Text thyID]),
   393       XML.Elem (("PROBLEMID", []), [ps]),
   394       XML.Elem (("METHODID", []), [ms])])) = (thyID, xml_to_strs ps, xml_to_strs ms)
   395   | xml_to_spec tree = raise ERROR ("xml_to_spec: wrong XML.tree \n" ^ xmlstr 0 tree)
   396 
   397 fun xml_of_variant (items, spec) = 
   398   XML.Elem (("VARIANT", []), [xml_of_strs items, xml_of_spec spec])
   399 fun xml_to_variant (XML.Elem (("VARIANT", []), [items, spec])) = 
   400     (xml_to_strs items, xml_to_spec spec)
   401   | xml_to_variant tree = raise ERROR ("xml_to_variant: wrong XML.tree \n" ^ xmlstr 0 tree)
   402 
   403 fun xml_of_fmz [] = xml_of_fmz [Formalise.empty]
   404   | xml_of_fmz vs = XML.Elem (("FORMALIZATION", []), map xml_of_variant vs)
   405 fun xml_to_fmz (XML.Elem (("FORMALIZATION", []), vars)) = map xml_to_variant vars
   406   | xml_to_fmz tree = raise ERROR ("xml_to_fmz: wrong XML.tree \n" ^ xmlstr 0 tree)
   407 
   408 fun xml_of_modspec ((b, p_, head, gfr, pre, spec): Ctree.ocalhd) =
   409   XML.Elem (("CALCHEAD", [("status", if b then "correct" else "incorrect")]), [
   410     XML.Elem (("HEAD", []), [xml_of_term_NEW head]),
   411     xml_of_model gfr pre,
   412     XML.Elem (("BELONGSTO", []), [
   413       XML.Text (case p_ of Pbl => "Pbl" | Met => "Met" | _ => "Und")]),
   414     xml_of_spec spec])
   415 
   416 fun xml_of_posmodspec ((p: Pos.pos', (b, p_, head, gfr, pre, spec): Ctree.ocalhd)) =
   417   XML.Elem (("CALCHEAD", [("status", if b then "correct" else "incorrect")]), [
   418     xml_of_pos "POSITION" p,
   419     XML.Elem (("HEAD", []), [xml_of_term_NEW head]),
   420     xml_of_model gfr pre,
   421     XML.Elem (("BELONGSTO", []), [
   422       XML.Text (case p_ of Pbl => "Pbl" | Met => "Met" | _ => "Und")]),
   423     xml_of_spec spec])
   424 fun xml_to_imodel
   425     (XML.Elem (("IMODEL", []), [
   426       XML.Elem (("GIVEN", []), givens),
   427       (*XML.Elem (("WHERE", []), wheres),  ... Where is never input*)
   428       XML.Elem (("FIND", []), finds),
   429       XML.Elem (("RELATE", []), relates)])) =
   430     ([In_Chead.Given (map xml_to_cterm givens), 
   431       In_Chead.Find (map xml_to_cterm finds), 
   432       In_Chead.Relate (map xml_to_cterm relates)]) : In_Chead.imodel
   433   | xml_to_imodel x = raise ERROR ("xml_to_imodel: WRONG arg = " ^ xmlstr 0 x)
   434 fun xml_to_icalhd
   435     (XML.Elem ((         "ICALCHEAD", []), [
   436       pos as XML.Elem ((   "POSITION", []), _),
   437       XML.Elem ((          "HEAD", []), [form]),
   438       imodel as XML.Elem (("MATHML", []), _), (* TODO WN150813 ?!?*)
   439       XML.Elem ((          "POS", []), [XML.Text belongsto]),
   440       spec as XML.Elem ((  "SPECIFICATION", []), _)])) =
   441     (xml_to_pos pos, xml_to_term_NEW form |> UnparseC.term, xml_to_imodel imodel, 
   442     Pos.str2pos_ belongsto, xml_to_spec spec) : In_Chead.icalhd
   443   | xml_to_icalhd x = raise ERROR ("xml_to_icalhd: WRONG arg = " ^ xmlstr 0 x)
   444 
   445 fun xml_of_sub (id, value) =
   446   XML.Elem (("PAIR", []), [
   447     XML.Elem (("VARIABLE", []), [xml_of_term id]),
   448     XML.Elem (("VALUE", []), [xml_of_term value])])
   449 fun xml_to_sub
   450     (XML.Elem (("PAIR", []), [
   451       XML.Elem (("VARIABLE", []), [id]),
   452       XML.Elem (("VALUE", []), [value])])) = (xml_to_term id, xml_to_term value)
   453   | xml_to_sub x = raise ERROR ("xml_to_sub wrong arg: " ^ xmlstr 0 x)
   454 fun xml_of_subs (subs : Subst.input) =
   455   XML.Elem (("SUBSTITUTION", []), map xml_of_sub (Subst.T_from_input (ThyC.get_theory "Isac_Knowledge") subs))
   456 fun xml_to_subs
   457     (XML.Elem (("SUBSTITUTION", []), 
   458       subs)) = Subst.T_to_input (map xml_to_sub subs)
   459   | xml_to_subs x = raise ERROR ("xml_to_subs wrong arg: " ^ xmlstr 0 x)
   460 fun xml_of_sube sube =
   461   XML.Elem (("SUBSTITUTION", []), map xml_of_sub (Subst.T_from_string_eqs (ThyC.get_theory "Isac_Knowledge") sube))
   462 fun xml_to_sube
   463     (XML.Elem (("SUBSTITUTION", []), 
   464       xml_var_val_pairs)) = Subst.T_to_string_eqs (map xml_to_sub xml_var_val_pairs)
   465   | xml_to_sube x = raise ERROR ("xml_to_sube wrong arg: " ^ xmlstr 0 x)
   466 
   467 fun thm''2xml j (thm : thm) =
   468     indt j ^ "<THEOREM>\n" ^
   469     indt (j+i) ^ "<ID> " ^ ThmC.id_of_thm thm ^ " </ID>\n"^
   470     term2xml j (Thm.prop_of thm) ^ "\n" ^
   471     indt j ^ "</THEOREM>\n";
   472 fun xml_of_thm' (ID, form) =
   473   XML.Elem (("THEOREM", []), [
   474     XML.Elem (("ID", []), [XML.Text ID]),
   475     XML.Elem (("FORMULA", []), [
   476       XML.Text form])])           (* repair for MathML: use term instead String *)
   477 (* at the front-end theorems can be shown by their term, so term is transported isac-java <--- ME *)
   478 fun xml_of_thm'' (ID, thm) =
   479 (*---xml_of_thm''------------------------------------------thm'_to_thm''--------------
   480   XML.Elem (("THEOREM", []), [
   481     XML.Elem (("ID", []), [XML.Text ID]),
   482     xml_of_term_NEW term])
   483 -----xml_of_thm''------------------------------------------thm'_to_thm''------------*)
   484   XML.Elem (("THEOREM", []), [
   485     XML.Elem (("ID", []), [XML.Text ID]),
   486     XML.Elem (("FORMULA", []), [
   487       XML.Text ((UnparseC.term o Thm.prop_of) thm)])])           (* repair for MathML: use term instead String *)
   488 
   489 fun xml_to_thm'
   490     (XML.Elem (("THEOREM", []), [
   491       XML.Elem (("ID", []), [XML.Text ID]),
   492       XML.Elem (("FORMULA", []), [XML.Text "NO_ad_hoc_thm_FROM_FRONTEND = True"])])) =
   493     (ID, "NO_ad_hoc_thm_FROM_GUI = True")
   494   | xml_to_thm' x = raise ERROR ("xml_of_thm' wrong arg:\n" ^ xmlstr 0 x)
   495 (* at the front-end theorems are identified only by their name, so NO isac-java \<longrightarrow> ME *)
   496 fun xml_to_thm''
   497 (*---xml_of_thm''------------------------------------------thm'_to_thm''--------------
   498     (XML.Elem (("THEOREM", []), [
   499       XML.Elem (("ID", []), [XML.Text ID]),
   500       xterm])) =
   501     (ID, xml_to_term_NEW xterm) : thm''
   502   | xml_to_thm'' x = raise ERROR ("xml_to_thm'' wrong arg:\n" ^ xmlstr 0 x)
   503 -----xml_of_thm''------------------------------------------thm'_to_thm''------------*)
   504     (XML.Elem (("THEOREM", []), [
   505       XML.Elem (("ID", []), [XML.Text ID]),
   506       XML.Elem (("FORMULA", []), [
   507         XML.Text term])])) = (ID, ThmC.thm_from_thy (ThyC.Isac ()) ID)
   508   | xml_to_thm'' x = raise ERROR ("xml_of_thm' wrong arg:" ^ xmlstr 0 x)
   509 
   510 fun xml_of_src Rule.Empty_Prog =
   511     XML.Elem (("NOCODE", []), [XML.Text "empty"])
   512   | xml_of_src (Rule.Prog term) =
   513     XML.Elem (("CODE", []), [
   514       if term = TermC.empty then xml_of_src Rule.Empty_Prog
   515       else xml_of_term (TermC.inst_abs term)])
   516   | xml_of_src (Rule.Rfuns _) =
   517     XML.Elem (("NOCODE", []), [XML.Text "reverse rewrite functions"])
   518 
   519 (*.convert a tactic into xml-format .*)
   520 fun xml_of_tac (Tactic.Subproblem (dI, pI)) =
   521     XML.Elem (("SUBPROBLEMTACTIC", [("name", "Subproblem")]), [
   522       XML.Elem (("THEORY", []), [XML.Text dI]),
   523       XML.Elem (("PROBLEM", []), [xml_of_strs pI])])
   524   | xml_of_tac (Tactic.Substitute cterms) =
   525     (*Substitute: sube -> tac; Subst.string_eqs_empty: cterm' list; UNCLEAR HOW TO INPUT ON FRONTEND*)
   526     XML.Elem (("STRINGLISTTACTIC", [("name", "Substitute")]), [xml_of_sube cterms])
   527     (*----- Rewrite* -----------------------------------------------------*)
   528   | xml_of_tac (Tactic.Rewrite thm'') =
   529     XML.Elem (("REWRITETACTIC", [("name", "Rewrite")]), [xml_of_thm'' thm''])
   530   | xml_of_tac (Tactic.Rewrite_Inst (subs, thm'')) =
   531     XML.Elem (("REWRITEINSTTACTIC", [("name", "Rewrite_Inst")]), (
   532       xml_of_subs subs ::
   533       xml_of_thm'' thm'' :: []))
   534   | xml_of_tac (Tactic.Rewrite_Set rls') =
   535     XML.Elem (("REWRITESETTACTIC", [("name", "Rewrite_Set")]), [XML.Text rls'])
   536   | xml_of_tac (Tactic.Rewrite_Set_Inst (subs, rls')) =
   537     XML.Elem (("REWRITESETINSTTACTIC", [("name", "Rewrite_Set_Inst")]), ([
   538       xml_of_subs subs,
   539       XML.Elem (("RULESET", []), [XML.Text rls'])]))
   540     (*----- FORMTACTIC ---------------------------------------------------*)
   541   | xml_of_tac (Tactic.Add_Find ct) =
   542     XML.Elem (("FORMTACTIC", [("name", "Add_Find")]), [xml_of_cterm ct])
   543   | xml_of_tac (Tactic.Add_Given ct) =
   544     XML.Elem (("FORMTACTIC", [("name", "Add_Given")]), [xml_of_cterm ct])
   545   | xml_of_tac (Tactic.Add_Relation ct) =
   546     XML.Elem (("FORMTACTIC", [("name", "Add_Relation")]), [xml_of_cterm ct])
   547   | xml_of_tac (Tactic.Check_elementwise ct) =
   548     XML.Elem (("FORMTACTIC", [("name", "Check_elementwise")]), [xml_of_cterm ct])
   549   | xml_of_tac (Tactic.Take ct) =
   550     XML.Elem (("FORMTACTIC", [("name", "Take")]), [xml_of_cterm ct])
   551     (*----- SIMPLETACTIC -------------------------------------------------*)
   552   | xml_of_tac (Tactic.Calculate opstr) =
   553     XML.Elem (("SIMPLETACTIC", [("name", "Calculate")]), [XML.Text opstr])
   554   | xml_of_tac (Tactic.Or_to_List) =
   555     XML.Elem (("SIMPLETACTIC", [("name", "Or_to_List")]), [(*//////////*)])
   556   | xml_of_tac (Tactic.Specify_Theory ct) =
   557     XML.Elem (("SIMPLETACTIC", [("name", "Specify_Theory")]), [XML.Text ct])
   558     (*----- STRINGLISTTACTIC ---------------------------------------------*)
   559   | xml_of_tac (Tactic.Apply_Method mI) =
   560     XML.Elem (("STRINGLISTTACTIC", [("name", "Apply_Method")]), [xml_of_strs mI])
   561   | xml_of_tac (Tactic.Check_Postcond pI) =
   562     XML.Elem (("STRINGLISTTACTIC", [("name", "Check_Postcond")]), [xml_of_strs pI])
   563   | xml_of_tac Model_Problem =
   564     XML.Elem (("STRINGLISTTACTIC", [("name", "Model_Problem")]), [])
   565   | xml_of_tac (Tactic.Refine_Tacitly pI) =
   566     XML.Elem (("STRINGLISTTACTIC", [("name", "Refine_Tacitly")]), [xml_of_strs pI])
   567   | xml_of_tac (Tactic.Specify_Method ct) =
   568     XML.Elem (("STRINGLISTTACTIC", [("name", "Specify_Method")]), [xml_of_strs ct])
   569   | xml_of_tac (Tactic.Specify_Problem ct) =
   570     XML.Elem (("STRINGLISTTACTIC", [("name", "Specify_Problem")]), [xml_of_strs ct])
   571   | xml_of_tac tac = raise ERROR ("xml_of_tac: not impl. for " ^ Tactic.input_to_string tac);
   572 
   573 fun xml_to_tac 
   574     (XML.Elem (("SUBPROBLEMTACTIC", [("name", "Subproblem")]), [
   575       XML.Elem (("THEORY", []), [XML.Text dI]),
   576       XML.Elem (("PROBLEM", []), [pI])])) = Tactic.Subproblem (dI, xml_to_strs pI)
   577   | xml_to_tac
   578     (*Substitute: sube -> tac; Subst.string_eqs_empty: cterm' list; UNCLEAR HOW TO INPUT ON FRONTEND*)
   579     (XML.Elem (("STRINGLISTTACTIC", [
   580       ("name", "Substitute")]), [cterms])) = Tactic.Substitute (xml_to_sube cterms)
   581     (*----- Rewrite* -----------------------------------------------------*)
   582   | xml_to_tac
   583     (XML.Elem (("REWRITETACTIC", [
   584       ("name", "Rewrite")]), [thm])) = Tactic.Rewrite (xml_to_thm'' thm)
   585   | xml_to_tac
   586     (XML.Elem (("REWRITEINSTTACTIC", [
   587       ("name", "Rewrite_Inst")]), [
   588         subs, thm])) = Tactic.Rewrite_Inst (xml_to_subs subs, xml_to_thm'' thm)
   589   | xml_to_tac
   590     (XML.Elem (("REWRITESETTACTIC", [
   591       ("name", "Rewrite_Set")]), [XML.Text rls'])) = Tactic.Rewrite_Set (rls')
   592   | xml_to_tac
   593     (XML.Elem (("REWRITESETINSTTACTIC", [
   594       ("name", "Rewrite_Set_Inst")]), [
   595         subs,
   596         XML.Elem (("RULESET", []), [XML.Text rls'])])) = Tactic.Rewrite_Set_Inst (xml_to_subs subs, rls')
   597     (*----- FORMTACTIC ---------------------------------------------------*)
   598   | xml_to_tac
   599     (XML.Elem (("FORMTACTIC", [
   600       ("name", "Add_Find")]), [ct])) =  Tactic.Add_Find (xml_to_cterm ct)
   601   | xml_to_tac
   602     (XML.Elem (("FORMTACTIC", [
   603       ("name", "Add_Given")]), [ct])) = Tactic.Add_Given (xml_to_cterm ct)
   604   | xml_to_tac
   605     (XML.Elem (("FORMTACTIC", [
   606       ("name", "Add_Relation")]), [ct])) = Tactic.Add_Relation (xml_to_cterm ct)
   607   | xml_to_tac
   608     (XML.Elem (("FORMTACTIC", [
   609       ("name", "Take")]), [ct])) = Tactic.Take (xml_to_cterm ct)
   610   | xml_to_tac
   611     (XML.Elem (("FORMTACTIC", [
   612       ("name", "Check_elementwise")]), [ct])) = Tactic.Check_elementwise (xml_to_cterm ct)
   613     (*----- SIMPLETACTIC -------------------------------------------------*)
   614   | xml_to_tac
   615     (XML.Elem (("SIMPLETACTIC", [
   616       ("name", "Calculate")]), [XML.Text opstr])) = Tactic.Calculate opstr
   617   | xml_to_tac
   618     (XML.Elem (("SIMPLETACTIC", [("name", "Or_to_List")]), [])) = Tactic.Or_to_List
   619   | xml_to_tac
   620     (XML.Elem (("SIMPLETACTIC", [
   621       ("name", "Specify_Theory")]), [XML.Text ct])) = Tactic.Specify_Theory ct
   622     (*----- STRINGLISTTACTIC ---------------------------------------------*)
   623   | xml_to_tac
   624     (XML.Elem (("STRINGLISTTACTIC", [
   625       ("name", "Apply_Method")]), [mI])) = Tactic.Apply_Method (xml_to_strs  mI)
   626   | xml_to_tac
   627     (XML.Elem (("STRINGLISTTACTIC", [
   628       ("name", "Check_Postcond")]), [pI])) = Tactic.Check_Postcond (xml_to_strs pI)
   629   | xml_to_tac
   630     (XML.Elem (("STRINGLISTTACTIC", [
   631       ("name", "Model_Problem")]), [])) = Tactic.Model_Problem 
   632   | xml_to_tac
   633     (XML.Elem (("STRINGLISTTACTIC", [
   634       ("name", "Refine_Tacitly")]), [pI])) = Tactic.Refine_Tacitly (xml_to_strs pI)
   635   | xml_to_tac
   636     (XML.Elem (("STRINGLISTTACTIC", [
   637       ("name", "Specify_Method")]), [ct])) = Tactic.Specify_Method (xml_to_strs ct)
   638   | xml_to_tac
   639     (XML.Elem (("STRINGLISTTACTIC", [
   640       ("name", "Specify_Problem")]), [ct])) = Tactic.Specify_Problem (xml_to_strs ct)
   641   | xml_to_tac x = raise ERROR ("xml_to_tac: not impl. for " ^ xmlstr 0 x);
   642 
   643 val e_pblterm = (Thm.term_of o the o (TermC.parse @{theory Prog_Tac})) 
   644 		    ("Problem (" ^ ThyC.id_empty ^ "," ^ strs2str' Problem.id_empty ^ ")");
   645 
   646 (*WN051224 minimal adaption to exporting Formulae _only_ by getFormulaeFromTo*)
   647 fun xml_of_posterm (p, t, _) =
   648   let val input_request = Free ("________________________________________________", dummyT)
   649   in 
   650     XML.Elem (("CALCFORMULA", []),
   651       [xml_of_pos "POSITION" p,
   652        if t = e_pblterm (*headline in pbl is e_ <- _root_pbl for CAS-command*)
   653        then xml_of_term_NEW input_request
   654        else xml_of_term_NEW t])
   655   end
   656 
   657 fun xml_of_asm_val (asm, vl) =
   658   XML.Elem (("ASMEVALUATED", []),[
   659     XML.Elem (("ASM", []), [xml_of_term asm]),
   660     XML.Elem (("VALUE", []), [xml_of_term vl])])
   661 
   662 (*.a reference to an element in the theory hierarchy; 
   663    compare 'fun keref2xml'.*)
   664 (* val (j, thyID, typ, xstring) = 
   665        (i+i, snd (thy_containing_rls thy' prls'), "Rulesets", prls');
   666    *)
   667 fun theref2xml j thyID typ xstring =
   668     let val guh = Thy_Write.theID2guh ["IsacKnowledge", thyID, typ, xstring]
   669 	val typ' = (implode o (drop_last_n 1) o Symbol.explode) typ
   670     in indt j ^ "<KESTOREREF>\n" ^
   671        indt (j+i) ^ "<TAG> " ^ typ' ^ " </TAG>\n" ^
   672        indt (j+i) ^ "<ID> " ^ xstring ^ " </ID>\n" ^
   673        indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
   674        indt j ^ "</KESTOREREF>\n"
   675     end;
   676 fun xml_of_theref thyid typ xstring =
   677   let 
   678     val guh = Thy_Write.theID2guh ["IsacKnowledge", thyid, typ, xstring]
   679     val typ' = (implode o (drop_last_n 1) o Symbol.explode) typ
   680   in 
   681     XML.Elem (("KESTOREREF", []),[
   682       XML.Elem (("TAG", []), [XML.Text typ']),
   683       XML.Elem (("ID", []), [XML.Text xstring]),
   684       XML.Elem (("GUH", []), [XML.Text guh])])
   685   end
   686 
   687 fun xml_of_contthy Thy_Present.EContThy =
   688     error "contthy2xml called with EContThy"
   689 
   690   | xml_of_contthy (Thy_Present.ContThm {thyID, thm, applto, applat, reword, 
   691 				asms,lhs, rhs, result, resasms, asmrls}) =
   692     XML.Elem (("CONTEXTDATA", []), [
   693       XML.Elem (("GUH", []), [XML.Text thm]),
   694       XML.Elem (("APPLTO", []), [xml_of_term applto]),
   695       XML.Elem (("APPLAT", []), [xml_of_term applat]),
   696       XML.Elem (("ORDER", []), [ (* should be a theref2xml *)
   697         XML.Elem (("ID", []), [XML.Text reword])]),
   698       XML.Elem (("ASMSEVAL", []), map xml_of_asm_val asms),
   699       XML.Elem (("LHS", []), [xml_of_term (fst lhs)]),
   700       XML.Elem (("LHSINST", []), [xml_of_term (snd lhs)]),
   701       XML.Elem (("RHS", []), [xml_of_term (fst rhs)]),
   702       XML.Elem (("RHSINST", []), [xml_of_term (snd rhs)]),
   703       XML.Elem (("RESULT", []), [xml_of_term result]),
   704       XML.Elem (("ASSUMPTIONS", []), map xml_of_term resasms),
   705       XML.Elem (("EVALRLS", []), [xml_of_theref thyID "Rulesets" asmrls])])
   706 
   707   | xml_of_contthy (Thy_Present.ContThmInst {thyID, thm, bdvs, thminst, applto, applat, 
   708 				reword, asms, lhs, rhs, result, resasms, asmrls}) =
   709     XML.Elem (("CONTEXTDATA", []), [
   710       XML.Elem (("GUH", []), [XML.Text thm]),
   711       XML.Elem (("SUBSLIST", []), [ (* should be an environment = substitution *)
   712         xml_of_cterm (Env.subst2str' bdvs)]),
   713       XML.Elem (("INSTANTIATED", []), [xml_of_term thminst]),
   714       XML.Elem (("APPLTO", []), [xml_of_term applto]),
   715       XML.Elem (("APPLAT", []), [xml_of_term applat]),
   716       XML.Elem (("ORDER", []), [ (* should be a theref2xml *)
   717         XML.Elem (("ID", []), [XML.Text reword])]),
   718       XML.Elem (("ASMSEVAL", []), map xml_of_asm_val asms),
   719       XML.Elem (("LHS", []), [xml_of_term (fst lhs)]),
   720       XML.Elem (("LHSINST", []), [xml_of_term (snd lhs)]),
   721       XML.Elem (("RHS", []), [xml_of_term (fst rhs)]),
   722       XML.Elem (("RHSINST", []), [xml_of_term (snd rhs)]),
   723       XML.Elem (("RESULT", []), [xml_of_term result]),
   724       XML.Elem (("ASSUMPTIONS", []), map xml_of_term resasms),
   725       XML.Elem (("EVALRLS", []), [xml_of_theref thyID "Rulesets" asmrls])])
   726 
   727   | xml_of_contthy (Thy_Present.ContRls {thyID = _, rls, applto, result, asms}) =
   728     XML.Elem (("CONTEXTDATA", []), [
   729       XML.Elem (("GUH", []), [XML.Text rls]),
   730       XML.Elem (("APPLTO", []), [xml_of_term applto]),
   731       XML.Elem (("RESULT", []), [xml_of_term result]),
   732       XML.Elem (("ASSUMPTIONS", []), map xml_of_term asms)])
   733 
   734   | xml_of_contthy (Thy_Present.ContRlsInst {thyID = _, rls, bdvs, applto, result, asms}) =
   735     XML.Elem (("CONTEXTDATA", []), [
   736       XML.Elem (("GUH", []), [XML.Text rls]),
   737       XML.Elem (("SUBSLIST", []), [ (* should be an environment = substitution *)
   738         xml_of_cterm (Env.subst2str' bdvs)]),
   739       XML.Elem (("INSTANTIATED", []), [xml_of_cterm (Env.subst2str' bdvs)]),
   740       XML.Elem (("APPLTO", []), [xml_of_term applto]),
   741       XML.Elem (("RESULT", []), [xml_of_term result]),
   742       XML.Elem (("ASSUMPTIONS", []), map xml_of_term asms)])
   743 
   744   | xml_of_contthy (Thy_Present.ContNOrew {thyID = _, thm_rls, applto}) =
   745     XML.Elem (("CONTEXTDATA", []), [
   746       XML.Elem (("GUH", []), [XML.Text thm_rls]),
   747       XML.Elem (("APPLTO", []), [xml_of_term applto])])
   748 
   749   | xml_of_contthy (Thy_Present.ContNOrewInst{thyID = _, thm_rls, bdvs, thminst, applto}) =
   750     XML.Elem (("CONTEXTDATA", []), [
   751       XML.Elem (("GUH", []), [XML.Text thm_rls]),
   752       XML.Elem (("SUBSLIST", []), [ (* should be an environment = substitution *)
   753         xml_of_cterm (Env.subst2str' bdvs)]),
   754       XML.Elem (("INSTANTIATED", []), [xml_of_term thminst]),
   755       XML.Elem (("APPLTO", []), [xml_of_term applto])])
   756 
   757 fun xml_of_matchpbl (model_ok, pI, hdl, pbl, pre) =
   758   XML.Elem (("CONTEXTDATA", []), [
   759     XML.Elem (("GUH", []), [XML.Text (Specify.pblID2guh pI)]),
   760     XML.Elem (("STATUS", []), [
   761       XML.Text ((if model_ok then "correct" else "incorrect"))]),
   762     XML.Elem (("HEAD", []), [xml_of_term_NEW hdl]),
   763     xml_of_model pbl pre])
   764 
   765 fun xml_of_matchmet (model_ok, pI, scr, pbl, pre) =
   766   XML.Elem (("CONTEXTDATA", []), [
   767     XML.Elem (("GUH", []), [XML.Text (Specify.metID2guh pI)]),
   768     XML.Elem (("STATUS", []), [
   769       XML.Text ((if model_ok then "correct" else "incorrect"))]),
   770     XML.Elem (("PROGRAM", []), [xml_of_src scr]),
   771     xml_of_model pbl pre])
   772 
   773 fun xml_of_calcchanged calcid tag old del new =
   774   (*TODO: make analogous to xml_to_calcchanged*)
   775   XML.Elem ((tag, []),[
   776     XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
   777     XML.Elem (("CALCCHANGED", []), [
   778       xml_of_pos "UNCHANGED" old,
   779       xml_of_pos "DELETED" del,
   780       xml_of_pos "GENERATED" new])])
   781 fun xml_to_calcchanged (XML.Elem (("CALCCHANGED", []), [old, del, new])) = 
   782       (xml_to_pos old, xml_to_pos del, xml_to_pos new)
   783   | xml_to_calcchanged x = raise ERROR ("xml_to_calcchanged: WRONG arg = " ^ xmlstr 0 x)
   784 
   785 (* for checking output at Frontend *)
   786 fun cut_xml xml i = xml |> xmlstr 0 |> Symbol.explode |> curry take i |> implode
   787 (*------------------------------------------------------------------
   788 end
   789 open datatypes;
   790 ------------------------------------------------------------------*)
   791 
   792