diff options
| author | Alasdair Armstrong | 2019-02-11 16:16:30 +0000 |
|---|---|---|
| committer | Alasdair Armstrong | 2019-02-11 16:16:30 +0000 |
| commit | 9d86711a30ba93a1de7a5112dcfb58365cdbf3fd (patch) | |
| tree | d97a19c84fc8d5dd3a7d1b0748bacd55c40b0dcb /src | |
| parent | 2d2d077599da6bbb035db5fd79dfb6b26a4ba73c (diff) | |
Add tests for implicit arguments
Diffstat (limited to 'src')
| -rw-r--r-- | src/type_check.ml | 13 |
1 files changed, 13 insertions, 0 deletions
diff --git a/src/type_check.ml b/src/type_check.ml index a19f77de..a236323b 100644 --- a/src/type_check.ml +++ b/src/type_check.ml @@ -805,9 +805,22 @@ end = struct with | Not_found -> typ_error env (id_loc id) ("No union constructor found for " ^ string_of_id id) + let rec valid_implicits env start = function + | Typ_aux (Typ_app (Id_aux (Id "implicit", _), [A_aux (A_nexp (Nexp_aux (Nexp_var v, _)), _)]), l) :: rest -> + if start then + valid_implicits env true rest + else + typ_error env l "Arguments are invalid, implicit arguments must come before all other arguments" + | Typ_aux (Typ_app (Id_aux (Id "implicit", _), [A_aux (A_nexp _, l)]), _) :: rest -> + typ_error env l "Implicit argument must contain a single type variable" + | _ :: rest -> valid_implicits env false rest + | [] -> () + let rec update_val_spec id (typq, typ) env = begin match expand_synonyms env typ with | Typ_aux (Typ_fn (arg_typs, ret_typ, effect), l) -> + valid_implicits env true arg_typs; + (* We perform some canonicalisation for function types where existentials appear on the left, so ({'n, 'n >= 2, int('n)}, foo) -> bar would become |