PRecord (marche pas)

This commit is contained in:
Nicolas PENELOUX 2023-12-06 16:56:42 +01:00
parent 61bcf58096
commit 9168e114c0

View file

@ -213,7 +213,7 @@ and pattern_tagval
-> HopixAST.ty Position.located list option -> HopixAST.pattern Position.located list
-> HopixTypes.aty * HopixTypes.typing_environment
=
fun tenv cons tlist plist -> (*failwith "synth_pattern | PTagged"*)
fun tenv cons tlist plist ->
let cons_scheme =
try HopixTypes.lookup_type_scheme_of_constructor cons.position cons.value tenv with
@ -265,7 +265,38 @@ and pattern_record
-> HopixAST.ty Position.located list option
-> HopixTypes.aty * HopixTypes.typing_environment
=
fun tenv plist tlist -> failwith "synth_pattern | PRecord"
fun tenv plist tlist ->
let label = fst(List.hd plist) in
let type_cons,_,labels =
let LId label_name = label.value in
HopixTypes.lookup_type_constructor_of_label label.position label.value tenv
(* Printf.sprintf "erreur message ici"*)
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
List.iter
(fun (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 arrow =
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 arrow in
let given,_ = synth_pattern tenv pat in
check_equal_types label_pos ~expected ~given)
plist;
ATyCon (type_cons, tlist'),tenv
and synth_variable
: HopixTypes.typing_environment -> identifier Position.located