fmt

flap/src/hopix/hopixTypechecker.ml

@@ -150,20 +150,27 @@ and pattern_tannot
   let aty_of_ty = HopixTypes.internalize_ty tenv ty in
   match p.value with
   | PWildcard -> aty_of_ty, tenv
-  | PVariable i -> aty_of_ty,HopixTypes.bind_value i.value (HopixTypes.monomorphic_type_scheme aty_of_ty) tenv
+  | PVariable i ->
-  | _ -> let pattern_type, tenv = synth_pattern tenv p in 
+    ( aty_of_ty
-  check_equal_types p.position ~expected:aty_of_ty ~given:pattern_type; pattern_type, tenv
+    , HopixTypes.bind_value i.value (HopixTypes.monomorphic_type_scheme aty_of_ty) tenv )
+  | _ ->
+    let pattern_type, tenv = synth_pattern tenv p in
+    check_equal_types p.position ~expected:aty_of_ty ~given:pattern_type;
+    pattern_type, tenv
 
 and pattern_tuple
   :  HopixTypes.typing_environment -> HopixAST.pattern Position.located list
   -> HopixTypes.aty * HopixTypes.typing_environment
   =
-  fun tenv plist -> let tys, tenv =
+  fun tenv plist ->
-  List.fold_left(
+  let tys, tenv =
-    fun(tys,tenv) pat ->
+    List.fold_left
-      let (ty,tenv) = synth_pattern tenv pat in
+      (fun (tys, tenv) pat ->
-      (ty::tys,tenv)
+        let ty, tenv = synth_pattern tenv pat in
-  ) ([],tenv) plist in
+        ty :: tys, tenv)
+      ([], tenv)
+      plist
+  in
   HopixTypes.ATyTuple (List.rev tys), tenv
 
 and pattern_or
@@ -171,13 +178,17 @@ and pattern_or
   -> HopixTypes.aty * HopixTypes.typing_environment
   =
   fun tenv plist ->
-    let ty', tenv' = synth_pattern tenv (List.hd (plist)) in 
+  let ty', tenv' = synth_pattern tenv (List.hd plist) in
-    let tenv = List.fold_left (
+  let tenv =
-      fun tenv pat ->
+    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 
+        check_equal_types pat.position ~expected:pattern_type ~given:ty';
-    ) tenv' plist
+        tenv)
-      in ty', tenv
+      tenv'
+      plist
+  in
+  ty', tenv
 
 (* TODO : Même code que pattern_or, à revoir ? *)
 and pattern_and
@@ -185,13 +196,17 @@ and pattern_and
   -> HopixTypes.aty * HopixTypes.typing_environment
   =
   fun tenv plist ->
-    let ty', tenv' = synth_pattern tenv (List.hd (plist)) in 
+  let ty', tenv' = synth_pattern tenv (List.hd plist) in
-    let tenv = List.fold_left (
+  let tenv =
-      fun tenv pat ->
+    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 
+        check_equal_types pat.position ~expected:pattern_type ~given:ty';
-    ) tenv' plist
+        tenv)
-      in ty', tenv
+      tenv'
+      plist
+  in
+  ty', tenv
 
 and pattern_tagval
   :  HopixTypes.typing_environment -> HopixAST.constructor Position.located
@@ -199,7 +214,8 @@ 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.
+(* (* 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)) ->
@@ -216,8 +232,7 @@ and pattern_tagval
     try HopixTypes.instantiate_type_scheme cons_scheme tys with
     | HopixTypes.InvalidInstantiation { expected; given } ->
       invalid_instantiation cons.position expected given
-  in
+  in *)
- *)
 
 and pattern_record
   :  HopixTypes.typing_environment
@@ -227,7 +242,6 @@ 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