Paris7/compilation
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Activity

Merge branch 'jalon3' of gaufre.informatique.univ-paris-diderot.fr:Anri/compilation-m1-2023 into jalon3

Browse source
This commit is contained in:
Nicolas PENELOUX 2023-12-05 20:48:41 +01:00
commit 90bec5c08d
1 changed files with 17 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
flap/src/hopix/hopixTypechecker.ml
View file

@ -258,32 +258,24 @@ and synth_field
: HopixTypes.typing_environment -> expression Position.located : HopixTypes.typing_environment -> expression Position.located
-> label Position.located -> ty Position.located list option -> HopixTypes.aty -> label Position.located -> ty Position.located list option -> HopixTypes.aty
= =
fun tenv expr lbl tlist -> fun tenv expr lbl _tlist ->
(* TODO *) let expr_type = synth_expression tenv expr in
failwith "synth_field"
(*let expr_type = synth_expression tenv expr in
match expr_type with match expr_type with
| ATyCon(cons,atlist) -> | ATyCon (cons, atlist) ->
( let label_scheme =
(* Impossible car n'est pas dans le mli*) try HopixTypes.lookup_type_scheme_of_label lbl.position lbl.value tenv with
let lbllist = HopixTypes.lookup_information_of_type_constructor lbl.position cons tenv in | HopixTypes.Unbound (pos, Label (LId i)) ->
match lbllist with HopixTypes.type_error pos (Printf.sprintf "Unbound label `%s'." i)
| Record r -> in
if List.mem lbl.value r let arrow =
then try HopixTypes.instantiate_type_scheme label_scheme atlist with
let label_scheme = | HopixTypes.InvalidInstantiation { expected; given } ->
try HopixTypes.lookup_type_scheme_of_label label_pos label_val tenv with invalid_instantiation (Position.position expr) expected given
| HopixTypes.Unbound (pos, Label (LId i)) -> in
HopixTypes.type_error pos (Printf.sprintf "Unbound label `%s'." i) (* Peut être inutile ? *)
in let _ = HopixTypes.lookup_fields_of_type_constructor lbl.position cons tenv in
try HopixTypes.instantiate_type_scheme label_scheme atlist with snd (HopixTypes.destruct_function_type lbl.position arrow)
| HopixTypes.InvalidInstantiation { expected; given } -> | _ as x -> x
invalid_instantiation (Position.position expr) expected given
else
failwith "Erreur de label"
)
| _ -> failwith "Ceci n'est pas un label"
*)
and synth_tuple and synth_tuple
: HopixTypes.typing_environment -> expression Position.located list -> HopixTypes.aty : HopixTypes.typing_environment -> expression Position.located list -> HopixTypes.aty