[TESTS][LAMBDA] Add some tests; fix environment in compute

tests/lambda/src/compute.ml

@@ -156,7 +156,7 @@ and parse_abstr env l loc fun_name iface fv body =
   let t = type_of_ptype ptype in
   let brs = { Typed.br_typ=t; br_accept=accept_type t; br_branches=b } in
   let abstr = { Typed.fun_name=fun_name; fun_iface=iface; fun_body=brs;
-                fun_typ=fun_typ; fun_fv=fv } in
+                fun_typ=fun_typ; fun_fv=(env@fv) } in
   env, l, { Typed.exp_loc=caml_loc_to_cduce loc; exp_typ=fun_typ;
 	    exp_descr=Typed.Abstraction(abstr) }
 
@@ -170,7 +170,7 @@ and make_patterns t fv d =
 
 and parse_branches env l toptype acc btype = function
   | (loc, p, e) :: rest ->
-    let t, d, fv, br_locals, br_used = parse_match_value env l [] toptype p in
+    let t, d, env, br_locals, br_used = parse_match_value env l [] toptype p in
     let line = Loc.start_line loc in
     let cbegin = Loc.start_off loc - Loc.start_bol loc in
     let cend = Loc.stop_off loc - Loc.start_bol loc in
@@ -183,7 +183,7 @@ and parse_branches env l toptype acc btype = function
 	  fname line cbegin cend;
         make_patterns t [] d
        end else
-         make_patterns t fv d
+         make_patterns t env d
     in
     let b = {
       Typed.br_loc = caml_loc_to_cduce loc;
@@ -293,5 +293,5 @@ let to_typed expr =
   Eval.register_op "%" (arith_op ( mod ));
   Eval.register_op "=" equal;
   Eval.register_op "@" concat;
-  let env, _, expr = _to_typed Compile.empty_toplevel Locals.empty expr in
-  env, expr
+  let _, _, expr = _to_typed [] Locals.empty expr in
+  Compile.empty_toplevel, expr

tests/lambda/src/lambdaTests.ml

@@ -74,7 +74,7 @@ let tests_poly_abstr = [
   "Test CDuce.lambda.identity_applied failed",
   "Apply(PolyAbstraction(Dummy,Dummy,,,,Sel(Env(1),(`$A -> `$A),{ { `$A = 
 Int
- } }),Env(1)),Const(2))",
+ } })),Const(2))",
   "(fun f x : 'A : 'A -> x)[{A/Int}].2";
 ];;
 
@@ -109,7 +109,9 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
       assert_equal ~msg:"Test CDuce.runtime.abstr.let_simple failed"
 	~printer:(fun x -> x) "3"
 	(run_test_eval "let x : Int = 3 in x : Int");
-
+      assert_equal ~msg:"Test CDuce.runtime.abstr.let_sum failed"
+	~printer:(fun x -> x) "5"
+	(run_test_eval "let x : Int = 2 in (let y : Int = 3 in (x + y) : Int) : Int");
       assert_equal ~msg:"Test CDuce.runtime.abstr.let_medium failed"
 	~printer:(fun x -> x) "2"
 	(run_test_eval "let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x)
@@ -131,6 +133,10 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
 	~printer:(fun x -> x)
 	"Abstraction((Int,[ Char* ] -> [ Int Char* ]),Mono)"
 	(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
+      assert_equal ~msg:"Test CDuce.runtime.abstr.hard failed"
+	~printer:(fun x -> x)
+	"Abstraction((Int -> Int -> Int,Int -> Int -> Int),Mono)"
+	(run_test_eval "fun (((Int -> Int) -> Int) -> (Int -> Int) -> Int) | x : ((Int -> Int) -> Int) -> (fun ((Int -> Int) -> Int) | y : (Int -> Int) -> x.y)");
     );
 
     "apply" >:: ( fun test_ctxt ->
@@ -215,6 +221,17 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
                           match x : ['A] with
                             | (el : 'A) :: [] -> f.el
                             | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))");
+      assert_equal ~msg:"Test CDuce.runtime.misc.map_even failed"
+	~printer:(fun x -> x)
+	"Abstraction(([ `$A* ],[ `$B* ]),Sel(1,([ `$A* ] -> [ `$B* ]),Id))"
+	(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
+                          match x : ['A] with
+                            | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
+                            | [] -> []).(fun ((Int -> Bool) & ((!Int) -> (!Int)))
+                          | x : Int -> (match (x % 2) : Int with
+                                          | 0 -> `true
+                                          | 1 -> `false)
+                          | x : (!Int) -> x)");
       assert_equal ~msg:"Test CDuce.runtime.misc.map_even_simple failed"
 	~printer:(fun x -> x)
 	"(\"hey\",(Atom(false),Atom(nil),Mono),Mono)"