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