Merge branch 'codegen-alex' into codegen-alex-opt

8 files changed, 254 insertions, 24 deletions

diff --git a/src/typing.ml b/src/typing.ml
index 7a76b69..56942f1 100644
--- a/src/typing.ml
+++ b/src/typing.ml
@@ -395,9 +395,9 @@ and compute_type env e =
                     | Some k ->
                         begin try 
                             let proto = closest_proto env.b_pe args_types (find_protos_in_class env.b_pe k.tc_name i) in
-                            let upcasted = if proto.tp_virtual = None then e_this_not_ptr
-                                  else upcast env.b_pe e_this_not_ptr 
-                                  (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in
+                            let upcasted =
+                                  upcast env.b_pe e_this_not_ptr
+                                     (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in
                             Some upcasted, proto
                         with NoCorrespondingPrototype ->
                             None, closest_proto env.b_pe args_types funs
@@ -408,9 +408,9 @@ and compute_type env e =
                     begin match e.type_expr with
                     | TClass(k), a, b when a || b ->
                         let proto = closest_proto env.b_pe args_types (find_protos_in_class env.b_pe k i) in
-                        let upcasted = if proto.tp_virtual = None then e
-                              else upcast env.b_pe e
-                              (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in
+                        let upcasted =
+                              upcast env.b_pe e
+                                 (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in
                         Some upcasted, proto
                     | _ -> ty_error "Invalid argument type for method call (not a class, or not a lvalue)"
                     end
@@ -420,9 +420,8 @@ and compute_type env e =
                         let sc = try find_cls_superclass env.b_pe k.tc_name c
                             with Not_found -> ty_error (c ^ " is no superclass of current class " ^ k.tc_name) in
                         let proto = closest_proto env.b_pe args_types (find_protos_in_class env.b_pe sc.h_class i) in
-                        let upcasted = if proto.tp_virtual = None
-                            then upcast env.b_pe e_this_not_ptr (TClass(c))
-                            else upcast env.b_pe e_this_not_ptr
+                        let upcasted =
+                            upcast env.b_pe e_this_not_ptr
                                 (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in
                         Some upcasted, proto
                     | None -> ty_error "Qualified identifier in a function belonging to no class."
@@ -585,17 +584,18 @@ let parse_args env a =
     let rec aux = function
         | [] -> ()
         | p::q -> ty_assert (not (List.mem p q)) ("Argument name appears twice : " ^ p); aux q
-    in aux (List.map snd args);
-    args
+    in
+        aux (List.map snd args);
+        args
  
 let get_fun env p b = (* p : proto   b : block -> tp, tb, env2*)
   assert (p.p_class = None);
   let name = p.p_name in
-  let ty_args = parse_args env p.p_args in
+  let args = parse_args env p.p_args in
   (* Check there is not already a function with similar prototype *)
-  let args_type = List.map fst ty_args in
+  let args_types = List.map fst args in
   ty_assert (not (List.exists
-    (fun p -> p.tp_name = name && (List.map fst p.tp_args) = args_type) env.e_funs))
+    (fun p -> p.tp_name = name && (List.map fst p.tp_args) = args_types) env.e_funs))
     ("Redefinition of function: " ^ name);
 
   let ret_type = build_type_or_ref
@@ -610,13 +610,13 @@ let get_fun env p b = (* p : proto   b : block -> tp, tb, env2*)
         tp_class = None ;
         tp_virtual = None ;
         tp_ret_type = Some ret_type ;
-        tp_args = ty_args; } in
+        tp_args = args; } in
   let env2 = { env with e_funs = tproto::(env.e_funs) } in
   (* Build local env *)
   let locales = List.fold_left (* tr = (ty,ref?) *)
-    (fun envir (tr,i) -> Smap.add i tr envir)
+    (fun envir (tr, i) -> Smap.add i tr envir)
     Smap.empty
-    ty_args
+    args
   in (* contexte ds l'instruction *)
   let contexte = { b_pe = env2; b_locals = locales; b_class = None } in
   let tb = get_block ret_type contexte b in (* vérif instructions typées*)
@@ -668,9 +668,10 @@ let compute_tclass env c =
                     ty_assert (proto.p_ret_type <> None || proto.p_name = cls_name) "Invalid name for constructor";
                     (* Make sure prototype is well formed *)
                     let args = parse_args forward_env proto.p_args in
+                    let args_types = List.map fst args in
                     (* Make sure method is compatible with other declarations in this class *)
                     ty_assert (not (List.exists
-                            (fun p -> p.tp_name = proto.p_name && (List.map fst p.tp_args) = (List.map fst args)) meth))
+                            (fun p -> p.tp_name = proto.p_name && (List.map fst p.tp_args) = args_types) meth))
                         ("Redefinition of function " ^ proto.p_name ^ " with same argument types.");
                     (* Check return type *)
                     let ret_type = match proto.p_ret_type with
