[REFACTOR]remove make_proc/make_meth

diff --git a/src/OMakefile b/src/OMakefile
index 2f602ad..d8ce5db 100644 (file)
--- a/src/OMakefile
+++ b/src/OMakefile
@@ -57,13 +57,12 @@ FILES[] =
        parsec
        sexp
 
-
-PROGRAM = aosh
+PROGRAM = habc-core
 OCAML_OTHER_LIBS += threads
 
 .DEFAULT: $(OCamlProgram $(PROGRAM), main $(FILES))
 
-OCamlLibrary(aosh, $(FILES))
+OCamlLibrary($(PROGRAM), $(FILES))
 
 ################################################
 #

diff --git a/src/asm.ml b/src/asm.ml
index dba99f3..517670a 100644 (file)
--- a/src/asm.ml
+++ b/src/asm.ml
@@ -21,33 +21,6 @@ let empty_method = {
 }
 
 
-(* util function *)
-let make_meth ?(scope=Global) ?(args=[]) name body = 
-  let inst =
-    body @ [ReturnValue] in
-    { name  = Cpool.make_qname name;
-      params= args;
-      return= 0;
-      flags = 0;
-      exceptions=[];
-      traits= [];
-      fun_scope=scope;
-      instructions=inst;
-    }
-
-let make_proc ?(scope=Global) ?(args=[]) name body = 
-  let inst =
-    body @ [ReturnVoid] in
-    { name  = Cpool.make_qname name;
-      params= args;
-      return= 0;
-      flags = 0;
-      exceptions=[];
-      traits= [];
-      fun_scope=scope;
-      instructions=inst
-    }
-
 (**
    - meth contains instruction list.
    - instruction contains meth list.

diff --git a/src/codegen.ml b/src/codegen.ml
index 3c6888a..7f1d80c 100644 (file)
--- a/src/codegen.ml
+++ b/src/codegen.ml
@@ -196,7 +196,10 @@ let rec generate_expr expr env =
             let body' = 
               generate_expr body e in
             let m =
-              Asm.make_meth ~args:args' "" body' in
+              {Asm.empty_method with
+                 name   = make_qname "";
+                 params = args';
+                 instructions = body' @ [ReturnValue] } in
               [NewFunction m])
     | Var name ->
        var_ref name env
@@ -272,20 +275,34 @@ type class_method = {
   cinit: Asm.meth; init: Asm.meth; methods: Asm.meth list
 }
 
+let init_prefix = 
+  [GetLocal_0;
+   ConstructSuper 0]
+  
 let generate_stmt env stmt =
   match stmt with
       Expr expr -> 
        env,(generate_expr expr env)@[Pop]
     | Define (name,body) ->
        define_scope name env @@ generate_expr body
-    | Ast.Class (name,(ns,sname),attributes,body) ->
-       let name' =
-         make_qname name in
+    | Ast.Class (klass_name,(ns,sname),attributes,body) ->
+       let klass_name' =
+         make_qname klass_name in
        let sname' = 
          make_qname ~ns:ns sname in
-       let prefix = 
-         [GetLocal_0;
-          ConstructSuper 0] in
+       let init =
+         { Asm.empty_method with
+             name = make_qname "init";
+             fun_scope = Asm.Class klass_name';
+             instructions = init_prefix @ [ReturnVoid] } in
+       let cinit = 
+         {Asm.empty_method with
+            name = make_qname "cinit";
+            fun_scope = Asm.Class klass_name';
+            instructions = [ReturnVoid] } in
+       let meth =
+         {Asm.empty_method with
+            fun_scope = Asm.Class klass_name' } in
        let {init=init; cinit=cinit; methods=methods} =
          List.fold_left
            (fun ctx (name,args,body) ->
@@ -293,46 +310,36 @@ let generate_stmt env stmt =
                   "init" -> 
                     {ctx with init = arguments_self args
                         (fun e args' ->
-                           {Asm.empty_method with
+                           {init with
                               params = 
                                args';
-                              name = 
-                               make_qname name;
-                              fun_scope =
-                               Asm.Class name';
                               instructions = 
-                               prefix @ (generate_expr body e) @ [ReturnVoid] }) }
+                               init_prefix @ 
+                                 (generate_expr body e) @ 
+                                 [Pop;ReturnVoid] }) }
                 | "cinit" ->
                     {ctx with cinit = arguments_self args
                         (fun e args' ->
-                           {Asm.empty_method with
+                           {cinit with
                               params =
                                args';
-                              name  =
-                               make_qname name;
-                              fun_scope =
-                               Asm.Class name';
                               instructions =
-                               (generate_expr body e) @ [ReturnVoid] })}
+                               (generate_expr body e) @ [Pop;ReturnVoid] })}
                 | _  ->
                     {ctx with methods = 
                         (arguments_self args
                            (fun e args' ->
-                              {Asm.empty_method with
+                              {meth with
                                  params =
                                   args';
                                  name =
                                   make_qname name;
-                                 fun_scope =
-                                  Asm.Class name';
                                  instructions =
-                                  (generate_expr body e) @ [ReturnValue] })) 
+                                  (generate_expr body e) @ [ReturnValue] }))
                         :: ctx.methods})
