Commit 43ee4bb8 authored by charguer's avatar charguer

cp

parent c3764bf3
......@@ -128,8 +128,8 @@ let rec lift_btyp loc t =
coq_prod (List.map aux ts)
| Btyp_var (b,s,ty) ->
typvar_mark_used ty;
if b then unsupported loc "non-generalizable free type variables (of the form '_a); please add a type annotation, because the relaxed value restriction is not supported.";
(* TODO: check if this is needed *)
(* if b then unsupported loc "non-generalizable free type variables (of the form '_a); please add a type annotation, because the relaxed value restriction is not supported.";
TODO: check if this is needed *)
Coq_var s
| Btyp_poly (ss,t) ->
unsupported_noloc "poly-types"
......@@ -722,15 +722,13 @@ let rec cfg_exp env e =
(* term let-binding *)
end else begin
let (fvs_strict, fvs_others, typ) = get_fvs_typ() in
(* if debug_generic
then *)
Printf.printf "fvs_strict = %s\n" (show_list show_str " , " fvs_strict);
Printf.printf "fvs_others = %s\n" (show_list show_str " , " fvs_others);
if fvs_strict <> [] || fvs_others <> []
then unsupported loc "relaxed value restriction";
if fvs_strict <> [] || fvs_others <> [] then begin
Printf.printf "fvs_strict = %s\n" (show_list show_str " , " fvs_strict);
Printf.printf "fvs_others = %s\n" (show_list show_str " , " fvs_others);
unsupported loc "relaxed value restriction";
(* not_in_normal_form loc ("(un value restriction) "
^ (Print_tast.string_of_expression false e));*)
end;
let cf1 = cfg_exp env bod in
let env' = Ident.add (pattern_ident pat) (List.length fvs_strict) env in
let cf2 = cfg_exp env' body in
......
......@@ -835,7 +835,7 @@ let close_hook ?(showtyp=(fun t -> ())) () =
if debug_generic then begin
Format.fprintf Format.err_formatter "-->now at level %d\n" t.level;
end;
if (t.level = generic_level) && not (List.memq t !r)
if (t.level = generic_level || t.level = !nongen_level) && not (List.memq t !r)
then r := t::!r
| Tunivar -> failwith "unsupported Tunivar type"
| _ -> ()
......
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