diff --git a/flap/src/hopix/hopixTypechecker.ml b/flap/src/hopix/hopixTypechecker.ml index 7a54b9f..62f45b7 100644 --- a/flap/src/hopix/hopixTypechecker.ml +++ b/flap/src/hopix/hopixTypechecker.ml @@ -235,31 +235,22 @@ and synth_field -> label Position.located -> ty Position.located list option -> HopixTypes.aty = fun tenv expr lbl tlist -> - (* TODO *) - failwith "synth_field" -(*let expr_type = synth_expression tenv expr in + let expr_type = synth_expression tenv expr in match expr_type with - | ATyCon(cons,atlist) -> - ( - (* Impossible car n'est pas dans le mli*) - let lbllist = HopixTypes.lookup_information_of_type_constructor lbl.position cons tenv in - match lbllist with - | Record r -> - if List.mem lbl.value r - then - 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 - try HopixTypes.instantiate_type_scheme label_scheme atlist with - | HopixTypes.InvalidInstantiation { expected; given } -> - invalid_instantiation (Position.position expr) expected given - else - failwith "Erreur de label" - ) - | _ -> failwith "Ceci n'est pas un label" -*) + | ATyCon (cons, atlist) -> + let label_scheme = + try HopixTypes.lookup_type_scheme_of_label lbl.position lbl.value tenv with + | HopixTypes.Unbound (pos, Label (LId i)) -> + HopixTypes.type_error pos (Printf.sprintf "Unbound label `%s'." i) + in + let arrow = + try HopixTypes.instantiate_type_scheme label_scheme atlist with + | HopixTypes.InvalidInstantiation { expected; given } -> + invalid_instantiation (Position.position expr) expected given + in + (* TODO: On doit utiliser cons et tlist aussi *) + snd (HopixTypes.destruct_function_type lbl.position arrow) + | _ as x -> x and synth_tuple : HopixTypes.typing_environment -> expression Position.located list -> HopixTypes.aty