Use internal_assertion_fail instead of the simple_error that are just assertions

This commit is contained in:
Georges Dupéron 2019-06-05 11:38:59 +02:00
parent 1750895a65
commit 24db060dae
3 changed files with 6 additions and 5 deletions

View File

@ -603,7 +603,7 @@ let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value
| Leaf (k, t), v -> ok (k, v, t)
| Node {a}, D_left v -> aux (a, v)
| Node {b}, D_right v -> aux (b, v)
| _ -> simple_fail "bad constructor path"
| _ -> internal_assertion_fail "bad constructor path"
in
let%bind (s, v, t) = aux (tree, v) in
ok (s, v, t)
@ -617,7 +617,7 @@ let extract_tuple (v : value) (tree : AST.type_value Append_tree.t') : ((value *
let%bind a' = aux (a, va) in
let%bind b' = aux (b, vb) in
ok (a' @ b')
| _ -> simple_fail "bad tuple path"
| _ -> internal_assertion_fail "bad tuple path"
in
aux (tree, v)
@ -630,7 +630,7 @@ let extract_record (v : value) (tree : _ Append_tree.t') : (_ list) result =
let%bind a' = aux (a, va) in
let%bind b' = aux (b, vb) in
ok (a' @ b')
| _ -> simple_fail "bad record path"
| _ -> internal_assertion_fail "bad record path"
in
aux (tree, v)

View File

@ -714,7 +714,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
O.merge_annotation
(Some tv)
(Some expr'.type_annotation)
(simple_error "assertion failed") in
(internal_assertion_fail "merge_annotations (Some ...) (Some ...) failed") in
ok {expr' with type_annotation}
@ -729,7 +729,7 @@ and type_constant (name:string) (lst:O.type_value list) (tv_opt:O.type_value opt
let untype_type_value (t:O.type_value) : (I.type_expression) result =
match t.simplified with
| Some s -> ok s
| _ -> simple_fail "trying to untype generated type"
| _ -> internal_assertion_fail "trying to untype generated type"
let untype_literal (l:O.literal) : I.literal result =
let open I in

View File

@ -200,6 +200,7 @@ let prepend_info = fun info err ->
let simple_error str () = mk_error ~title:(thunk str) ()
let simple_info str () = mk_info ~title:(thunk str) ()
let simple_fail str = fail @@ simple_error str
let internal_assertion_fail str = fail @@ simple_error ("assertion failed: " ^ str)
(**
To be used when you only want to signal an error. It can be useful when