@@ -693,7 +694,7 @@ let compute_tclass env c =
                       | Some k -> Some k
                       | None ->
                         List.fold_left (fun f (i, p) -> 
-                          if (p.tp_name = proto.p_name && (List.map fst p.tp_args) = (List.map fst args))
+                          if (p.tp_name = proto.p_name && (List.map fst p.tp_args) = args_types)
                             then Some (s, i)
                             else f) None s.h_vtable
                     in let super = match check_in_super hier with
@@ -758,21 +759,24 @@ let get_method env proto block =    (* return : TDFunction *)
     | Some(cls_name) ->
     try let c = get_c env cls_name in
         let args = parse_args env proto.p_args in
+        let args_types = List.map fst args in
         let ret_type = match proto.p_ret_type with
             | Some k -> Some (build_type_or_ref k)
             | None -> None in
         (* Find prototype in class *)
         begin try let cproto = List.find 
-                (fun p -> p.tp_args = args && p.tp_ret_type = ret_type && p.tp_name = proto.p_name) c.tc_methods
+                (fun p -> (List.map fst p.tp_args) = args_types
+                    && p.tp_ret_type = ret_type
+                    && p.tp_name = proto.p_name) c.tc_methods
             in
             let locals = List.fold_left
-                (fun env (tr, i) -> Smap.add i tr env) Smap.empty args in
+                (fun env (ty, i) -> Smap.add i ty env) Smap.empty args in
             let contexte = {
                 b_pe = env;
                 b_locals = locals;
                 b_class = Some c; } in
             let tb = get_block (match ret_type with | None -> T_Void, false | Some k -> k) contexte block in
-                cproto, tb
+                { cproto with tp_args = args }, tb
         with
         | Not_found -> ty_error ("Implementation corresponds to no declared method of class " ^ cls_name)
         end
@@ -793,14 +797,14 @@ let compute_decl env d =
                 { env with e_globals = (Smap.add i tr env.e_globals); }
           (* on voudrait une liste de ident pr decl plsr en meme temps *)
           | DFunction (p,b) ->
-            ty_assert (not (Smap.mem p.p_name env.e_globals)) ("Redeclaration of: " ^ p.p_name ^ ", was previously a global variable");
             begin match p.p_class with
             | None ->
+                ty_assert (not (Smap.mem p.p_name env.e_globals)) ("Redeclaration of: " ^ p.p_name ^ ", was previously a global variable");
                 let tp, tb, env2 = get_fun env p b in
                 TDFunction(tp, tb), env2
             | Some _ ->
                 let tp, tb = get_method env p b in
-                (TDFunction(tp, tb)), env(* env is not modified *)
+                (TDFunction(tp, tb)), env (* env is not modified *)
             end
           | DClass c ->
             let tc = compute_tclass env c in
diff --git a/tests/exec/Makefile b/tests/exec/Makefile
index b260ba0..afe0fdc 100644
--- a/tests/exec/Makefile
+++ b/tests/exec/Makefile
@@ -1,3 +1,6 @@
+%.out: %.cpp
+	g++ -o /tmp/tmp_exec_test $^ && /tmp/tmp_exec_test > $@ && rm /tmp/tmp_exec_test
+
 
 %: %.cpp
 	g++ -o $@ $^
