Commit e18e076b authored by Julien Lopez's avatar Julien Lopez

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

[TESTS][LAMBDA] Improved pp_lambda; update a test
parent 9287f623
......@@ -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
......
......@@ -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";
......
......@@ -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
......
......@@ -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)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment