Skip to content

Commit a3c0174

Browse files
digama0digama0
committed
fix tests
1 parent 7db7df9 commit a3c0174

File tree

5 files changed

+67
-86
lines changed

5 files changed

+67
-86
lines changed

‎examples/lambda/basics/binderLib.sml

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -290,9 +290,9 @@ fun check_for_errors tm = let
290290
"Function being defined must be applied to one argument"
291291
val dom_ty = #1 (dom_rng (type_of f))
292292
val recthm = valOf (recthm_for_type dom_ty)
293-
handle Option => ERR "prove_recursive_term_function_exists"
294-
("No recursion theorem for type "^
295-
type_to_string dom_ty)
293+
handle Option =>
294+
raise ERR "prove_recursive_term_function_exists"
295+
("No recursion theorem for type " ^ type_to_string dom_ty)
296296
val constructors = map #1 (find_constructors recthm)
297297
val () =
298298
case List.find
@@ -507,8 +507,8 @@ fun define_wrapper worker q = let
507507
val a = Absyn q
508508
val f = head_sym a
509509
val fstr = case f of
510-
Absyn.IDENT(_, s) => s
511-
| x => ERR "define_recursive_term_function" "invalid head symbol"
510+
Absyn.IDENT(_, s) => s
511+
| x => raise ERR "define_recursive_term_function" "invalid head symbol"
512512
val restore_this = hide fstr
513513
fun restore() = Parse.update_overload_maps fstr restore_this
514514
val tm = Parse.absyn_to_term (Parse.term_grammar()) a

‎examples/lambda/other-models/ncScript.sml

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -612,9 +612,7 @@ fun nc_INDUCT_TAC (A,g) =
612612
val ith = ISPEC P nc_INDUCTION
613613
fun bconv tm =
614614
if rator tm !~ P then
615-
raise HOL_ERR{origin_structure = "ncScript.sml",
616-
origin_function = "nc_INDUCT_TAC",
617-
message = "function bconv failed"}
615+
raise mk_HOL_ERR "ncScript.sml" "nc_INDUCT_TAC" "function bconv failed"
618616
else BETA_CONV tm
619617
val bth = CONV_RULE (ONCE_DEPTH_CONV bconv) ith
620618
in

‎src/prekernel/Feedback.sml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,10 @@ fun quiet_messages f = Portable.with_flag (emit_MESG, false) f
9090
fun format_err_rec {message, origin_function, origin_structure, source_location} =
9191
String.concat
9292
["at ", origin_structure, ".", origin_function, ":\n",
93-
locn.toString source_location, ":\n", message]
93+
case source_location of
94+
Loc_Unknown => ""
95+
| _ => locn.toString source_location ^ ":\n",
96+
message]
9497

9598
fun format_ERR err_rec =
9699
String.concat ["\nException raised ", format_err_rec err_rec, "\n"]

‎src/quotient/examples/ind_rel.sml

Lines changed: 56 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -55,14 +55,10 @@ in
5555
(fst current_goal, new_claim)],
5656
fn [goalthm,claimthm] =>
5757
MP (DISCH new_claim goalthm) claimthm
58-
| _ => raise HOL_ERR
59-
{origin_structure = "define_inductive_relations",
60-
origin_function = "SUPPOSE_TAC",
61-
message = "invalid application"})
62-
else raise HOL_ERR
63-
{origin_structure = "define_inductive_relations",
64-
origin_function = "SUPPOSE_TAC",
65-
message = "The claim doesn't have type :bool"}
58+
| _ => raise mk_HOL_ERR "define_inductive_relations" "SUPPOSE_TAC"
59+
"invalid application")
60+
else raise mk_HOL_ERR "define_inductive_relations" "SUPPOSE_TAC"
61+
"The claim doesn't have type :bool"
6662
end
6763

6864

