fmt
This commit is contained in:
parent
026805bd12
commit
e8c6f8da9b
1 changed files with 47 additions and 33 deletions
|
@ -150,48 +150,63 @@ and pattern_tannot
|
||||||
let aty_of_ty = HopixTypes.internalize_ty tenv ty in
|
let aty_of_ty = HopixTypes.internalize_ty tenv ty in
|
||||||
match p.value with
|
match p.value with
|
||||||
| PWildcard -> aty_of_ty, tenv
|
| PWildcard -> aty_of_ty, tenv
|
||||||
| PVariable i -> aty_of_ty,HopixTypes.bind_value i.value (HopixTypes.monomorphic_type_scheme aty_of_ty) tenv
|
| PVariable i ->
|
||||||
| _ -> let pattern_type, tenv = synth_pattern tenv p in
|
( aty_of_ty
|
||||||
check_equal_types p.position ~expected:aty_of_ty ~given:pattern_type; pattern_type, tenv
|
, HopixTypes.bind_value i.value (HopixTypes.monomorphic_type_scheme aty_of_ty) tenv )
|
||||||
|
| _ ->
|
||||||
|
let pattern_type, tenv = synth_pattern tenv p in
|
||||||
|
check_equal_types p.position ~expected:aty_of_ty ~given:pattern_type;
|
||||||
|
pattern_type, tenv
|
||||||
|
|
||||||
and pattern_tuple
|
and pattern_tuple
|
||||||
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
|
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
|
||||||
-> HopixTypes.aty * HopixTypes.typing_environment
|
-> HopixTypes.aty * HopixTypes.typing_environment
|
||||||
=
|
=
|
||||||
fun tenv plist -> let tys, tenv =
|
fun tenv plist ->
|
||||||
List.fold_left(
|
let tys, tenv =
|
||||||
fun(tys,tenv) pat ->
|
List.fold_left
|
||||||
let (ty,tenv) = synth_pattern tenv pat in
|
(fun (tys, tenv) pat ->
|
||||||
(ty::tys,tenv)
|
let ty, tenv = synth_pattern tenv pat in
|
||||||
) ([],tenv) plist in
|
ty :: tys, tenv)
|
||||||
HopixTypes.ATyTuple(List.rev tys), tenv
|
([], tenv)
|
||||||
|
plist
|
||||||
|
in
|
||||||
|
HopixTypes.ATyTuple (List.rev tys), tenv
|
||||||
|
|
||||||
and pattern_or
|
and pattern_or
|
||||||
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
|
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
|
||||||
-> HopixTypes.aty * HopixTypes.typing_environment
|
-> HopixTypes.aty * HopixTypes.typing_environment
|
||||||
=
|
=
|
||||||
fun tenv plist ->
|
fun tenv plist ->
|
||||||
let ty', tenv' = synth_pattern tenv (List.hd (plist)) in
|
let ty', tenv' = synth_pattern tenv (List.hd plist) in
|
||||||
let tenv = List.fold_left (
|
let tenv =
|
||||||
fun tenv pat ->
|
List.fold_left
|
||||||
|
(fun tenv pat ->
|
||||||
let pattern_type, tenv = synth_pattern tenv pat in
|
let pattern_type, tenv = synth_pattern tenv pat in
|
||||||
check_equal_types pat.position ~expected:pattern_type ~given:ty';tenv
|
check_equal_types pat.position ~expected:pattern_type ~given:ty';
|
||||||
) tenv' plist
|
tenv)
|
||||||
in ty', tenv
|
tenv'
|
||||||
|
plist
|
||||||
|
in
|
||||||
|
ty', tenv
|
||||||
|
|
||||||
(* TODO : Même code que pattern_or, à revoir ?*)
|
(* TODO : Même code que pattern_or, à revoir ? *)
|
||||||
and pattern_and
|
and pattern_and
|
||||||
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
|
: HopixTypes.typing_environment -> HopixAST.pattern Position.located list
|
||||||
-> HopixTypes.aty * HopixTypes.typing_environment
|
-> HopixTypes.aty * HopixTypes.typing_environment
|
||||||
=
|
=
|
||||||
fun tenv plist ->
|
fun tenv plist ->
|
||||||
let ty', tenv' = synth_pattern tenv (List.hd (plist)) in
|
let ty', tenv' = synth_pattern tenv (List.hd plist) in
|
||||||
let tenv = List.fold_left (
|
let tenv =
|
||||||
fun tenv pat ->
|
List.fold_left
|
||||||
|
(fun tenv pat ->
|
||||||
let pattern_type, tenv = synth_pattern tenv pat in
|
let pattern_type, tenv = synth_pattern tenv pat in
|
||||||
check_equal_types pat.position ~expected:pattern_type ~given:ty';tenv
|
check_equal_types pat.position ~expected:pattern_type ~given:ty';
|
||||||
) tenv' plist
|
tenv)
|
||||||
in ty', tenv
|
tenv'
|
||||||
|
plist
|
||||||
|
in
|
||||||
|
ty', tenv
|
||||||
|
|
||||||
and pattern_tagval
|
and pattern_tagval
|
||||||
: HopixTypes.typing_environment -> HopixAST.constructor Position.located
|
: HopixTypes.typing_environment -> HopixAST.constructor Position.located
|
||||||
|
@ -199,7 +214,8 @@ and pattern_tagval
|
||||||
-> 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.
|
(* (* 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)) ->
|
||||||
|
@ -216,8 +232,7 @@ 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 *)
|
||||||
*)
|
|
||||||
|
|
||||||
and pattern_record
|
and pattern_record
|
||||||
: HopixTypes.typing_environment
|
: HopixTypes.typing_environment
|
||||||
|
@ -227,7 +242,6 @@ and pattern_record
|
||||||
=
|
=
|
||||||
fun tenv plist tlist -> failwith "synth_pattern | PRecord"
|
fun tenv plist tlist -> failwith "synth_pattern | PRecord"
|
||||||
|
|
||||||
|
|
||||||
and synth_variable
|
and synth_variable
|
||||||
: HopixTypes.typing_environment -> identifier Position.located
|
: HopixTypes.typing_environment -> identifier Position.located
|
||||||
-> ty Position.located list option -> HopixTypes.aty
|
-> ty Position.located list option -> HopixTypes.aty
|
||||||
|
|
Reference in a new issue