correction d'un bug
This commit is contained in:
parent
e0bb403e11
commit
8b3a34ba2d
1 changed files with 11 additions and 12 deletions
|
@ -271,33 +271,32 @@ and pattern_record
|
||||||
let LId label_name = label.value in
|
let LId label_name = label.value in
|
||||||
try HopixTypes.lookup_type_constructor_of_label label.position label.value tenv with
|
try HopixTypes.lookup_type_constructor_of_label label.position label.value tenv with
|
||||||
| HopixTypes.Unbound (pos, Label (LId i)) ->
|
| HopixTypes.Unbound (pos, Label (LId i)) ->
|
||||||
HopixTypes.type_error pos (Printf.sprintf "There is no type definition for label `%s'." label_name )
|
HopixTypes.type_error pos (Printf.sprintf "There is no type definition for label `%s'." label_name )
|
||||||
|
|
||||||
(* Printf.sprintf "erreur message ici"*)
|
|
||||||
|
|
||||||
in
|
in
|
||||||
let tlist' =
|
let tlist' =
|
||||||
match tlist with
|
match tlist with
|
||||||
| Some tlist -> List.map (fun t -> HopixTypes.internalize_ty tenv t) tlist
|
| Some tlist -> List.map (fun t -> HopixTypes.internalize_ty tenv t) tlist
|
||||||
| None -> HopixTypes.type_error label.position "No types found."
|
| None -> HopixTypes.type_error label.position "No types found."
|
||||||
in
|
in
|
||||||
List.iter
|
let tenv =
|
||||||
(fun (Position.{ position = label_pos; value = label_val }, pat) ->
|
List.fold_left (
|
||||||
|
fun tenv (Position.{ position = label_pos; value = label_val }, pat) ->
|
||||||
let label_scheme =
|
let label_scheme =
|
||||||
try HopixTypes.lookup_type_scheme_of_label label_pos label_val tenv with
|
try HopixTypes.lookup_type_scheme_of_label label_pos label_val tenv with
|
||||||
| HopixTypes.Unbound (pos, Label (LId i)) ->
|
| HopixTypes.Unbound (pos, Label (LId i)) ->
|
||||||
HopixTypes.type_error pos (Printf.sprintf "Unbound label `%s'." i)
|
HopixTypes.type_error pos (Printf.sprintf "Unbound label `%s'." i)
|
||||||
in
|
in
|
||||||
let arrow =
|
let instance_type_scheme =
|
||||||
try HopixTypes.instantiate_type_scheme label_scheme tlist' with
|
try HopixTypes.instantiate_type_scheme label_scheme tlist' with
|
||||||
| HopixTypes.InvalidInstantiation { expected; given } ->
|
| HopixTypes.InvalidInstantiation { expected; given } ->
|
||||||
invalid_instantiation (Position.position pat) expected given
|
invalid_instantiation (Position.position pat) expected given
|
||||||
in
|
in
|
||||||
let expected,_ = HopixTypes.destruct_function_type label_pos arrow in
|
let _,expected = HopixTypes.destruct_function_type label_pos instance_type_scheme in
|
||||||
let given,_ = synth_pattern tenv pat in
|
let (given,tenv) = synth_pattern tenv pat in
|
||||||
check_equal_types label_pos ~expected ~given)
|
check_equal_types label_pos ~expected ~given; tenv
|
||||||
plist;
|
) tenv plist;
|
||||||
ATyCon (type_cons, tlist'),tenv
|
in
|
||||||
|
ATyCon(type_cons, tlist'),tenv
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Reference in a new issue