ajout check_pattern_linearity
This commit is contained in:
parent
6bbb1f0996
commit
ff8a7f9a31
1 changed files with 29 additions and 5 deletions
|
@ -30,8 +30,32 @@ let check_equal_types pos ~expected ~given =
|
|||
let rec check_pattern_linearity
|
||||
: identifier list -> pattern Position.located -> identifier list
|
||||
=
|
||||
fun vars Position.{ value; position } ->
|
||||
failwith "Students! This is your job! (check_pattern_linearity)"
|
||||
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
|
||||
|
||||
(* 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
|
||||
|
||||
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"
|
||||
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
|
||||
|
||||
|
||||
;;
|
||||
|
||||
(** Type-checking code *)
|
||||
|
@ -92,9 +116,9 @@ and synth_pattern
|
|||
=
|
||||
fun env Position.{ value = p; position = pos } ->
|
||||
match p with
|
||||
| PWildcard -> failwith "synth_pattern | PWildcard"
|
||||
| PLiteral l -> failwith "synth_pattern | Pliteral"
|
||||
| PVariable pv -> failwith "synth_pattern | PVariable"
|
||||
| PWildcard -> assert false
|
||||
| PLiteral l -> synth_literal l.value, env
|
||||
| PVariable pv -> assert false
|
||||
| PTypeAnnotation (p, ty) -> failwith "synth_pattern | PTypeAnnot"
|
||||
| PTuple plist -> failwith "synth_pattern | PTuple"
|
||||
| POr plist -> failwith "synth_pattern | POr"
|
||||
|
|
Reference in a new issue