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 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 *)