Commit 3fbcac2e authored by Julien Lopez's avatar Julien Lopez
Browse files

Add TLVs for records; small fixes in compilation and tests

parent eda0779c
......@@ -10,14 +10,15 @@ let run_test_compile msg expected totest _ =
let tests_poly_abstr = [
"Test CDuce.lambda.const_abstr failed",
"",
"fun f x : 'A : 'A -> 2";
"fun f x : Int : Int -> 2",
"fun f (x : Int) : Int = 2";
(*
"Test CDuce.lambda.let",
"",
"let x : Int = 3 in x : Int",
"let x : Int = 3 in x : Int";
(*
"Test CDuce.lambda.identity",
"",
"(fun f x : 'A : 'A -> x)[{A/Int}].2";
......@@ -51,7 +52,7 @@ let tests_compile = "CDuce compile tests (Typed -> Lambda )" >:::
let run_test_eval msg expected totest _ =
let expected = parse_texpr_vexpr expected in
let totest = parse_cduce_vexpr totest in
assert_equal ~msg:msg ~printer:(fun x -> Value.value_to_string x) expected totest
assert_equal ~msg:msg ~printer:(fun x -> x) (Value.value_to_string expected) (Value.value_to_string totest)
let tests_eval = "CDuce evaluation tests (Typed -> Lambda -> Value )" >:::
List.map (fun (m,e,f) -> f >:: run_test_eval m e f) tests_poly_abstr
......
......@@ -428,12 +428,26 @@ let arrow x y = { empty with
arrow = BoolPair.atom (`Atm (Pair.atom (x,y)));
toplvars = TLV.pair (descr x).toplvars (descr y).toplvars }
(* XXX toplevel variables are not properly set for records *)
let record label t =
{ empty with
record = BoolRec.atom (`Atm (Rec.atom (true,LabelMap.singleton label t))) }
record = BoolRec.atom (`Atm (Rec.atom (true,LabelMap.singleton label t)));
toplvars = (descr t).toplvars}
let tlv_from_rec (_, l) =
let union x y =
let open TLV in {
varonly = x.varonly && y.varonly ;
tlv = Set.union x.tlv y.tlv ;
fv = Var.Set.union x.fv y.fv
} in
let rec aux acc = function
| (_, n) :: rest -> aux (union acc (descr n).toplvars) rest
| [] -> acc in
aux TLV.empty (Ident.LabelMap.get l)
let record_fields x =
{ empty with record = BoolRec.atom (`Atm (Rec.atom x)) }
{ empty with record = BoolRec.atom (`Atm (Rec.atom x));
toplvars = tlv_from_rec x }
let atom a = { empty with atoms = BoolAtoms.atom (`Atm a) }
......
......@@ -213,7 +213,6 @@ module Print = struct
and pp_vars_poly ppf m =
let pp_aux ppf (x,s) = Format.fprintf ppf "%a : %a" Ident.print x Var.Set.print s in
print_lst ~sep:";" pp_aux ppf m
print_lst ~sep:";" pp_aux ppf (Ident.IdMap.get m)
let typed_to_string = print_to_string pp_typed
end
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