refactoring cpool

diff --git a/src/asm.ml b/src/asm.ml
index 977e2ba..2469739 100644 (file)
--- a/src/asm.ml
+++ b/src/asm.ml
@@ -20,8 +20,8 @@ type instruction =
 type mmap = meth Pool.map
 type config = {
   op:     int;
-  args:   Cpool.cmap * mmap -> Bytes.t list;
-  prefix: Cpool.cmap * mmap -> Bytes.t list;
+  args:   Cpool.t * mmap -> Bytes.t list;
+  prefix: Cpool.t * mmap -> Bytes.t list;
   const:  Cpool.t;
   meth:   meth option;
   stack:  int;
@@ -68,7 +68,7 @@ let rec collect ({instructions=insts;traits=traits} as meth) =
       (Pool.empty,Cpool.empty) @@ List.map meth_and_const insts in
   let traits' =
     collect_traits traits in
-    Pool.add meth meths,Cpool.append traits' consts
+    Pool.add meth meths,consts
 
 (* convert instruction *)
 let add (max,current) n = 
@@ -121,16 +121,12 @@ let asm_method map index m =
       info,body
 
 let assemble meth =
-  let meths,consts = 
+  let meths,cpool = 
     collect meth in
-  let cmap =
-    Cpool.to_cmap consts in
-  let cpool =
-    Cpool.to_cpool cmap in
   let mmap =
     Pool.to_map meths in
   let meths' =
     Pool.to_list meths in
   let info,body =
-    ExtList.List.split @@ ExtList.List.mapi (fun i x-> asm_method (cmap,mmap) i x) meths' in
-    cpool,info,body
+    ExtList.List.split @@ ExtList.List.mapi (fun i x-> asm_method (cpool,mmap) i x) meths' in
+    Cpool.to_abc cpool,info,body

diff --git a/src/base.ml b/src/base.ml
index beec60e..d0543bc 100644 (file)
--- a/src/base.ml
+++ b/src/base.ml
@@ -63,3 +63,13 @@ let rec group_by f =
     | x::xs ->
        [x]::group_by f xs
   
+let index x xs = 
+  let rec loop i = function
+      [] -> 
+       raise Not_found
+    | y::ys -> 
+       if x = y then
+         i
+       else
+         loop (i+1) ys in
+    loop 1 xs

diff --git a/src/cpool.ml b/src/cpool.ml
index e8ef4b1..a4d176a 100644 (file)
--- a/src/cpool.ml
+++ b/src/cpool.ml
@@ -1,5 +1,6 @@
 open Base
 module Set = Core.Std.Set
+
 type namespace = 
     Namespace of string 
   | PackageNamespace of string
@@ -10,7 +11,8 @@ type multiname =
   | Multiname of string * namespace_set
 
 type 'a set = 'a Set.t
-type constants = {
+
+type t = {
   int: int set;
   uint: int set;
   double: float set;
@@ -20,12 +22,7 @@ type constants = {
   multiname: multiname set;
 }
 
-type t = constants
-type cmap = Abc.cpool
-
-
-
-(* for table *)
+(* lift *)
 type op = {app: 'a . 'a set -> 'a set -> 'a set}
 
 let lift2 {app=f} x y =
@@ -46,9 +43,6 @@ let empty =
    namespace_set = Set.empty;
    multiname     = Set.empty }
 
-let lift1 f x =
-  lift2 f x empty
-
 let append x y = 
   lift2 {app=Set.union} x y
 
@@ -92,18 +86,7 @@ let multiname name=
           namespace_set = Set.singleton ns_set;
           multiname     = Set.singleton name }
 
-(* conversion *)
-let index x xs = 
-  let rec loop i = function
-      [] -> 
-       raise Not_found
-    | y::ys -> 
-       if x = y then
-         i
-       else
-         loop (i+1) ys in
-    loop 1 xs
-    
+(* conversion *)    
 let of_namespace ~string ns =
   let i =
     index (ns_name ns) string in
@@ -123,8 +106,7 @@ let of_multiname ~string ~namespace ~namespace_set =
     | Multiname (s,nss) ->
        Abc.Multiname (index s string,index (of_namespace_set ~string:string ~namespace:namespace nss) namespace_set)
 
-let to_cpool x = x
-let to_cmap tbl = 
+let to_abc tbl = 
   let int,uint,double,str,ns,nss =
     Set.to_list tbl.int,
     Set.to_list tbl.uint,
@@ -147,35 +129,33 @@ let to_cmap tbl =
       Abc.multiname     = mname
     }
 
-(* for cmap *)
 let index_u30 x xs=
   Bytes.u30 @@ index x xs
 
 let accessor f = 
   let nget value map =
-    index value @@ f map in
+    index value @@ Set.to_list @@ f map in
   let get value map =
-    index_u30 value @@ f map in
+    index_u30 value @@ Set.to_list @@ f map in
     nget,get
 
 let int_nget,int_get =
-  accessor (fun {Abc.int=map}->map)
+  accessor (fun {int=map}->map)
 
 let uint_nget,uint_get =
-  accessor (fun {Abc.uint=map}->map)
+  accessor (fun {uint=map}->map)
 
 let string_nget,string_get =
-  accessor (fun {Abc.string=map}->map)
+  accessor (fun {string=map}->map)
 
 let double_nget,double_get =
-  accessor (fun {Abc.double=map}->map)
+  accessor (fun {double=map}->map)
+
+let namespace_nget,namespace_get =
+  accessor (fun {namespace=map}->map)
 
