aboutsummaryrefslogtreecommitdiffhomepage
path: root/contrib/correctness/perror.ml
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/correctness/perror.ml')
-rw-r--r--contrib/correctness/perror.ml72
1 files changed, 36 insertions, 36 deletions
diff --git a/contrib/correctness/perror.ml b/contrib/correctness/perror.ml
index 17c673a54..19b4db992 100644
--- a/contrib/correctness/perror.ml
+++ b/contrib/correctness/perror.ml
@@ -30,38 +30,38 @@ let raise_with_loc = function
let unbound_variable id loc =
raise_with_loc loc
(UserError ("Perror.unbound_variable",
- (hOV 0 [<'sTR"Unbound variable"; 'sPC; pr_id id; 'fNL >])))
+ (hov 0 (str"Unbound variable" ++ spc () ++ pr_id id ++ fnl ()))))
let unbound_reference id loc =
raise_with_loc loc
(UserError ("Perror.unbound_reference",
- (hOV 0 [<'sTR"Unbound reference"; 'sPC; pr_id id; 'fNL >])))
+ (hov 0 (str"Unbound reference" ++ spc () ++ pr_id id ++ fnl ()))))
let clash id loc =
raise_with_loc loc
(UserError ("Perror.clash",
- (hOV 0 [< 'sTR"Clash with previous constant"; 'sPC;
- 'sTR(string_of_id id); 'fNL >])))
+ (hov 0 (str"Clash with previous constant" ++ spc () ++
+ str(string_of_id id) ++ fnl ()))))
let not_defined id =
raise
(UserError ("Perror.not_defined",
- (hOV 0 [< 'sTR"The object"; 'sPC; pr_id id; 'sPC;
- 'sTR"is not defined"; 'fNL >])))
+ (hov 0 (str"The object" ++ spc () ++ pr_id id ++ spc () ++
+ str"is not defined" ++ fnl ()))))
let check_for_reference loc id = function
Ref _ -> ()
| _ -> Stdpp.raise_with_loc loc
(UserError ("Perror.check_for_reference",
- hOV 0 [< pr_id id; 'sPC;
- 'sTR"is not a reference" >]))
+ hov 0 (pr_id id ++ spc () ++
+ str"is not a reference")))
let check_for_array loc id = function
Array _ -> ()
| _ -> Stdpp.raise_with_loc loc
(UserError ("Perror.check_for_array",
- hOV 0 [< pr_id id; 'sPC;
- 'sTR"is not an array" >]))
+ hov 0 (pr_id id ++ spc () ++
+ str"is not an array")))
let is_constant_type s = function
TypePure c ->
@@ -75,56 +75,56 @@ let check_for_index_type loc v =
if not is_index then
Stdpp.raise_with_loc loc
(UserError ("Perror.check_for_index",
- hOV 0 [< 'sTR"This expression is an index"; 'sPC;
- 'sTR"and should have type int (Z)" >]))
+ hov 0 (str"This expression is an index" ++ spc () ++
+ str"and should have type int (Z)")))
let check_no_effect loc ef =
if not (Peffect.get_writes ef = []) then
Stdpp.raise_with_loc loc
(UserError ("Perror.check_no_effect",
- hOV 0 [< 'sTR"A boolean should not have side effects"
- >]))
+ hov 0 (str"A boolean should not have side effects"
+)))
let should_be_boolean loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.should_be_boolean",
- hOV 0 [< 'sTR"This expression is a test:" ; 'sPC;
- 'sTR"it should have type bool" >]))
+ hov 0 (str"This expression is a test:" ++ spc () ++
+ str"it should have type bool")))
let test_should_be_annotated loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.test_should_be_annotated",
- hOV 0 [< 'sTR"This test should be annotated" >]))
+ hov 0 (str"This test should be annotated")))
let if_branches loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.if_branches",
- hOV 0 [< 'sTR"The two branches of an `if' expression" ; 'sPC;
- 'sTR"should have the same type" >]))
+ hov 0 (str"The two branches of an `if' expression" ++ spc () ++
+ str"should have the same type")))
let check_for_not_mutable loc v =
if is_mutable v then
Stdpp.raise_with_loc loc
(UserError ("Perror.check_for_not_mutable",
- hOV 0 [< 'sTR"This expression cannot be a mutable" >]))
+ hov 0 (str"This expression cannot be a mutable")))
let check_for_pure_type loc v =
if not (is_pure v) then
Stdpp.raise_with_loc loc
(UserError ("Perror.check_for_pure_type",
- hOV 0 [< 'sTR"This expression must be pure"; 'sPC;
- 'sTR"(neither a mutable nor a function)" >]))
+ hov 0 (str"This expression must be pure" ++ spc () ++
+ str"(neither a mutable nor a function)")))
let check_for_let_ref loc v =
if not (is_pure v) then
Stdpp.raise_with_loc loc
(UserError ("Perror.check_for_let_ref",
- hOV 0 [< 'sTR"References can only be bound in pure terms">]))
+ hov 0 (str"References can only be bound in pure terms")))
let informative loc s =
Stdpp.raise_with_loc loc
(UserError ("Perror.variant_informative",
- hOV 0 [< 'sTR s; 'sPC; 'sTR"must be informative" >]))
+ hov 0 (str s ++ spc () ++ str"must be informative")))
let variant_informative loc = informative loc "Variant"
let should_be_informative loc = informative loc "This term"
@@ -132,41 +132,41 @@ let should_be_informative loc = informative loc "This term"
let app_of_non_function loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.app_of_non_function",
- hOV 0 [< 'sTR"This term cannot be applied"; 'sPC;
- 'sTR"(either it is not a function"; 'sPC;
- 'sTR"or it is applied to non pure arguments)" >]))
+ hov 0 (str"This term cannot be applied" ++ spc () ++
+ str"(either it is not a function" ++ spc () ++
+ str"or it is applied to non pure arguments)")))
let partial_app loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.partial_app",
- hOV 0 [< 'sTR"This function does not have";
- 'sPC; 'sTR"the right number of arguments" >]))
+ hov 0 (str"This function does not have" ++
+ spc () ++ str"the right number of arguments")))
let expected_type loc s =
Stdpp.raise_with_loc loc
(UserError ("Perror.expected_type",
- hOV 0 [< 'sTR"Argument is expected to have type"; 'sPC; s >]))
+ hov 0 (str"Argument is expected to have type" ++ spc () ++ s)))
let expects_a_type id loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.expects_a_type",
- hOV 0 [< 'sTR"The argument "; pr_id id; 'sPC;
- 'sTR"in this application is supposed to be a type" >]))
+ hov 0 (str"The argument " ++ pr_id id ++ spc () ++
+ str"in this application is supposed to be a type")))
let expects_a_term id =
raise
(UserError ("Perror.expects_a_type",
- hOV 0 [< 'sTR"The argument "; pr_id id; 'sPC;
- 'sTR"in this application is supposed to be a term" >]))
+ hov 0 (str"The argument " ++ pr_id id ++ spc () ++
+ str"in this application is supposed to be a term")))
let should_be_a_variable loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.should_be_a_variable",
- hOV 0 [< 'sTR"Argument should be a variable" >]))
+ hov 0 (str"Argument should be a variable")))
let should_be_a_reference loc =
Stdpp.raise_with_loc loc
(UserError ("Perror.should_be_a_reference",
- hOV 0 [< 'sTR"Argument of function should be a reference" >]))
+ hov 0 (str"Argument of function should be a reference")))