OSDN Git Service

[FIX] Multi class definison's bug is fixed
authormzp <mzpppp@gmail.com>
Tue, 4 Nov 2008 12:03:15 +0000 (21:03 +0900)
committermzp <mzpppp@gmail.com>
Tue, 4 Nov 2008 12:03:15 +0000 (21:03 +0900)
Bug example:
 (define-class A (Object) ())
 (define-class B (Object) ())

Fix:
 - don't share defalut constructor
 - class-slot index is based to 1

example/dup.scm [new file with mode: 0644]
src/asm.ml
src/codegen.ml
test/test_codegen.ml

diff --git a/example/dup.scm b/example/dup.scm
new file mode 100644 (file)
index 0000000..0993a20
--- /dev/null
@@ -0,0 +1,10 @@
+;;; [class A]
+;;; [class B]
+;;; [class C]
+
+(define-class A (Object) ())
+(define-class B (Object) ())
+(define-class C (Object) ())
+(print A)
+(print B)
+(print C)
\ No newline at end of file
index edfd14d..e0562ef 100644 (file)
@@ -66,14 +66,12 @@ let collect_const meth=
 
 
 (** [collect_klass meth] returns all class which contained by [meth]. *)
-let collect_klass =
-  Set.to_list $ 
-    fold_instruction (fun set i-> 
-                       match (get_config i).klass with
-                         Some k ->
-                           Set.add k set
-                       | _ ->
-                           set) Set.empty
+let collect_klass meth =
+  meth.instructions +>  HList.concat_map 
+    (fun i ->
+       match (get_config i).klass with
+          Some k -> [k]
+        | None   -> [])
 
 (** [collect_method meth] return all methods which contained by [meth]. *)
 let collect_method =
index c2fb99a..e4aaf24 100644 (file)
@@ -286,6 +286,8 @@ let generate_stmt env stmt =
        let prefix = 
          [GetLocal_0;
           ConstructSuper 0] in
+       let member x =
+         name ^ "::" ^ x in
        let {init=init; cinit=cinit; methods=methods} =
          List.fold_left
            (fun ctx (name,args,body) ->
@@ -293,18 +295,18 @@ let generate_stmt env stmt =
                   "init" -> 
                     {ctx with init = arguments_self args
                         (fun e args ->
-                           Asm.make_proc ~args:args name @@ prefix @ (generate_expr body e))}
+                           Asm.make_proc ~args:args (member name) @@ prefix @ (generate_expr body e))}
                 | "cinit" ->
                     {ctx with cinit = arguments_self args
                         (fun e args ->
-                           Asm.make_proc ~args:args name @@ generate_expr body e)}
+                           Asm.make_proc ~args:args (member name) @@ generate_expr body e)}
                 | _       ->
                     {ctx with methods = 
                         (arguments_self args
                            (fun e args->
-                              Asm.make_meth ~args:args name @@ generate_expr body e)) :: ctx.methods})
-           {init  = make_proc "init" prefix;
-            cinit = make_proc "cinit" [];
+                              Asm.make_meth ~args:args (member name) @@ generate_expr body e)) :: ctx.methods})
+           {init  = make_proc (member "init") prefix;
+            cinit = make_proc (member "cinit") [];
             methods = []} body in
        let klass = {
          Asm.cname  = name';
@@ -340,7 +342,7 @@ let generate program =
   let traits_class =
     ExtList.List.mapi 
       (fun i {Abc.name_i=name} -> 
-        {Abc.t_name=name; data=Abc.ClassTrait (i,i)})
+        {Abc.t_name=name; data=Abc.ClassTrait (i+1,i)})
       instance_info in
     { Abc.cpool=cpool;
       method_info=info;
index d21d625..ea22e05 100644 (file)
@@ -249,8 +249,8 @@ test klass =
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
          attributes = [];
-         cinit     = Asm.make_proc "cinit" [];
-         iinit     = Asm.make_proc "init"  @@ prefix@[PushByte 10];
+         cinit     = Asm.make_proc "Foo::cinit" [];
+         iinit     = Asm.make_proc "Foo::init"  @@ prefix@[PushByte 10];
          interface = [];
          methods   = []})
       (generate_script @@ compile_string 
@@ -264,8 +264,8 @@ test klass_empty =
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
          attributes = [];
-         cinit     = Asm.make_proc "cinit" [];
-         iinit     = Asm.make_proc "init" prefix;
+         cinit     = Asm.make_proc "Foo::cinit" [];
+         iinit     = Asm.make_proc "Foo::init" prefix;
          interface = [];
          methods   = []})
       (generate_script @@ compile_string "(define-class Foo (Object) ())")
