From 1ec8670611ce3a1c5019c41eb85705c080349b5c Mon Sep 17 00:00:00 2001 From: mzp Date: Thu, 10 Sep 2009 22:24:42 +0900 Subject: [PATCH] remove extra file --- swflib/OMakefile | 3 +- swflib/abc.ml | 11 ---- swflib/abcTest.ml | 174 -------------------------------------------------- swflib/cpool.ml | 174 -------------------------------------------------- swflib/cpool.mli | 39 ----------- swflib/cpoolTest.ml | 76 ---------------------- swflib/iSpec.ml | 65 ------------------- swflib/revList.ml | 33 ---------- swflib/revList.mli | 7 -- swflib/revListTest.ml | 37 ----------- 10 files changed, 2 insertions(+), 617 deletions(-) delete mode 100644 swflib/abc.ml delete mode 100644 swflib/abcTest.ml delete mode 100644 swflib/cpool.ml delete mode 100644 swflib/cpool.mli delete mode 100644 swflib/cpoolTest.ml delete mode 100644 swflib/iSpec.ml delete mode 100644 swflib/revList.ml delete mode 100644 swflib/revList.mli delete mode 100644 swflib/revListTest.ml diff --git a/swflib/OMakefile b/swflib/OMakefile index 191147b..18e8a96 100644 --- a/swflib/OMakefile +++ b/swflib/OMakefile @@ -10,8 +10,9 @@ FILES[] = label lowInst abcType + abcWriter asm - abc + UseCamlp4(pa_openin pa_oo) diff --git a/swflib/abc.ml b/swflib/abc.ml deleted file mode 100644 index 8b099d6..0000000 --- a/swflib/abc.ml +++ /dev/null @@ -1,11 +0,0 @@ -open Base - -include AbcType -type 'a s = 'a t - -module A = Asm.Make(LowInst) - -let write ch insts = - insts - +> A.to_bytes - +> Bytes.output_bytes ch diff --git a/swflib/abcTest.ml b/swflib/abcTest.ml deleted file mode 100644 index 22589a9..0000000 --- a/swflib/abcTest.ml +++ /dev/null @@ -1,174 +0,0 @@ -open Base -open Abc -open OUnit -open Bytes - -let cpool = - { empty_cpool with - int = [~-1;42]; - uint = [42]; - string = ["abc"]; - namespace = [{kind=0x08; namespace_name=1}]; - namespace_set = [[1;2]]; - multiname=[QName (0,1);Multiname (2,3)] } - -let info = - { params=[]; return=1; method_name=2; method_flags=3 } - -let body = - { method_sig=1; - max_stack=2; - local_count=3; - init_scope_depth=4; - max_scope_depth=5; - code=[u8 1;u8 2;u8 3;s24 1]; - exceptions=[]; - method_traits=[] } - -let script = - {init=0x7F; script_traits=[]} - -let ok x y = - OUnit.assert_equal (to_int_list x) (to_int_list y) - -let _ = - ("abc.ml" >::: - ["of_script test" >:: - (fun () -> - ok [u30 0x7F; u30 0] @@ of_script script); - "of_trait test" >:: - (fun () -> - ok [u30 1;u8 0; u30 1; u30 2; u30 3; u8 4; ] @@ - of_trait {trait_name=1; data=SlotTrait (1,2,3,4)}; - ok [u30 1;u8 0; u30 1; u30 2; u30 0] @@ - of_trait {trait_name=1; data=SlotTrait (1,2,0,4)}; - ok [u30 1;u8 1; u30 1; u30 2] @@ - of_trait {trait_name=1; data=MethodTrait (1,2,[])}; - ok [u30 1;u8 2; u30 1; u30 2] @@ - of_trait {trait_name=1; data=GetterTrait (1,2,[])}; - ok [u30 1;u8 3; u30 1; u30 2] @@ - of_trait {trait_name=1; data=SetterTrait (1,2,[])}; - ok [u30 1;u8 4; u30 1; u30 2] @@ - of_trait {trait_name=1; data=ClassTrait (1,2)}; - ok [u30 1;u8 5; u30 1; u30 2] @@ - of_trait {trait_name=1; data=FunctionTrait (1,2)}; - ok [u30 1;u8 6; u30 1; u30 2; u30 3; u8 4] @@ - of_trait {trait_name=1; data=ConstTrait (1,2,3,4)}; - ok [u30 1;u8 6; u30 1; u30 2; u30 0] @@ - of_trait {trait_name=1; data=ConstTrait (1,2,0,4)}); - "of_method_info test" >:: - (fun () -> - ok - [u30 0; u30 1; u30 2; u8 3] @@ - of_method_info info); - "of_method_body test" >:: - (fun () -> - ok [u30 1; - u30 2; - u30 3; - u30 4; - u30 5; - u30 6; u8 1; u8 2; u8 3;s24 1; - u30 0; - u30 0] @@ - of_method_body body); - "of_cpool test" >:: - (fun () -> - ok [u30 1;(* int *) - u30 1;(* uint *) - u30 1;(* double *) - u30 1;(* string *) - u30 1;(* ns *) - u30 1;(* ns_set *) - u30 1 (* mname *)] @@ - of_cpool empty_cpool; - ok [u30 3; s32 ~-1; s32 42; (* int *) - u30 2; u32 42; (* uint *) - u30 1; (* double *) - u30 2; u30 3; u8 0x61; u8 0x62; u8 0x63; (* string *) - u30 2; u8 0x08; u30 1; (* ns *) - u30 2; u30 2; u30 1; u30 2; (* ns_set *) - u30 3; u8 0x07; u30 0; u30 1; - u8 0x09; u30 2; u30 3; (* mname *)] @@ - of_cpool cpool); - "of_class test" >:: - (fun () -> - ok [u30 10; u30 0] @@ - of_class {cinit=10; class_traits=[]}); - "of_instance test" >:: - (fun () -> - ok [u30 1; (* name *) - u30 2; (* super name *) - u8 3; (* flags *) - u30 4; (* interface count *) - u30 1; u30 2; u30 3; u30 4; (* interface *) - u30 5; (* iinit *) - u30 0; (* traits count *) ] @@ - of_instance { - instance_name=1; - super_name=2; - instance_flags=[Sealed;Final]; - interface=[1;2;3;4]; - iinit=5; - instance_traits=[]}); - "of_instance protected ns" >:: - (fun () -> - ok [u30 1; (* name *) - u30 2; (* super name *) - u8 8; (* flags *) - u30 1; (* protected ns *) - u30 4; (* interface count *) - u30 1; u30 2; u30 3; u30 4; (* interface *) - u30 5; (* iinit *) - u30 0; (* traits count *) ] @@ - of_instance { - instance_name=1; - super_name=2; - instance_flags=[ProtectedNs 1]; - interface=[1;2;3;4]; - iinit=5; - instance_traits=[]}); - "spimle abc" >:: - (fun () -> - ok [u16 16; u16 46;(* version *) - u30 1; u30 1; u30 1; u30 1; u30 1; u30 1; u30 1; - (* cpool *) - u30 0; (* info *) - u30 0; (* meta *) - u30 0; (* class *) - u30 0; (* script *) - u30 0; (* body *) ] @@ - to_bytes { - cpool = empty_cpool; - method_info = []; - metadata = []; - classes = []; - instances = []; - scripts = []; - method_bodies = []}); - "full abc" >:: - (fun () -> - ok (List.concat [ - (* version *) [ u16 16; u16 46]; - (* cpool *) of_cpool {empty_cpool with string=["foo"] }; - (* info *) [ u30 1]; of_method_info info; - (* meta *) [u30 0]; - (* class *) [u30 0]; - (* script *) [u30 1]; of_script script; - (* body *) [u30 1]; [u30 1; - u30 2; - u30 3; - u30 4; - u30 5; - u30 6;u8 1; u8 2; u8 3;s24 1; - u30 0; - u30 0] ]) @@ - Abc.to_bytes { - cpool = {empty_cpool with string=["foo"] } ; - method_info = [info]; - metadata = []; - classes = []; - instances = []; - scripts = [script]; - method_bodies = [body]}) - ] ) +> run_test_tt_main diff --git a/swflib/cpool.ml b/swflib/cpool.ml deleted file mode 100644 index adb97b6..0000000 --- a/swflib/cpool.ml +++ /dev/null @@ -1,174 +0,0 @@ -open Base - -type namespace = [ - `Namespace of string -| `PackageNamespace of string -| `PackageInternalNamespace of string -| `ProtectedNamespace of string -| `ExplicitNamespace of string -| `StaticProtectedNamespace of string -| `PrivateNamespace of string ] - -type namespace_set = namespace list - -type multiname = [ - `QName of namespace * string -| `Multiname of string * namespace_set -] - -type entry = [ -| `Int of int -| `UInt of int -| `Double of float -| `String of string -| namespace -| multiname -] - -type t = { - int: int RevList.t; - uint: int RevList.t; - double: float RevList.t; - string: string RevList.t; - namespace: namespace RevList.t; - namespace_set: namespace_set RevList.t; - multiname: multiname RevList.t; -} - -let empty = - {int = RevList.empty; - uint = RevList.empty; - double = RevList.empty; - string = RevList.empty; - namespace = RevList.empty; - namespace_set = RevList.empty; - multiname = RevList.empty} - -let ns_name = - function - `Namespace name - | `PackageNamespace name - | `PackageInternalNamespace name - | `ProtectedNamespace name - | `ExplicitNamespace name - | `StaticProtectedNamespace name - | `PrivateNamespace name -> - name - -let add x xs = - if RevList.mem x xs then - xs - else - RevList.add x xs - -let add_list xs ys = - RevList.add_list (List.filter (fun x -> not (RevList.mem x ys)) xs) ys - -let add_namespace ns cpool = - {cpool with - string = cpool.string - +> add (ns_name ns); - namespace = add ns cpool.namespace } - -let add_multiname name cpool = - match name with - `QName (ns,str) -> - let cpool = - {cpool with - string = cpool.string - +> add str; - multiname = add name cpool.multiname } in - add_namespace ns cpool - | `Multiname (str,ns_set) -> - {cpool with - string = cpool.string - +> add_list (List.map ns_name ns_set) - +> add str; - namespace = add_list ns_set cpool.namespace; - namespace_set = add ns_set cpool.namespace_set; - multiname = add name cpool.multiname } - -let add entry cpool = - match entry with - `Int n -> - { cpool with int= add n cpool.int } - | `UInt n -> - { cpool with uint= add n cpool.uint } - | `String s -> - { cpool with string = add s cpool.string } - | `Double d -> - { cpool with double = add d cpool.double } - | #namespace as ns -> - add_namespace ns cpool - | #multiname as m -> - add_multiname m cpool - -(* conversion *) -(* - assumption: - - list has only unique element -*) -let rindex x set = - 1 + RevList.index x set - -let index entry cpool = - match entry with - `Int n -> - rindex n cpool.int - | `UInt n -> - rindex n cpool.uint - | `Double d -> - rindex d cpool.double - | `String s -> - rindex s cpool.string - | #namespace as ns -> - rindex ns cpool.namespace - | #multiname as m -> - rindex m cpool.multiname - -let of_namespace {string=string} (ns : namespace) = - let i = - rindex (ns_name ns) string in - let kind = - match ns with - `Namespace _ -> - 0x08 - | `PackageNamespace _ -> - 0x16 - | `PackageInternalNamespace _ -> - 0x17 - | `ProtectedNamespace _ -> - 0x18 - | `ExplicitNamespace _ -> - 0x19 - | `StaticProtectedNamespace _ -> - 0x1A - | `PrivateNamespace _ -> - 0x05 in - {Abc.kind=kind; namespace_name=i} - -let of_namespace_set {namespace=namespace} nss = - List.map (fun ns -> rindex ns namespace) nss - -let of_multiname {namespace=namespace; namespace_set=namespace_set; string=string} : multiname -> Abc.multiname = - function - `QName (ns,s) -> - Abc.QName (rindex ns namespace, rindex s string) - | `Multiname (s,nss) -> - Abc.Multiname (rindex s string,rindex nss namespace_set) - -let to_abc cpool = - { Abc.int = RevList.to_list cpool.int; - Abc.uint = RevList.to_list cpool.uint; - Abc.double = RevList.to_list cpool.double; - Abc.string = RevList.to_list cpool.string; - Abc.namespace = cpool.namespace - +> RevList.to_list - +> List.map (of_namespace cpool); - Abc.namespace_set = cpool.namespace_set - +> RevList.to_list - +> List.map (of_namespace_set cpool); - Abc.multiname = cpool.multiname - +> RevList.to_list - +> List.map (of_multiname cpool) - } diff --git a/swflib/cpool.mli b/swflib/cpool.mli deleted file mode 100644 index c3a2817..0000000 --- a/swflib/cpool.mli +++ /dev/null @@ -1,39 +0,0 @@ -(** - Constant pool(CPool). - - CPool create the map from a value to the index, or a list of the value. - *) - -(** A type of namespace *) -type namespace = [ - `Namespace of string -| `PackageNamespace of string -| `PackageInternalNamespace of string -| `ProtectedNamespace of string -| `ExplicitNamespace of string -| `StaticProtectedNamespace of string -| `PrivateNamespace of string ] - -type namespace_set = namespace list - -(** A type of multiname *) -type multiname = [ - `QName of namespace * string -| `Multiname of string * namespace_set -] - -type entry = [ -| `Int of int -| `UInt of int -| `Double of float -| `String of string -| namespace -| multiname -] - -type t - -val empty : t -val add : [< entry] -> t -> t -val index : [< entry] -> t -> int -val to_abc : t -> Abc.cpool diff --git a/swflib/cpoolTest.ml b/swflib/cpoolTest.ml deleted file mode 100644 index c9fc91b..0000000 --- a/swflib/cpoolTest.ml +++ /dev/null @@ -1,76 +0,0 @@ -open Base -open Cpool -open Bytes -open OUnit - -let empty_cpool = - { Abc.int = []; - uint = []; - double = []; - string = []; - namespace = []; - namespace_set = []; - multiname = []} - -let test_index value = - let cpool = - Cpool.add value Cpool.empty in - assert_equal 1 (Cpool.index value cpool) - -let ok cpool value = - assert_equal cpool (to_abc @@ Cpool.add value Cpool.empty) - -let _ = - ("cpool.ml" >::: [ - "int" >:: - (fun () -> - test_index (`Int 42); - test_index (`Int ~-42)); - "uint" >:: - (fun () -> - test_index (`UInt 42)); - "string" >:: - (fun () -> - test_index (`String "foobar")); - "multiname" >:: - (fun () -> - test_index (`QName ((`Namespace "std"),"print")); - test_index (`Multiname ("print",[])); - test_index (`Multiname ("print",[`Namespace "std"]))); - "literal cpool" >:: - (fun () -> - ok {empty_cpool with Abc.string=["foobar"]} (`String "foobar"); - ok {empty_cpool with Abc.int=[30]} (`Int 30); - ok {empty_cpool with Abc.int=[~-30]} (`Int ~-30); - ok {empty_cpool with Abc.uint=[42]} (`UInt 42)); - "qname cpool" >:: - (fun () -> - ok - {empty_cpool with - Abc.string = ["foobar"; "std"]; - namespace = [{Abc.kind=0x08; namespace_name=2}]; - multiname = [Abc.QName (1,1)]} - (`QName (`Namespace "std","foobar"))); - "multiname cpool" >:: - (fun () -> - ok - {empty_cpool with - Abc.string = ["std";"foobar"]; - namespace = [{Abc.kind=0x08; namespace_name=1}]; - namespace_set= [[1]]; - multiname=[Abc.Multiname (2,1)]} - (`Multiname ("foobar",[`Namespace "std"]))); - "cpool entry should be unique" >:: - (fun () -> - let cpool = - List.fold_left (flip Cpool.add) empty [`String "foo"; `String "bar"; `String "foo"] in - assert_equal 1 (Cpool.index (`String "foo") cpool); - assert_equal {empty_cpool with Abc.string=["foo";"bar"]} (to_abc cpool)); - "index is not change" >:: - (fun () -> - let cpool1 = - Cpool.add (`Int 42) empty in - let cpool2 = - Cpool.add (`Int 42) cpool1 in - assert_equal (Cpool.index (`Int 42) cpool1) (Cpool.index (`Int 42) cpool2)) - ]) +> run_test_tt_main diff --git a/swflib/iSpec.ml b/swflib/iSpec.ml deleted file mode 100644 index d1d5b69..0000000 --- a/swflib/iSpec.ml +++ /dev/null @@ -1,65 +0,0 @@ -type function_scope = - [ `Global - | `Class of Cpool.multiname] - -type class_type = - [ `Sealed - | `Final - | `Interface - | `ProtectedNs of Cpool.namespace] - -type 'a method_ = { - method_name: Cpool.multiname; - params: int list; - return: int; - method_flags: int; - instructions: 'a list; - traits: int list; - exceptions: int list; - fun_scope: function_scope; - method_attrs : [`Override | `Final] list -} -type 'a class_ = { - class_name: Cpool.multiname; - super: Cpool.multiname; - class_flags: class_type list; - cinit: 'a method_; - iinit: 'a method_; - interface: 'a class_ list; - instance_methods: 'a method_ list; - static_methods: 'a method_ list; - attributes: Cpool.multiname list -} - -(* - Because I want use structual subtyping, I use object as record. -*) -class type ['a] context = object - method cpool: Cpool.t - method methods: 'a method_ RevList.t - method classes: 'a class_ RevList.t -end - -type 'a t = { - op: int; - args: 'a context -> Bytes.t list; - prefix: 'a context -> Bytes.t list; - const: Cpool.entry list; - method_: 'a method_ option; - class_ : 'a class_ option; - stack : int; - scope : int; - count : int; -} - -let empty_method = { - method_attrs = []; - method_name = `QName (`Namespace "",""); - params = []; - return = 0; - method_flags = 0; - instructions = []; - traits= []; - exceptions= []; - fun_scope= `Global -} diff --git a/swflib/revList.ml b/swflib/revList.ml deleted file mode 100644 index a92ea1a..0000000 --- a/swflib/revList.ml +++ /dev/null @@ -1,33 +0,0 @@ -(** -Index immutable Set. - -If you add some elements to a set, [index] is not change. -*) -open Base - -type 'a t = 'a list - -let empty = - [] - -let add x xs = - x::xs - -let add_list xs ys = - List.fold_left (flip add) ys xs - -let rec index x = - function - [] -> - raise Not_found - | y::ys -> - if x = y then - List.length ys - else - index x ys - -let to_list xs = - List.rev xs - -let mem x xs = - List.mem x xs diff --git a/swflib/revList.mli b/swflib/revList.mli deleted file mode 100644 index ff1604f..0000000 --- a/swflib/revList.mli +++ /dev/null @@ -1,7 +0,0 @@ -type 'a t -val add : 'a -> 'a t -> 'a t -val add_list : 'a list -> 'a t -> 'a t -val index : 'a -> 'a t -> int -val to_list : 'a t -> 'a list -val empty : 'a t -val mem : 'a -> 'a t -> bool diff --git a/swflib/revListTest.ml b/swflib/revListTest.ml deleted file mode 100644 index 37b5a46..0000000 --- a/swflib/revListTest.ml +++ /dev/null @@ -1,37 +0,0 @@ -open Base -open RevList -open OUnit - -let _ = - ("ISet" >::: [ - "index is immutable" >:: - (fun () -> - let set1 = - RevList.add 0 empty in - let set2 = - RevList.add 1 set1 in - assert_equal (index 0 set1) (RevList.index 0 set2)); - "mem" >:: - (fun () -> - assert_equal false (RevList.mem 0 empty); - assert_equal true (RevList.mem 0 (RevList.add 0 empty))); - "index" >:: - (fun () -> - let set = - RevList.add 42 empty in - assert_equal 0 (RevList.index 42 set)); - "to_list" >:: - (fun () -> - let set1 = - RevList.add 42 empty in - let set2 = - RevList.add 0 set1 in - assert_equal [42;0] (RevList.to_list set2)); - "add_list" >:: - (fun () -> - let set1 = - RevList.add_list [1;2;3] empty in - let set2 = - RevList.add 3 (RevList.add 2 (RevList.add 1 empty)) in - assert_equal set1 set2) - ]) +> run_test_tt_main -- 2.11.0