PTagged 72/111

This commit is contained in:
Nicolas PENELOUX 2023-12-06 14:46:18 +01:00
parent c98eb70a06
commit 61bcf58096

View file

@ -213,9 +213,8 @@ and pattern_tagval
-> HopixAST.ty Position.located list option -> HopixAST.pattern Position.located list -> HopixAST.ty Position.located list option -> HopixAST.pattern Position.located list
-> HopixTypes.aty * HopixTypes.typing_environment -> HopixTypes.aty * HopixTypes.typing_environment
= =
fun tenv cons tlist plist -> failwith "synth_pattern | PTagged" 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 = let cons_scheme =
try HopixTypes.lookup_type_scheme_of_constructor cons.position cons.value tenv with try HopixTypes.lookup_type_scheme_of_constructor cons.position cons.value tenv with
| HopixTypes.Unbound (pos, Constructor (KId c)) -> | HopixTypes.Unbound (pos, Constructor (KId c)) ->
@ -232,7 +231,33 @@ and pattern_tagval
try HopixTypes.instantiate_type_scheme cons_scheme tys with try HopixTypes.instantiate_type_scheme cons_scheme tys with
| HopixTypes.InvalidInstantiation { expected; given } -> | HopixTypes.InvalidInstantiation { expected; given } ->
invalid_instantiation cons.position expected given invalid_instantiation cons.position expected given
in *) 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
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
and pattern_record and pattern_record
: HopixTypes.typing_environment : HopixTypes.typing_environment