From 1f1e58f84ff08dc0f80206ac12a2148bbaa3d291 Mon Sep 17 00:00:00 2001 From: Mylloon Date: Wed, 6 Dec 2023 18:06:52 +0100 Subject: [PATCH] fmt --- flap/src/hopix/hopixTypechecker.ml | 102 +++++++++++++++-------------- 1 file changed, 52 insertions(+), 50 deletions(-) diff --git a/flap/src/hopix/hopixTypechecker.ml b/flap/src/hopix/hopixTypechecker.ml index d5956e5..f4caabb 100644 --- a/flap/src/hopix/hopixTypechecker.ml +++ b/flap/src/hopix/hopixTypechecker.ml @@ -214,7 +214,6 @@ and pattern_tagval -> HopixTypes.aty * HopixTypes.typing_environment = fun tenv cons tlist plist -> - let cons_scheme = try HopixTypes.lookup_type_scheme_of_constructor cons.position cons.value tenv with | HopixTypes.Unbound (pos, Constructor (KId c)) -> @@ -233,31 +232,30 @@ and pattern_tagval invalid_instantiation cons.position expected given in let p_args, tenv = synth_list_pattern tenv plist in - ( - let expected_args, result = - HopixTypes.destruct_function_type_maximally cons.position tcons - in - (try - List.iter2 - (fun expected given -> check_equal_types cons.position ~expected ~given) - expected_args - p_args - with - | Invalid_argument _ -> - (* 35-bad *) - check_equal_types - cons.position - ~expected:result - ~given:(HopixTypes.ATyArrow (result, result))); - result - ),tenv + ( (let expected_args, result = + HopixTypes.destruct_function_type_maximally cons.position tcons + in + (try + List.iter2 + (fun expected given -> check_equal_types cons.position ~expected ~given) + expected_args + p_args + with + | Invalid_argument _ -> + (* 35-bad *) + check_equal_types + cons.position + ~expected:result + ~given:(HopixTypes.ATyArrow (result, result))); + result) + , tenv ) and synth_list_pattern tenv = function -| [] -> [], tenv -| p :: plist -> - let ty, tenv = synth_pattern tenv p in - let tys, tenv = synth_list_pattern tenv plist in - ty::tys, tenv + | [] -> [], tenv + | p :: plist -> + let ty, tenv = synth_pattern tenv p in + let tys, tenv = synth_list_pattern tenv plist in + ty :: tys, tenv and pattern_record : HopixTypes.typing_environment @@ -265,40 +263,44 @@ and pattern_record -> HopixAST.ty Position.located list option -> HopixTypes.aty * HopixTypes.typing_environment = - fun tenv plist tlist -> - let label = fst(List.hd plist) in - let type_cons,_,labels = - let LId label_name = label.value in + fun tenv plist tlist -> + let label = fst (List.hd plist) in + let type_cons, _, labels = + let (LId label_name) = label.value in try HopixTypes.lookup_type_constructor_of_label label.position label.value tenv with | HopixTypes.Unbound (pos, Label (LId i)) -> - HopixTypes.type_error pos (Printf.sprintf "There is no type definition for label `%s'." label_name ) + HopixTypes.type_error + pos + (Printf.sprintf "There is no type definition for label `%s'." label_name) in let tlist' = match tlist with | Some tlist -> List.map (fun t -> HopixTypes.internalize_ty tenv t) tlist | None -> HopixTypes.type_error label.position "No types found." in - let tenv = - List.fold_left ( - fun tenv (Position.{ position = label_pos; value = label_val }, pat) -> - 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 - let instance_type_scheme = - try HopixTypes.instantiate_type_scheme label_scheme tlist' with - | HopixTypes.InvalidInstantiation { expected; given } -> - invalid_instantiation (Position.position pat) expected given - in - let _,expected = HopixTypes.destruct_function_type label_pos instance_type_scheme in - let (given,tenv) = synth_pattern tenv pat in - check_equal_types label_pos ~expected ~given; tenv - ) tenv plist; - in - ATyCon(type_cons, tlist'),tenv - - + let tenv = + List.fold_left + (fun tenv (Position.{ position = label_pos; value = label_val }, pat) -> + 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 + let instance_type_scheme = + try HopixTypes.instantiate_type_scheme label_scheme tlist' with + | HopixTypes.InvalidInstantiation { expected; given } -> + invalid_instantiation (Position.position pat) expected given + in + let _, expected = + HopixTypes.destruct_function_type label_pos instance_type_scheme + in + let given, tenv = synth_pattern tenv pat in + check_equal_types label_pos ~expected ~given; + tenv) + tenv + plist + in + ATyCon (type_cons, tlist'), tenv and synth_variable : HopixTypes.typing_environment -> identifier Position.located