From 5aa687ce67be8da7c134836810d9d273eee13fb3 Mon Sep 17 00:00:00 2001
From: mzp <mzpppp@gmail.com>
Date: Thu, 6 Nov 2008 23:00:44 +0900
Subject: [PATCH] [FIX] Multi method define problem

Bug:
Generate invalid abc-code for following code:

  (define-method f ([self A]))
  (define-method f ([self B]))
---
 .gitignore          |  1 +
 src/asm.ml          | 15 ++++++++++++++-
 src/codegen.ml      | 41 +++++++++++++++++++++++++++++++++--------
 src/instruction.mlp |  2 ++
 4 files changed, 50 insertions(+), 9 deletions(-)

diff --git a/.gitignore b/.gitignore
index ec6150b..3e28703 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,6 +8,7 @@ src/instruction.ml
 src/match_body.ml
 src/opcode.ml
 test/runner.h
+test/runner.ml
 
 # compiled result
 test/runner
diff --git a/src/asm.ml b/src/asm.ml
index e0562ef..3e4b186 100644
--- a/src/asm.ml
+++ b/src/asm.ml
@@ -9,6 +9,17 @@ type t = {
   instance_info: Abc.instance_info list
 }
 
+let empty_method = {
+  name  = Cpool.make_qname "<default-method>";
+  params= [];
+  return= 0;
+  flags = 0;
+  exceptions=[];
+  traits= [];
+  fun_scope=Global;
+  instructions=[];
+}
+
 
 (* util function *)
 let make_meth ?(args=[]) name body = 
@@ -20,7 +31,8 @@ let make_meth ?(args=[]) name body =
       flags = 0;
       exceptions=[];
       traits= [];
-      instructions=inst
+      fun_scope=Global;
+      instructions=inst;
     }
 
 let make_proc ?(args=[]) name body = 
@@ -32,6 +44,7 @@ let make_proc ?(args=[]) name body =
       flags = 0;
       exceptions=[];
       traits= [];
+      fun_scope=Global;
       instructions=inst
     }
 
diff --git a/src/codegen.ml b/src/codegen.ml
index e4aaf24..7801d86 100644
--- a/src/codegen.ml
+++ b/src/codegen.ml
@@ -278,7 +278,7 @@ let generate_stmt env stmt =
 	env,(generate_expr expr env)@[Pop]
     | Define (name,body) ->
 	define_scope name env @@ generate_expr body
-    | Class (name,(ns,sname),attributes,body) ->
+    | Ast.Class (name,(ns,sname),attributes,body) ->
 	let name' =
 	  make_qname name in
 	let sname' = 
@@ -294,17 +294,42 @@ let generate_stmt env stmt =
 	       match name with
 		   "init" -> 
 		     {ctx with init = arguments_self args
-			 (fun e args ->
-			    Asm.make_proc ~args:args (member name) @@ prefix @ (generate_expr body e))}
+			 (fun e args' ->
+			    {Asm.empty_method with
+			       params = 
+				args';
+			       name = 
+				make_qname name;
+			       fun_scope =
+				Asm.Class name';
+			       instructions = 
+				prefix @ (generate_expr body e) @ [ReturnVoid] }) }
 		 | "cinit" ->
 		     {ctx with cinit = arguments_self args
-			 (fun e args ->
-			    Asm.make_proc ~args:args (member name) @@ generate_expr body e)}
-		 | _       ->
+			 (fun e args' ->
+			    {Asm.empty_method with
+			       params =
+				args';
+			       name  =
+				make_qname name;
+			       fun_scope =
+				Asm.Class name';
+			       instructions =
+				(generate_expr body e) @ [ReturnVoid] })}
+		 | _  ->
 		     {ctx with methods = 
 			 (arguments_self args
-			    (fun e args->
-			       Asm.make_meth ~args:args (member name) @@ generate_expr body e)) :: ctx.methods})
+			    (fun e args' ->
+			       {Asm.empty_method with
+				  params =
+				   args';
+				  name =
+				   make_qname name;
+				  fun_scope =
+				   Asm.Class name';
+				  instructions =
+				   (generate_expr body e) @ [ReturnValue] })) 
+			 :: ctx.methods})
 	    {init  = make_proc (member "init") prefix;
 	     cinit = make_proc (member "cinit") [];
 	     methods = []} body in
diff --git a/src/instruction.mlp b/src/instruction.mlp
index fe3ccff..0a8b098 100644
--- a/src/instruction.mlp
+++ b/src/instruction.mlp
@@ -6,6 +6,7 @@ module Set = Core.Std.Set
 type 'a set = 'a Set.t
 
 type klass_type = Sealed | Final | Interface | ProtectedNs of Cpool.namespace
+type function_scope = Global | Class of multiname
 
 type instruction =
 #include "opcode.ml"
@@ -17,6 +18,7 @@ type instruction =
   instructions:instruction list;
   traits: int list;
   exceptions: int list;
+  fun_scope: function_scope;
 } and klass = {
    cname:     multiname;
    sname:     multiname;
-- 
2.11.0