fmt
This commit is contained in:
parent
4990e18caf
commit
cfbaa90ed9
1 changed files with 20 additions and 16 deletions
|
@ -30,32 +30,36 @@ let check_equal_types pos ~expected ~given =
|
||||||
let rec check_pattern_linearity
|
let rec check_pattern_linearity
|
||||||
: identifier list -> pattern Position.located -> identifier list
|
: identifier list -> pattern Position.located -> identifier list
|
||||||
=
|
=
|
||||||
fun vars Position.{ value; position } -> match value with
|
fun vars Position.{ value; position = _ } ->
|
||||||
|
match value with
|
||||||
| PWildcard -> vars
|
| PWildcard -> vars
|
||||||
| PLiteral _ -> vars
|
| PLiteral _ -> vars
|
||||||
| PVariable v -> linearity_variable v vars
|
| PVariable v -> linearity_variable v vars
|
||||||
| PTypeAnnotation(p,_) -> check_pattern_linearity vars p
|
| PTypeAnnotation (p, _) ->
|
||||||
|
(* Pour les deux matchs qui suivent, on fait la même chose :
|
||||||
|
On regarde récursivement chaque pattern de chaque liste, et on effectue le
|
||||||
|
check de linéarité pour chaque pattern.
|
||||||
|
|
||||||
(* Pour les deux matchs qui suivent, on fait la même chose : On regarde récursivement chaque pattern
|
Seulement, pour PRecord qui est un (label located * pattern located),
|
||||||
de chaque liste, et on effectue le check de linéarité pour chaque pattern. Seulement, pour PRecord qui est
|
on doit séparer en deux matchs distinct pour "ouvrir" la paire de PRecord *)
|
||||||
un (label located * pattern located), on doit séparer en deux matchs distinct pour "ouvrir" la paire de PRecord *)
|
check_pattern_linearity vars p
|
||||||
| PTaggedValue(_,_,plist) | PTuple(plist) | POr (plist) | PAnd (plist)
|
| PTaggedValue (_, _, plist) | PTuple plist | POr plist | PAnd plist ->
|
||||||
-> linearity_pattern_list plist vars
|
linearity_pattern_list plist vars
|
||||||
| PRecord(plist,_)
|
| PRecord (plist, _) -> linearity_precord_list plist vars
|
||||||
-> linearity_precord_list plist vars
|
|
||||||
|
|
||||||
and linearity_variable v vars =
|
and linearity_variable v vars =
|
||||||
if List.mem v.value vars then
|
if List.mem v.value vars
|
||||||
failwith "Il y a déjà une occurence de la variable dans le pattern"
|
then
|
||||||
else v.value::vars
|
HopixTypes.type_error
|
||||||
|
v.position
|
||||||
|
"Il y a déjà une occurence de la variable dans le pattern"
|
||||||
|
else v.value :: vars
|
||||||
|
|
||||||
and linearity_pattern_list plist vars =
|
and linearity_pattern_list plist vars =
|
||||||
List.fold_left (fun vars pat -> check_pattern_linearity vars pat) vars plist
|
List.fold_left (fun vars pat -> check_pattern_linearity vars pat) vars plist
|
||||||
|
|
||||||
and linearity_precord_list plist vars =
|
and linearity_precord_list plist vars =
|
||||||
List.fold_left (fun vars (label,pat) -> check_pattern_linearity vars pat) vars plist
|
List.fold_left (fun vars (_, pat) -> check_pattern_linearity vars pat) vars plist
|
||||||
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
|
|
||||||
(** Type-checking code *)
|
(** Type-checking code *)
|
||||||
|
|
Reference in a new issue