Add: Xml serializer

- Xml serializer dumps ABC for swfmill.

diff --git a/src/_tags b/src/_tags
index f450202..a1ece2c 100644 (file)
--- a/src/_tags
+++ b/src/_tags
@@ -1,5 +1,5 @@
 <instruction.*>: pp(cpp -I../src)
 <asm.mli>: pp(cpp -I../src)
-<*.ml>:pkg_extlib,pkg_core,pkg_threads,debug
+<*.ml>:pkg_extlib,pkg_core,pkg_threads,pkg_xml-light,debug
 "lexer.ml" or "sexp.ml" or "parsec.ml": camlp4o
-<*.byte>:pkg_extlib,pkg_threads,pkg_core,debug
+<*.byte>:pkg_extlib,pkg_threads,pkg_core,pkg_xml-light,debug

diff --git a/src/xmlSerialize.ml b/src/xmlSerialize.ml
new file mode 100644 (file)
index 0000000..9eedc36
--- /dev/null
+++ b/src/xmlSerialize.ml
@@ -0,0 +1,52 @@
+open Base
+let element name child =
+  Xml.Element (name,[],child)
+
+let attr name attr value =
+  Xml.Element (name,[attr,value],[])
+
+let u30 =
+  attr "U30" "value"
+
+let i2s =
+  string_of_int
+
+let of_cpool {
+  Abc.int       = ints;
+  uint          = uints;
+  double        = doubles;
+  string        = strings;
+  namespace     = ns;
+  namespace_set = nss;
+  multiname     = mn;
+} =
+  element "Constants"
+    [element "ints"          @@ List.map (u30 $ i2s) ints;
+     element "uints"         @@ List.map (u30 $ i2s) uints;
+     element "doubles"       @@ List.map (u30 $ string_of_float) doubles;
+     element "strings"       @@ List.map (attr "String2" "value") strings;
+     element "namespaces"    @@ 
+       List.map (fun {Abc.ns_name=i}-> attr "Namespace" "index" @@ i2s i) ns;
+     element "namespaceSets" @@ 
+       List.map (element "NamespaceSet" $ List.map (u30 $ i2s)) nss;
+     element "multinames"    @@
+       List.map (function 
+                    Abc.QName (ns,name) ->
+                      Xml.Element ("QName",
+                                   ["namespaceIndex",i2s ns;
+                                    "nameIndex"     ,i2s name],[])
+                  | Abc.Multiname (name,nss) ->
+                      Xml.Element ("Multiname",
+                                   ["nameIndex",i2s name;
+                                    "namespaceSetIndex",i2s nss],[]))
+       mn;
+    ]
+
+(*val of_method_info : Abc.method_info -> Bytes.t list
+val of_script : Abc.script -> Bytes.t list
+val of_trait : Abc.trait -> Bytes.t list
+val of_method_body : Abc.method_body -> Bytes.t list
+
+val of_class : Abc.class_info -> Bytes.t list
+val of_instance : Abc.instance_info -> Bytes.t list
+*)

diff --git a/test/_tags b/test/_tags
index eb5ac6a..6a6e6e6 100644 (file)
--- a/test/_tags
+++ b/test/_tags
@@ -1,3 +1,3 @@
 "runner.ml":pp(cpp -I../test)
-<*.ml>:pkg_oUnit,pkg_extlib,pkg_threads,pkg_core,pp(camlp4o -I camlp4 TestCaseCollector.cmo)
-<*.byte>:pkg_oUnit,pkg_extlib,pkg_threads,pkg_core
\ No newline at end of file
+<*.ml>:pkg_oUnit,pkg_extlib,pkg_threads,pkg_core,pkg_xml-light,pp(camlp4o -I camlp4 TestCaseCollector.cmo)
+<*.byte>:pkg_oUnit,pkg_extlib,pkg_threads,pkg_core,pkg_xml-light
\ No newline at end of file

