Commit 6ffd23bb authored by Julien Lopez's avatar Julien Lopez
Browse files

Better comp function and one new test on comp

parent a84b4fed
......@@ -86,9 +86,11 @@ let rec comp s1 s2 = match s1, s2 with
| _, Identity -> s1
| Comp(s3, s4), List(_) -> (match comp s4 s2 with
| Comp(_) as s5 when s4 = s5 -> s1
| Comp(_) -> Comp(s1, s2)
| res -> comp s3 res)
| List(_), Comp(s3, s4) | Sel(_), Comp(s3, s4) -> (match comp s1 s3 with
| Comp(_) as s5 when s3 = s5 -> s2
| Comp(_) -> Comp(s1, s2)
| res -> comp res s4)
| Comp(s3, s4), Comp(s5, s6) -> (match comp s4 s5 with
......@@ -99,10 +101,7 @@ let rec comp s1 s2 = match s1, s2 with
| _, _ when not (Var.Set.is_empty (Var.Set.inter (domain s1) (codomain s2)))
-> Comp(s1, s2)
| List(_), List(_) ->
if Var.Set.subset (domain s1) (domain s2) then s2 else Comp(s1, s2)
| Sel(_), List(_) ->
| List(_), List(_) | Sel(_), List(_) ->
if Var.Set.subset (domain s1) (domain s2) then s2 else Comp(s1, s2)
(* Default: comp s1 s2 -> Comp(s1, s2). *)
......
......@@ -45,9 +45,11 @@ let rec comp s1 s2 = match s1, s2 with
| _, Mono -> s1
| Comp(s3, s4), List(_) -> (match comp s4 s2 with
| Comp(_) as s5 when s4 = s5 -> s1
| Comp(_) -> Comp(s1, s2)
| res -> comp s3 res)
| List(_), Comp(s3, s4) | Sel(_), Comp(s3, s4) -> (match comp s1 s3 with
| Comp(_) as s5 when s3 = s5 -> s2
| Comp(_) -> Comp(s1, s2)
| res -> comp res s4)
| Comp(s3, s4), Comp(s5, s6) -> (match comp s4 s5 with
......@@ -58,10 +60,7 @@ let rec comp s1 s2 = match s1, s2 with
| _, _ when not (Var.Set.is_empty (Var.Set.inter (domain s1) (codomain s2)))
-> Comp(s1, s2)
| List(_), List(_) ->
if Var.Set.subset (domain s1) (domain s2) then s2 else Comp(s1, s2)
| Sel(_), List(_) ->
| List(_), List(_) | Sel(_), List(_) ->
if Var.Set.subset (domain s1) (domain s2) then s2 else Comp(s1, s2)
(* Default: comp s1 s2 -> Comp(s1, s2). *)
......
......@@ -508,6 +508,12 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
} })))"
(run_test_eval "(((((fun f x : 'A : 'A -> x)[{A/'B}])[{A/Int}])[{B/Int}])[{B/Int}])[{B/'A}]");
assert_equal ~msg:"Test CDuce.runtime.poly.multicomp.5 failed"
~printer:(fun x -> x) "Abstraction((`$A,`$A),Sel(1,(`$A -> `$A),Comp(Comp({ { `$D = `$C
} ,{ `$C = `$B } },{ { `$B = `$C } }),{ { `$A = `$B } ,{ `$C = `$D
} })))"
(run_test_eval "((((fun f x : 'A : 'A -> x)[{A/'B},{C/'D}])[{B/'C}])[{B/'D}])[{D/'C},{C/'B}]");
);
]
......
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