diff --git a/tests/exec/multisuper1.cpp b/tests/exec/multisuper1.cpp
new file mode 100644
index 0000000..48014f7
--- /dev/null
+++ b/tests/exec/multisuper1.cpp
@@ -0,0 +1,57 @@
+#include <iostream>
+
+class A {
+    public:
+    int y;
+    A();
+    int f(int x);
+};
+
+class B {
+    public:
+    int z;
+    B();
+    int g(int x);
+};
+
+class C : public A, public B {
+    public:
+    int q;
+    C();
+    int f(int x);
+};
+
+A::A() {
+    y = 12;
+}
+
+B::B() {
+    z = 7;
+}
+
+C::C() {
+    q = 11;
+}
+
+int A::f(int x) {
+    return x * y;
+}
+
+int B::g(int x) {
+    return x * z;
+}
+
+int C::f(int x) {
+    return x * q;
+}
+
+int main() {
+    C test;
+    std::cout << "C.f(1) = " << test.f(1) << "\n";
+    std::cout << "C.g(1) = " << test.g(1) << "\n";
+    A *q = &test;
+    std::cout << "A.f(1) = " << q->f(1) << "\n";
+    B *r = &test;
+    std::cout << "B.g(1) = " << r->g(1) << "\n";
+}
+
diff --git a/tests/exec/multisuper1.out b/tests/exec/multisuper1.out
new file mode 100644
index 0000000..0298410
--- /dev/null
+++ b/tests/exec/multisuper1.out
@@ -0,0 +1,4 @@
+C.f(1) = 11
+C.g(1) = 7
+A.f(1) = 12
+B.g(1) = 7
diff --git a/tests/exec/multisuper2.cpp b/tests/exec/multisuper2.cpp
new file mode 100644
index 0000000..42d51ac
--- /dev/null
+++ b/tests/exec/multisuper2.cpp
@@ -0,0 +1,68 @@
+#include <iostream>
+
+class A {
+    public:
+    int y;
+    A();
+    virtual int f(int x);
+};
+
+class B {
+    public:
+    int z;
+    B();
+    int g(int x);
+};
+
+class C : public A, public B {
+    public:
+    int q;
+    C();
+    virtual int f(int x);
+    int g(int x);
+};
+
+A::A() {
+    y = 12;
+}
+
+B::B() {
+    z = 7;
+}
+
+C::C() {
+    q = 11;
+}
+
+int A::f(int x) {
+    return x * y;
+}
+
+int B::g(int x) {
+    return x * z;
+}
+
+int C::f(int x) {
+    return x * q;
+}
+
+int C::g(int x) {
+    return x * q * 404;
+}
+
+int main() {
+    A test2;
+    std::cout << "A.f(1) = " << test2.f(1) << "\n";
+
+    B test3;
+    std::cout << "B.g(1) = " << test3.g(1) << "\n";
+
+    C test;
+    std::cout << "C.f(1) = " << test.f(1) << "\n";
+    std::cout << "C.g(1) = " << test.g(1) << "\n";
+    A *q = &test;
+    std::cout << "(C as A).f(1) = " << q->f(1) << "\n";
+    B *r = &test;
+    std::cout << "(C as B).g(1) = " << r->g(1) << "\n";
+}
+
diff --git a/tests/exec/multisuper2.out b/tests/exec/multisuper2.out
new file mode 100644
index 0000000..c850040
--- /dev/null
+++ b/tests/exec/multisuper2.out
@@ -0,0 +1,6 @@
+A.f(1) = 12
+B.g(1) = 7
+C.f(1) = 11
+C.g(1) = 4444
+(C as A).f(1) = 11
+(C as B).g(1) = 7
diff --git a/tests/exec/multisuper3.cpp b/tests/exec/multisuper3.cpp
new file mode 100644
index 0000000..55f4c45
--- /dev/null
+++ b/tests/exec/multisuper3.cpp
@@ -0,0 +1,76 @@
+#include <iostream>
+
+class A {
+    public:
+    int y;
+    A();
+    virtual int f(int x);
+};
+
+class B {
+    public:
+    int z;
+    B();
+    int g(int x);
+};
+
+class C : public A, public B {
+    public:
+    int q;
+    C();
+    virtual int f(int x);
+    int g(int x);
+};
+
+A::A() {
+    y = 12;
+}
+
+B::B() {
+    z = 7;
+}
+
+C::C() {
+    q = 11;
+}
+
+int A::f(int xopia) {
+    y++;
+    return xopia * y;
+}
+
+int B::g(int xulliver) {
+    z++;
+    return xulliver * z;
+}
+
+int C::f(int xerod) {
+    return xerod * q;
+}
+
+int C::g(int xavon) {
+    return xavon * q * 404;
+}
+
+int main() {
+    A test2;
+    std::cout << "A.f(1) = " << test2.f(1) << "\n";
+
+    B test3;
+    std::cout << "B.g(1) = " << test3.g(1) << "\n";
+
+    C test;
+    std::cout << "C.f(1) = " << test.f(1) << "\n";
+    std::cout << "C.g(1) = " << test.g(1) << "\n";
+    A *q = &test;
+    std::cout << "(C as A).f(1) = " << q->f(1) << "\n";
+    std::cout << "C.f(1) = " << test.f(1) << "\n";
+    std::cout << "(C as A).f(1) = " << q->f(1) << "\n";
+    std::cout << "C.f(1) = " << test.f(1) << "\n";
+    B *r = &test;
+    std::cout << "(C as B).g(1) = " << r->g(1) << "\n";
+    std::cout << "C.g(1) = " << test.g(1) << "\n";
+    std::cout << "(C as B).g(1) = " << r->g(1) << "\n";
+    std::cout << "C.g(1) = " << test.g(1) << "\n";
+}
+
diff --git a/tests/exec/multisuper3.out b/tests/exec/multisuper3.out
new file mode 100644
index 0000000..cead147
--- /dev/null
+++ b/tests/exec/multisuper3.out
@@ -0,0 +1,12 @@
+A.f(1) = 13
+B.g(1) = 8
+C.f(1) = 11
+C.g(1) = 4444
+(C as A).f(1) = 11
+C.f(1) = 11
+(C as A).f(1) = 11
+C.f(1) = 11
+(C as B).g(1) = 8
+C.g(1) = 4444
+(C as B).g(1) = 9
+C.g(1) = 4444