diff --git a/test/test_xmlserialize.ml b/test/test_xmlserialize.ml
new file mode 100644 (file)
index 0000000..f158de9
--- /dev/null
+++ b/test/test_xmlserialize.ml
@@ -0,0 +1,153 @@
+open Base
+open Xml
+open XmlSerialize
+
+let assert_equal lhs rhs =
+  OUnit.assert_equal ~printer:Xml.to_string_fmt lhs rhs;;
+
+let u30 n =
+  Element ("U30",["value",n],[])
+
+let u30i =
+  u30 $ string_of_int
+
+let string2 n =
+  Element ("String2",["value",n],[])
+
+test empty_cpool =
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[]);
+                 Element ("uints",[],[]);
+                 Element ("doubles",[],[]);
+                 Element ("strings",[],[]);
+                 Element ("namespaces",[],[]);
+                 Element ("namespaceSets",[],[]);
+                 Element ("multinames",[],[])])) @@
+      of_cpool Abc.empty_cpool
+
+test int =
+  assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[u30i 1;u30i 2;u30i 3]);
+                 Element ("uints",[],[]);
+                 Element ("doubles",[],[]);
+                 Element ("strings",[],[]);
+                 Element ("namespaces",[],[]);
+                 Element ("namespaceSets",[],[]);
+                 Element ("multinames",[],[])])) @@
+    of_cpool {Abc.empty_cpool  with Abc.int = [1;2;3] }
+
+test uint =
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[]);
+                 Element ("uints",[],[u30i 4;u30i 5;u30i 6]);
+                 Element ("doubles",[],[]);
+                 Element ("strings",[],[]);
+                 Element ("namespaces",[],[]);
+                 Element ("namespaceSets",[],[]);
+                 Element ("multinames",[],[])]))
+      (of_cpool { Abc.empty_cpool with Abc.uint = [4;5;6] })
+
+test doubles =
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[]);
+                 Element ("uints",[],[]);
+                 Element ("doubles",[],List.map (u30 $ string_of_float) [7.;8.;9.]);
+                 Element ("strings",[],[]);
+                 Element ("namespaces",[],[]);
+                 Element ("namespaceSets",[],[]);
+                 Element ("multinames",[],[]);])) @@
+      of_cpool {
+       Abc.empty_cpool with
+         Abc.double = [7.;8.;9.];
+      }
+
+test strings = 
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[]);
+                 Element ("uints",[],[]);
+                 Element ("doubles",[],[]);
+                 Element ("strings",[],List.map string2 ["foo";"bar";"baz"]);
+                 Element ("namespaces",[],[]);
+                 Element ("namespaceSets",[],[]);
+                 Element ("multinames",[],[]);])) @@
+      of_cpool {
+       Abc.empty_cpool with Abc.string = ["foo";"bar";"baz"];
+      }
+
+
+test namespace_cpool =
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[]);
+                 Element ("uints",[],[]);
+                 Element ("doubles",[],[]);
+                 Element ("strings",[],[]);
+                 Element ("namespaces",[],List.map 
+                            (fun i->Element ("Namespace",["index",string_of_int i],[])) [1;2]);
+                 Element ("namespaceSets",[],[]);
+                 Element ("multinames",[],[])])) @@
+      of_cpool {Abc.empty_cpool with
+                 Abc.namespace = [{Abc.kind=0;ns_name=1};{Abc.kind=0;ns_name=2}]}
+
+test namespace_set_cpool =
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[]);
+                 Element ("uints",[],[]);
+                 Element ("doubles",[],[]);
+                 Element ("strings",[],[]);
+                 Element ("namespaces",[],[]);
+                 Element ("namespaceSets",[],
+                          [Element ("NamespaceSet",[],[u30i 1;u30i 2;u30i 3])]);
+                 Element ("multinames",[],[])])) @@
+      of_cpool {Abc.empty_cpool with
+                 Abc.namespace_set = [[1;2;3]]}
+
+test multiname_cpool =
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[]);
+                 Element ("uints",[],[]);
+                 Element ("doubles",[],[]);
+                 Element ("strings",[],[]);
+                 Element ("namespaces",[],[]);
+                 Element ("namespaceSets",[],[]);
+                 Element ("multinames",[],[
+                            Element ("QName",["namespaceIndex","1";"nameIndex","2"],[]);
+                            Element ("Multiname",["nameIndex","3";"namespaceSetIndex","4"],[]);
+                          ]);])) @@
+      of_cpool {Abc.empty_cpool with
+                 Abc.multiname = [Abc.QName (1,2);Abc.Multiname (3,4)]}
+
+(*
+test int =
+    assert_equal
+      (Element ("Constants",[],[
+                 Element ("ints", [],[u30i 1;u30i 2;u30i 3]);
+                 Element ("uints",[],[u30i 4;u30i 5;u30i 6]);
+                 Element ("doubles",[],List.map (u30 $ string_of_float) [7.;8.;9.]);
+                 Element ("strings",[],List.map string2 ["foo";"bar";"baz"]);
+                 Element ("namespaces",[],List.map 
+                            (fun i->Element ("Namespace",["index",string_of_int i],[])) [1;2]);o
+                 Element ("namespaceSets",[],
+                          [Element ("namespaceSet",[],[u30i 1;u30i 2;u30i 3])]);
+                 Element ("multinames",[],[
+                            Element ("QName",["namespaceIndex","1";"nameIndex","2"],[]);
+                            Element ("Multiname",["nameIndex","3";"namespaceSetIndex","4"],[]);
+                          ]);])) @@
+      of_cpool {
+       Abc.int    = [1;2;3];
+       Abc.uint   = [4;5;6];
+       Abc.double = [7.;8.;9.];
+       Abc.string = ["foo";"bar";"baz"];
+       Abc.namespace = [{Abc.kind=0;ns_name=1};{Abc.kind=0;ns_name=2}];
+       Abc.namespace_set = [[1;2;3]];
+       Abc.multiname = [Abc.QName (1,2);Abc.Multiname (3,4)]
+      }
+
+*)