@@ -122,19 +118,13 @@ fun MP_IMP_TAC imp_thm (thisgoal as (asms,goal)) =
122118
fn imp_thm => fn (asms,goal) =>
123119
([(asms,fst(dest_imp(concl imp_thm)))],
124120
fn [thm] => MP imp_thm thm
125-
| _ => raise HOL_ERR
126-
{origin_structure = "define_inductive_relations",
127-
origin_function = "MP_IMP_TAC",
128-
message = "invalid application"})}
121+
| _ => raise mk_HOL_ERR "define_inductive_relations" "MP_IMP_TAC"
122+
"invalid application")}
129123
thisgoal
130-
else raise HOL_ERR
131-
{origin_structure = "define_inductive_relations",
132-
origin_function = "MP_IMP_TAC",
133-
message = "theorem doesn't imply goal"}
134-
else raise HOL_ERR
135-
{origin_structure = "define_inductive_relations",
136-
origin_function = "MP_IMP_TAC",
137-
message = "theorem is not an implication"}
124+
else raise mk_HOL_ERR "define_inductive_relations" "MP_IMP_TAC"
125+
"theorem doesn't imply goal"
126+
else raise mk_HOL_ERR "define_inductive_relations" "MP_IMP_TAC"
127+
"theorem is not an implication"
138128

139129

