Fresh variables for patterns kept after a call to Compile.approx_var.

[TESTS][LAMBDA] Improved pp_lambda; update a test

compile/compile.ml

@@ -185,8 +185,8 @@ and compile_branch env br =
   let t, fv, d = br.Typed.br_pat.Patterns.descr in
   let fv, d = incr Patterns.counter;
     let freshname = "pat" ^ (string_of_int !Patterns.counter) ^ ":x" in
-    let newfv = fv @ [!Patterns.counter, freshname] in
-    newfv, Patterns.Cap((Types.any, newfv, Patterns.Capture(!Patterns.counter, freshname)), (t, fv, d))
+    let fv = fv @ [!Patterns.counter, freshname] in
+    fv, Patterns.Cap((Types.any, fv, Patterns.Capture(!Patterns.counter, freshname)), (t, fv, d))
   in
   let pat = { br.Typed.br_pat with Patterns.descr=(t,fv,d); Patterns.fv=fv } in
   let env = List.fold_left enter_local env fv in

tests/lambda/src/lambdaTests.ml

@@ -48,7 +48,15 @@ Int } ,{ `$A = [ Char* ]
 `$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow),{}))",
   "fun pair x : ('A[{}] * 'B[{}]) : 'A[{}] -> match x : ('A[{}] * 'B[{}]) with | (z : 'A[{}], y : 'B[{}]) -> z";
 
-  "Test CDuce.runtime.poly.match_abstr failed", "Apply(,)",
+  "Test CDuce.runtime.poly.match_abstr failed", "Apply(Match(Abstraction(Dummy,,,,Sel(,(`$A & Int | Char | Atom | (Any,Any) |
+                                       <(Any) (Any)>Any | Arrow -> `$A & Int |
+                                                                   Char |
+                                                                   Atom |
+                                                                   (Any,Any) |
+                                                                   <(Any) (Any)>Any |
+                                                                   Arrow),{})), {accept_chars=false; brs_disp=<disp>; brs_rhs=[| (2, TVar(Local(0),Comp({},{ { `$A = 
+Int
+ } }))) |]; brs_stack_pos=0}),Const(3))",
   "(match (fun f x : 'A[{}] : 'A[{}] -> x) : ('A[{}] -> 'A[{}]) with | y : ('A[{}] -> 'A[{}]) -> y[{A/Int}]).3";
 
 

tests/lambda/src/printer.ml

@@ -217,8 +217,20 @@ let rec pp_lambda ppf =
   | Apply (e1,e2) -> Format.fprintf ppf "Apply(%a,%a)" pp_lambda e1 pp_lambda e2
   | Abstraction (va, l, b, i, true, sigma) -> Format.fprintf ppf "PolyAbstraction(%a,,,,%a)" pp_vloc_array va pp_sigma sigma
   | Abstraction (va, l, b, i, false, sigma) -> Format.fprintf ppf "Abstraction(%a,,,,%a)" pp_vloc_array va pp_sigma sigma
+  | Check(_) -> Format.fprintf ppf "Check"
+  | Const(v) -> Format.fprintf ppf "Const(%a)" pp_value v
+  | Pair(e1, e2) -> Format.fprintf ppf "Pair(%a, %a)" pp_lambda e1 pp_lambda e2
+  | String(_) -> Format.fprintf ppf "String"
+  | Match(e, brs) -> Format.fprintf ppf "Match(%a, %a)" pp_lambda e pp_lbranches brs
   | _ -> ()
 
+and pp_lbranches ppf brs =
+  let open Lambda in
+  Format.fprintf ppf "{accept_chars=%b; brs_disp=<disp>; brs_rhs=[| %a |]; brs_stack_pos=%d}" brs.brs_accept_chars pp_patrhs brs.brs_rhs brs.brs_stack_pos
+
+and pp_patrhs ppf arr =
+  Array.iter (function | Auto_pat.Match(i, e) -> Format.fprintf ppf "(%d, %a)" i pp_lambda e | _ -> ()) arr
+
 let print_to_string f x =
   let b = Buffer.create 1024 in
   let ppf = Format.formatter_of_buffer b in

types/patterns.ml

@@ -371,10 +371,9 @@ x=(1,2)
 	  approx_var seen p2 (Types.diff t a1)
 	    (approx_var seen p1 (Types.cap t a1) xs) 
       | Cap ((_,fv1,d1) as p1,((_,fv2,d2) as p2)) ->
-	(* TODO: In case we have a fresh variable, we must keep it somewhere *)
 	(match d1 with
 	  | Capture(_, name) when Str.string_match (Str.regexp "pat[0-9]+:") name 0 ->
-	    (match d2 with | Constr _ -> xs | _ -> approx_var seen p2 t xs)
+	    (match d2 with | Constr _ -> fv2 | _ -> approx_var seen p2 t xs)
 	  | _ -> IdSet.cup
 	    (approx_var seen p1 t (IdSet.cap fv1 xs))
 	    (approx_var seen p2 t (IdSet.cap fv2 xs)))