@@ -277,10 +277,10 @@ test klass_f =
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
          attributes = [];
-         cinit     = Asm.make_proc "cinit" [];
-         iinit     = Asm.make_proc "init" prefix;
+         cinit     = Asm.make_proc "Foo::cinit" [];
+         iinit     = Asm.make_proc "Foo::init" prefix;
          interface = [];
-         methods   = [Asm.make_meth "f" [PushByte 42]]})
+         methods   = [Asm.make_meth "Foo::f" [PushByte 42]]})
       (generate_script @@ compile_string 
         "(define-class Foo (Object) ())
           (define-method f ((self Foo)) 42)")
@@ -293,8 +293,8 @@ test klass_with_ns =
                      sname     = make "flash.text" "Object";
                      flags_k   = [Asm.Sealed];
                      attributes = [];
-                     cinit     = Asm.make_proc "cinit" [];
-                     iinit     = Asm.make_proc "init" @@ prefix@[PushByte 10];
+                     cinit     = Asm.make_proc "Foo::cinit" [];
+                     iinit     = Asm.make_proc "Foo::init" @@ prefix@[PushByte 10];
                      interface = [];
                      methods   = []})
          (generate_script @@ compile_string 
@@ -308,8 +308,8 @@ test klass_args =
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
          attributes = [];
-         cinit     = Asm.make_proc "cinit" [];
-         iinit     = Asm.make_proc "init" ~args:[0] @@ prefix@[GetLocal 1];
+         cinit     = Asm.make_proc "Foo::cinit" [];
+         iinit     = Asm.make_proc "Foo::init" ~args:[0] @@ prefix@[GetLocal 1];
          interface = [];
          methods   = []})
       (generate_script @@ compile_string 
@@ -323,8 +323,8 @@ test klass_self =
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
          attributes = [];
-         cinit     = Asm.make_proc "cinit" [];
-         iinit     = Asm.make_proc "init" ~args:[] @@ prefix@[GetLocal 0];
+         cinit     = Asm.make_proc "Foo::cinit" [];
+         iinit     = Asm.make_proc "Foo::init" ~args:[] @@ prefix@[GetLocal 0];
          interface = [];
          methods   = []})
       (generate_script @@ compile_string 
@@ -338,11 +338,11 @@ test klass_f_args =
         {Asm.cname = make_qname "Foo"; 
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
-         cinit     = Asm.make_proc "cinit" [];
-         iinit     = Asm.make_proc "init" prefix;
+         cinit     = Asm.make_proc "Foo::cinit" [];
+         iinit     = Asm.make_proc "Foo::init" prefix;
          interface = [];
          attributes = [];
-         methods   = [Asm.make_meth "f" ~args:[0] [GetLocal 1]]})
+         methods   = [Asm.make_meth "Foo::f" ~args:[0] [GetLocal 1]]})
       (generate_script @@ compile_string "(define-class Foo (Object) ())
  (define-method f ((self Foo) x) x)")
 
@@ -352,8 +352,8 @@ test klass_attr =
         {Asm.cname = make_qname "Foo"; 
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
-         cinit     = Asm.make_proc "cinit" [];
-         iinit     = Asm.make_proc "init" prefix;
+         cinit     = Asm.make_proc "Foo::cinit" [];
+         iinit     = Asm.make_proc "Foo::init" prefix;
          interface = [];
          attributes = [Cpool.make_qname "x";Cpool.make_qname "y"];
          methods   = []})