ajout POr PAnd PTuple et début PTagged

This commit is contained in:
Nicolas PENELOUX 2023-12-05 23:03:03 +01:00
parent fbd63b1c5d
commit 026805bd12

View file

@ -158,19 +158,40 @@ and pattern_tuple
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
-> HopixTypes.aty * HopixTypes.typing_environment
=
fun tenv plist -> failwith "synth_pattern | PTuple"
fun tenv plist -> let tys, tenv =
List.fold_left(
fun(tys,tenv) pat ->
let (ty,tenv) = synth_pattern tenv pat in
(ty::tys,tenv)
) ([],tenv) plist in
HopixTypes.ATyTuple(List.rev tys), tenv
and pattern_or
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
-> HopixTypes.aty * HopixTypes.typing_environment
=
fun tenv plist -> failwith "synth_pattern | POr"
fun tenv plist ->
let ty', tenv' = synth_pattern tenv (List.hd (plist)) in
let tenv = 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
) tenv' plist
in ty', tenv
(* TODO : Même code que pattern_or, à revoir ?*)
and pattern_and
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
-> HopixTypes.aty * HopixTypes.typing_environment
=
fun tenv plist -> failwith "synth_pattern | PAnd"
fun tenv plist ->
let ty', tenv' = synth_pattern tenv (List.hd (plist)) in
let tenv = 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
) tenv' plist
in ty', tenv
and pattern_tagval
: HopixTypes.typing_environment -> HopixAST.constructor Position.located
@ -178,6 +199,25 @@ 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.
let cons_scheme =
try HopixTypes.lookup_type_scheme_of_constructor cons.position cons.value tenv with
| HopixTypes.Unbound (pos, Constructor (KId c)) ->
HopixTypes.type_error pos (Printf.sprintf "Unbound constructor `%s'." c)
in
let tys =
List.map
(fun x -> HopixTypes.internalize_ty tenv x)
(match tlist with
| Some t -> t
| None -> HopixTypes.type_error cons.position "No types found.")
in
let tcons =
try HopixTypes.instantiate_type_scheme cons_scheme tys with
| HopixTypes.InvalidInstantiation { expected; given } ->
invalid_instantiation cons.position expected given
in
*)
and pattern_record
: HopixTypes.typing_environment
@ -187,6 +227,7 @@ 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