From cbb7d8613b0613a9b2bedde00ce71d1a994dbe5e Mon Sep 17 00:00:00 2001 From: Zoltan Somogyi Date: Tue, 27 Aug 2019 14:34:01 +1000 Subject: [PATCH] Make --warn-inconsistent-pred-order-clauses the default in most directories. library/LIB_FLAGS.in: mfilterjavac/MFILTERJAVAC_FLAGS.in: profiler/PROF_FLAGS.in: slice/SLICE_FLAGS.in: ssdb/SSDB_FLAGS.in: Specify --warn-inconsistent-pred-order-clauses as a default flag in these directories as well. library/string.m: Reorder code to make this module compile cleanly with --warn-inconsistent-pred-order-clauses. Don't export base_string_to_int_underscore to lexer.m, since lexer.m does not use it anymore, and neither does anything else. (The export was not publicly documented.) library/benchmarking.m: library/bitmap.m: library/builtin.m: library/map.m: library/profiling_builtin.m: library/rbtree.m: library/table_builtin.m: library/uint.m: profiler/globals.m: profiler/options.m: profiler/prof_info.m: slice/mdice.m: slice/mslice.m: slice/mtc_diff.m: slice/mtc_union.m: ssdb/ssdb.m: Reorder code to make these modules compile cleanly with --warn-inconsistent-pred-order-clauses. library/Mercury.options: Specify --no-warn-inconsistent-pred-order-clauses for the modules that would still get warnings without this option. --- library/LIB_FLAGS.in | 1 + library/Mercury.options | 24 ++-- library/benchmarking.m | 12 +- library/bitmap.m | 76 ++++++------ library/builtin.m | 100 ++++++++-------- library/map.m | 168 +++++++++++++-------------- library/profiling_builtin.m | 180 +++++++++++++++-------------- library/rbtree.m | 78 ++++++------- library/string.m | 40 +++---- library/table_builtin.m | 46 ++++---- library/uint.m | 32 ++--- mfilterjavac/MFILTERJAVAC_FLAGS.in | 1 + profiler/PROF_FLAGS.in | 1 + profiler/globals.m | 16 +-- profiler/options.m | 53 +++++---- profiler/prof_info.m | 178 ++++++++++++++-------------- slice/SLICE_FLAGS.in | 1 + slice/mdice.m | 30 ++--- slice/mslice.m | 30 ++--- slice/mtc_diff.m | 10 +- slice/mtc_union.m | 14 ++- ssdb/SSDB_FLAGS.in | 1 + ssdb/ssdb.m | 44 +++---- 23 files changed, 575 insertions(+), 561 deletions(-) diff --git a/library/LIB_FLAGS.in b/library/LIB_FLAGS.in index b541a0fc4..141aecf1c 100644 --- a/library/LIB_FLAGS.in +++ b/library/LIB_FLAGS.in @@ -6,6 +6,7 @@ --warn-unknown-format-calls --warn-non-contiguous-clauses --warn-non-contiguous-foreign-procs +--warn-inconsistent-pred-order-clauses --warn-unused-imports --warn-insts-with-functors-without-type --warn-suspicious-foreign-code diff --git a/library/Mercury.options b/library/Mercury.options index abb5203f0..27807baa3 100644 --- a/library/Mercury.options +++ b/library/Mercury.options @@ -94,11 +94,19 @@ MCFLAGS-lazy += --no-warn-non-term-special-preds # erlang_rtti_implementation, which is needed in some grades. MCFLAGS-type_desc += --no-warn-unused-imports -MCFLAGS-int8 += --warn-inconsistent-pred-order-clauses -MCFLAGS-int16 += --warn-inconsistent-pred-order-clauses -MCFLAGS-int32 += --warn-inconsistent-pred-order-clauses -MCFLAGS-int64 += --warn-inconsistent-pred-order-clauses -MCFLAGS-uint8 += --warn-inconsistent-pred-order-clauses -MCFLAGS-uint16 += --warn-inconsistent-pred-order-clauses -MCFLAGS-uint32 += --warn-inconsistent-pred-order-clauses -MCFLAGS-uint64 += --warn-inconsistent-pred-order-clauses +# Keep all modules' contents in a consistent order, except these (for now). +MCFLAGS-array += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-bt_array += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-exception += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-getopt += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-getopt_io += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-io += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-pprint += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-robdd += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-set += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-set += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-set_bbbtree += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-set_ctree234 += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-set_ordlist += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-set_tree234 += --no-warn-inconsistent-pred-order-clauses +MCFLAGS-set_unordlist += --no-warn-inconsistent-pred-order-clauses diff --git a/library/benchmarking.m b/library/benchmarking.m index 46bb2bcaa..c6e2a34e7 100644 --- a/library/benchmarking.m +++ b/library/benchmarking.m @@ -229,12 +229,6 @@ extern void ML_report_full_memory_stats(void); %---------------------------------------------------------------------------% -report_memory_attribution(Label, Collect) :- - trace [io(!IO)] ( - report_memory_attribution(Label, Collect, !IO) - ), - impure impure_true. - :- pragma foreign_proc("C", report_memory_attribution(Label::in, Collect::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure], @@ -250,6 +244,12 @@ report_memory_attribution(Label, Collect) :- report_memory_attribution(_, _, !IO). +report_memory_attribution(Label, Collect) :- + trace [io(!IO)] ( + report_memory_attribution(Label, Collect, !IO) + ), + impure impure_true. + report_memory_attribution(Label, !IO) :- report_memory_attribution(Label, yes, !IO). diff --git a/library/bitmap.m b/library/bitmap.m index 68b865618..de39b8e11 100644 --- a/library/bitmap.m +++ b/library/bitmap.m @@ -775,44 +775,6 @@ _ ^ unsafe_byte(_) = _ :- %---------------------------------------------------------------------------% -get_uint8(BM, N) = U8 :- - ( if byte_in_range(BM, N) then - U8 = unsafe_get_uint8(BM, N) - else - throw_byte_bounds_error(BM, "bitmap.get_uint8", N) - ). - -:- pragma foreign_proc("C", - unsafe_get_uint8(BM::in, N::in) = (U8::out), - [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail], -" - U8 = (uint8_t) BM->elements[N]; -"). - -:- pragma foreign_proc("Java", - unsafe_get_uint8(BM::in, N::in) = (U8::out), - [will_not_call_mercury, promise_pure, thread_safe], -" - U8 = BM.elements[N]; -"). - -:- pragma foreign_proc("C#", - unsafe_get_uint8(BM::in, N::in) = (U8::out), - [will_not_call_mercury, promise_pure, thread_safe], -" - U8 = BM.elements[N]; -"). - -:- pragma foreign_proc("Erlang", - unsafe_get_uint8(BM::in, N::in) = (U8::out), - [will_not_call_mercury, promise_pure, thread_safe], -" - {Bin, _} = BM, - <<_:N/binary, U8/integer, _/binary>> = Bin -"). - -%---------------------------------------------------------------------------% - (!.BM ^ byte(N) := Byte) = !:BM :- ( if byte_in_range(!.BM, N) then !BM ^ unsafe_byte(N) := Byte @@ -859,6 +821,44 @@ get_uint8(BM, N) = U8 :- %---------------------------------------------------------------------------% +get_uint8(BM, N) = U8 :- + ( if byte_in_range(BM, N) then + U8 = unsafe_get_uint8(BM, N) + else + throw_byte_bounds_error(BM, "bitmap.get_uint8", N) + ). + +:- pragma foreign_proc("C", + unsafe_get_uint8(BM::in, N::in) = (U8::out), + [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail], +" + U8 = (uint8_t) BM->elements[N]; +"). + +:- pragma foreign_proc("Java", + unsafe_get_uint8(BM::in, N::in) = (U8::out), + [will_not_call_mercury, promise_pure, thread_safe], +" + U8 = BM.elements[N]; +"). + +:- pragma foreign_proc("C#", + unsafe_get_uint8(BM::in, N::in) = (U8::out), + [will_not_call_mercury, promise_pure, thread_safe], +" + U8 = BM.elements[N]; +"). + +:- pragma foreign_proc("Erlang", + unsafe_get_uint8(BM::in, N::in) = (U8::out), + [will_not_call_mercury, promise_pure, thread_safe], +" + {Bin, _} = BM, + <<_:N/binary, U8/integer, _/binary>> = Bin +"). + +%---------------------------------------------------------------------------% + set_uint8(N, U8, !BM) :- ( if byte_in_range(!.BM, N) then unsafe_set_uint8(N, U8, !BM) diff --git a/library/builtin.m b/library/builtin.m index 2aef964af..58832e249 100644 --- a/library/builtin.m +++ b/library/builtin.m @@ -412,22 +412,6 @@ :- interface. - % `get_one_solution' and `get_one_solution_io' are impure alternatives - % to `promise_one_solution' and `promise_one_solution_io', respectively. - % They get a solution to the procedure, without requiring any promise - % that there is only one solution. However, they can only be used in - % impure code. - % -:- pragma obsolete(get_one_solution/1). -:- impure func get_one_solution(pred(T)) = T. -:- mode get_one_solution(pred(out) is cc_multi) = out is det. -:- mode get_one_solution(pred(out) is cc_nondet) = out is semidet. - -:- pragma obsolete(get_one_solution_io/4). -:- impure pred get_one_solution_io(pred(T, IO, IO), T, IO, IO). -:- mode get_one_solution_io(pred(out, di, uo) is cc_multi, - out, di, uo) is det. - % compare_representation(Result, X, Y): % % compare_representation is similar to the builtin predicate compare/3, @@ -448,6 +432,22 @@ :- pred compare_representation(comparison_result, T, T). :- mode compare_representation(uo, in, in) is cc_multi. + % `get_one_solution' and `get_one_solution_io' are impure alternatives + % to `promise_one_solution' and `promise_one_solution_io', respectively. + % They get a solution to the procedure, without requiring any promise + % that there is only one solution. However, they can only be used in + % impure code. + % +:- pragma obsolete(get_one_solution/1). +:- impure func get_one_solution(pred(T)) = T. +:- mode get_one_solution(pred(out) is cc_multi) = out is det. +:- mode get_one_solution(pred(out) is cc_nondet) = out is semidet. + +:- pragma obsolete(get_one_solution_io/4). +:- impure pred get_one_solution_io(pred(T, IO, IO), T, IO, IO). +:- mode get_one_solution_io(pred(out, di, uo) is cc_multi, + out, di, uo) is det. + % Set up Mercury runtime to call special predicates implemented in this % module. % @@ -484,22 +484,10 @@ promise_only_solution(CCPred::(pred(uo) is cc_nondet)) = (OutVal::uo) :- impure OutVal0 = get_one_solution(CCPred), OutVal = unsafe_promise_unique(OutVal0). -get_one_solution(CCPred) = OutVal :- - promise_equivalent_solutions [OutVal] ( - CCPred(OutVal), - impure impure_true - ). - :- pragma promise_pure(promise_only_solution_io/4). promise_only_solution_io(Pred, X, !IO) :- impure get_one_solution_io(Pred, X, !IO). -get_one_solution_io(Pred, X, !IO) :- - promise_equivalent_solutions [!:IO, X] ( - Pred(X, !IO), - impure impure_true - ). - %---------------------------------------------------------------------------% % IMPORTANT: any changes or additions to external predicates should be @@ -561,26 +549,6 @@ X @>= Y :- :- pragma foreign_decl("C", "#include ""mercury_ho_call.h"""). -init_runtime_hooks. - -:- pragma foreign_proc("C", - init_runtime_hooks, - [will_not_call_mercury, thread_safe, may_not_duplicate], -" -#ifdef MR_HIGHLEVEL_CODE - MR_special_pred_hooks.MR_unify_tuple_pred = ML_unify_tuple; - MR_special_pred_hooks.MR_compare_tuple_pred = ML_compare_tuple; - MR_special_pred_hooks.MR_compare_rep_tuple_pred = ML_compare_rep_tuple; -#else - MR_special_pred_hooks.MR_unify_tuple_pred = - MR_ENTRY(mercury__builtin__unify_tuple_2_0); - MR_special_pred_hooks.MR_compare_tuple_pred = - MR_ENTRY(mercury__builtin__compare_tuple_3_0); - MR_special_pred_hooks.MR_compare_rep_tuple_pred = - MR_ENTRY(mercury__builtin__compare_rep_tuple_3_0); -#endif -"). - :- pred unify_tuple(T::in, T::in) is semidet. :- pragma foreign_export("C", unify_tuple(in, in), "ML_unify_tuple"). @@ -1416,6 +1384,42 @@ dynamic_cast(X, Y) :- Y = X "). +%---------------------------------------------------------------------------% + +get_one_solution(CCPred) = OutVal :- + promise_equivalent_solutions [OutVal] ( + CCPred(OutVal), + impure impure_true + ). + +get_one_solution_io(Pred, X, !IO) :- + promise_equivalent_solutions [!:IO, X] ( + Pred(X, !IO), + impure impure_true + ). + +%---------------------------------------------------------------------------% + +init_runtime_hooks. + +:- pragma foreign_proc("C", + init_runtime_hooks, + [will_not_call_mercury, thread_safe, may_not_duplicate], +" +#ifdef MR_HIGHLEVEL_CODE + MR_special_pred_hooks.MR_unify_tuple_pred = ML_unify_tuple; + MR_special_pred_hooks.MR_compare_tuple_pred = ML_compare_tuple; + MR_special_pred_hooks.MR_compare_rep_tuple_pred = ML_compare_rep_tuple; +#else + MR_special_pred_hooks.MR_unify_tuple_pred = + MR_ENTRY(mercury__builtin__unify_tuple_2_0); + MR_special_pred_hooks.MR_compare_tuple_pred = + MR_ENTRY(mercury__builtin__compare_tuple_3_0); + MR_special_pred_hooks.MR_compare_rep_tuple_pred = + MR_ENTRY(mercury__builtin__compare_rep_tuple_3_0); +#endif +"). + %---------------------------------------------------------------------------% :- end_module builtin. %---------------------------------------------------------------------------% diff --git a/library/map.m b/library/map.m index 0fe6463d7..6380ccf51 100644 --- a/library/map.m +++ b/library/map.m @@ -756,18 +756,6 @@ pred(in, out, in, out, in, out, in, out) is semidet, in, out, in, out, in, out, in, out) is semidet. - % intersect_list(Pred, M, Ms, ResultM): - % - % Take the non-empty list of maps [M | Ms], and intersect pairs of - % those maps (using map.intersect above) until there is only one map left. - % Return this map as ResultM. The order of in which those intersect - % operations are performed is not defined, so the caller should choose - % a Pred for which the order does not matter. - % -:- pred intersect_list(pred(V, V, V), map(K, V), list(map(K, V)), map(K, V)). -:- mode intersect_list(pred(in, in, out) is semidet, in, in, out) is semidet. -:- mode intersect_list(pred(in, in, out) is det, in, in, out) is det. - % Given two maps M1 and M2, create a third map M3 that has only the % keys that occur in both M1 and M2. For keys that occur in both M1 % and M2, compute the value in the final map by applying the supplied @@ -789,6 +777,18 @@ :- pred det_intersect(pred(V, V, V), map(K, V), map(K, V), map(K, V)). :- mode det_intersect(pred(in, in, out) is semidet, in, in, out) is det. + % intersect_list(Pred, M, Ms, ResultM): + % + % Take the non-empty list of maps [M | Ms], and intersect pairs of + % those maps (using map.intersect above) until there is only one map left. + % Return this map as ResultM. The order of in which those intersect + % operations are performed is not defined, so the caller should choose + % a Pred for which the order does not matter. + % +:- pred intersect_list(pred(V, V, V), map(K, V), list(map(K, V)), map(K, V)). +:- mode intersect_list(pred(in, in, out) is semidet, in, in, out) is semidet. +:- mode intersect_list(pred(in, in, out) is det, in, in, out) is det. + % Given two maps M1 and M2, create a third map M3 that has only the % keys that occur in both M1 and M2. For keys that occur in both M1 % and M2, compute the corresponding values. If they are the same, @@ -1571,6 +1571,78 @@ det_intersect(CommonPred, Map1, Map2, Common) :- unexpected($pred, "map.intersect failed") ). +intersect_list(CommonPred, HeadMap, TailMaps, Common) :- + map.to_sorted_assoc_list(HeadMap, HeadAssocList), + list.map(map.to_sorted_assoc_list, TailMaps, TailAssocLists), + map.intersect_list_passes(HeadAssocList, TailAssocLists, CommonPred, + CommonAssocList), + map.from_sorted_assoc_list(CommonAssocList, Common). + +:- pred intersect_list_passes(assoc_list(K, V), list(assoc_list(K, V)), + pred(V, V, V), assoc_list(K, V)). +:- mode intersect_list_passes(in, in, pred(in, in, out) is semidet, out) + is semidet. +:- mode intersect_list_passes(in, in, pred(in, in, out) is det, out) + is det. + +intersect_list_passes(HeadAssocList, TailAssocLists, CommonPred, + CommonAssocList) :- + ( + TailAssocLists = [], + CommonAssocList = HeadAssocList + ; + TailAssocLists = [_ | _], + map.intersect_list_pass(HeadAssocList, TailAssocLists, CommonPred, + FirstAssocList, LaterAssocLists), + map.intersect_list_passes(FirstAssocList, LaterAssocLists, CommonPred, + CommonAssocList) + ). + + % If the list [HeadAssocList | TailAssocLists] has 2k sorted association + % lists (representing 2k maps), then reduce these to k sorted association + % lists by intersecting assoclist 2i with assoc list 2i+1 for all i + % in 0..(k-1). If it has 2k+1 sorted association lists, intersect + % the first 2k as above, and add the last to the end of the list as is, + % without intersecting it with anything. + % + % If the input has N assoc lists, the output will have ceil(N/2) assoc + % lists. If invoked with two or more lists, the output will always have + % fewer assoc lists than the input. This will always be the case, since + % our caller does not call us when N<2. + % +:- pred intersect_list_pass(assoc_list(K, V), list(assoc_list(K, V)), + pred(V, V, V), assoc_list(K, V), list(assoc_list(K, V))). +:- mode intersect_list_pass(in, in, pred(in, in, out) is semidet, out, out) + is semidet. +:- mode intersect_list_pass(in, in, pred(in, in, out) is det, out, out) + is det. + +intersect_list_pass(HeadAssocList, TailAssocLists, CommonPred, + FirstAssocList, LaterAssocLists) :- + ( + TailAssocLists = [], + FirstAssocList = HeadAssocList, + LaterAssocLists = [] + ; + TailAssocLists = [HeadTailAssocList | TailTailAssocLists], + map.intersect_loop(HeadAssocList, HeadTailAssocList, CommonPred, + [], RevFirstAssocList), + list.reverse(RevFirstAssocList, FirstAssocList), + ( + TailTailAssocLists = [], + LaterAssocLists = [] + ; + TailTailAssocLists = + [HeadTailTailAssocList | TailTailTailAssocLists], + map.intersect_list_pass(HeadTailTailAssocList, + TailTailTailAssocLists, CommonPred, + HeadLaterAssocList, TailLaterAssocLists), + LaterAssocLists = [HeadLaterAssocList | TailLaterAssocLists] + ) + ). + +%---------------------------------------------------------------------------% + %---------------------------------------------------------------------------% common_subset(Map1, Map2) = Common :- @@ -1695,78 +1767,6 @@ det_union(CommonPred, Map1, Map2, Union) :- %---------------------------------------------------------------------------% -intersect_list(CommonPred, HeadMap, TailMaps, Common) :- - map.to_sorted_assoc_list(HeadMap, HeadAssocList), - list.map(map.to_sorted_assoc_list, TailMaps, TailAssocLists), - map.intersect_list_passes(HeadAssocList, TailAssocLists, CommonPred, - CommonAssocList), - map.from_sorted_assoc_list(CommonAssocList, Common). - -:- pred intersect_list_passes(assoc_list(K, V), list(assoc_list(K, V)), - pred(V, V, V), assoc_list(K, V)). -:- mode intersect_list_passes(in, in, pred(in, in, out) is semidet, out) - is semidet. -:- mode intersect_list_passes(in, in, pred(in, in, out) is det, out) - is det. - -intersect_list_passes(HeadAssocList, TailAssocLists, CommonPred, - CommonAssocList) :- - ( - TailAssocLists = [], - CommonAssocList = HeadAssocList - ; - TailAssocLists = [_ | _], - map.intersect_list_pass(HeadAssocList, TailAssocLists, CommonPred, - FirstAssocList, LaterAssocLists), - map.intersect_list_passes(FirstAssocList, LaterAssocLists, CommonPred, - CommonAssocList) - ). - - % If the list [HeadAssocList | TailAssocLists] has 2k sorted association - % lists (representing 2k maps), then reduce these to k sorted association - % lists by intersecting assoclist 2i with assoc list 2i+1 for all i - % in 0..(k-1). If it has 2k+1 sorted association lists, intersect - % the first 2k as above, and add the last to the end of the list as is, - % without intersecting it with anything. - % - % If the input has N assoc lists, the output will have ceil(N/2) assoc - % lists. If invoked with two or more lists, the output will always have - % fewer assoc lists than the input. This will always be the case, since - % our caller does not call us when N<2. - % -:- pred intersect_list_pass(assoc_list(K, V), list(assoc_list(K, V)), - pred(V, V, V), assoc_list(K, V), list(assoc_list(K, V))). -:- mode intersect_list_pass(in, in, pred(in, in, out) is semidet, out, out) - is semidet. -:- mode intersect_list_pass(in, in, pred(in, in, out) is det, out, out) - is det. - -intersect_list_pass(HeadAssocList, TailAssocLists, CommonPred, - FirstAssocList, LaterAssocLists) :- - ( - TailAssocLists = [], - FirstAssocList = HeadAssocList, - LaterAssocLists = [] - ; - TailAssocLists = [HeadTailAssocList | TailTailAssocLists], - map.intersect_loop(HeadAssocList, HeadTailAssocList, CommonPred, - [], RevFirstAssocList), - list.reverse(RevFirstAssocList, FirstAssocList), - ( - TailTailAssocLists = [], - LaterAssocLists = [] - ; - TailTailAssocLists = - [HeadTailTailAssocList | TailTailTailAssocLists], - map.intersect_list_pass(HeadTailTailAssocList, - TailTailTailAssocLists, CommonPred, - HeadLaterAssocList, TailLaterAssocLists), - LaterAssocLists = [HeadLaterAssocList | TailLaterAssocLists] - ) - ). - -%---------------------------------------------------------------------------% - union_list(CommonPred, HeadMap, TailMaps, Common) :- map.to_sorted_assoc_list(HeadMap, HeadAssocList), list.map(map.to_sorted_assoc_list, TailMaps, TailAssocLists), diff --git a/library/profiling_builtin.m b/library/profiling_builtin.m index 89326404c..8e156cd80 100644 --- a/library/profiling_builtin.m +++ b/library/profiling_builtin.m @@ -265,90 +265,7 @@ "). %---------------------------------------------------------------------------% -% Port procedures -%---------------------------------------------------------------------------% - -% These are all implemented in runtime/mercury_profiling_builtin.c, -% which is generated by tools/make_port_code. - -:- pragma external_pred(det_call_port_code_ac/3). -:- pragma external_pred(det_call_port_code_sr/4). -:- pragma external_pred(det_exit_port_code_ac/2). -:- pragma external_pred(det_exit_port_code_sr/3). -:- pragma external_pred(semi_call_port_code_ac/3). -:- pragma external_pred(semi_call_port_code_sr/4). -:- pragma external_pred(semi_exit_port_code_ac/2). -:- pragma external_pred(semi_exit_port_code_sr/3). -:- pragma external_pred(semi_fail_port_code_ac/2). -:- pragma external_pred(semi_fail_port_code_sr/3). -:- pragma external_pred(non_call_port_code_ac/4). -:- pragma external_pred(non_call_port_code_sr/5). -:- pragma external_pred(non_exit_port_code_ac/2). -:- pragma external_pred(non_exit_port_code_sr/3). -:- pragma external_pred(non_redo_port_code_ac/2). -:- pragma external_pred(non_redo_port_code_sr/2). -:- pragma external_pred(non_fail_port_code_ac/2). -:- pragma external_pred(non_fail_port_code_sr/3). - -det_call_port_code_ac(_, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("det_call_port_code_ac"). -det_call_port_code_sr(_, _, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("det_call_port_code_sr"). -det_exit_port_code_ac(_, _) :- - impure private_builtin.imp, - private_builtin.sorry("det_exit_port_code_ac"). -det_exit_port_code_sr(_, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("det_exit_port_code_sr"). -semi_call_port_code_ac(_, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("semi_call_port_code_ac"). -semi_call_port_code_sr(_, _, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("semi_call_port_code_sr"). -semi_exit_port_code_ac(_, _) :- - impure private_builtin.imp, - private_builtin.sorry("semi_exit_port_code_ac"). -semi_exit_port_code_sr(_, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("semi_exit_port_code_sr"). -semi_fail_port_code_ac(_, _) :- - impure private_builtin.imp, - semidet_succeed, - private_builtin.sorry("semi_fail_port_code_ac"). -semi_fail_port_code_sr(_, _, _) :- - impure private_builtin.imp, - semidet_succeed, - private_builtin.sorry("semi_fail_port_code_sr"). -non_call_port_code_ac(_, _, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_call_port_code_ac"). -non_call_port_code_sr(_, _, _, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_call_port_code_sr"). -non_exit_port_code_ac(_, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_exit_port_code_ac"). -non_exit_port_code_sr(_, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_exit_port_code_sr"). -non_redo_port_code_ac(_, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_redo_port_code_ac"). -non_redo_port_code_sr(_, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_redo_port_code_sr"). -non_fail_port_code_ac(_, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_fail_port_code_ac"). -non_fail_port_code_sr(_, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("non_fail_port_code_sr"). - -%---------------------------------------------------------------------------% -% Procedures that prepare for calls +% Procedures that prepare for calls. %---------------------------------------------------------------------------% :- pragma foreign_proc("C", @@ -636,7 +553,7 @@ prepare_for_callback(_) :- private_builtin.sorry("prepare_for_callback"). %---------------------------------------------------------------------------% -% Procedures needed for handling tail recursive procedures +% Procedures needed for handling tail recursive procedures. %---------------------------------------------------------------------------% :- pragma foreign_proc("C", @@ -690,6 +607,91 @@ prepare_for_tail_call(_) :- impure private_builtin.imp, private_builtin.sorry("prepare_for_tail_call"). +%---------------------------------------------------------------------------% +% Port procedures. +%---------------------------------------------------------------------------% + +% These are all implemented in runtime/mercury_profiling_builtin.c, +% which is generated by tools/make_port_code. + +:- pragma external_pred(det_call_port_code_ac/3). +:- pragma external_pred(det_call_port_code_sr/4). +:- pragma external_pred(det_exit_port_code_ac/2). +:- pragma external_pred(det_exit_port_code_sr/3). +:- pragma external_pred(semi_call_port_code_ac/3). +:- pragma external_pred(semi_call_port_code_sr/4). +:- pragma external_pred(semi_exit_port_code_ac/2). +:- pragma external_pred(semi_exit_port_code_sr/3). +:- pragma external_pred(semi_fail_port_code_ac/2). +:- pragma external_pred(semi_fail_port_code_sr/3). +:- pragma external_pred(non_call_port_code_ac/4). +:- pragma external_pred(non_call_port_code_sr/5). +:- pragma external_pred(non_exit_port_code_ac/2). +:- pragma external_pred(non_exit_port_code_sr/3). +:- pragma external_pred(non_redo_port_code_ac/2). +:- pragma external_pred(non_redo_port_code_sr/2). +:- pragma external_pred(non_fail_port_code_ac/2). +:- pragma external_pred(non_fail_port_code_sr/3). + +det_call_port_code_ac(_, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("det_call_port_code_ac"). +det_call_port_code_sr(_, _, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("det_call_port_code_sr"). +det_exit_port_code_ac(_, _) :- + impure private_builtin.imp, + private_builtin.sorry("det_exit_port_code_ac"). +det_exit_port_code_sr(_, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("det_exit_port_code_sr"). +semi_call_port_code_ac(_, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("semi_call_port_code_ac"). +semi_call_port_code_sr(_, _, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("semi_call_port_code_sr"). +semi_exit_port_code_ac(_, _) :- + impure private_builtin.imp, + private_builtin.sorry("semi_exit_port_code_ac"). +semi_exit_port_code_sr(_, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("semi_exit_port_code_sr"). +semi_fail_port_code_ac(_, _) :- + impure private_builtin.imp, + semidet_succeed, + private_builtin.sorry("semi_fail_port_code_ac"). +semi_fail_port_code_sr(_, _, _) :- + impure private_builtin.imp, + semidet_succeed, + private_builtin.sorry("semi_fail_port_code_sr"). +non_call_port_code_ac(_, _, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_call_port_code_ac"). +non_call_port_code_sr(_, _, _, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_call_port_code_sr"). +non_exit_port_code_ac(_, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_exit_port_code_ac"). +non_exit_port_code_sr(_, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_exit_port_code_sr"). +non_redo_port_code_ac(_, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_redo_port_code_ac"). +non_redo_port_code_sr(_, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_redo_port_code_sr"). +non_fail_port_code_ac(_, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_fail_port_code_ac"). +non_fail_port_code_sr(_, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("non_fail_port_code_sr"). + +%---------------------------------------------------------------------------% + :- pragma foreign_proc("C", save_and_zero_activation_info_ac(Count::out, Ptr::out), [thread_safe, will_not_call_mercury], @@ -907,7 +909,7 @@ reset_activation_info_sr(_) :- private_builtin.sorry("reset_activation_info_sr"). %---------------------------------------------------------------------------% -% instance of increment_{static,dynamic}_coverage_point_count +% Instances of increment_{static,dynamic}_coverage_point_count. %---------------------------------------------------------------------------% :- pragma foreign_proc("C", @@ -1010,7 +1012,7 @@ increment_dynamic_coverage_point_count(_) :- private_builtin.sorry("increment_dynamic_coverage_point_count"). %---------------------------------------------------------------------------% -% instances of save_recursion_depth_N +% Instances of save_recursion_depth_N. %---------------------------------------------------------------------------% :- pragma foreign_proc("C", @@ -1282,7 +1284,7 @@ save_recursion_depth_9(_, _, _, _, _, _, _, _, _, _, _) :- private_builtin.sorry("save_recursion_depth_9"). %---------------------------------------------------------------------------% -% instances of restore_recursion_depth_exit_N +% Instances of restore_recursion_depth_exit_N. %---------------------------------------------------------------------------% :- pragma foreign_proc("C", @@ -1554,7 +1556,7 @@ restore_recursion_depth_exit_9(_, _, _, _, _, _, _, _, _, _, _) :- private_builtin.sorry("restore_recursion_exith_fail_9"). %---------------------------------------------------------------------------% -% instances of restore_recursion_depth_fail_N +% Instances of restore_recursion_depth_fail_N. %---------------------------------------------------------------------------% :- pragma foreign_proc("C", diff --git a/library/rbtree.m b/library/rbtree.m index 658aef0aa..f49af1b18 100644 --- a/library/rbtree.m +++ b/library/rbtree.m @@ -55,14 +55,14 @@ :- func init = rbtree(K, V). :- pred init(rbtree(K, V)::uo) is det. - % Initialise an rbtree containing the given key-value pair. - % -:- func singleton(K, V) = rbtree(K, V). - % Check whether a tree is empty. % :- pred is_empty(rbtree(K, V)::in) is semidet. + % Initialise an rbtree containing the given key-value pair. + % +:- func singleton(K, V) = rbtree(K, V). + % Inserts a new key-value pair into the tree. % Fails if key already in the tree. % @@ -937,39 +937,6 @@ delete_2(black(K0, V0, L, R), K, MustRemove, MaybeV, Tree) :- remove(K, V, !Tree) :- rbtree.delete_2(!.Tree, K, yes, yes(V), !:Tree). -remove_largest(_K, _V, empty, _Tree) :- - fail. -remove_largest(NewK, NewV, red(K0, V0, L, R), Tree) :- - ( - R = empty, - NewK = K0, - NewV = V0, - Tree = L - ; - ( R = red(_, _, _, _) - ; R = black(_, _, _, _) - ), - rbtree.remove_largest(NewK, NewV, R, NewR), - Tree = red(K0, V0, L, NewR) - ). -remove_largest(NewK, NewV, black(K0, V0, L, R), Tree) :- - ( - R = empty, - NewK = K0, - NewV = V0, - Tree = L - ; - ( R = red(_, _, _, _) - ; R = black(_, _, _, _) - ), - rbtree.remove_largest(NewK, NewV, R, NewR), - Tree = black(K0, V0, L, NewR) - ). - -% rbtree.remove_smallest: -% Deletes the node with the minimum K from the tree, and returns the -% key and value fields. - remove_smallest(_K, _V, empty, _Tree) :- fail. remove_smallest(NewK, NewV, red(K0, V0, L, R), Tree) :- @@ -999,6 +966,35 @@ remove_smallest(NewK, NewV, black(K0, V0, L, R), Tree) :- Tree = black(K0, V0, NewL, R) ). +remove_largest(_K, _V, empty, _Tree) :- + fail. +remove_largest(NewK, NewV, red(K0, V0, L, R), Tree) :- + ( + R = empty, + NewK = K0, + NewV = V0, + Tree = L + ; + ( R = red(_, _, _, _) + ; R = black(_, _, _, _) + ), + rbtree.remove_largest(NewK, NewV, R, NewR), + Tree = red(K0, V0, L, NewR) + ). +remove_largest(NewK, NewV, black(K0, V0, L, R), Tree) :- + ( + R = empty, + NewK = K0, + NewV = V0, + Tree = L + ; + ( R = red(_, _, _, _) + ; R = black(_, _, _, _) + ), + rbtree.remove_largest(NewK, NewV, R, NewR), + Tree = black(K0, V0, L, NewR) + ). + %---------------------------------------------------------------------------% keys(RBT) = Ks :- @@ -1046,8 +1042,6 @@ count(black(_K, _V, L, R), N) :- %---------------------------------------------------------------------------% -from_assoc_list(AList) = rbtree.assoc_list_to_rbtree(AList). - assoc_list_to_rbtree(AL) = RBT :- rbtree.assoc_list_to_rbtree(AL, RBT). @@ -1056,9 +1050,9 @@ assoc_list_to_rbtree([K - V | T], Tree) :- rbtree.assoc_list_to_rbtree(T, Tree0), rbtree.set(K, V, Tree0, Tree). -%---------------------------------------------------------------------------% +from_assoc_list(AList) = rbtree.assoc_list_to_rbtree(AList). -to_assoc_list(T) = rbtree.rbtree_to_assoc_list(T). +%---------------------------------------------------------------------------% rbtree_to_assoc_list(RBT) = AL :- rbtree.rbtree_to_assoc_list(RBT, AL). @@ -1073,6 +1067,8 @@ rbtree_to_assoc_list(black(K0, V0, Left, Right), L) :- rbtree.rbtree_to_assoc_list(Right, L1), list.append(L0, [K0 - V0|L1], L). +to_assoc_list(T) = rbtree.rbtree_to_assoc_list(T). + %---------------------------------------------------------------------------% foldl(F, T, A) = B :- diff --git a/library/string.m b/library/string.m index 983d2a4c4..4c9493571 100644 --- a/library/string.m +++ b/library/string.m @@ -125,6 +125,18 @@ :- mode to_char_list(in, out) is det. :- mode to_char_list(uo, in) is det. + % Convert the string to a list of characters (code points) in reverse order. + % The reverse mode of the predicate throws an exception if + % the list of characters contains a null character. + % + % NOTE: In the future we may also throw an exception if the list contains + % a surrogate code point. + % +:- func to_rev_char_list(string) = list(char). +:- pred to_rev_char_list(string, list(char)). +:- mode to_rev_char_list(in, out) is det. +:- mode to_rev_char_list(uo, in) is det. + % Convert a list of characters (code points) to a string. % Throws an exception if the list of characters contains a null character. % @@ -144,18 +156,6 @@ % :- pred semidet_from_char_list(list(char)::in, string::uo) is semidet. - % Convert the string to a list of characters (code points) in reverse order. - % The reverse mode of the predicate throws an exception if - % the list of characters contains a null character. - % - % NOTE: In the future we may also throw an exception if the list contains - % a surrogate code point. - % -:- func to_rev_char_list(string) = list(char). -:- pred to_rev_char_list(string, list(char)). -:- mode to_rev_char_list(in, out) is det. -:- mode to_rev_char_list(uo, in) is det. - % Same as from_char_list, except that it reverses the order % of the characters. % Throws an exception if the list of characters contains a null character. @@ -1409,16 +1409,6 @@ :- include_module format. :- include_module parse_util. - % Exported for use by lexer.m (XXX perhaps it ought to be defined in - % that module instead?) - % - % Like base_string_to_int/3, but allow for an arbitrary number of - % underscores between the other characters. Leading and trailing - % underscores are allowed. - % -:- pred base_string_to_int_underscore(int::in, string::in, int::out) - is semidet. - %---------------------------------------------------------------------------% :- implementation. @@ -5526,7 +5516,13 @@ accumulate_negative_int(Base, Char, N0, N) :- %---------------------% +:- pred base_string_to_int_underscore(int::in, string::in, int::out) + is semidet. + base_string_to_int_underscore(Base, String, Int) :- + % This predicate and much of its calltree is currently unused. + % (It used to be exported for use by lexer.m, but lexer.m does not + % need it anymore.) index(String, 0, Char), End = count_code_units(String), ( if Char = ('-') then diff --git a/library/table_builtin.m b/library/table_builtin.m index 78a05ade4..b772385f9 100644 --- a/library/table_builtin.m +++ b/library/table_builtin.m @@ -845,17 +845,6 @@ table_io_right_bracket_unitized_goal(_TraceEnabled) :- :- pragma external_pred(table_mm_return_all_nondet/2). :- pragma external_pred(table_mm_return_all_multi/2). -:- pragma foreign_proc("C", - table_mm_return_all_shortcut(AnswerBlock::in), - [will_not_call_mercury, promise_semipure, does_not_affect_liveness], -" - MR_tbl_mm_return_all_shortcut(AnswerBlock); -"). - -table_mm_return_all_shortcut(_) :- - semipure private_builtin.semip, - private_builtin.sorry("table_mm_return_all_shortcut"). - :- pragma foreign_proc("C", table_mm_get_answer_table(Subgoal::in, AnswerTable::out), [will_not_call_mercury, promise_semipure, does_not_affect_liveness], @@ -918,6 +907,17 @@ table_mm_fill_answer_block_shortcut(_) :- impure private_builtin.imp, private_builtin.sorry("table_mm_fill_answer_block_shortcut"). +:- pragma foreign_proc("C", + table_mm_return_all_shortcut(AnswerBlock::in), + [will_not_call_mercury, promise_semipure, does_not_affect_liveness], +" + MR_tbl_mm_return_all_shortcut(AnswerBlock); +"). + +table_mm_return_all_shortcut(_) :- + semipure private_builtin.semip, + private_builtin.sorry("table_mm_return_all_shortcut"). + %---------------------------------------------------------------------------% :- interface. @@ -1500,18 +1500,6 @@ table_lookup_insert_uint(_, _, _) :- impure private_builtin.imp, private_builtin.sorry("table_lookup_insert_uint"). -:- pragma foreign_proc("C", - table_lookup_insert_start_int(T0::in, S::in, V::in, T::out), - [will_not_call_mercury, does_not_affect_liveness], -" - MR_tbl_lookup_insert_start_int(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, - T0, S, V, T); -"). - -table_lookup_insert_start_int(_, _, _, _) :- - impure private_builtin.imp, - private_builtin.sorry("table_lookup_insert_start_int"). - :- pragma foreign_proc("C", table_lookup_insert_int8(T0::in, V::in, T::out), [will_not_call_mercury, does_not_affect_liveness], @@ -1600,6 +1588,18 @@ table_lookup_insert_uint64(_, _, _) :- impure private_builtin.imp, private_builtin.sorry("table_lookup_insert_uint64"). +:- pragma foreign_proc("C", + table_lookup_insert_start_int(T0::in, S::in, V::in, T::out), + [will_not_call_mercury, does_not_affect_liveness], +" + MR_tbl_lookup_insert_start_int(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, + T0, S, V, T); +"). + +table_lookup_insert_start_int(_, _, _, _) :- + impure private_builtin.imp, + private_builtin.sorry("table_lookup_insert_start_int"). + :- pragma foreign_proc("C", table_lookup_insert_char(T0::in, V::in, T::out), [will_not_call_mercury, does_not_affect_liveness], diff --git a/library/uint.m b/library/uint.m index 06f46a354..9df06a697 100644 --- a/library/uint.m +++ b/library/uint.m @@ -50,6 +50,14 @@ % :- pred (uint::in) >= (uint::in) is semidet. + % Maximum. + % +:- func max(uint, uint) = uint. + + % Minimum. + % +:- func min(uint, uint) = uint. + % Addition. % :- func uint + uint = uint. @@ -73,14 +81,6 @@ :- func (uint::in) * (uint::in) = (uint::uo) is det. :- func times(uint, uint) = uint. - % Maximum. - % -:- func max(uint, uint) = uint. - - % Minimum. - % -:- func min(uint, uint) = uint. - % Truncating integer division. % % Throws a `math.domain_error' exception if the right operand is zero. @@ -289,6 +289,14 @@ cast_to_int(_) = _ :- %---------------------------------------------------------------------------% +max(X, Y) = + ( if X > Y then X else Y ). + +min(X, Y) = + ( if X < Y then X else Y ). + +%---------------------------------------------------------------------------% + X div Y = X // Y. :- pragma inline('//'/2). @@ -332,14 +340,6 @@ X >> Y = Result :- %---------------------------------------------------------------------------% -max(X, Y) = - ( if X > Y then X else Y ). - -min(X, Y) = - ( if X < Y then X else Y ). - -%---------------------------------------------------------------------------% - :- pragma inline(even/1). even(X) :- (X /\ 1u) = 0u. diff --git a/mfilterjavac/MFILTERJAVAC_FLAGS.in b/mfilterjavac/MFILTERJAVAC_FLAGS.in index b77ee59da..a885f5e91 100644 --- a/mfilterjavac/MFILTERJAVAC_FLAGS.in +++ b/mfilterjavac/MFILTERJAVAC_FLAGS.in @@ -4,6 +4,7 @@ --warn-unknown-format-calls --warn-non-contiguous-clauses --warn-non-contiguous-foreign-procs +--warn-inconsistent-pred-order-clauses --warn-unused-imports --warn-insts-with-functors-without-type --halt-at-warn diff --git a/profiler/PROF_FLAGS.in b/profiler/PROF_FLAGS.in index 0d41eea33..6d6f39eb7 100644 --- a/profiler/PROF_FLAGS.in +++ b/profiler/PROF_FLAGS.in @@ -4,6 +4,7 @@ --warn-unknown-format-calls --warn-non-contiguous-clauses --warn-non-contiguous-foreign-procs +--warn-inconsistent-pred-order-clauses --warn-unused-imports --warn-insts-with-functors-without-type --warn-suspicious-foreign-code diff --git a/profiler/globals.m b/profiler/globals.m index f1e8e9176..b2d05f185 100644 --- a/profiler/globals.m +++ b/profiler/globals.m @@ -142,14 +142,6 @@ globals.lookup_bool_option(Globals, Option, Value) :- error("globals.lookup_bool_option: invalid bool option") ). -globals.lookup_string_option(Globals, Option, Value) :- - globals.lookup_option(Globals, Option, OptionData), - ( if OptionData = string(String) then - Value = String - else - error("globals.lookup_string_option: invalid string option") - ). - globals.lookup_int_option(Globals, Option, Value) :- globals.lookup_option(Globals, Option, OptionData), ( if OptionData = int(Int) then @@ -158,6 +150,14 @@ globals.lookup_int_option(Globals, Option, Value) :- error("globals.lookup_int_option: invalid int option") ). +globals.lookup_string_option(Globals, Option, Value) :- + globals.lookup_option(Globals, Option, OptionData), + ( if OptionData = string(String) then + Value = String + else + error("globals.lookup_string_option: invalid string option") + ). + globals.lookup_accumulating_option(Globals, Option, Value) :- globals.lookup_option(Globals, Option, OptionData), ( if OptionData = accumulating(Accumulating) then diff --git a/profiler/options.m b/profiler/options.m index 17b1a0412..ed6ac3eb0 100644 --- a/profiler/options.m +++ b/profiler/options.m @@ -75,33 +75,6 @@ %---------------------------------------------------------------------------% - % Verbosity Options -option_default(verbose, bool(no)). -option_default(very_verbose, bool(no)). - - % General profiler options -option_default(dynamic_cg, bool(no)). -option_default(call_graph, bool(no)). -option_default(profile, string_special). -option_default(profile_time, special). -option_default(profile_memory_words, special). -option_default(profile_memory_cells, special). -option_default(countfile, string("Prof.Counts")). -option_default(pairfile, string("Prof.CallPair")). -option_default(declfile, string("Prof.Decl")). -option_default(libraryfile, string("")). -option_default(demangle, bool(yes)). -option_default(snapshots, bool(no)). -option_default(snapshots_file, string("Prof.Snapshots")). -option_default(snapshots_by_type, bool(no)). -option_default(snapshots_brief, bool(no)). -option_default(snapshots_include_runtime, bool(no)). -option_default(snapshots_recalc_size, bool(yes)). - - % Miscellaneous Options -option_default(help, bool(no)). - - % please keep this in alphabetic order short_option('b', snapshots_brief). short_option('C', countfile). @@ -143,6 +116,32 @@ long_option("use-dynamic", dynamic_cg). long_option("verbose", verbose). long_option("very-verbose", very_verbose). + % Verbosity Options +option_default(verbose, bool(no)). +option_default(very_verbose, bool(no)). + + % General profiler options +option_default(dynamic_cg, bool(no)). +option_default(call_graph, bool(no)). +option_default(profile, string_special). +option_default(profile_time, special). +option_default(profile_memory_words, special). +option_default(profile_memory_cells, special). +option_default(countfile, string("Prof.Counts")). +option_default(pairfile, string("Prof.CallPair")). +option_default(declfile, string("Prof.Decl")). +option_default(libraryfile, string("")). +option_default(demangle, bool(yes)). +option_default(snapshots, bool(no)). +option_default(snapshots_file, string("Prof.Snapshots")). +option_default(snapshots_by_type, bool(no)). +option_default(snapshots_brief, bool(no)). +option_default(snapshots_include_runtime, bool(no)). +option_default(snapshots_recalc_size, bool(yes)). + + % Miscellaneous Options +option_default(help, bool(no)). + special_handler(profile, string(WhatToProfile), !.OptionTable, Result) :- ( if valid_profile_option(WhatToProfile, CountFile) then map.set(countfile, string(CountFile), !OptionTable), diff --git a/profiler/prof_info.m b/profiler/prof_info.m index e2b874d83..acd4840a1 100644 --- a/profiler/prof_info.m +++ b/profiler/prof_info.m @@ -49,6 +49,13 @@ %---------------------------------------------------------------------------% + % Initialise prof predicates. + % +:- func prof_node_init(string) = prof_node. + +:- func prof_node_init_cycle(string, int, int, float, list(pred_info), int, + int) = prof_node. + % Get prof_node from via predicate name. % :- pred get_prof_node(string::in, addrdecl::in, prof_node_map::in, @@ -57,13 +64,6 @@ :- pred update_prof_node(string::in, prof_node::in, addrdecl::in, prof_node_map::in, prof_node_map::out) is det. - % Initialise prof predicates. - % -:- func prof_node_init(string) = prof_node. - -:- func prof_node_init_cycle(string, int, int, float, list(pred_info), int, - int) = prof_node. - %---------------------------------------------------------------------------% % % `prof' access predicates. @@ -88,14 +88,14 @@ %---------------------------------------------------------------------------% % -% *** Special prof_node predicates *** +% Special prof_node predicates. % :- pred prof_node_type(prof_node::in, prof_node_type::out) is det. %---------------------------------------------------------------------------% % -% *** Access Predicate for prof_node *** +% Access Predicate for prof_node. % :- pred prof_node_get_entire_pred(prof_node::in, string::out, int::out, @@ -116,7 +116,7 @@ %---------------------------------------------------------------------------% % -% *** Update prof_node predicates *** +% Update prof_node predicates. % :- pred prof_node_set_cycle_num(int::in, prof_node::in, prof_node::out) is det. @@ -147,14 +147,14 @@ %---------------------------------------------------------------------------% % -% *** Init predicates for pred_info *** +% Init predicates for pred_info. % :- pred pred_info_init(string::in, int::in, pred_info::out) is det. %---------------------------------------------------------------------------% % -% *** Access predicates for pred_info *** +% Access predicates for pred_info. % :- pred pred_info_get_entire(pred_info::in, string::out, int::out) is det. @@ -170,28 +170,25 @@ :- type prof ---> prof( + % Scaling factor. scaling_factor :: float, - % Scaling factor. + % Units (Each profiling count is equivalent to Scale Units). units :: string, - % Units (Each profiling count is - % equivalent to Scale Units) + % Total counts of the profile run. total_count :: int, - % Total counts of the profile run. + % Map between label name and label addr used to find key + % to look up prof_node_map. addr_decl_map :: addrdecl, - % Map between label name and label addr - % used to find key to look up - % prof_node_map. + % Map between label addresses and all the relevant data + % about that predicate. prof_node_map :: prof_node_map, - % Map between label addresses and all the - % relevant data about that predicate. + % Map between predicate name and its cycle number. cycle_map :: cycle_map - % Map between predicate name - % and its cycle number. ). :- type prof_node @@ -203,30 +200,23 @@ pred_self_counts :: int, pred_propagated_counts :: float, + % Parent pred and the number of times it calls this predicate. + % XXX pred_parent_list :: list(pred_info), - % Parent pred and the number - % of times it calls this - % predicate. - % XXX + % Child pred and the number of times they are called + % from this predicate. pred_child_list :: list(pred_info), - % Child pred and the number of - % times they are called from - % this predicate. + % Total count of times this predicate called. pred_total_calls :: int, - % Total count of times this - % predicate called. + % Number of self recursive calls of this routine. pred_self_calls :: int, - % Number of self recursive - % calls of this routine. + % Alternative names for this predicate, e.g. labels with + % different names but the same address. prd_name_list :: list(string) - % Alternative names for this - % predicate, e.g. labels with - % different names but the same - % address. ) ; cycle_node( % A node which is built up with more than one predicate @@ -237,19 +227,16 @@ cycle_self_counts :: int, cycle_propagated_counts :: float, + % Cycle members plus total calls to that predicate. + % XXX cycle_members :: list(pred_info), - % Cycle members plus total - % calls to that predicated - % XXX + % Total count of times this predicate called. + % XXX cycle_total_calls :: int, - % total count of times this - % predicate called. - % XXX + % Number of calls to fellow cycle members. cycle_self_calls :: int - % Number of calls to fellow - % cycle members. ). :- type pred_info @@ -259,40 +246,9 @@ ). %---------------------------------------------------------------------------% - - % get_prof_node: - % - % Gets the prof_node given a label name. - % -get_prof_node(Pred, AddrMap, ProfNodeMap, ProfNode) :- - map.lookup(AddrMap, Pred, Key), - map.lookup(ProfNodeMap, Key, ProfNode). - -update_prof_node(Pred, ProfNode, AddrMap, !ProfNodeMap) :- - map.lookup(AddrMap, Pred, Key), - map.det_update(Key, ProfNode, !ProfNodeMap). - -%---------------------------------------------------------------------------% - -% *** Access prof predicates *** % - -prof_get_entire(prof(A, B, C, D, E, F), A, B, C, D, E, F). - -prof_get_addrdeclmap(Prof, Prof ^ addr_decl_map). -prof_get_profnodemap(Prof, Prof ^ prof_node_map). - -%---------------------------------------------------------------------------% - -% *** Update prof predicates *** % - -prof_set_entire(A, B, C, D, E, F, prof(A, B, C, D, E, F)). - -prof_set_profnodemap(ProfNodeMap, Prof, Prof ^ prof_node_map := ProfNodeMap). -prof_set_cyclemap(CycleMap, Prof, Prof ^ cycle_map := CycleMap). - -%---------------------------------------------------------------------------% - -% *** Initialise predicates *** % +% +% Initialise predicates. +% prof_node_init(PredName) = pred_node(PredName, 0, 0, 0.0, [], [], 0, 0, []). @@ -302,14 +258,50 @@ prof_node_init_cycle(A, B, C, D, E, F, G) = %---------------------------------------------------------------------------% -% *** Special prof_node predicates *** % +get_prof_node(Pred, AddrMap, ProfNodeMap, ProfNode) :- + map.lookup(AddrMap, Pred, Key), + map.lookup(ProfNodeMap, Key, ProfNode). + +update_prof_node(Pred, ProfNode, AddrMap, !ProfNodeMap) :- + map.lookup(AddrMap, Pred, Key), + map.det_update(Key, ProfNode, !ProfNodeMap). + +%---------------------------------------------------------------------------% +% +% Access prof predicates. +% + +prof_get_entire(prof(A, B, C, D, E, F), A, B, C, D, E, F). + +prof_get_addrdeclmap(Prof, X) :- + X = Prof ^ addr_decl_map. +prof_get_profnodemap(Prof, X) :- + X = Prof ^ prof_node_map. + +%---------------------------------------------------------------------------% +% +% Update prof predicates. +% + +prof_set_entire(A, B, C, D, E, F, prof(A, B, C, D, E, F)). + +prof_set_profnodemap(X, !Prof) :- + !Prof ^ prof_node_map := X. +prof_set_cyclemap(X, !Prof) :- + !Prof ^ cycle_map := X. + +%---------------------------------------------------------------------------% +% +% Special prof_node predicates. +% prof_node_type(pred_node(_, _, _, _, _, _, _, _, _), predicate). prof_node_type(cycle_node(_, _, _, _, _, _, _), cycle). %---------------------------------------------------------------------------% - -% *** Access prof_node predicates *** % +% +% Access prof_node predicates. +% prof_node_get_entire_pred(pred_node(A,B,C,D,E,F,G,H,I),A,B,C,D,E,F,G,H,I). prof_node_get_entire_pred(cycle_node(_,_,_,_,_,_,_),_,_,_,_,_,_,_,_,_) :- @@ -346,8 +338,9 @@ prof_node_get_self_calls(pred_node(_, _, _, _, _, _, _, Calls, _), Calls). prof_node_get_self_calls(cycle_node(_, _, _, _, _, _, Calls), Calls). %---------------------------------------------------------------------------% - -% *** Update prof_node predicates *** % +% +% Update prof_node predicates. +% prof_node_set_cycle_num(Cycle, pred_node(A, _, C, D, E, F, G, H, I), pred_node(A, Cycle, C, D, E, F, G, H, I)). @@ -395,19 +388,22 @@ prof_node_concat_to_member(_, _, pred_node(_, _, _, _, _, _, _, _, _), _) :- error("prof_node_concat_to_member: pred_node has no members\n"). %---------------------------------------------------------------------------% - -% *** Init predicates for pred_info *** % +% +% Init predicates for pred_info. pred_info_init(Name, Count, pred_info(Name, Count)). %---------------------------------------------------------------------------% - -% *** Access predicates for pred_info *** % +% +% Access predicates for pred_info. +% pred_info_get_entire(pred_info(A, B), A, B). -pred_info_get_pred_name(Pred, Pred ^ pred_info_name). -pred_info_get_counts(Pred, Pred ^ pred_info_count). +pred_info_get_pred_name(Pred, X) :- + X = Pred ^ pred_info_name. +pred_info_get_counts(Pred, X) :- + X = Pred ^ pred_info_count. %---------------------------------------------------------------------------% :- end_module prof_info. diff --git a/slice/SLICE_FLAGS.in b/slice/SLICE_FLAGS.in index 7a8d27ae5..829e7e1cc 100644 --- a/slice/SLICE_FLAGS.in +++ b/slice/SLICE_FLAGS.in @@ -4,6 +4,7 @@ --warn-unknown-format-calls --warn-non-contiguous-clauses --warn-non-contiguous-foreign-procs +--warn-inconsistent-pred-order-clauses --warn-unused-imports --warn-insts-with-functors-without-type --warn-suspicious-foreign-code diff --git a/slice/mdice.m b/slice/mdice.m index 9cb6d8636..f84dacde3 100644 --- a/slice/mdice.m +++ b/slice/mdice.m @@ -114,7 +114,23 @@ usage(OutStream, !IO) :- :- type option_table == option_table(option). :- pred short_option(character::in, option::out) is semidet. + +short_option('s', sort). +short_option('l', max_row). +short_option('n', max_pred_column). +short_option('p', max_path_column). +short_option('f', max_file_column). +short_option('m', modulename). + :- pred long_option(string::in, option::out) is semidet. + +long_option("sort", sort). +long_option("limit", max_row). +long_option("max-name-column", max_pred_column). +long_option("max-path-column", max_path_column). +long_option("max-file-column", max_file_column). +long_option("module", modulename). + :- pred option_default(option::out, option_data::out) is multi. option_default(sort, string("S")). @@ -124,18 +140,4 @@ option_default(max_path_column, int(12)). option_default(max_file_column, int(20)). option_default(modulename, string("")). -short_option('s', sort). -short_option('l', max_row). -short_option('n', max_pred_column). -short_option('p', max_path_column). -short_option('f', max_file_column). -short_option('m', modulename). - -long_option("sort", sort). -long_option("limit", max_row). -long_option("max-name-column", max_pred_column). -long_option("max-path-column", max_path_column). -long_option("max-file-column", max_file_column). -long_option("module", modulename). - %-----------------------------------------------------------------------------% diff --git a/slice/mslice.m b/slice/mslice.m index c2b3d5a09..39679e123 100644 --- a/slice/mslice.m +++ b/slice/mslice.m @@ -107,7 +107,23 @@ usage(OutStream, !IO) :- :- type option_table == option_table(option). :- pred short_option(character::in, option::out) is semidet. + +short_option('s', sort). +short_option('l', max_row). +short_option('n', max_pred_column). +short_option('p', max_path_column). +short_option('f', max_file_column). +short_option('m', modulename). + :- pred long_option(string::in, option::out) is semidet. + +long_option("sort", sort). +long_option("limit", max_row). +long_option("max-name-column", max_pred_column). +long_option("max-path-column", max_path_column). +long_option("max-file-column", max_file_column). +long_option("module", modulename). + :- pred option_default(option::out, option_data::out) is multi. option_default(sort, string("C")). @@ -117,18 +133,4 @@ option_default(max_path_column, int(12)). option_default(max_file_column, int(20)). option_default(modulename, string("")). -short_option('s', sort). -short_option('l', max_row). -short_option('n', max_pred_column). -short_option('p', max_path_column). -short_option('f', max_file_column). -short_option('m', modulename). - -long_option("sort", sort). -long_option("limit", max_row). -long_option("max-name-column", max_pred_column). -long_option("max-path-column", max_path_column). -long_option("max-file-column", max_file_column). -long_option("module", modulename). - %-----------------------------------------------------------------------------% diff --git a/slice/mtc_diff.m b/slice/mtc_diff.m index c0ff8485a..105b42afb 100644 --- a/slice/mtc_diff.m +++ b/slice/mtc_diff.m @@ -110,14 +110,16 @@ usage(OutStream, !IO) :- :- type option_table == option_table(option). :- pred short_option(character::in, option::out) is semidet. + +short_option('o', output_filename). + :- pred long_option(string::in, option::out) is semidet. + +long_option("out", output_filename). + :- pred option_default(option::out, option_data::out) is multi. :- pragma no_determinism_warning(option_default/2). option_default(output_filename, string("")). -short_option('o', output_filename). - -long_option("out", output_filename). - %-----------------------------------------------------------------------------% diff --git a/slice/mtc_union.m b/slice/mtc_union.m index 07c89c2a4..489f982c8 100644 --- a/slice/mtc_union.m +++ b/slice/mtc_union.m @@ -103,16 +103,18 @@ usage(OutStream, !IO) :- :- type option_table == option_table(option). :- pred short_option(character::in, option::out) is semidet. + +short_option('o', output_filename). +short_option('v', verbose). + :- pred long_option(string::in, option::out) is semidet. + +long_option("out", output_filename). +long_option("verbose", verbose). + :- pred option_default(option::out, option_data::out) is multi. option_default(output_filename, string("")). option_default(verbose, bool(no)). -short_option('o', output_filename). -short_option('v', verbose). - -long_option("out", output_filename). -long_option("verbose", verbose). - %-----------------------------------------------------------------------------% diff --git a/ssdb/SSDB_FLAGS.in b/ssdb/SSDB_FLAGS.in index 1c6d7ea49..420e9da39 100644 --- a/ssdb/SSDB_FLAGS.in +++ b/ssdb/SSDB_FLAGS.in @@ -4,6 +4,7 @@ --warn-unknown-format-calls --warn-non-contiguous-clauses --warn-non-contiguous-foreign-procs +--warn-inconsistent-pred-order-clauses --warn-unused-imports --warn-insts-with-functors-without-type --warn-suspicious-foreign-code diff --git a/ssdb/ssdb.m b/ssdb/ssdb.m index 030214bc6..57e709862 100644 --- a/ssdb/ssdb.m +++ b/ssdb/ssdb.m @@ -541,28 +541,6 @@ step_next_stop(!IO) :- %-----------------------------------------------------------------------------% -pause_debugging(Paused, !IO) :- - get_debugger_state_safer(Paused, !IO), - ( - Paused = debugger_off - ; - Paused = debugger_on, - set_debugger_state(debugger_off, !IO) - ). - -resume_debugging(Paused, !IO) :- - ( - Paused = debugger_on, - set_debugger_state(debugger_on, !IO) - ; - Paused = debugger_off - ). - -enable_debugging(!IO) :- - set_debugger_state(debugger_on, !IO). - -%-----------------------------------------------------------------------------% - set_context(FileName, Line) :- impure set_cur_filename(FileName), impure set_cur_line_number(Line). @@ -3515,5 +3493,27 @@ nonnegative_int(S, N) :- string.to_int(S, N), N >= 0. +%-----------------------------------------------------------------------------% + +pause_debugging(Paused, !IO) :- + get_debugger_state_safer(Paused, !IO), + ( + Paused = debugger_off + ; + Paused = debugger_on, + set_debugger_state(debugger_off, !IO) + ). + +resume_debugging(Paused, !IO) :- + ( + Paused = debugger_on, + set_debugger_state(debugger_on, !IO) + ; + Paused = debugger_off + ). + +enable_debugging(!IO) :- + set_debugger_state(debugger_on, !IO). + %----------------------------------------------------------------------------% %----------------------------------------------------------------------------%