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