implements compiler module

diff --git a/swflib/compile.ml b/swflib/compile.ml
index 584861b..dee549c 100644 (file)
--- a/swflib/compile.ml
+++ b/swflib/compile.ml
@@ -1,5 +1,6 @@
 open Base
 open AbcType
+open ExtList
 
 type 'a t = {
   cpool:         Cpool.t;
@@ -45,8 +46,8 @@ type 'a class_ = {
 
 class type ['a] context = object
   method cpool:   Cpool.t
-  method methods: 'a method_ RevList.t
-  method classes: 'a class_ RevList.t
+  method methods: 'a method_ list
+  method classes: 'a class_ list
 end
 
 module type Inst = sig
@@ -77,16 +78,16 @@ module Make(Inst : Inst) = struct
 
   let methods ({code=code} as m) =
     List.concat [
-      [m];
       filter_map Inst.method_ code;
       HList.concat_map methods_of_class @@ filter_map Inst.class_ code;
+      [m];
     ]
 
   let classes ms =
     methods_map (filter_map Inst.class_) ms
 
   (* cpool *)
-  let cpool ms cs =
+  let consts ms cs =
     let entries x =
       (x :> Cpool.entry list) in
     let inst_const =
@@ -103,16 +104,103 @@ module Make(Inst : Inst) = struct
        meth_const;
        class_const]
 
+  (* methods *)
+  let method_info cpool {method_name  = name;
+                        params       = params;
+                        return       = return;
+                        method_flags = flags} =
+    {
+      AbcType.params = params;
+      return         = return;
+      method_name    = Cpool.index cpool name;
+      method_flags   = flags
+    }
+
+  let method_body ctx i {params=params; code=code} =
+    let max_value f xs  =
+      snd @@ List.fold_left
+       (fun (c,m) x ->
+          let c' = c + f x in
+            (c',max c' m))
+       (0,0) xs in
+      {
+       AbcType.method_sig = i;
+       max_stack          = max_value Inst.stack code;
+       local_count        = List.length params + 1;
+       init_scope_depth   = 0;
+       max_scope_depth    = max_value Inst.scope code;
+       code               = List.map (Inst.inst ctx) code;
+       exceptions         = [];
+       method_traits      = [];
+      }
+
+  let index x xs =
+    fst @@ List.findi (fun _ y -> x = y) xs
+
+  let table xs =
+    fun x ->
+      List.assoc x xs
+
+  let method_trait ctx ({method_name=name; method_attrs=attrs} as m) =
+    let attrs' =
+     List.map (table [`Override, AbcType.ATTR_Override;
+                     `Final   , AbcType.ATTR_Final])
+       attrs in
+    {
+      AbcType.trait_name = Cpool.index ctx#cpool name;
+      data               = AbcType.MethodTrait (0,index m ctx#methods,attrs')
+    }
+
+  let attr_trait ctx i name = {
+    AbcType.trait_name = Cpool.index ctx#cpool name;
+    data               = AbcType.SlotTrait (i+1,0,0,0)
+  }
+
+  let class_info ctx {cinit=m; static_methods=sms} = {
+    AbcType.cinit = index m ctx#methods;
+    class_traits  = List.map (method_trait ctx) sms;
+  }
+
+  let instance_info ctx c =
+    let flag =
+      function
+       | `ProtectedNs ns -> AbcType.ProtectedNs (Cpool.index ctx#cpool ns)
+       | _ as x ->
+           table [`Sealed,AbcType.Sealed;
+                  `Final,AbcType.Final;
+                  `Interface,AbcType.Interface] x in
+    {
+      AbcType.instance_name =
+       Cpool.index ctx#cpool c.class_name;
+      super_name        =
+       Cpool.index ctx#cpool c.super;
+      instance_flags    =
+       List.map flag c.class_flags;
+      interface         =
+       List.map (flip index ctx#classes) c.interface;
+      iinit             =
+       index c.iinit ctx#methods;
+      instance_traits   =
+       List.concat [
+         List.map  (method_trait ctx) c.instance_methods;
+         List.mapi (attr_trait ctx)   c.attrs
+       ]
+    }
+
   let to_abc top_method =
     let ms =
       methods top_method in
     let cs =
       classes ms in
+    let cpool =
+      consts ms cs in
+    let ctx =
+      {| cpool = cpool; methods = ms; classes = cs |} in
       {
-       cpool=cpool ms cs;
-       method_info=[];
-       method_body=[];
-       class_info=[];
-       instance_info=[];
+       cpool         = cpool;
+       method_info   = List.map  (method_info cpool) ms;
+       method_body   = List.mapi (method_body ctx)   ms;
+       class_info    = List.map  (class_info ctx)    cs;
+       instance_info = List.map  (instance_info ctx) cs;
       }
 end