-           {init  = make_proc ~scope:(Class name') "init" prefix;
-            cinit = make_proc ~scope:(Class name') "cinit" [];
-            methods = []} body in
+           {init  = init; cinit = cinit; methods = []} body in
        let klass = {
-         Asm.cname  = name';
+         Asm.cname  = klass_name';
          sname      = sname';
          flags_k    = [Sealed];
          cinit      = cinit;
@@ -341,7 +348,7 @@ let generate_stmt env stmt =
          methods    = methods;
          attributes = List.map Cpool.make_qname attributes
        } in
-         define_class name klass env
+         define_class klass_name klass env
 
 let generate_program xs env =
   List.concat @@ snd @@ map_accum_left generate_stmt env xs
@@ -351,7 +358,11 @@ let generate_script xs =
     script_bootstrap () in
   let program =
     generate_program xs env in
-    Asm.make_proc "" (bootstrap @ program)
+    {Asm.empty_method with
+       name = 
+       make_qname "";
+       instructions =
+       bootstrap @ program @ [ReturnVoid]}
 
 let generate program =
   let script = 

diff --git a/test/OMakefile b/test/OMakefile
index 02f4cdd..1a26ad4 100644 (file)
--- a/test/OMakefile
+++ b/test/OMakefile
@@ -64,7 +64,7 @@ FILES[] =
        test_abc
 
 PROGRAM = runner
-OCAML_LIBS += ../src/aosh
+OCAML_LIBS += ../src/habc-core
 
 OCAML_OTHER_LIBS += threads
 

diff --git a/test/test_asm.ml b/test/test_asm.ml
index bc90b7c..1d41a64 100644 (file)
--- a/test/test_asm.ml
+++ b/test/test_asm.ml
@@ -54,22 +54,34 @@ test collect_const =
        multiname @@ make_qname "f";
        multiname @@ make_qname "g"] in
   let meth  =
-    make_meth "g" [
-      PushInt 42;
-      NewFunction (make_meth "f" [PushString "hoge"])] in
+    {Asm.empty_method with
+       name = make_qname "f";
+       instructions = [PushInt 42; 
+                      NewFunction ({Asm.empty_method with
+                                      name = make_qname "g";
+                                      instructions =
+                                       [PushString "hoge"]})]} in
     assert_equal (Cpool.to_abc cpool) (Cpool.to_abc (collect_const meth))
 
 module Set = Core.Std.Set
 
 test collect_method =
    let m1 =
-     make_meth "M1" [PushInt 1] in
+     {Asm.empty_method with
+       name = make_qname "M1";
+       instructions = [] } in
    let m2 =
-     make_meth "M2" [NewFunction m1] in
-   let m3 = 
-     make_meth "M3" [NewFunction m1] in
+     {Asm.empty_method with
+       name = make_qname "M2";
+       instructions = [NewFunction m1] } in
+   let m3 =
+     {Asm.empty_method with
+       name = make_qname "M2";
+       instructions = [NewFunction m2] } in
    let m4 =
-     make_meth "M4" [NewFunction m2;NewFunction m3] in
+     {Asm.empty_method with
+       name = make_qname "M2";
+       instructions = [NewFunction m3] } in
    let expect =
      Set.to_list @@ Set.of_list [m1;m2;m3;m4] in
      assert_equal expect (collect_method m4)

diff --git a/test/test_codegen.ml b/test/test_codegen.ml
index 3d696fd..d740903 100644 (file)
--- a/test/test_codegen.ml
+++ b/test/test_codegen.ml
@@ -27,28 +27,28 @@ let assert_equal lhs rhs =
   OUnit.assert_equal ~printer:Std.dump ~msg:"exceptions"
     lhs.exceptions   rhs.exceptions
 
-let make_meth ?(scope=Global) args inst = {
-  name=make_qname "";
-  params=args;
-  return=0;
-  fun_scope=scope;
-  flags=0;
-  instructions=inst;
-  traits=[];
-  exceptions=[]}
-
 let expr inst = 
-  {Asm.empty_meth with
+  {Asm.empty_method with
+     name =
+      make_qname "";
      instructions=
-      [GetLocal_0;PushScope]@inst@[Pop;ReturnValue]}
+      [GetLocal_0;PushScope]@inst@[Pop;ReturnVoid]}
 
 let toplevel inst = 
-  {Asm.empty_meth with
+  {Asm.empty_method with
+     name =
+      make_qname "";
      instructions=
-      [GetLocal_0;PushScope]@inst@[Pop;ReturnVoid]}
+      [GetLocal_0;PushScope]@inst@[ReturnVoid]}
 
 let inner args inst =
-  make_meth args (inst@[ReturnValue])
+  {Asm.empty_method with
+     name =
+      make_qname "";
+     params =
+      args;
+     instructions=
+      inst@[ReturnValue] }
 
 let qname name =
   QName ((Namespace ""),name)
@@ -273,7 +273,8 @@ test klass =
          flags_k   = [Asm.Sealed];
          attributes = [];
          cinit     = cinit;
-         iinit     = init;
+         iinit     = {init with
+                        instructions = prefix@[PushByte 10;Pop]@[ReturnVoid] };
          interface = [];
          methods   = []})
       (generate_script @@ compile_string 
@@ -300,13 +301,13 @@ test klass_f =
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
          attributes = [];
-         cinit     = ciint;
+         cinit     = cinit;
          iinit     = init;
          interface = [];
          methods   = [{ Asm.empty_method with
                           name = make_qname "f";
                           fun_scope = Asm.Class (make_qname "Foo");
-                          instructions = [PushByte 42;ReturnValue] }];
+                          instructions = [PushByte 42;ReturnValue] }]})
       (generate_script @@ compile_string 
         "(define-class Foo (Object) ())
           (define-method f ((self Foo)) 42)")
@@ -315,15 +316,22 @@ test klass_with_ns =
       let make ns x =
        QName ((Namespace ns),x) in
        assert_equal 
-         (new_class {Asm.cname = make_qname "Foo"; 
-                     sname     = make "flash.text" "Object";
-                     flags_k   = [Asm.Sealed];
-                     attributes = [];
-                     cinit     = ciint;
-                     iinit     = {init with 
-                                    instructions = prefix @ [PushByte 42] @ [ReturnVoid]}
-                     interface = [];
-                     methods   = []})
+         (new_class 
+            {Asm.cname = 
+                make_qname "Foo"; 
+             sname =
+                make "flash.text" "Object";
+             flags_k =
+                [Asm.Sealed];
+             attributes = 
+                [];
+             cinit = 
+                cinit;
+             iinit = 
+                {init with 
+                   instructions = prefix @ [PushByte 42; Pop; ReturnVoid]};
+             interface = [];
+             methods   = []})
          (generate_script @@ compile_string 
             "(define-class Foo (flash.text.Object) ())
               (define-method init ((self Foo))  42)")
@@ -336,11 +344,11 @@ test klass_args =
          flags_k   = [Asm.Sealed];
          attributes = [];
          cinit     = cinit;
-         iinit     = {inti with
-                        args = [0];
+         iinit     = {init with
+                        params = [0];
                         instructions = List.concat [
                           prefix;
-                          [GetLocal 1; ReturnVoid] ] };
+                          [GetLocal 1; Pop;ReturnVoid] ] };
          interface = [];
          methods   = []})
       (generate_script @@ compile_string 
@@ -356,7 +364,7 @@ test klass_self =
          attributes = [];
          cinit     = cinit;
          iinit     = {init with
-                        instructions = prefix @ [GetLocal 1] @ [ReturnVoid] };
+                        instructions = prefix @ [GetLocal 0;Pop;ReturnVoid] };
          interface = [];
          methods   = []})
       (generate_script @@ compile_string 
@@ -374,15 +382,15 @@ test klass_f_args =
          iinit     = init;
          interface = [];
          attributes = [];
-         methods   = [{Asm.empty_metod with
+         methods   = [{Asm.empty_method with
                          name = 
                           make_qname "f";
                          fun_scope = 
                           Asm.Class (make_qname "Foo");
-                         args = 
+                         params = 
                           [0];
                          instructions =
-                          [GetLocal 1;ReturnValue] }]
+                          [GetLocal 1;ReturnValue] }]})
       (generate_script @@ compile_string "(define-class Foo (Object) ())
  (define-method f ((self Foo) x) x)")
 
@@ -393,8 +401,7 @@ test klass_attr =
          sname     = make_qname "Object";
          flags_k   = [Asm.Sealed];
          cinit     = cinit;
-            "cinit" [];
-         iinit     = iint;
+         iinit     = init;
          interface = [];
          attributes = [Cpool.make_qname "x";Cpool.make_qname "y"];
          methods   = []})