From 8b3a34ba2df1572a64ad43984ec5252fdecfaa4a Mon Sep 17 00:00:00 2001 From: Nicolas PENELOUX Date: Wed, 6 Dec 2023 18:05:43 +0100 Subject: [PATCH] correction d'un bug --- flap/src/hopix/hopixTypechecker.ml | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/flap/src/hopix/hopixTypechecker.ml b/flap/src/hopix/hopixTypechecker.ml index afab0d9..d5956e5 100644 --- a/flap/src/hopix/hopixTypechecker.ml +++ b/flap/src/hopix/hopixTypechecker.ml @@ -271,33 +271,32 @@ and pattern_record let LId label_name = label.value in try HopixTypes.lookup_type_constructor_of_label label.position label.value tenv with | HopixTypes.Unbound (pos, Label (LId i)) -> - HopixTypes.type_error pos (Printf.sprintf "There is no type definition for label `%s'." label_name ) - - (* Printf.sprintf "erreur message ici"*) - + HopixTypes.type_error pos (Printf.sprintf "There is no type definition for label `%s'." label_name ) in let tlist' = match tlist with | Some tlist -> List.map (fun t -> HopixTypes.internalize_ty tenv t) tlist | None -> HopixTypes.type_error label.position "No types found." in - List.iter - (fun (Position.{ position = label_pos; value = label_val }, pat) -> + let tenv = + List.fold_left ( + fun tenv (Position.{ position = label_pos; value = label_val }, pat) -> let label_scheme = try HopixTypes.lookup_type_scheme_of_label label_pos label_val tenv with | HopixTypes.Unbound (pos, Label (LId i)) -> HopixTypes.type_error pos (Printf.sprintf "Unbound label `%s'." i) in - let arrow = + let instance_type_scheme = try HopixTypes.instantiate_type_scheme label_scheme tlist' with | HopixTypes.InvalidInstantiation { expected; given } -> invalid_instantiation (Position.position pat) expected given in - let expected,_ = HopixTypes.destruct_function_type label_pos arrow in - let given,_ = synth_pattern tenv pat in - check_equal_types label_pos ~expected ~given) - plist; - ATyCon (type_cons, tlist'),tenv + let _,expected = HopixTypes.destruct_function_type label_pos instance_type_scheme in + let (given,tenv) = synth_pattern tenv pat in + check_equal_types label_pos ~expected ~given; tenv + ) tenv plist; + in + ATyCon(type_cons, tlist'),tenv