From 026805bd1250ca59d052bd80ed44fd6bb6264ed9 Mon Sep 17 00:00:00 2001
From: Nicolas PENELOUX <nicolas.peneloux@free.fr>
Date: Tue, 5 Dec 2023 23:03:03 +0100
Subject: [PATCH] =?UTF-8?q?ajout=20POr=20PAnd=20PTuple=20et=20d=C3=A9but?=
 =?UTF-8?q?=20PTagged?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/flap/src/hopix/hopixTypechecker.ml b/flap/src/hopix/hopixTypechecker.ml
index 38c7437..1d4bd98 100644
--- a/flap/src/hopix/hopixTypechecker.ml
+++ b/flap/src/hopix/hopixTypechecker.ml
@@ -158,19 +158,40 @@ and pattern_tuple
   :  HopixTypes.typing_environment -> HopixAST.pattern Position.located list
   -> HopixTypes.aty * HopixTypes.typing_environment
   =
-  fun tenv plist -> failwith "synth_pattern | PTuple"
+  fun tenv plist -> let tys, tenv =
+  List.fold_left(
+    fun(tys,tenv) pat ->
+      let (ty,tenv) = synth_pattern tenv pat in
+      (ty::tys,tenv)
+  ) ([],tenv) plist in
+  HopixTypes.ATyTuple(List.rev tys), tenv
 
 and pattern_or
   :  HopixTypes.typing_environment -> HopixAST.pattern Position.located list
   -> HopixTypes.aty * HopixTypes.typing_environment
   =
-  fun tenv plist -> failwith "synth_pattern | POr"
+  fun tenv plist -> 
+    let ty', tenv' = synth_pattern tenv (List.hd (plist)) in 
+    let tenv = List.fold_left (
+      fun tenv pat ->
+        let pattern_type, tenv = synth_pattern tenv pat in
+        check_equal_types pat.position ~expected:pattern_type ~given:ty';tenv 
+    ) tenv' plist
+      in ty', tenv
 
+      (* TODO : Même code que pattern_or, à revoir ?*)
 and pattern_and
   :  HopixTypes.typing_environment -> HopixAST.pattern Position.located list
   -> HopixTypes.aty * HopixTypes.typing_environment
   =
-  fun tenv plist -> failwith "synth_pattern | PAnd"
+  fun tenv plist -> 
+    let ty', tenv' = synth_pattern tenv (List.hd (plist)) in 
+    let tenv = List.fold_left (
+      fun tenv pat ->
+        let pattern_type, tenv = synth_pattern tenv pat in
+        check_equal_types pat.position ~expected:pattern_type ~given:ty';tenv 
+    ) tenv' plist
+      in ty', tenv
 
 and pattern_tagval
   :  HopixTypes.typing_environment -> HopixAST.constructor Position.located
@@ -178,6 +199,25 @@ and pattern_tagval
   -> HopixTypes.aty * HopixTypes.typing_environment
   =
   fun tenv cons tlist plist -> failwith "synth_pattern | PTagged"
+    (* TODO : à finir (trop fatigué sah): s'inspirer de ce qui a déjà été fait pour lex expressions.
+    let cons_scheme =
+    try HopixTypes.lookup_type_scheme_of_constructor cons.position cons.value tenv with
+    | HopixTypes.Unbound (pos, Constructor (KId c)) ->
+      HopixTypes.type_error pos (Printf.sprintf "Unbound constructor `%s'." c)
+  in
+  let tys =
+    List.map
+      (fun x -> HopixTypes.internalize_ty tenv x)
+      (match tlist with
+       | Some t -> t
+       | None -> HopixTypes.type_error cons.position "No types found.")
+  in
+  let tcons =
+    try HopixTypes.instantiate_type_scheme cons_scheme tys with
+    | HopixTypes.InvalidInstantiation { expected; given } ->
+      invalid_instantiation cons.position expected given
+  in
+ *)
 
 and pattern_record
   :  HopixTypes.typing_environment
@@ -187,6 +227,7 @@ and pattern_record
   =
   fun tenv plist tlist -> failwith "synth_pattern | PRecord"
 
+
 and synth_variable
   :  HopixTypes.typing_environment -> identifier Position.located
   -> ty Position.located list option -> HopixTypes.aty