Merge branch 'jalon3' of gaufre.informatique.univ-paris-diderot.fr:Anri/compilation-m1-2023 into jalon3

flap/src/hopix/hopixTypechecker.ml

@@ -258,32 +258,24 @@ and synth_field
   :  HopixTypes.typing_environment -> expression Position.located
   -> label Position.located -> ty Position.located list option -> HopixTypes.aty
   =
-  fun tenv expr lbl tlist ->
+  fun tenv expr lbl _tlist ->
-  (* TODO *)
+  let expr_type = synth_expression tenv expr in
-  failwith "synth_field"
-(*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
+      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
-        else
+    in
-          failwith "Erreur de label"
+    (* Peut être inutile ? *)
-    )
+    let _ = HopixTypes.lookup_fields_of_type_constructor lbl.position cons tenv in
-    | _ -> failwith "Ceci n'est pas un label"
+    snd (HopixTypes.destruct_function_type lbl.position arrow)
-*)
+  | _ as x -> x
 
 and synth_tuple
   : HopixTypes.typing_environment -> expression Position.located list -> HopixTypes.aty