1.1 --- a/src/Tools/isac/xmlsrc/mathml.sml Tue Oct 06 15:51:10 2015 +0200
1.2 +++ b/src/Tools/isac/xmlsrc/mathml.sml Tue Oct 06 15:56:47 2015 +0200
1.3 @@ -22,11 +22,22 @@
1.4 | dec (">"::cs) = "&"::"g"::"t"::";"::(dec cs)
1.5 | dec (c::cs) = c::(dec cs)
1.6 in (implode o dec o Symbol.explode) str:cterm' end;
1.7 +
1.8 +fun dop_leading _ [] = []
1.9 + | dop_leading c (c' :: cs) =
1.10 + if c = c' then dop_leading c cs else (c' :: cs)
1.11 +fun rm_doublets _ singled [] = singled
1.12 + | rm_doublets c singled (c' :: cs) =
1.13 + if c = c'
1.14 + then
1.15 + let val cs' = dop_leading "^" cs
1.16 + in rm_doublets c (singled @ [c']) cs' end
1.17 + else rm_doublets c (singled @ [c']) cs
1.18 fun encode (str : cterm') =
1.19 let fun enc [] = []
1.20 | enc ("^" :: cs) = "^" :: "^" :: "^" :: (enc cs)
1.21 | enc (c :: cs) = c :: (enc cs)
1.22 - in (implode o enc o Symbol.explode) str:cterm' end;
1.23 + in str |> Symbol.explode |> rm_doublets "^" [] |> enc |> implode end;
1.24
1.25 val indentation = 2;
1.26
2.1 --- a/test/Tools/isac/xmlsrc/mathml.sml Tue Oct 06 15:51:10 2015 +0200
2.2 +++ b/test/Tools/isac/xmlsrc/mathml.sml Tue Oct 06 15:56:47 2015 +0200
2.3 @@ -1,9 +1,6 @@
2.4 (* Title: tests for mathml.sml
2.5 Author: Walther Neuper 060311
2.6 (c) isac-team 2006
2.7 -
2.8 -use"../smltest/xmlsrc/mathml.sml";
2.9 -use"mathml.sml";
2.10 *)
2.11 "-----------------------------------------------------------------";
2.12 "table of contents -----------------------------------------------";
2.13 @@ -12,6 +9,8 @@
2.14 "-----------------------------------------------------------------";
2.15 "--------- encode ^^^ -> ^ ---------------------------------------";
2.16 "--------- encode < -> < and > -> > --------------------------";
2.17 +"--------- fun rm_doublets '-4 * b ^^^^^^^^^ 2 / (...' -----------";
2.18 +"--------- fun decode '-4 * b ^^^^^^^^^ 2 / (...' ----------------";
2.19 "-----------------------------------------------------------------";
2.20 "exported from struct --------------------------------------------";
2.21 "-----------------------------------------------------------------";
2.22 @@ -70,3 +69,30 @@
2.23 "exported from struct --------------------------------------------";
2.24 "-----------------------------------------------------------------";
2.25 ========== inhibit exn AK110725 ================================================*)
2.26 +
2.27 +"--------- fun rm_doublets '-4 * b ^^^^^^^^^ 2 / (...' -----------";
2.28 +"--------- fun rm_doublets '-4 * b ^^^^^^^^^ 2 / (...' -----------";
2.29 +"--------- fun rm_doublets '-4 * b ^^^^^^^^^ 2 / (...' -----------";
2.30 +val c = "^";
2.31 +val cs = ["^","^","^","d","e"];
2.32 +if rm_doublets c [] cs = Symbol.explode "^de"
2.33 +then () else error "rm_doublets '^^^de' CHANGED";
2.34 +
2.35 +val cs = ["a","b","^","^","^","d","e"];
2.36 +if rm_doublets c [] cs = Symbol.explode "ab^de"
2.37 +then () else error "rm_doublets 'ab^^^de' CHANGED";
2.38 +
2.39 +val cstr =
2.40 +"-4 * b ^^^^^^^^^ 2 / (a + b) + 4 * a ^^^^^^^^^ 2 / (a + b) -4 * b ^ 2 / (a + b) + 4 * a ^ 2 / (a + b)";
2.41 +val cs = Symbol.explode cstr;
2.42 +if rm_doublets c [] cs = Symbol.explode
2.43 + "-4 * b ^ 2 / (a + b) + 4 * a ^ 2 / (a + b) -4 * b ^ 2 / (a + b) + 4 * a ^ 2 / (a + b)"
2.44 +then () else error "rm_doublets '-4 * b ^^^^^..' CHANGED";
2.45 +
2.46 +"--------- fun decode '-4 * b ^^^^^^^^^ 2 / (...' ----------------";
2.47 +"--------- fun decode '-4 * b ^^^^^^^^^ 2 / (...' ----------------";
2.48 +"--------- fun decode '-4 * b ^^^^^^^^^ 2 / (...' ----------------";
2.49 +if encode cstr =
2.50 +"-4 * b ^^^ 2 / (a + b) + 4 * a ^^^ 2 / (a + b) -4 * b ^^^ 2 / (a + b) + 4 * a ^^^ 2 / (a + b)"
2.51 +then () else error "encode '-4 * b ^^^^^..' CHANGED";
2.52 +