140130
(* This function takes in the rules, checks them, quantifies them, and
@@ -231,38 +221,34 @@ fun check_rule rule_num rule =
231221
(* check that the relations don't occur in rands *)
232222
if (foldr (fn (tm, acc) => relations_in_tm tm orelse acc)
233223
false rands) then
234-
raise HOL_ERR
235-
{message = "found relation being defined"^
224+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
225+
("found relation being defined"^
236226
" in arg to "^(fst(dest_var rator))^
237227
" in hypothesis ofrule number "^
238-
(Lib.int_to_string rule_num),
239-
origin_function = "check_rule",
240-
origin_structure = "define_inductive_relations"}
228+
(Lib.int_to_string rule_num))
241229
else check_hyp hyps
242-
else if relations_in_tm hyp1 then raise HOL_ERR
243-
{message = "found relation being defined"^
230+
else if relations_in_tm hyp1 then
231+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
232+
("found relation being defined"^
244233
" in side condition in rule number "^
245-
(Lib.int_to_string rule_num),
246-
origin_function = "check_rule",
247-
origin_structure = "define_inductive_relations"}
248-
else check_hyp hyps
234+
(Lib.int_to_string rule_num))
235+
else check_hyp hyps
249236
end |
250237
check_hyp [] = true
251238
fun check_concl tm =
252239
let val (rator, rands) = strip_comb tm in
253-
if not (tmem rator relations) then raise HOL_ERR
254-
{message = "must have relation as operator in "^
255-
"conclusion of rule "^(Lib.int_to_string rule_num),
256-
origin_function = "check_rule",
257-
origin_structure = "define_inductive_relations"} else
258-
if (foldr (fn (tm, acc) => relations_in_tm tm orelse acc)
259-
false rands) then raise HOL_ERR
260-
{message = "found relation being defined"^
240+
if not (tmem rator relations) then
241+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
242+
("must have relation as operator in "^
243+
"conclusion of rule "^(Lib.int_to_string rule_num))
244+
else if
245+
foldr (fn (tm, acc) => relations_in_tm tm orelse acc) false rands
246+
then
247+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
248+
("found relation being defined"^
261249
" in arg to "^(fst(dest_var rator))^
262250
" in conclusion of rule number "^
263-
(Lib.int_to_string rule_num),
264-
origin_function = "check_rule",
265-
origin_structure = "define_inductive_relations"}
251+
(Lib.int_to_string rule_num))
266252
else true
267253
end
268254
in
@@ -478,38 +464,34 @@ fun check_rule rule_num rule =
478464
(* check that the relations don't occur in rands *)
479465
if (foldr (fn (tm, acc) => relations_in_tm tm orelse acc)
480466
false rands) then
481-
raise HOL_ERR
482-
{message = "found relation being defined"^
483-
" in arg to "^(fst(dest_var rator))^
484-
" in hypothesis ofrule number "^
485-
(Lib.int_to_string rule_num),
486-
origin_function = "check_rule",
487-
origin_structure = "define_inductive_relations"}
467+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
468+
("found relation being defined"^
469+
" in arg to "^(fst(dest_var rator))^
470+
" in hypothesis ofrule number "^
471+
(Lib.int_to_string rule_num))
488472
else check_hyp hyps
489-
else if relations_in_tm hyp1 then raise HOL_ERR
490-
{message = "found relation being defined"^
473+
else if relations_in_tm hyp1 then
474+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
475+
("found relation being defined"^
491476
" in side condition in rule number "^
492-
(Lib.int_to_string rule_num),
493-
origin_function = "check_rule",
494-
origin_structure = "define_inductive_relations"}
495-
else check_hyp hyps
496-
end |
497-
check_hyp [] = true
477+
(Lib.int_to_string rule_num))
478+
else check_hyp hyps
479+
end
480+
| check_hyp [] = true
498481
fun check_concl tm =
499482
let val (rator, rands) = strip_comb tm in
500-
if not (tmem rator relations) then raise HOL_ERR
501-
{message = "must have relation as operator in "^
502-
"conclusion of rule "^(Lib.int_to_string rule_num),
503-
origin_function = "check_rule",
504-
origin_structure = "define_inductive_relations"} else
505-
if (foldr (fn (tm, acc) => relations_in_tm tm orelse acc)
506-
false rands) then raise HOL_ERR
507-
{message = "found relation being defined"^
483+
if not (tmem rator relations) then
484+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
485+
("must have relation as operator in "^
486+
"conclusion of rule "^(Lib.int_to_string rule_num))
487+
else if
488+
foldr (fn (tm, acc) => relations_in_tm tm orelse acc) false rands
489+
then
490+
raise mk_HOL_ERR "define_inductive_relations" "check_rule"
491+
("found relation being defined"^
508492
" in arg to "^(fst(dest_var rator))^
509493
" in conclusion of rule number "^
510-
(Lib.int_to_string rule_num),
511-
origin_function = "check_rule",
512-
origin_structure = "define_inductive_relations"}
494+
(Lib.int_to_string rule_num))
513495
else true
514496
end
515497
in
@@ -992,10 +974,9 @@ fun simp_rule sfn set vs rul th =
992974
end
993975
end;
994976

995-
fun bad_error ftn_name = raise HOL_ERR
996-
{message = "this case should never happen, real problem here!",
997-
origin_function = ftn_name,
998-
origin_structure = "prove_inversion_theorems"}
977+
fun bad_error ftn_name =
978+
raise mk_HOL_ERR "prove_inversion_theorems" ftn_name
979+
"this case should never happen, real problem here!"
999980

1000981
fun simp set sfn rul th =
1001982
let val vs = fst(strip_forall (dest_neg (concl th)))
@@ -1727,10 +1708,9 @@ local
17271708
fun get_correct_tm ((rel, tm)::more_info) rel2 =
17281709
if rel ~~ rel2 then tm
17291710
else get_correct_tm more_info rel2
1730-
| get_correct_tm [] rel2 = raise HOL_ERR
1731-
{origin_structure = "inductive_relations",
1732-
origin_function = "rule_induct",
1733-
message = "need term for relation "^(fst (dest_const rel2))}
1711+
| get_correct_tm [] rel2 =
1712+
raise mk_HOL_ERR "inductive_relations" "rule_induct"
1713+
("need term for relation "^(fst (dest_const rel2)))
17341714
in
17351715
fun rule_induct induct_thm (asms, gl) =
17361716
let val reltns_goals_list = map process_term (strip_conj gl)

‎src/tactictoe/src/tttEval.sml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ fun catch_err msg f x =
2222
fun catch_err_ignore msg f x =
2323
f x handle HOL_ERR {origin_structure,origin_function,source_location,message} =>
2424
(print_endline
25-
(msg ^ ":" ^ origin_structure ^ ":" ^ origin_function ^ ":" ^ locn.toShortString source_location ^ ^ ":" ^ message))
25+
(msg ^ ":" ^ origin_structure ^ ":" ^ origin_function ^ ":" ^ locn.toShortString source_location ^ ":" ^ message))
2626

2727

2828
(* -------------------------------------------------------------------------

0 commit comments

Comments
 (0)