-let namespace_get value {Abc.namespace=ns;Abc.string=str} =
-  index_u30 (of_namespace ~string:str value) ns
+let multiname_nget,multiname_get =
+  accessor (fun {multiname=map}->map)
 
-let multiname_get value {Abc.namespace=ns;Abc.namespace_set=nss;Abc.string=str;Abc.multiname=mn} =
-  index_u30 (of_multiname ~string:str ~namespace:ns ~namespace_set:nss value) mn
 
-let multiname_nget value {Abc.namespace=ns;Abc.namespace_set=nss;Abc.string=str;Abc.multiname=mn} =
-  index (of_multiname ~string:str ~namespace:ns ~namespace_set:nss value) mn
 

diff --git a/src/cpool.mli b/src/cpool.mli
index af6c993..89b8769 100644 (file)
--- a/src/cpool.mli
+++ b/src/cpool.mli
@@ -1,5 +1,4 @@
 type t
-type cmap
 
 type namespace = 
     Namespace of string 
@@ -21,14 +20,17 @@ val string:    string    -> t
 val namespace: namespace -> t
 val multiname: multiname -> t
 
-val int_get       : int       -> cmap -> Bytes.t
-val uint_get      : int       -> cmap -> Bytes.t
-val string_get    : string    -> cmap -> Bytes.t
-val string_nget   : string    -> cmap -> int
-val double_get    : float     -> cmap -> Bytes.t
-val namespace_get : namespace -> cmap -> Bytes.t
-val multiname_get : multiname -> cmap -> Bytes.t
-val multiname_nget: multiname -> cmap -> int
+val to_abc : t -> Abc.cpool
 
-val to_cmap  : t -> cmap
-val to_cpool : cmap -> Abc.cpool
+val int_nget : int -> t -> int
+val int_get : int -> t -> Bytes.t
+val uint_nget : int -> t -> int
+val uint_get : int -> t -> Bytes.t
+val string_nget : string -> t -> int
+val string_get : string -> t -> Bytes.t
+val double_nget : float -> t -> int
+val double_get : float -> t -> Bytes.t
+val namespace_nget : namespace -> t -> int
+val namespace_get : namespace -> t -> Bytes.t
+val multiname_nget : multiname -> t -> int
+val multiname_get : multiname -> t -> Bytes.t

diff --git a/test/test_asm.ml b/test/test_asm.ml
index 515cbbe..041de28 100644 (file)
--- a/test/test_asm.ml
+++ b/test/test_asm.ml
@@ -44,3 +44,5 @@ test asm =
                             u8 71];
                   Abc.exceptions=[];
                   Abc.trait_m=[] }] body;
+
+

diff --git a/test/test_cpool.ml b/test/test_cpool.ml
index ba5b745..7c136eb 100644 (file)
--- a/test/test_cpool.ml
+++ b/test/test_cpool.ml
@@ -7,7 +7,7 @@ test empty_append =
     assert_equal empty (append empty empty)
 
 let test_pair get make value =
-  assert_equal (u30 1) (get value @@ to_cmap (make value))
+  assert_equal (u30 1) (get value @@ (make value))
 
 test int =
   test_pair int_get int 42;
@@ -25,26 +25,18 @@ test multiname =
   test_pair multiname_get multiname (Multiname ("print",[Namespace "std"]));
 
 test append =
-  let cmap =
-    to_cmap @@ append (string "foobar") (int 42) in
-    assert_equal (u30 1) (int_get 42 cmap);
-    assert_equal (u30 1) (string_get "foobar" cmap)
+  let cpool =
+    append (string "foobar") (int 42) in
+    assert_equal (u30 1) (int_get 42 cpool);
+    assert_equal (u30 1) (string_get "foobar" cpool)
 
 let cpool_test cpool entry =
   let cpool1 =
-    to_cpool @@ to_cmap entry in
+    entry in
   let cpool2 =
-    to_cpool @@ to_cmap (append entry entry) in
-    assert_equal cpool cpool1;
-    assert_equal cpool cpool2;
-
-test dummy_pack =
-  let cmap = 
-    to_cmap (List.fold_left append empty [string "foo";string "bar";string "foo"]) in
-  let cpool = 
-    to_cpool @@ cmap in
-    assert_equal (u30 2) (string_get "foo" cmap);
-    assert_equal {Abc.empty_cpool with Abc.string=["bar";"foo"]} cpool
+    append entry entry in
+    assert_equal cpool (to_abc cpool1);
+    assert_equal cpool (to_abc cpool2);
 
 test cpool =
    cpool_test {Abc.empty_cpool with Abc.string=["foobar"]} (string "foobar");
@@ -52,6 +44,12 @@ test cpool =
    cpool_test {Abc.empty_cpool with Abc.int=[~-30]} (int ~-30);
    cpool_test {Abc.empty_cpool with Abc.uint=[42]} (uint 42)
 
+test dummy_pack =
+  let cpool = 
+    List.fold_left append empty [string "foo";string "bar";string "foo"] in
+    assert_equal 2 (string_nget "foo" cpool);
+    assert_equal {Abc.empty_cpool with Abc.string=["bar";"foo"]} (to_abc cpool)
+
 test mname_cpool =
    cpool_test 
      {Abc.empty_cpool with 
@@ -59,7 +57,7 @@ test mname_cpool =
        Abc.namespace=[{Abc.kind=0x08;Abc.ns_name=2}];
        Abc.multiname=[Abc.QName (1,1)]} 
      (multiname (QName (Namespace "std","foobar")));
-   cpool_test 
+   cpool_test
      {Abc.empty_cpool with 
        Abc.string=["foobar";"std"];
        Abc.namespace=[{Abc.kind=0x08;Abc.ns_name=2}];