Skip to content

Commit

Permalink
Fix typing rule for E_vector_update
Browse files Browse the repository at this point in the history
Potentially means a few less things typecheck, but should be much simpler
and avoids bad cases where it could backtrack a lot
  • Loading branch information
Alasdair committed Feb 9, 2024
1 parent 35a56cb commit 5929b9b
Show file tree
Hide file tree
Showing 5 changed files with 50 additions and 26 deletions.
44 changes: 28 additions & 16 deletions src/lib/type_check.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3274,22 +3274,7 @@ and infer_exp env (E_aux (exp_aux, (l, uannot)) as exp) =
)
| exn -> raise exn
end
| E_vector_update (v, n, exp) -> begin
try infer_exp env (E_aux (E_app (mk_id "vector_update", [v; n; exp]), (l, uannot))) with
| Type_error (err_l, err) -> (
try
let inferred_v = infer_exp env v in
begin
match (typ_of inferred_v, n) with
| Typ_aux (Typ_id id, _), E_aux (E_id field, _) ->
let update_id = (Bitfield.field_accessor_ids id field).update in
infer_exp env (mk_exp ~loc:l (E_app (update_id, [v; exp])))
| _, _ -> typ_error l "Vector update could not be interpreted as a bitfield update"
end
with Type_error (err_l', err') -> typ_raise err_l (err_because (err, err_l', err'))
)
| exn -> raise exn
end
| E_vector_update (v, n, exp) -> infer_vector_update l env v n exp
| E_vector_update_subrange (v, n, m, exp) ->
infer_exp env (E_aux (E_app (mk_id "vector_update_subrange", [v; n; m; exp]), (l, uannot)))
| E_vector_append (v1, E_aux (E_vector [], _)) -> infer_exp env v1
Expand Down Expand Up @@ -3371,6 +3356,33 @@ and infer_exp env (E_aux (exp_aux, (l, uannot)) as exp) =

and infer_funapp l env f xs ret_ctx_typ = infer_funapp' l env f (Env.get_val_spec f env) xs ret_ctx_typ

and infer_vector_update l env v n exp =
let rec nested_updates acc = function
| E_aux (E_vector_update (v, n, exp), (l, _)) -> nested_updates ((n, exp, l) :: acc) v
| v -> (v, List.rev acc)
in
let v, updates = nested_updates [(n, exp, l)] v in
let inferred_v = infer_exp env v in
match typ_of inferred_v with
| Typ_aux (Typ_id id, _) when Env.is_bitfield id env ->
let update_exp =
List.fold_left
(fun v (field, exp, l) ->
match field with
| E_aux (E_id field_id, (field_id_loc, _)) ->
let (Id_aux (update_name, _)) = (Bitfield.field_accessor_ids id field_id).update in
mk_exp ~loc:l (E_app (Id_aux (update_name, field_id_loc), [v; exp]))
| _ -> typ_error l "Vector update could not be interpreted as a bitfield update"
)
v updates
in
infer_exp env update_exp
| _ ->
let update_exp =
List.fold_left (fun v (n, exp, l) -> mk_exp ~loc:l (E_app (mk_id "vector_update", [v; n; exp]))) v updates
in
infer_exp env update_exp

and instantiation_of (E_aux (_, (l, tannot)) as exp) =
match fst tannot with
| Some t -> begin
Expand Down
7 changes: 7 additions & 0 deletions test/typecheck/fail/bv_update_error.expect
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
Type error:
fail/bv_update_error.sail:13.18-22:
13 | let _ = [v with FIEL = 0xFF];
 | ^--^
 | No function type found for _update_b_FIEL
 |
 | Did you mean _update_b_FIELD?
15 changes: 15 additions & 0 deletions test/typecheck/fail/bv_update_error.sail
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
default Order dec

$include <prelude.sail>

bitfield b : bits(32) = {
FIELD : 7 .. 0
}

val main : unit -> unit

function main() = {
let v = Mk_b(0x0000_0000);
let _ = [v with FIEL = 0xFF];
()
}
5 changes: 0 additions & 5 deletions test/typecheck/pass/vec_length/v2.expect
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,3 @@
 | * (0 <= 10 & 10 < 8)
 | * plain_vector_update
 | Could not unify vector('n, 'a) and bitvector(8)
 |
 | Caused by pass/vec_length/v2.sail:7.10-25:
 | 7 | let z = [x with 10 = y];
 |  | ^-------------^
 |  | Vector update could not be interpreted as a bitfield update
5 changes: 0 additions & 5 deletions test/typecheck/pass/vec_length/v2_inc.expect
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,3 @@
 | * (0 <= 10 & 10 < 8)
 | * plain_vector_update
 | Could not unify vector('n, 'a) and bitvector(8)
 |
 | Caused by pass/vec_length/v2_inc.sail:7.10-25:
 | 7 | let z = [x with 10 = y];
 |  | ^-------------^
 |  | Vector update could not be interpreted as a bitfield update

0 comments on commit 5929b9b

Please sign in to comment.