From 624590e8492d1f8a3fc92bc2f85bc363552cb24c Mon Sep 17 00:00:00 2001
From: Mylloon <kennel.anri@tutanota.com>
Date: Tue, 5 Dec 2023 20:27:51 +0100
Subject: [PATCH 1/2] wip: synth_field

---
 flap/src/hopix/hopixTypechecker.ml | 39 ++++++++++++------------------
 1 file changed, 15 insertions(+), 24 deletions(-)

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

From a6f8ea69d0721a9dd4886acd5923d63f2600d2ea Mon Sep 17 00:00:00 2001
From: Mylloon <kennel.anri@tutanota.com>
Date: Tue, 5 Dec 2023 20:39:55 +0100
Subject: [PATCH 2/2] ? j'en sais rien

---
 flap/src/hopix/hopixTypechecker.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/flap/src/hopix/hopixTypechecker.ml b/flap/src/hopix/hopixTypechecker.ml
index 62f45b7..663e942 100644
--- a/flap/src/hopix/hopixTypechecker.ml
+++ b/flap/src/hopix/hopixTypechecker.ml
@@ -234,7 +234,7 @@ 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 ->
   let expr_type = synth_expression tenv expr in
   match expr_type with
   | ATyCon (cons, atlist) ->
@@ -248,7 +248,8 @@ and synth_field
       | HopixTypes.InvalidInstantiation { expected; given } ->
         invalid_instantiation (Position.position expr) expected given
     in
-    (* TODO: On doit utiliser cons et tlist aussi *)
+    (* Peut être inutile ? *)
+    let _ = HopixTypes.lookup_fields_of_type_constructor lbl.position cons tenv in
     snd (HopixTypes.destruct_function_type lbl.position arrow)
   | _ as x -> x