This commit is contained in:
Mylloon 2023-12-05 20:58:36 +01:00
parent 4990e18caf
commit cfbaa90ed9
Signed by: Anri
GPG key ID: A82D63DFF8D1317F

View file

@ -30,32 +30,36 @@ let check_equal_types pos ~expected ~given =
let rec check_pattern_linearity
: 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
| PLiteral _ -> 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
de chaque liste, et on effectue le check de linéarité pour chaque pattern. Seulement, pour PRecord qui est
un (label located * pattern located), on doit séparer en deux matchs distinct pour "ouvrir" la paire de PRecord *)
| PTaggedValue(_,_,plist) | PTuple(plist) | POr (plist) | PAnd (plist)
-> linearity_pattern_list plist vars
| PRecord(plist,_)
-> linearity_precord_list plist vars
Seulement, pour PRecord qui est 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 ->
linearity_pattern_list plist vars
| PRecord (plist, _) -> linearity_precord_list plist vars
and linearity_variable v vars =
if List.mem v.value vars then
failwith "Il y a déjà une occurence de la variable dans le pattern"
if List.mem v.value vars
then
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 =
List.fold_left (fun vars pat -> check_pattern_linearity vars pat) vars plist
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 *)