From a529a380e23588bcf4c2024dde00cb15eb62a16f Mon Sep 17 00:00:00 2001 From: Simon Taylor Date: Wed, 12 Jun 2002 06:46:46 +0000 Subject: [PATCH] Back out Pete's unreviewed change from yesterday. Estimated hours taken: 0.2 Branches: main library/*.m Back out Pete's unreviewed change from yesterday. It doesn't compile without a recent bug fix, but no CVS tag was added. --- library/array.m | 41 +-- library/benchmarking.m | 68 +++-- library/builtin.m | 6 - library/char.m | 14 +- library/construct.m | 67 +++-- library/deconstruct.m | 33 ++- library/exception.m | 1 + library/float.m | 51 ++-- library/gc.m | 6 +- library/int.m | 16 -- library/io.m | 469 ++++++++++++-------------------- library/library.m | 3 - library/math.m | 49 +--- library/private_builtin.m | 15 +- library/profiling_builtin.m | 465 ++++++++++++++++++++------------ library/rtti_implementation.m | 35 +-- library/sparse_bitset.m | 3 - library/std_util.m | 39 +-- library/store.m | 143 ++++++---- library/string.m | 209 +++++---------- library/table_builtin.m | 485 +++++++++++++++++++++------------- library/time.m | 89 +++++-- library/type_desc.m | 27 +- 23 files changed, 1165 insertions(+), 1169 deletions(-) diff --git a/library/array.m b/library/array.m index ce85db278..52069a8bf 100644 --- a/library/array.m +++ b/library/array.m @@ -725,9 +725,6 @@ array__compare_elements(N, Size, Array1, Array2, Result) :- #endif "). -bounds_checks :- - private_builtin__sorry("array__bounds_checks"). - %-----------------------------------------------------------------------------% :- pragma foreign_decl("C", " @@ -789,15 +786,15 @@ array__init(Size, Item, Array) :- } "). -array__init_2(_, _, _) :- - private_builtin__sorry("array__init_2"). +:- pragma foreign_proc("C#", + array__make_empty_array(_Array::array_uo), + [will_not_call_mercury, promise_pure, thread_safe], " + mercury.runtime.Errors.SORRY(""foreign code for this predicate""); +"). -array__make_empty_array(_) :- - private_builtin__sorry("array__make_empty_array"). %-----------------------------------------------------------------------------% -:- pragma promise_pure(array__min/2). :- pragma foreign_proc("C", array__min(Array::array_ui, Min::out), [will_not_call_mercury, promise_pure, thread_safe], " @@ -824,10 +821,6 @@ array__make_empty_array(_) :- Min = 0; "). -array__min(_, _) :- - private_builtin__sorry("array__min"). - -:- pragma promise_pure(array__max/2). :- pragma foreign_proc("C", array__max(Array::array_ui, Max::out), [will_not_call_mercury, promise_pure, thread_safe], " @@ -849,8 +842,6 @@ array__min(_, _) :- Max = Array.Length - 1; "). -array__max(_, _) :- - private_builtin__sorry("array__max"). array__bounds(Array, Min, Max) :- array__min(Array, Min), @@ -858,7 +849,6 @@ array__bounds(Array, Min, Max) :- %-----------------------------------------------------------------------------% -:- pragma promise_pure(array__size/2). :- pragma foreign_proc("C", array__size(Array::array_ui, Max::out), [will_not_call_mercury, promise_pure, thread_safe], " @@ -881,8 +871,6 @@ array__bounds(Array, Min, Max) :- Max = Array.Length; "). -array__size(_, _) :- - private_builtin__sorry("array__size"). %-----------------------------------------------------------------------------% @@ -918,7 +906,6 @@ array__lookup(Array, Index, Item) :- :- pred array__unsafe_lookup(array(T), int, T). :- mode array__unsafe_lookup(array_ui, in, out) is det. :- mode array__unsafe_lookup(in, in, out) is det. -:- pragma promise_pure(array__unsafe_lookup/3). :- pragma foreign_proc("C", array__unsafe_lookup(Array::array_ui, Index::in, Item::out), @@ -944,8 +931,6 @@ array__lookup(Array, Index, Item) :- Item = Array.GetValue(Index); }"). -array__unsafe_lookup(_, _, _) :- - private_builtin__sorry("array__unsafe_lookup"). %-----------------------------------------------------------------------------% @@ -976,8 +961,6 @@ array__set(Array0, Index, Item, Array) :- Array = Array0; }"). -array__unsafe_set(_, _, _, _) :- - private_builtin__sorry("array__unsafe_set"). %-----------------------------------------------------------------------------% @@ -1056,8 +1039,6 @@ ML_resize_array(MR_ArrayType *array, MR_ArrayType *old_array, } "). -array__resize(_, _, _, _) :- - private_builtin__sorry("array__resize"). %-----------------------------------------------------------------------------% @@ -1122,8 +1103,6 @@ array__shrink(Array0, Size, Array) :- System.Array.Copy(Array0, Array, Size); "). -array__shrink_2(_, _, _) :- - private_builtin__sorry("array__shrink_2"). %-----------------------------------------------------------------------------% @@ -1183,9 +1162,13 @@ ML_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array) System.Array.Copy(Array0, Array, Array0.Length); "). -:- pragma promise_pure(array__copy/2). -array__copy(_, _) :- - private_builtin__sorry("array__copy"). +:- pragma foreign_proc("C#", + array__copy(Array0::in, Array::array_uo), + [will_not_call_mercury, promise_pure, thread_safe], " + mercury.runtime.Errors.SORRY(""foreign code for this function""); + // XXX need to deep copy it + Array = Array0; +"). %-----------------------------------------------------------------------------% diff --git a/library/benchmarking.m b/library/benchmarking.m index 65c6b1224..c516502f8 100644 --- a/library/benchmarking.m +++ b/library/benchmarking.m @@ -76,26 +76,30 @@ extern void ML_report_full_memory_stats(void); "). % end pragma foreign_decl :- pragma foreign_proc("C", report_stats, - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " ML_report_stats(); "). :- pragma foreign_proc("C", report_full_memory_stats, - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " #ifdef MR_MPROF_PROFILE_MEMORY ML_report_full_memory_stats(); #endif "). -report_stats :- - impure private_builtin__imp, - private_builtin__sorry("report_stats"). +:- pragma foreign_proc("MC++", report_stats, + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -report_full_memory_stats :- - impure private_builtin__imp, - private_builtin__sorry("report_full_memory_stats"). +:- pragma foreign_proc("MC++", report_full_memory_stats, + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). %-----------------------------------------------------------------------------% @@ -647,14 +651,11 @@ repeat(N) :- ( true ; impure repeat(N - 1) ). :- impure pred get_user_cpu_miliseconds(int::out) is det. - :- pragma foreign_proc("C", get_user_cpu_miliseconds(Time::out), [will_not_call_mercury], " Time = MR_get_user_cpu_miliseconds(); "). - -/* XXX for the MC++ implementation :- pragma foreign_proc("MC++", get_user_cpu_miliseconds(_Time::out), [will_not_call_mercury], " @@ -667,11 +668,6 @@ repeat(N) :- mercury::runtime::Errors::SORRY(""foreign code for this function""); "). -*/ - -get_user_cpu_miliseconds(_) :- - impure private_builtin__imp, - private_builtin__sorry("get_user_cpu_miliseconds"). /* ** To prevent the C compiler from optimizing the benchmark code @@ -686,30 +682,23 @@ get_user_cpu_miliseconds(_) :- "). :- impure pred do_nothing(T::in) is det. - :- pragma foreign_proc("C", do_nothing(X::in), [will_not_call_mercury, thread_safe], " ML_benchmarking_dummy_word = (MR_Word) X; "). - /* ** To prevent the MC++ compiler from optimizing the benchmark code ** away, we assign the benchmark output to a volatile static variable. ** XXX at least, we should do this but it doesn't seem to work. */ -/* :- pragma foreign_proc("MC++", do_nothing(X::in), [will_not_call_mercury, thread_safe], " mercury::runtime::Errors::SORRY(""foreign code for this function""); - // static volatile MR_Word ML_benchmarking_dummy_word; - // ML_benchmarking_dummy_word = (MR_Word) X; -"). +/* static volatile MR_Word ML_benchmarking_dummy_word; + ML_benchmarking_dummy_word = (MR_Word) X; */ - -do_nothing(_) :- - impure private_builtin__imp, - private_builtin__sorry("benchmaring__do_nothing"). +"). %-----------------------------------------------------------------------------% @@ -726,9 +715,12 @@ do_nothing(_) :- MR_incr_hp(Ref, 1); * (MR_Integer *) Ref = X; "). -new_int_reference(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("benchmarking__new_int_reference"). +:- pragma foreign_proc("MC++", + new_int_reference(_X::in, _Ref::out), [will_not_call_mercury], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + :- impure pred incr_ref(int_reference::in) is det. incr_ref(Ref) :- @@ -737,15 +729,16 @@ incr_ref(Ref) :- :- semipure pred ref_value(int_reference::in, int::out) is det. :- pragma inline(ref_value/2). -:- pragma promise_semipure(ref_value/2). :- pragma foreign_proc("C", ref_value(Ref::in, X::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_semipure], " X = * (MR_Integer *) Ref; "). -ref_value(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("benchmarking__ref_value"). +:- pragma foreign_proc("MC++", ref_value(_Ref::in, _X::out), + [will_not_call_mercury, promise_semipure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). :- impure pred update_ref(int_reference::in, T::in) is det. :- pragma inline(update_ref/2). @@ -753,8 +746,9 @@ ref_value(_, _) :- update_ref(Ref::in, X::in), [will_not_call_mercury], " * (MR_Integer *) Ref = X; "). -update_ref(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("benchmarking__update_ref"). +:- pragma foreign_proc("MC++", + update_ref(_Ref::in, _X::in), [will_not_call_mercury], " + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). %-----------------------------------------------------------------------------% diff --git a/library/builtin.m b/library/builtin.m index 7f57a6cfc..da91989ac 100644 --- a/library/builtin.m +++ b/library/builtin.m @@ -284,9 +284,6 @@ get_one_solution(CCPred) = OutVal :- (Y :: out(pred(out) is semidet)), [will_not_call_mercury, thread_safe], "Y = X;"). -cc_cast(_) = _ :- - impure private_builtin__imp, - private_builtin__sorry("builtin__cc_cast"). :- pragma promise_pure(promise_only_solution_io/4). promise_only_solution_io(Pred, X) --> @@ -310,9 +307,6 @@ get_one_solution_io(Pred, X) --> (Y :: out(pred(out, di, uo) is det)), [will_not_call_mercury, thread_safe], "Y = X;"). -cc_cast_io(_) = _ :- - impure private_builtin__imp, - private_builtin__sorry("builtin__cc_cast_io"). %-----------------------------------------------------------------------------% diff --git a/library/char.m b/library/char.m index 30778e386..d89c9b253 100644 --- a/library/char.m +++ b/library/char.m @@ -457,11 +457,6 @@ char__lower_upper('z', 'Z'). SUCCESS_INDICATOR = (Character == Int); "). -:- pragma promise_pure(char__to_int/2). -char__to_int(_, _) :- - private_builtin__sorry("char__to_int"). - - % We used unsigned character codes, so the minimum character code % is always zero. @@ -474,8 +469,13 @@ char__min_char_value(0). Max = UCHAR_MAX; "). -char__max_char_value(_) :- - private_builtin__sorry("char__max_char_value"). +:- pragma foreign_proc("MC++", + char__max_char_value(_Max::out), + [will_not_call_mercury, promise_pure, thread_safe], " + mercury::runtime::Errors::SORRY(""c code for this function""); +"). + + %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/library/construct.m b/library/construct.m index bb726f07c..01d990ca5 100644 --- a/library/construct.m +++ b/library/construct.m @@ -102,9 +102,6 @@ MR_restore_transient_registers(); }"). -num_functors(_) = _ :- - private_builtin__sorry("construct__num_functors"). - :- pragma foreign_proc("C", get_functor(TypeDesc::in, FunctorNumber::in, FunctorName::out, Arity::out, TypeInfoList::out), @@ -158,9 +155,6 @@ num_functors(_) = _ :- SUCCESS_INDICATOR = success; }"). -get_functor(_, _, _, _, _) :- - private_builtin__sorry("construct__get_functor"). - get_functor(TypeDesc, I, Functor, Arity, TypeInfoList, ArgNameList) :- get_functor_2(TypeDesc, I, Functor, Arity, TypeInfoList, ArgNameList0), ArgNameList = map(null_to_no, ArgNameList0). @@ -186,9 +180,6 @@ null_to_no(S) = ( if null(S) then no else yes(S) ). SUCCESS_INDICATOR = (S == NULL); "). -null(_) :- - private_builtin__sorry("construct__null"). - :- pred get_functor_2(type_desc__type_desc::in, int::in, string::out, int::out, list(type_desc__type_desc)::out, list(string)::out) is semidet. @@ -247,8 +238,14 @@ null(_) :- SUCCESS_INDICATOR = success; }"). -get_functor_2(_, _, _, _, _, _) :- - private_builtin__sorry("construct__get_functor_2"). +:- pragma foreign_proc("MC++", + get_functor_2(_TypeDesc::in, _FunctorNumber::in, _FunctorName::out, + _Arity::out, _TypeInfoList::out, _ArgNameList::out), + [will_not_call_mercury, thread_safe, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for get_functor_2""); + SUCCESS_INDICATOR = MR_FALSE; +"). :- pragma foreign_proc("C", get_functor_ordinal(TypeDesc::in, FunctorNumber::in, Ordinal::out), @@ -304,9 +301,6 @@ get_functor_2(_, _, _, _, _, _) :- SUCCESS_INDICATOR = success; }"). -get_functor_ordinal(_, _, _) :- - private_builtin__sorry("construct__get_functor_ordinal"). - :- pragma foreign_proc("C", construct(TypeDesc::in, FunctorNumber::in, ArgList::in) = (Term::out), [will_not_call_mercury, thread_safe, promise_pure], @@ -513,8 +507,40 @@ get_functor_ordinal(_, _, _) :- SUCCESS_INDICATOR = success; }"). -construct(_, _, _) = _ :- - private_builtin__sorry("construct__construct"). +:- pragma foreign_proc("C#", + num_functors(_TypeInfo::in) = (Functors::out), + [will_not_call_mercury, thread_safe, promise_pure], +"{ + mercury.runtime.Errors.SORRY(""foreign code for num_functors""); + // XXX keep the C# compiler quiet + Functors = 0; +}"). + +:- pragma foreign_proc("MC++", + get_functor(_TypeDesc::in, _FunctorNumber::in, _FunctorName::out, + _Arity::out, _TypeInfoList::out), + [will_not_call_mercury, thread_safe, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for get_functor""); +"). + +:- pragma foreign_proc("MC++", + get_functor_ordinal(_TypeDesc::in, _FunctorNumber::in, _Ordinal::out), + [will_not_call_mercury, thread_safe, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for get_functor_ordinal""); +"). + +:- pragma foreign_proc("C#", + construct(_TypeDesc::in, _FunctorNumber::in, _ArgList::in) + = (_Term::out), + [will_not_call_mercury, thread_safe, promise_pure], +"{ + mercury.runtime.Errors.SORRY(""foreign code for construct""); + _Term = null; + // XXX this is required to keep the C# compiler quiet + SUCCESS_INDICATOR = false; +}"). construct_tuple(Args) = construct_tuple_2(Args, @@ -563,5 +589,10 @@ construct_tuple(Args) = MR_new_univ_on_hp(Term, type_info, new_data); }"). -construct_tuple_2(_, _, _) = _ :- - private_builtin__sorry("construct__construct_tuple_2"). +:- pragma foreign_proc("C#", + construct_tuple_2(_Args::in, _ArgTypes::in, _Arity::in) = (_Term::out), + [will_not_call_mercury, thread_safe, promise_pure], +"{ + mercury.runtime.Errors.SORRY(""construct_tuple_2""); + _Term = null; +}"). diff --git a/library/deconstruct.m b/library/deconstruct.m index c24c52eb6..b53ba093d 100644 --- a/library/deconstruct.m +++ b/library/deconstruct.m @@ -816,8 +816,12 @@ get_functor_info(Univ, FunctorInfo) :- } }"). -get_notag_functor_info(_, _) :- - private_builtin__sorry("deconstruct__get_notag_functor_info"). +:- pragma foreign_proc("MC++", + get_notag_functor_info(_Univ::in, _ExpUniv::out), + [will_not_call_mercury, thread_safe, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for get_notag_functor_info""); +"). % Given a value of an arbitrary type, succeed if its type is defined % as an equivalence type, and return a univ which bundles up the value @@ -858,8 +862,12 @@ get_notag_functor_info(_, _) :- } }"). -get_equiv_functor_info(_, _) :- - private_builtin__sorry("get_equiv_functor_info"). +:- pragma foreign_proc("MC++", + get_equiv_functor_info(_Univ::in, _ExpUniv::out), + [will_not_call_mercury, thread_safe, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for get_equiv_functor_info""); +"). % Given a value of an arbitrary type, succeed if it is an enum type, % and return the integer value corresponding to the value. @@ -888,8 +896,12 @@ get_equiv_functor_info(_, _) :- } }"). -get_enum_functor_info(_, _) :- - private_builtin__sorry("deconstruct__get_enum_functor_info"). +:- pragma foreign_proc("MC++", + get_enum_functor_info(_Univ::in, _Enum::out), + [will_not_call_mercury, thread_safe, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for get_enum_functor_info""); +}"). % Given a value of an arbitrary type, succeed if it is a general du type % (i.e. non-enum, non-notag du type), and return the top function symbol's @@ -989,5 +1001,10 @@ get_enum_functor_info(_, _) :- } }"). -get_du_functor_info(_, _, _, _, _) :- - private_builtin__sorry("get_du_functor_info"). +:- pragma foreign_proc("MC++", + get_du_functor_info(_Univ::in, _Where::out, _Ptag::out, _Sectag::out, + _Args::out), + [will_not_call_mercury, thread_safe, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for get_du_functor_info""); +"). diff --git a/library/exception.m b/library/exception.m index 36a665807..eb5397a9f 100644 --- a/library/exception.m +++ b/library/exception.m @@ -1102,6 +1102,7 @@ mercury__exception__builtin_catch_model_non(MR_Mercury_Type_Info type_info, throw new mercury.runtime.Exception(T); "). + :- pragma foreign_proc("C#", catch_impl(Pred::pred(out) is det, Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " diff --git a/library/float.m b/library/float.m index 0dd53c0a8..0163cf43c 100644 --- a/library/float.m +++ b/library/float.m @@ -245,10 +245,6 @@ X / Y = Z :- SUCCESS_INDICATOR = MR_TRUE; #endif "). - -domain_checks :- - private_builtin__sorry("float__domain_checks"). - %---------------------------------------------------------------------------% % % Conversion functions @@ -269,8 +265,6 @@ float(Int) = Float :- " Ceil = System.Convert.ToInt32(System.Math.Ceiling(X)); "). -float__ceiling_to_int(_) = _ :- - private_builtin__sorry("float__ceiling_to_int"). % float__floor_to_int(X) returns the % largest integer not greater than X. @@ -284,8 +278,6 @@ float__ceiling_to_int(_) = _ :- " Floor = System.Convert.ToInt32(System.Math.Floor(X)); "). -float__floor_to_int(_) = _ :- - private_builtin__sorry("float__floor_to_int"). % float__round_to_int(X) returns the integer closest to X. % If X has a fractional value of 0.5, it is rounded up. @@ -299,8 +291,6 @@ float__floor_to_int(_) = _ :- " Round = System.Convert.ToInt32(System.Math.Floor(X + 0.5)); "). -float__round_to_int(_) = _ :- - private_builtin__sorry("float__round_to_int"). % float__truncate_to_int(X) returns the integer closest % to X such that |float__truncate_to_int(X)| =< |X|. @@ -314,8 +304,6 @@ float__round_to_int(_) = _ :- " Trunc = System.Convert.ToInt32(X); "). -float__truncate_to_int(_) = _ :- - private_builtin__sorry("float__truncate_to_int"). %---------------------------------------------------------------------------% % @@ -411,8 +399,6 @@ float__multiply_by_pow(Scale0, Base, Exp) = Result :- " H = F.GetHashCode(); "). -float__hash(_) = _ :- - private_builtin__sorry("float__hash"). %---------------------------------------------------------------------------% % @@ -450,8 +436,7 @@ float__hash(_) = _ :- :- pragma foreign_proc("C#", float__max = (Max::out), [will_not_call_mercury, promise_pure, thread_safe], "Max = System.Double.MaxValue;"). -float__max = _ :- - private_builtin__sorry("float__max"). + % Minimum normalised floating-point number */ :- pragma foreign_proc("C", float__min = (Min::out), @@ -460,8 +445,6 @@ float__max = _ :- :- pragma foreign_proc("C#", float__min = (Min::out), [will_not_call_mercury, promise_pure, thread_safe], "Min = System.Double.MinValue;"). -float__min = _ := - private_builtin__sorry("float__min"). % Smallest x such that x \= 1.0 + x :- pragma foreign_proc("C", float__epsilon = (Eps::out), @@ -470,22 +453,26 @@ float__min = _ := :- pragma foreign_proc("C#", float__epsilon = (Eps::out), [will_not_call_mercury, promise_pure, thread_safe], "Eps = System.Double.Epsilon;"). -float__epsilon = _ :- - private_builtin__sorry("float__epsilon"). % Radix of the floating-point representation. :- pragma foreign_proc("C", float__radix = (Radix::out), [will_not_call_mercury, promise_pure, thread_safe], "Radix = ML_FLOAT_RADIX;"). -float__radix = _ :- - private_builtin__sorry("float__radix"). +:- pragma foreign_proc("C#", float__radix = (_Radix::out), + [will_not_call_mercury, promise_pure, thread_safe], " + mercury.runtime.Errors.SORRY(""foreign code for this function""); + _Radix = 0; +"). % The number of base-radix digits in the mantissa. :- pragma foreign_proc("C", float__mantissa_digits = (MantDig::out), [will_not_call_mercury, promise_pure, thread_safe], "MantDig = ML_FLOAT_MANT_DIG;"). -float__mantissa_digits = _ :- - private_builtin__sorry("float__mantissa_digits"). +:- pragma foreign_proc("C#", float__mantissa_digits = (_MantDig::out), + [will_not_call_mercury, promise_pure, thread_safe], " + mercury.runtime.Errors.SORRY(""foreign code for this function""); + _MantDig = 0; +"). % Minimum negative integer such that: % radix ** (min_exponent - 1) @@ -493,8 +480,11 @@ float__mantissa_digits = _ :- :- pragma foreign_proc("C", float__min_exponent = (MinExp::out), [will_not_call_mercury, promise_pure, thread_safe], "MinExp = ML_FLOAT_MIN_EXP;"). -float__min_exponent = _ :- - private_builtin__sorry("float__min_exponent"). +:- pragma foreign_proc("C#", float__min_exponent = (_MinExp::out), + [will_not_call_mercury, promise_pure, thread_safe], " + mercury.runtime.Errors.SORRY(""foreign code for this function""); + _MinExp = 0; +"). % Maximum integer such that: % radix ** (max_exponent - 1) @@ -502,8 +492,13 @@ float__min_exponent = _ :- :- pragma foreign_proc("C", float__max_exponent = (MaxExp::out), [will_not_call_mercury, promise_pure, thread_safe], "MaxExp = ML_FLOAT_MAX_EXP;"). -float__max_exponent = _ :- - private_builtin__sorry("float__max_exponent"). + +:- pragma foreign_proc("C#", float__max_exponent = (_MaxExp::out), + [will_not_call_mercury, promise_pure, thread_safe], " + mercury.runtime.Errors.SORRY(""foreign code for this function""); + _MaxExp = 0; +"). + %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% diff --git a/library/gc.m b/library/gc.m index afcf995dd..af7a96a86 100644 --- a/library/gc.m +++ b/library/gc.m @@ -53,9 +53,9 @@ garbage_collect --> MR_garbage_collect(); #endif "). -garbage_collect :- - impure private_builtin__imp, - private_builtin__sorry("garbage_collect"). +:- pragma foreign_proc("MC++", garbage_collect, [will_not_call_mercury], " + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% diff --git a/library/int.m b/library/int.m index 85d6252e7..d2140ed75 100644 --- a/library/int.m +++ b/library/int.m @@ -343,9 +343,6 @@ X rem Y = Rem :- #endif "). -domain_checks :- - private_builtin__sorry("domain_checks"). - :- pragma inline(floor_to_multiple_of_bits_per_int/1). floor_to_multiple_of_bits_per_int(X) = Floor :- Trunc = quot_bits_per_int(X), @@ -507,8 +504,6 @@ is(X, X). " FloatVal = (MR_Float) IntVal; "). -int__to_float(_, _) :- - private_builtin__sorry("int__to_float"). %-----------------------------------------------------------------------------% @@ -563,7 +558,6 @@ int__to_float(_, _) :- Result = Int * ML_BITS_PER_INT; "). - :- pragma foreign_proc("C", int__rem_bits_per_int(Int::in) = (Rem::out), [will_not_call_mercury, promise_pure, thread_safe], " Rem = Int % ML_BITS_PER_INT; @@ -585,15 +579,6 @@ int__to_float(_, _) :- Bits = ML_BITS_PER_INT; "). -int__max_int(_) :- - private_builtin__sorry("int__max_int"). - -int__min_int(_) :- - private_builtin__sorry("int__min_int"). - -int__bits_per_int(_) :- - private_builtin__sorry("int__bits_per_int"). - int__quot_bits_per_int(Int::in) = (Result::out) :- Result = Int // int__bits_per_int. @@ -603,7 +588,6 @@ int__times_bits_per_int(Int::in) = (Result::out) :- int__rem_bits_per_int(Int::in) = (Result::out) :- Result = Int rem int__bits_per_int. - %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Ralph Becket 27/04/99 diff --git a/library/io.m b/library/io.m index 9a12b59c9..c175462e2 100644 --- a/library/io.m +++ b/library/io.m @@ -1603,8 +1603,14 @@ io__read_line_as_string(Stream, Result, IO0, IO) :- update_io(IO0, IO); "). -io__read_line_as_string_2(_, _, _) --> - { private_builtin__sorry("io__read_line_as_string_2") }. +:- pragma foreign_proc("MC++", + io__read_line_as_string_2(_File::in, _Res :: out, _RetString::out, + IO0::di, IO::uo), + [will_not_call_mercury, promise_pure,thread_safe], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); + update_io(IO0, IO); +"). io__read_file(Result) --> io__input_stream(Stream), @@ -1757,7 +1763,7 @@ io__input_stream_foldl2_io(Stream, Pred, T0, Res) --> :- mode io__clear_err(in, di, uo) is det. % same as ANSI C's clearerr(). -:- pragma foreign_proc("C", io__clear_err(Stream::in, IO0::di, IO::uo), +:- pragma foreign_proc("C", io__clear_err(Stream::in, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe], "{ @@ -1768,7 +1774,6 @@ io__input_stream_foldl2_io(Stream, Pred, T0, Res) --> } else { /* Not a file stream so do nothing */ } - update_io(IO0, IO); }"). :- pragma foreign_proc("MC++", io__clear_err(_Stream::in, IO0::di, IO::uo), @@ -1780,9 +1785,6 @@ io__input_stream_foldl2_io(Stream, Pred, T0, Res) --> update_io(IO0, IO); }"). -io__clear_err(_) --> - { private_builtin__sorry("io__clear_err") }. - :- pred io__check_err(stream, io__res, io__state, io__state). :- mode io__check_err(in, out, di, uo) is det. @@ -1800,7 +1802,7 @@ io__check_err(Stream, Res) --> % similar to ANSI C's ferror(). :- pragma foreign_proc("C", ferror(Stream::in, RetVal::out, RetStr::out, - IO0::di, IO::uo), + _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe], "{ @@ -1814,8 +1816,6 @@ io__check_err(Stream, Res) --> ML_maybe_make_err_msg(RetVal != 0, ""read failed: "", MR_PROC_LABEL, RetStr); - - update_io(IO0, IO); }"). :- pragma foreign_proc("MC++", ferror(_Stream::in, RetVal::out, _RetStr::out, @@ -1827,9 +1827,6 @@ io__check_err(Stream, Res) --> update_io(IO0, IO); }"). -ferror(_, _, _) --> - { private_builtin__sorry("ferror") }. - % io__make_err_msg(MessagePrefix, Message): % `Message' is an error message obtained by looking up the @@ -1839,24 +1836,19 @@ ferror(_, _, _) --> :- mode io__make_err_msg(in, out, di, uo) is det. :- pragma foreign_proc("C", - make_err_msg(Msg0::in, Msg::out, IO0::di, IO::uo), + make_err_msg(Msg0::in, Msg::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], "{ ML_maybe_make_err_msg(MR_TRUE, Msg0, MR_PROC_LABEL, Msg); - update_io(IO0, IO); }"). :- pragma foreign_proc("MC++", - make_err_msg(Msg0::in, Msg::out, IO0::di, IO::uo), + make_err_msg(Msg0::in, Msg::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure], "{ Msg = System::String::Concat(Msg0, MR_io_exception->Message); - update_io(IO0, IO); }"). -make_err_msg(_, _) --> - { private_builtin__sorry("io__make_err_msg") }. - %-----------------------------------------------------------------------------% @@ -1876,7 +1868,7 @@ make_err_msg(_, _) --> "). :- pragma foreign_proc("C", io__stream_file_size(Stream::in, Size::out, - IO0::di, IO::uo), + _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe], "{ @@ -1899,7 +1891,6 @@ make_err_msg(_, _) --> #else Size = -1; #endif - update_io(IO0, IO); }"). :- pragma foreign_proc("MC++", io__stream_file_size(Stream::in, Size::out, @@ -1916,10 +1907,6 @@ make_err_msg(_, _) --> update_io(IO0, IO); }"). -io__stream_file_size(_, _) --> - { private_builtin__sorry("io__stream_file_size") }. - - io__file_modification_time(File, Result) --> io__file_modification_time_2(File, Status, Msg, Time), { Status = 1 -> @@ -1957,8 +1944,12 @@ io__file_modification_time(File, Result) --> }"). -io__file_modification_time_2(_, _, _, _) --> - { private_builtin__sorry("io__file_modification_time_2") }. +:- pragma foreign_proc("MC++", io__file_modification_time_2(_FileName::in, + _Status::out, _Msg::out, _Time::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, thread_safe], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %-----------------------------------------------------------------------------% @@ -1979,9 +1970,6 @@ io__file_modification_time_2(_, _, _, _) --> MR_PROC_LABEL, ""io:buffer/0""); }"). -io__alloc_buffer(_, _) :- - private_builtin__sorry("io__alloc_buffer"). - :- pred io__resize_buffer(buffer::di, int::in, int::in, buffer::uo) is det. :- pragma foreign_proc("C", io__resize_buffer(Buffer0::di, OldSize::in, @@ -2021,9 +2009,6 @@ io__alloc_buffer(_, _) :- Buffer = (MR_Word) buffer; }"). -io__resize_buffer(_, _, _, _) :- - private_builtin__sorry("io__resize_buffer"). - :- pred io__buffer_to_string(buffer::di, int::in, string::uo) is det. :- pragma foreign_proc("C", io__buffer_to_string(Buffer::di, Len::in, Str::uo), @@ -2033,8 +2018,6 @@ io__resize_buffer(_, _, _, _) :- Str[Len] = '\\0'; }"). -io__buffer_to_string(_, _, _) :- - private_builtin__sorry("io__buffer_to_string/3"). :- pred io__buffer_to_string(buffer::di, string::uo) is det. :- pragma foreign_proc("C", @@ -2044,15 +2027,13 @@ io__buffer_to_string(_, _, _) :- Str = (MR_String) Buffer; }"). -io__buffer_to_string(_, _) :- - private_builtin__sorry("io__buffer_to_string/2"). :- pred io__read_into_buffer(stream::in, buffer::di, int::in, int::in, buffer::uo, int::out, io__state::di, io__state::uo) is det. :- pragma foreign_proc("C", io__read_into_buffer(Stream::in, Buffer0::di, Pos0::in, Size::in, - Buffer::uo, Pos::out, IO0::di, IO::uo), + Buffer::uo, Pos::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe], "{ @@ -2064,12 +2045,49 @@ io__buffer_to_string(_, _) :- Buffer = (MR_Word) buffer; Pos = Pos0 + items_read; - - update_io(IO0, IO); }"). -io__read_into_buffer(_, _, _, _, _, _) --> - { private_builtin__sorry("io__read_into_buffer") }. +:- pragma foreign_proc("MC++", + io__alloc_buffer(_Size::in, _Buffer::uo), + [will_not_call_mercury, promise_pure, thread_safe, + tabled_for_io], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + +:- pragma foreign_proc("MC++", + io__resize_buffer(_Buffer0::di, _OldSize::in, + _NewSize::in, _Buffer::uo), + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + +:- pragma foreign_proc("MC++", + io__buffer_to_string(_Buffer::di, _Len::in, _Str::uo), + [will_not_call_mercury, promise_pure, thread_safe, + tabled_for_io], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + +:- pragma foreign_proc("MC++", + io__buffer_to_string(_Buffer::di, _Str::uo), + [will_not_call_mercury, promise_pure, thread_safe, + tabled_for_io], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + +:- pragma foreign_proc("MC++", + io__read_into_buffer(_Stream::in, _Buffer0::di, _Pos0::in, _Size::in, + _Buffer::uo, _Pos::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure, thread_safe, + tabled_for_io], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + %-----------------------------------------------------------------------------% @@ -2977,12 +2995,6 @@ io__stream_name(Stream, Name) --> update_io(IO0, IO); "). -io__get_stream_names(_) --> - { private_builtin__sorry("io__get_stream_names") }. - -io__set_stream_names(_) --> - { private_builtin__sorry("io__set_stream_names") }. - :- pred io__delete_stream_name(io__stream, io__state, io__state). :- mode io__delete_stream_name(in, di, uo) is det. @@ -3040,12 +3052,6 @@ io__insert_stream_name(Stream, Name) --> update_io(IOState0, IOState); "). -io__set_globals(_) --> - { private_builtin__sorry("io__set_globals") }. - -io__get_globals(_) --> - { private_builtin__sorry("io__get_globals") }. - io__progname_base(DefaultName, PrognameBase) --> io__progname(DefaultName, Progname), { dir__basename(Progname, PrognameBase) }. @@ -3087,8 +3093,7 @@ io__get_stream_id(Stream) = Id :- io__get_stream_id(Stream, Id). Id = mf->id; "). -io__get_stream_id(_, _) :- - private_builtin__sorry("io__get_stream_id"). + %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -3207,18 +3212,9 @@ io__finalize_state --> ascii_encoder = new System::Text::ASCIIEncoding(); "). -io__gc_init(_, _) --> - { private_builtin__sorry("io__gc_init") }. - :- pred io__stream_init(io__state, io__state). :- mode io__stream_init(di, uo) is det. -:- pragma foreign_proc("C", - io__stream_init(IO0::di, IO::uo), [will_not_call_mercury, - promise_pure], " - update_io(IO0, IO); -"). - :- pragma foreign_proc("MC++", io__stream_init(IO0::di, IO::uo), [will_not_call_mercury, promise_pure], " @@ -3226,8 +3222,11 @@ io__gc_init(_, _) --> update_io(IO0, IO); "). -io__stream_init --> - { private_builtin__sorry("io__stream_init") }. +:- pragma foreign_proc("C", + io__stream_init(IO0::di, IO::uo), [will_not_call_mercury, + promise_pure], " + update_io(IO0, IO); +"). :- pred io__insert_std_stream_names(io__state, io__state). :- mode io__insert_std_stream_names(di, uo) is det. @@ -3968,14 +3967,6 @@ ML_fprintf(MercuryFile* mf, const char *format, ...) update_io(IO0, IO); }"). -io__read_char_code(_, _) --> - { private_builtin__sorry("io__read_char_code") }. - -io__putback_char(_, _) --> - { private_builtin__sorry("io__putback_char") }. - -io__putback_byte(_, _) --> - { private_builtin__sorry("io__putback_byte") }. /* output predicates - with output to mercury_current_text_output */ @@ -4135,29 +4126,6 @@ io__putback_byte(_, _) --> update_io(IO0, IO); "). -io__write_string(_) --> - { private_builtin__sorry("io__write_string") }. - -io__write_char(_) --> - { private_builtin__sorry("io__write_char") }. - -io__write_int(_) --> - { private_builtin__sorry("io__write_int") }. - -io__write_float(_) --> - { private_builtin__sorry("io__write_float") }. - -io__write_byte(_) --> - { private_builtin__sorry("io__write_byte") }. - -io__write_bytes(_) --> - { private_builtin__sorry("io__write_bytes") }. - -io__flush_output --> - { private_builtin__sorry("io__flush_output") }. - -io__flush_binary_output --> - { private_builtin__sorry("io__flush_binary_output") }. /* moving about binary streams */ @@ -4190,7 +4158,8 @@ io__seek_binary(Stream, Whence, Offset, IO0, IO) :- mercury_io_error(stream, ""io__seek_binary_2: unseekable stream""); } - update_io(IO0, IO); + + IO = IO0; }"). :- pragma foreign_proc("C", @@ -4208,14 +4177,29 @@ io__seek_binary(Stream, Whence, Offset, IO0, IO) :- mercury_io_error(stream, ""io__binary_stream_offset: untellable stream""); } - update_io(IO0, IO); + IO = IO0; }"). -io__seek_binary_2(_, _, _) --> - { private_builtin__sorry("io__seek_binary_2") }. +:- pragma foreign_proc("MC++", + io__seek_binary_2(_Stream::in, _Flag::in, _Off::in, + IO0::di, IO::uo), + [will_not_call_mercury, promise_pure, thread_safe, + tabled_for_io], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); + IO = IO0; +}"). + +:- pragma foreign_proc("MC++", + io__binary_stream_offset(_Stream::in, _Offset::out, + IO0::di, IO::uo), + [will_not_call_mercury, promise_pure, thread_safe, + tabled_for_io], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); + IO = IO0; +}"). -io__binary_stream_offset(_, _) --> - { private_builtin__sorry("io__binary_stream_offset") }. /* output predicates - with output to the specified stream */ @@ -4401,29 +4385,6 @@ io__binary_stream_offset(_, _) --> update_io(IO0, IO); }"). -io__write_string(_, _) --> - { private_builtin__sorry("io__write_string") }. - -io__write_char(_, _) --> - { private_builtin__sorry("io__write_char") }. - -io__write_int(_, _) --> - { private_builtin__sorry("io__write_int") }. - -io__write_float(_, _) --> - { private_builtin__sorry("io__write_float") }. - -io__write_byte(_, _) --> - { private_builtin__sorry("io__write_byte") }. - -io__write_bytes(_, _) --> - { private_builtin__sorry("io__write_bytes") }. - -io__flush_output(_) --> - { private_builtin__sorry("io__flush_output") }. - -io__flush_binary_output(_) --> - { private_builtin__sorry("io__flush_binary_output") }. /* stream predicates */ @@ -4549,7 +4510,7 @@ io__flush_binary_output(_) --> LineNum = MR_line_number(*mercury_current_text_output); update_io(IO0, IO); "). - + :- pragma foreign_proc("C", io__get_output_line_number(Stream::in, LineNum::out, IO0::di, IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], @@ -4838,80 +4799,6 @@ io__flush_binary_output(_) --> update_io(IO0, IO); "). -io__stdin_stream(_) --> - { private_builtin__sorry("io__stdin_stream") }. - -io__stdout_stream(_) --> - { private_builtin__sorry("io__stdout_stream") }. - -io__stderr_stream(_) --> - { private_builtin__sorry("io__stderr_stream") }. - -io__stdin_binary_stream(_) --> - { private_builtin__sorry("io__stdin_binary_stream") }. - -io__stdout_binary_stream(_) --> - { private_builtin__sorry("io__stdout_binary_stream") }. - -io__input_stream(_) --> - { private_builtin__sorry("io__input_stream") }. - -io__output_stream(_) --> - { private_builtin__sorry("io__output_stream") }. - -io__binary_input_stream(_) --> - { private_builtin__sorry("io__binary_input_stream") }. - -io__binary_output_stream(_) --> - { private_builtin__sorry("io__binary_output_stream") }. - -io__get_line_number(_) --> - { private_builtin__sorry("io__get_line_number") }. - -io__get_line_number(_, _) --> - { private_builtin__sorry("io__get_line_number") }. - -io__set_line_number(_) --> - { private_builtin__sorry("io__set_line_number") }. - -io__set_line_number(_, _) --> - { private_builtin__sorry("io__set_line_number") }. - -io__get_output_line_number(_) --> - { private_builtin__sorry("io__get_output_line_number") }. - -io__get_output_line_number(_, _) --> - { private_builtin__sorry("io__get_output_line_number") }. - -io__set_output_line_number(_) --> - { private_builtin__sorry("io__set_output_line_number") }. - -io__set_output_line_number(_, _) --> - { private_builtin__sorry("io__set_output_line_number") }. - -io__current_input_stream(_) --> - { private_builtin__sorry("io__current_input_stream") }. - -io__current_output_stream(_) --> - { private_builtin__sorry("io__current_output_stream") }. - -io__current_binary_input_stream(_) --> - { private_builtin__sorry(io__current_binary_input_stream) }. - -io__current_binary_output_stream(_) --> - { private_builtin__sorry(io__current_binary_output_stream) }. - -io__set_input_stream(_, _) --> - { private_builtin__sorry("io__set_input_stream") }. - -io__set_output_stream(_, _) --> - { private_builtin__sorry("io__set_output_stream") }. - -io__set_binary_input_stream(_, _) --> - { private_builtin__sorry("io__set_binary_input_stream") }. - -io__set_binary_output_stream(_, _) --> - { private_builtin__sorry("io__set_binary_output_stream") }. /* stream open/close predicates */ @@ -4941,9 +4828,6 @@ io__set_binary_output_stream(_, _) --> update_io(IO0, IO); "). -io__do_open(_, _, _, _) --> - { private_builtin__sorry("io__do_open") }. - io__close_input(Stream) --> io__delete_stream_name(Stream), io__close_stream(Stream). @@ -4976,11 +4860,13 @@ io__close_binary_output(Stream) --> update_io(IO0, IO); "). -io__close_stream(_) --> - { private_builtin__sorry("io__close_stream") }. - /* miscellaneous predicates */ +io__progname(DefaultProgName::in, ProgName::out, IO::di, IO::uo) :- + % This is a fall-back for back-ends which don't support the + % C interface. + ProgName = DefaultProgName. + :- pragma foreign_proc("C", io__progname(DefaultProgname::in, PrognameOut::out, IO0::di, IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, @@ -5004,62 +4890,6 @@ io__close_stream(_) --> update_io(IO0, IO); "). -io__progname(DefaultProgName::in, ProgName::out, IO::di, IO::uo) :- - % This is a fall-back for back-ends which don't support the - % C interface. - ProgName = DefaultProgName. - -io__handle_system_command_exit_status(Code0) = Status :- - Code = io__handle_system_command_exit_code(Code0), - ( Code = 127 -> - Status = error( - io_error("unknown result code from system command")) - ; Code < 0 -> - Status = ok(signalled(-Code)) - ; - Status = ok(exited(Code)) - ). - - % Interpret the child process exit status returned by - % system() or wait(): return negative for `signalled', - % non-negative for `exited', or 127 for anything else - % (e.g. an error invoking the command). -:- func io__handle_system_command_exit_code(int) = int. - -:- pragma foreign_proc("C", - io__handle_system_command_exit_code(Status0::in) = (Status::out), - [will_not_call_mercury, thread_safe, promise_pure], -" - #if defined (WIFEXITED) && defined (WEXITSTATUS) && \ - defined (WIFSIGNALED) && defined (WTERMSIG) - if (WIFEXITED(Status0)) { - Status = WEXITSTATUS(Status0); - } else if (WIFSIGNALED(Status0)) { - Status = -WTERMSIG(Status0); - } else { - Status = 127; - } - #else - if (Status0 & 0xff != 0) { - /* the process was killed by a signal */ - Status = -(Status0 & 0xff); - } else { - /* the process terminated normally */ - Status = (Status0 & 0xff00) >> 8; - } - #endif -"). - -% This is a fall-back for back-ends that don't support the C interface. -io__handle_system_command_exit_code(Status0::in) = (Status::out) :- - ( (Status0 /\ 0xff) \= 0 -> - /* the process was killed by a signal */ - Status = -(Status0 /\ 0xff) - ; - /* the process terminated normally */ - Status = (Status0 /\ 0xff00) >> 8 - ). - :- pragma foreign_proc("C", io__command_line_arguments(Args::out, IO0::di, IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, @@ -5114,6 +4944,58 @@ io__handle_system_command_exit_code(Status0::in) = (Status::out) :- update_io(IO0, IO); "). + +io__handle_system_command_exit_status(Code0) = Status :- + Code = io__handle_system_command_exit_code(Code0), + ( Code = 127 -> + Status = error( + io_error("unknown result code from system command")) + ; Code < 0 -> + Status = ok(signalled(-Code)) + ; + Status = ok(exited(Code)) + ). + + % Interpret the child process exit status returned by + % system() or wait(): return negative for `signalled', + % non-negative for `exited', or 127 for anything else + % (e.g. an error invoking the command). +:- func io__handle_system_command_exit_code(int) = int. + +% This is a fall-back for back-ends that don't support the C interface. +io__handle_system_command_exit_code(Status0::in) = (Status::out) :- + ( (Status0 /\ 0xff) \= 0 -> + /* the process was killed by a signal */ + Status = -(Status0 /\ 0xff) + ; + /* the process terminated normally */ + Status = (Status0 /\ 0xff00) >> 8 + ). + +:- pragma foreign_proc("C", + io__handle_system_command_exit_code(Status0::in) = (Status::out), + [will_not_call_mercury, thread_safe, promise_pure], +" + #if defined (WIFEXITED) && defined (WEXITSTATUS) && \ + defined (WIFSIGNALED) && defined (WTERMSIG) + if (WIFEXITED(Status0)) { + Status = WEXITSTATUS(Status0); + } else if (WIFSIGNALED(Status0)) { + Status = -WTERMSIG(Status0); + } else { + Status = 127; + } + #else + if (Status0 & 0xff != 0) { + /* the process was killed by a signal */ + Status = -(Status0 & 0xff); + } else { + /* the process terminated normally */ + Status = (Status0 & 0xff00) >> 8; + } + #endif +"). + :- pragma foreign_proc("MC++", io__command_line_arguments(Args::out, IO0::di, IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io, @@ -5144,7 +5026,6 @@ io__handle_system_command_exit_code(Status0::in) = (Status::out) :- update_io(IO0, IO); "). -/* :- pragma foreign_proc("MC++", io__call_system_code(Command::in, Status::out, _Msg::out, IO0::di, IO::uo), @@ -5160,27 +5041,25 @@ io__handle_system_command_exit_code(Status0::in) = (Status::out) :- Status = NULL; update_io(IO0, IO); "). -*/ -io__command_line_arguments(_) --> - { private_builtin__sorry("io__command_line_arguments") }. +io__current_input_stream(_::out, _::di, _::uo) :- + private_builtin__sorry("io__current_input_stream/3"). -io__get_exit_status(_) --> - { private_builtin__sorry("io__get_exit_status") }. +io__current_output_stream(_::out, _::di, _::uo) :- + private_builtin__sorry("io__current_output_stream/3"). -io__set_exit_status(_) --> - { private_builtin__sorry("io__set_exit_status") }. +io__current_binary_input_stream(_::out, _::di, _::uo) :- + private_builtin__sorry("io__current_binary_input_stream/3"). -io__call_system_code(_, _, _) --> - { private_builtin__sorry("io__call_system_code") }. +io__current_binary_output_stream(_::out, _::di, _::uo) :- + private_builtin__sorry("io__current_binary_output_stream/3"). /*---------------------------------------------------------------------------*/ /* io__getenv and io__putenv, from io.m */ -:- pragma promise_semipure(io__getenv/2). :- pragma foreign_proc("C", io__getenv(Var::in, Value::out), - [will_not_call_mercury, tabled_for_io], + [will_not_call_mercury, promise_semipure, tabled_for_io], "{ Value = getenv(Var); SUCCESS_INDICATOR = (Value != 0); @@ -5193,7 +5072,7 @@ io__call_system_code(_, _, _) --> "). :- pragma foreign_proc("MC++", io__getenv(Var::in, Value::out), - [will_not_call_mercury, tabled_for_io], + [will_not_call_mercury, promise_semipure, tabled_for_io], "{ Value = System::Environment::GetEnvironmentVariable(Var); SUCCESS_INDICATOR = (Value != 0); @@ -5207,13 +5086,6 @@ io__call_system_code(_, _, _) --> SUCCESS_INDICATOR = 0; "). -io__getenv(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("io__getenv"). - -io__putenv(_) :- - impure private_builtin__imp, - private_builtin__sorry("io__putenv"). /*---------------------------------------------------------------------------*/ @@ -5331,8 +5203,15 @@ io__make_temp(Dir, Prefix, Name) --> update_io(IO0, IO); }"). -io__do_make_temp(_, _, _, _, _) --> - { private_builtin__sorry("io__do_make_temp") }. +:- pragma foreign_proc("MC++", + io__do_make_temp(_Dir::in, _Prefix::in, _FileName::out, + _Error::out, _ErrorMessage::out, IO0::di, IO::uo), + [will_not_call_mercury, promise_pure, thread_safe], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); + update_io(IO0, IO); +}"). + /*---------------------------------------------------------------------------*/ @@ -5403,7 +5282,6 @@ io__remove_file(FileName, Result, IO0, IO) :- update_io(IO0, IO); }"). -/* :- pragma foreign_proc("MC++", io__remove_file_2(FileName::in, RetVal::out, RetStr::out, IO0::di, IO::uo), @@ -5416,10 +5294,7 @@ io__remove_file(FileName, Result, IO0, IO) :- RetStr = """"; update_io(IO0, IO); }"). -*/ -io__remove_file_2(_, _, _) --> - { private_builtin__sorry("io__remove_file_2") }. io__rename_file(OldFileName, NewFileName, Result, IO0, IO) :- io__rename_file_2(OldFileName, NewFileName, Res, ResString, IO0, IO), @@ -5444,8 +5319,16 @@ io__rename_file(OldFileName, NewFileName, Result, IO0, IO) :- update_io(IO0, IO); }"). -io__rename_file_2(_, _, _, _) --> - { private_builtin__sorry("io__rename_file_2") }. +:- pragma foreign_proc("MC++", + io__rename_file_2(_OldFileName::in, _NewFileName::in, + _RetVal::out, _RetStr::out, IO0::di, IO::uo), + [will_not_call_mercury, promise_pure, tabled_for_io, + thread_safe], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); + update_io(IO0, IO); +}"). + /*---------------------------------------------------------------------------*/ diff --git a/library/library.m b/library/library.m index 930e9d4d0..61b1c57d6 100644 --- a/library/library.m +++ b/library/library.m @@ -76,8 +76,5 @@ Version = MR_VERSION "", configured for "" MR_FULLARCH; "). -library__version(_) :- - private_builtin__sorry("library__version"). - %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% diff --git a/library/math.m b/library/math.m index 6ba3a8cb7..198f0b57e 100644 --- a/library/math.m +++ b/library/math.m @@ -264,10 +264,6 @@ #endif "). -domain_checks :- - semidet_succeed, - private__builtin__sorry("domain_checks"). - % % Mathematical constants from math.m % @@ -281,8 +277,6 @@ domain_checks :- [will_not_call_mercury, promise_pure, thread_safe]," Pi = System.Math.PI; "). -math__pi = _ :- - private__builtin__sorry("math__pi"). % Base of natural logarithms :- pragma foreign_proc("C", math__e = (E::out), @@ -293,8 +287,6 @@ math__pi = _ :- [will_not_call_mercury, promise_pure, thread_safe]," E = System.Math.E; "). -math__e = _ :- - private__builtin__sorry("math__e"). % % math__ceiling(X) = Ceil is true if Ceil is the smallest integer @@ -310,8 +302,6 @@ math__e = _ :- " Ceil = System.Math.Ceiling(Num); "). -math__ceiling(_) = _ :- - private__builtin__sorry("math__ceiling"). % % math__floor(X) = Floor is true if Floor is the largest integer @@ -327,8 +317,6 @@ math__ceiling(_) = _ :- " Floor = System.Math.Floor(Num); "). -math__floor(_) = _ :- - private__builtin__sorry("math__floor"). % % math__round(X) = Round is true if Round is the integer @@ -347,8 +335,6 @@ math__floor(_) = _ :- // Unfortunately they are better (round to nearest even number). Rounded = System.Math.Floor(Num+0.5); "). -math__round(_) = _ :- - private__builtin__sorry("math__round"). % % math__truncate(X) = Trunc is true if Trunc is the integer @@ -380,8 +366,7 @@ math__sqrt(X) = SquareRoot :- [thread_safe, promise_pure], " SquareRoot = System.Math.Sqrt(X); "). -math__sqrt_2(_) = _ :- - private__builtin__sorry("math__sqrt_2"). + % % math__solve_quadratic(A, B, C) = Roots is true if Roots are @@ -458,8 +443,6 @@ math__pow(X, Y) = Res :- [thread_safe, promise_pure], " Res = System.Math.Pow(X, Y); "). -math__pow_2(_, _) = _ :- - private__builtin__sorry("math__pow_2"). % @@ -474,8 +457,6 @@ math__pow_2(_, _) = _ :- [will_not_call_mercury, promise_pure, thread_safe]," Exp = System.Math.Exp(X); "). -math__exp(_) = _ :- - private__builtin__sorry("math__exp"). % % math__ln(X) = Log is true if Log is the natural logarithm @@ -501,8 +482,6 @@ math__ln(X) = Log :- [thread_safe, promise_pure], " Log = System.Math.Log(X); "). -math__ln_2(_) = _ :- - private__builtin__sorry("math__ln_2"). % % math__log10(X) = Log is true if Log is the logarithm to @@ -528,8 +507,6 @@ math__log10(X) = Log :- [thread_safe, promise_pure], " Log10 = System.Math.Log10(X); "). -math__log10_2(_) = _ :- - private__builtin__sorry("math__log10_2"). % % math__log2(X) = Log is true if Log is the logarithm to @@ -555,8 +532,6 @@ math__log2(X) = Log :- [thread_safe, promise_pure], " Log2 = System.Math.Log(X) / ML_FLOAT_LN2; "). -math__log2_2(_) = _ :- - private__builtin__sorry("math__log2_2"). % % math__log(B, X) = Log is true if Log is the logarithm to @@ -590,8 +565,6 @@ math__log(B, X) = Log :- [thread_safe, promise_pure], " Log = System.Math.Log(X,B); "). -math__log_2(_, _) = _ - - private_builtin__sorry("math__log_2"). % @@ -605,8 +578,6 @@ math__log_2(_, _) = _ - [will_not_call_mercury, promise_pure, thread_safe]," Sin = System.Math.Sin(X); "). -math__sin(_) = _ :- - private__builtin__sorry("math__sin"). % @@ -620,8 +591,6 @@ math__sin(_) = _ :- [will_not_call_mercury, promise_pure, thread_safe]," Cos = System.Math.Cos(X); "). -math__cos(_) = _ :- - private__builtin__sorry("math__cos"). % % math__tan(X) = Tan is true if Tan is the tangent of X. @@ -634,8 +603,6 @@ math__cos(_) = _ :- [will_not_call_mercury, promise_pure, thread_safe]," Tan = System.Math.Tan(X); "). -math__tan(_) = _ :- - private__builtin__sorry("math__tan"). % % math__asin(X) = ASin is true if ASin is the inverse @@ -666,8 +633,6 @@ math__asin(X) = ASin :- [thread_safe, promise_pure], " ASin = System.Math.Asin(X); "). -math__asin_2(_) = _ :- - private__builtin__sorry("math__asin_2"). % % math__acos(X) = ACos is true if ACos is the inverse @@ -698,8 +663,6 @@ math__acos(X) = ACos :- [thread_safe, promise_pure], " ACos = System.Math.Acos(X); "). -math__acos_2(_) = _ :- - private__builtin__sorry("math__acos_2"). % @@ -714,8 +677,6 @@ math__acos_2(_) = _ :- [will_not_call_mercury, promise_pure, thread_safe]," ATan = System.Math.Atan(X); "). -math__atan(_) = _ :- - private__builtin__sorry("math__atan"). % % math__atan2(Y, X) = ATan is true if ATan is the inverse @@ -729,8 +690,6 @@ math__atan(_) = _ :- [will_not_call_mercury, promise_pure, thread_safe], " ATan2 = System.Math.Atan2(Y, X); "). -math__atan2(_, _) = _ :- - private__builtin__sorry("math__atan2"). % % math__sinh(X) = Sinh is true if Sinh is the hyperbolic @@ -744,8 +703,6 @@ math__atan2(_, _) = _ :- [will_not_call_mercury, promise_pure, thread_safe]," Sinh = System.Math.Sinh(X); "). -math__sinh(_) = _ :- - private__builtin__sorry("math__sinh"). % % math__cosh(X) = Cosh is true if Cosh is the hyperbolic @@ -759,8 +716,6 @@ math__sinh(_) = _ :- [will_not_call_mercury, promise_pure, thread_safe]," Cosh = System.Math.Cosh(X); "). -math__cosh(_) = _ :- - private__builtin__sorry("math__cosh"). % % math__tanh(X) = Tanh is true if Tanh is the hyperbolic @@ -774,8 +729,6 @@ math__cosh(_) = _ :- [will_not_call_mercury, promise_pure, thread_safe]," Tanh = System.Math.Tanh(X); "). -math__tanh(_) = _ :- - private__builtin__sorry("math__tanh"). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% diff --git a/library/private_builtin.m b/library/private_builtin.m index aa0328b81..9377655df 100644 --- a/library/private_builtin.m +++ b/library/private_builtin.m @@ -169,8 +169,7 @@ builtin_compare_string(R, S1, S2) :- " Res = System::String::Compare(S1, S2); "). -builtin_strcmp(_, _, _) :- - sorry("builtin_strcmp"). + builtin_unify_float(F, F). @@ -878,18 +877,6 @@ static void init_runtime(void) MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index); "). -type_info_from_typeclass_info(_, _, _) :- - sorry("type_info_from_typeclass_info"). - -unconstrained_type_info_from_typeclass_info(_, _, _) :- - sorry("unconstrained_type_info_from_typeclass_info"). - -superclass_from_typeclass_info(_, _, _) :- - sorry("superclass_from_typeclass_info"). - -instance_constraint_from_typeclass_info(_, _, _) :- - sorry("instance_constraint_from_typeclass_info"). - %-----------------------------------------------------------------------------% diff --git a/library/profiling_builtin.m b/library/profiling_builtin.m index e4921e5b9..205d20e14 100644 --- a/library/profiling_builtin.m +++ b/library/profiling_builtin.m @@ -1619,179 +1619,292 @@ #undef MR_REC_DEPTH_BODY }"). -:- import_module std_util. - -prepare_for_normal_call(_) :- - impure private_builtin__imp, - private_builtin__sorry("prepare_for_normal_call"). -prepare_for_special_call(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("prepare_for_special_call"). -prepare_for_ho_call(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("prepare_for_ho_call"). -prepare_for_method_call(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("prepare_for_method_call"). -prepare_for_callback(_) :- - impure private_builtin__imp, - private_builtin__sorry("prepare_for_callback"). -prepare_for_tail_call(_) :- - impure private_builtin__imp, - private_builtin__sorry("prepare_for_tail_call"). - -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_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"). -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"). -save_and_zero_activation_info_ac(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_and_zero_activation_info_ac"). -save_and_zero_activation_info_sr(_) :- - impure private_builtin__imp, - private_builtin__sorry("save_and_zero_activation_info_sr"). -rezero_activation_info_ac :- - impure private_builtin__imp, - private_builtin__sorry("rezero_activation_info_ac"). -rezero_activation_info_sr :- - impure private_builtin__imp, - private_builtin__sorry("rezero_activation_info_sr"). -reset_activation_info_ac(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("reset_activation_info_ac"). -reset_activation_info_sr(_) :- - impure private_builtin__imp, - private_builtin__sorry("reset_activation_info_sr"). -save_recursion_depth_1(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_1"). -save_recursion_depth_2(_, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_2"). -save_recursion_depth_3(_, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_3"). -save_recursion_depth_4(_, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_4"). -save_recursion_depth_5(_, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_5"). -save_recursion_depth_6(_, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_6"). -save_recursion_depth_7(_, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_7"). -save_recursion_depth_8(_, _, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_8"). -save_recursion_depth_9(_, _, _, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("save_recursion_depth_9"). -restore_recursion_depth_exit_1(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_1"). -restore_recursion_depth_exit_2(_, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_2"). -restore_recursion_depth_exit_3(_, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_3"). -restore_recursion_depth_exit_4(_, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_4"). -restore_recursion_depth_exit_5(_, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_5"). -restore_recursion_depth_exit_6(_, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_6"). -restore_recursion_depth_exit_7(_, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_7"). -restore_recursion_depth_exit_8(_, _, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_8"). -restore_recursion_depth_exit_9(_, _, _, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_exit_9"). -restore_recursion_depth_fail_1(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_1"). -restore_recursion_depth_fail_2(_, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_2"). -restore_recursion_depth_fail_3(_, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_3"). -restore_recursion_depth_fail_4(_, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_4"). -restore_recursion_depth_fail_5(_, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_5"). -restore_recursion_depth_fail_6(_, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_6"). -restore_recursion_depth_fail_7(_, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_7"). -restore_recursion_depth_fail_8(_, _, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_8"). -restore_recursion_depth_fail_9(_, _, _, _, _, _, _, _, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("restore_recursion_depth_fail_9"). +:- pragma foreign_proc("MC++", prepare_for_normal_call(_N::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""prepare_for_normal_call""); +}"). +:- pragma foreign_proc("MC++", prepare_for_special_call(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""prepare_for_special_call""); +}"). +:- pragma foreign_proc("MC++", prepare_for_ho_call(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""prepare_for_ho_call""); +}"). +:- pragma foreign_proc("MC++", prepare_for_method_call(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""prepare_for_method_call""); +}"). +:- pragma foreign_proc("MC++", prepare_for_callback(_N::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""prepare_for_callback""); +}"). +:- pragma foreign_proc("MC++", prepare_for_tail_call(_N::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""prepare_for_tail_call""); +}"). +:- pragma foreign_proc("MC++", det_call_port_code_ac(_A::in, _B::out, _C::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""det_call_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + det_call_port_code_sr(_A::in, _B::out, _C::out, _D::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""det_call_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", det_exit_port_code_ac(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""det_exit_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + det_exit_port_code_sr(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""det_call_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", semi_call_port_code_ac(_A::in, _B::out, _C::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX semi_call_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + semi_call_port_code_sr(_A::in, _B::out, _C::out, _D::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX semi_call_port_code_sr""); +}"). +:- pragma foreign_proc("MC++", semi_exit_port_code_ac(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX semi_exit_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + semi_exit_port_code_sr(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX semi_exit_port_code_sr""); +}"). +:- pragma foreign_proc("MC++", semi_fail_port_code_ac(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX semi_fail_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + semi_fail_port_code_sr(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX semi_fail_port_code_sr""); +}"). +:- pragma foreign_proc("MC++", + non_call_port_code_ac(_A::in, _B::out, _C::out, _D::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_call_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + non_call_port_code_sr(_A::in, _B::out, _C::out, _D::out, _E::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_call_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", non_exit_port_code_ac(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_exit_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + non_exit_port_code_sr(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_call_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", non_fail_port_code_ac(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_fail_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + non_fail_port_code_sr(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_fail_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", non_redo_port_code_ac(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_redo_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", non_redo_port_code_sr(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""non_redo_port_code_ac""); +}"). +:- pragma foreign_proc("MC++", + save_and_zero_activation_info_ac(_A::out, _B::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_and_zero_activation_info_ac""); +}"). +:- pragma foreign_proc("MC++", save_and_zero_activation_info_sr(_A::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_and_zero_activation_info_sr""); +}"). +:- pragma foreign_proc("MC++", rezero_activation_info_ac, + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""rezero_activation_info_ac""); +}"). +:- pragma foreign_proc("MC++", rezero_activation_info_sr, + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""rezero_activation_info_sr""); +}"). +:- pragma foreign_proc("MC++", reset_activation_info_ac(_A::in, _B::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""reset_activation_info_ac""); +}"). +:- pragma foreign_proc("MC++", reset_activation_info_sr(_A::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""reset_activation_info_sr""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_1(_A::in, _B::in, _C::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_1""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_2(_A::in, _B::in, _C::out, _D::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_2""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_3(_A::in, _B::in, _C::out, _D::out, + _E::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_3""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_4(_A::in, _B::in, _C::out, _D::out, + _E::out, _F::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_4""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_5(_A::in, _B::in, _C::out, _D::out, + _E::out, _F::out, _G::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_5""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_6(_A::in, _B::in, _C::out, _D::out, + _E::out, _F::out, _G::out, _H::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_6""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_7(_A::in, _B::in, _C::out, _D::out, + _E::out, _F::out, _G::out, _H::out, _I::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_7""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_8(_A::in, _B::in, _C::out, _D::out, + _E::out, _F::out, _G::out, _H::out, _I::out, _J::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_8""); +}"). +:- pragma foreign_proc("MC++", + save_recursion_depth_9(_A::in, _B::in, _C::out, _D::out, + _E::out, _F::out, _G::out, _H::out, _I::out, _J::out, + _K::out), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""XXX save_recursion_depth_9""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_1(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_1""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_2(_A::in, _B::in, _C::in, _D::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_2""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_3(_A::in, _B::in, _C::in, _D::in, + _E::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_3""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_4(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_4""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_5(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_5""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_6(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_6""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_7(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in, _I::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_7""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_8(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in, _I::in, _J::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_8""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_exit_9(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in, _I::in, _J::in, + _K::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_exit_9""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_1(_A::in, _B::in, _C::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_1""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_2(_A::in, _B::in, _C::in, _D::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_2""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_3(_A::in, _B::in, _C::in, _D::in, + _E::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_3""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_4(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_4""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_5(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_5""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_6(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_6""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_7(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in, _I::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_7""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_8(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in, _I::in, _J::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_8""); +}"). +:- pragma foreign_proc("MC++", + restore_recursion_depth_fail_9(_A::in, _B::in, _C::in, _D::in, + _E::in, _F::in, _G::in, _H::in, _I::in, _J::in, + _K::in), + [thread_safe, will_not_call_mercury], "{ + mercury::runtime::Errors::SORRY(""restore_recursion_depth_fail_9""); +}"). diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m index 40ebde1db..0e4054162 100644 --- a/library/rtti_implementation.m +++ b/library/rtti_implementation.m @@ -127,24 +127,19 @@ :- type pseudo_type_info ---> pred_type(c_pointer). :- pragma foreign_proc("C#", - get_type_info(T::unused) = (TypeInfo::out), + get_type_info(_T::unused) = (TypeInfo::out), [will_not_call_mercury, promise_pure, thread_safe], " - // T TypeInfo = TypeInfo_for_T; "). :- pragma foreign_proc("C", - get_type_info(T::unused) = (TypeInfo::out), + get_type_info(_T::unused) = (TypeInfo::out), [will_not_call_mercury, promise_pure, thread_safe], " - /* T */ TypeInfo = TypeInfo_for_T; "). -get_type_info(_) = _ :- - private_builtin__sorry("get_type_info"). - %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -896,6 +891,7 @@ new_type_info(TypeInfo::in, _::in) = (NewTypeInfo::uo) :- System.Array.Copy(OldTypeInfo, NewTypeInfo, OldTypeInfo.Length); "). + % Get the pseudo-typeinfo at the given index from the argument types. :- some [T] func get_pti_from_arg_types(arg_types, int) = T. @@ -1092,9 +1088,6 @@ pseudotypeinfo_max_var = 1024. (MR_TypeInfo) TypeInfo); "). -get_type_ctor_info(_) = _ :- - private_builtin__sorry("get_type_ctor_info"). - :- pred same_pointer_value(T::in, T::in) is semidet. :- pred same_pointer_value_untyped(T::in, U::in) is semidet. @@ -1113,8 +1106,7 @@ same_pointer_value(X, Y) :- same_pointer_value_untyped(X, Y). " SUCCESS_INDICATOR = (T1 == T2); "). -same_pointer_value_untyped(_, _) :- - private_builtin__sorry("same_pointer_value_untyped"). + %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -1403,8 +1395,6 @@ det_unimplemented(S) :- MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo; Arity = tci->MR_type_ctor_arity; "). -type_ctor_arity(_) = _ :- - private_builtin__sorry("type_ctor_arity"). :- some [P] func type_ctor_unify_pred(type_ctor_info) = P. :- pragma foreign_proc("C#", @@ -1421,8 +1411,6 @@ type_ctor_arity(_) = _ :- MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo; UnifyPred = (MR_Integer) tci->MR_type_ctor_unify_pred; "). -type_ctor_unify_pred(_) = _ :- - private_builtin__sorry("type_ctor_unify_pred"). :- some [P] func type_ctor_compare_pred(type_ctor_info) = P. :- pragma foreign_proc("C#", @@ -1439,8 +1427,6 @@ type_ctor_unify_pred(_) = _ :- MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo; UnifyPred = (MR_Integer) tci->MR_type_ctor_compare_pred; "). -type_ctor_compare_pred(_) = _ :- - private_builtin__sorry("type_ctor_compare_pred"). @@ -1461,8 +1447,6 @@ type_ctor_compare_pred(_) = _ :- MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo; TypeCtorRep = MR_type_ctor_rep(tci); "). -type_ctor_rep(_) = _ :- - private_builtin__sorry("type_ctor_rep"). :- func type_ctor_module_name(type_ctor_info) = string. @@ -1484,9 +1468,6 @@ type_ctor_rep(_) = _ :- Name = (MR_String) MR_type_ctor_module_name(tci); "). -type_ctor_module_name(_) = _ :- - private_builtin__sorry("type_ctor_module_name"). - :- func type_ctor_name(type_ctor_info) = string. @@ -1506,8 +1487,6 @@ type_ctor_module_name(_) = _ :- Name = (MR_String) MR_type_ctor_name(tci); "). -type_ctor_name(_) = _ :- - private_builtin__sorry("type_ctor_name"). :- func type_layout(type_ctor_info) = type_layout. @@ -1526,9 +1505,6 @@ type_ctor_name(_) = _ :- TypeLayout = (MR_Word) &(MR_type_ctor_layout(tci)); "). -type_layout(_) = _ :- - private_builtin__sorry("type_layout"). - :- pragma foreign_proc("C", unsafe_cast(VarIn::in) = (VarOut::out), [will_not_call_mercury, promise_pure, thread_safe], @@ -1542,8 +1518,5 @@ type_layout(_) = _ :- VarOut = VarIn; "). -unsafe_cast(_) = _ :- - private_builtin__sorry("unsafe_cast"). - %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/library/sparse_bitset.m b/library/sparse_bitset.m index fe26e82d6..cf810d254 100644 --- a/library/sparse_bitset.m +++ b/library/sparse_bitset.m @@ -792,9 +792,6 @@ mask(N) = \ unchecked_left_shift(\ 0, N). mercury.runtime.LowLevelData.set_MR_Word_field(Pair, 2, B); }"). -make_bitset_elem(_, _) = _ :- - private_builtin__sorry("make_bitset_elem"). - %-----------------------------------------------------------------------------% init(init). diff --git a/library/std_util.m b/library/std_util.m index a601cf072..99503ff2a 100644 --- a/library/std_util.m +++ b/library/std_util.m @@ -1064,9 +1064,6 @@ non_cc_call(P::pred(in, out, di, uo) is cc_multi, X::in, More::out, "). -get_registers(_, _, _) :- - private_builtin__sorry("get_registers"). - :- impure pred check_for_floundering(trail_ptr::in) is det. :- pragma foreign_proc("C", @@ -1088,9 +1085,6 @@ get_registers(_, _, _) :- #endif "). -check_for_floundering(_) :- - private_builtin__sorry("check_for_floundering"). - % % Discard the topmost trail ticket. % @@ -1114,9 +1108,6 @@ check_for_floundering(_) :- #endif "). -discard_trail_ticket :- - private_builtin__sorry("discard_trail_ticket"). - % % Swap the heap with the solutions heap % @@ -1150,9 +1141,6 @@ discard_trail_ticket :- */ "). -swap_heap_and_solutions_heap :- - private_builtin__sorry("swap_heap_and_solutions_heap"). - % % partial_deep_copy(SolutionsHeapPtr, OldVal, NewVal): % Make a copy of all of the parts of OldVar that occur between @@ -1235,9 +1223,6 @@ swap_heap_and_solutions_heap :- NewVal = OldVal; "). -partial_deep_copy(_, _, _) :- - private_builtin__sorry("partial_deep_copy"). - % % reset_solutions_heap(SolutionsHeapPtr): % Reset the solutions heap pointer to the specified value, @@ -1248,7 +1233,7 @@ partial_deep_copy(_, _, _) :- :- pragma foreign_proc("C", reset_solutions_heap(SolutionsHeapPtr::in), - [will_not_call_mercury, thread_safe], + [will_not_call_mercury, thread_safe, promise_pure], " #ifdef MR_RECLAIM_HP_ON_FAILURE MR_sol_hp = (MR_Word *) SolutionsHeapPtr; @@ -1257,7 +1242,7 @@ partial_deep_copy(_, _, _) :- :- pragma foreign_proc("MC++", reset_solutions_heap(_SolutionsHeapPtr::in), - [will_not_call_mercury, thread_safe], + [will_not_call_mercury, thread_safe, promise_pure], " /* ** For the IL back-end, we don't have a separate `solutions heap'. @@ -1265,10 +1250,6 @@ partial_deep_copy(_, _, _) :- */ "). -reset_solutions_heap(_) :- - impure private_builtin__imp, - private_builtin__sorry("reset_solutions_heap"). - %-----------------------------------------------------------------------------% %%% :- module mutvar. @@ -1372,13 +1353,6 @@ XXX `ui' modes don't work yet Ref[0] = X; "). -new_mutvar(_, _) :- - private_builtin__sorry("new_mutvar"). -get_mutvar(_, _) :- - private_builtin__sorry("get_mutvar"). -set_mutvar(_, _) :- - private_builtin__sorry("set_mutvar"). - %%% end_module mutvar. %-----------------------------------------------------------------------------% @@ -1461,15 +1435,6 @@ unsorted_aggregate(Generator, Accumulator, Acc0, Acc) :- [will_not_call_mercury, thread_safe, promise_pure], "Y = X;"). -semidet_succeed :- - private_builtin__sorry("semidet_succeed"). -semidet_fail :- - private_builtin__sorry("semidet_fail"). - -:- pragma promise_pure(cc_multi_equal/2). -cc_multi_equal(_, _) :- - private_builtin__sorry("cc_multi_equal"). - %-----------------------------------------------------------------------------% % We call the constructor for univs `univ_cons' to avoid ambiguity diff --git a/library/store.m b/library/store.m index 4b7976f1c..ef4c08bff 100644 --- a/library/store.m +++ b/library/store.m @@ -250,12 +250,8 @@ store__init(S) :- :- pred store__do_init(store(some_store_type)). :- mode store__do_init(uo) is det. -:- pragma foreign_proc("C", store__do_init(S0::uo), - [will_not_call_mercury, promise_pure], - "/* XXX mention S0 to avoid warning */"). - -store__do_init(_) :- - private_builtin__sorry("store__do_init"). +:- pragma foreign_proc("C", store__do_init(_S0::uo), + [will_not_call_mercury, promise_pure], ""). /* Note -- the syntax for the operations on stores @@ -296,15 +292,6 @@ I wonder whether it is worth it? Hmm, probably not. S = S0; "). -new_mutvar(_, _) --> - { private_builtin__sorry("store__new_mutvar") }. - -get_mutvar(_, _) --> - { private_builtin__sorry("store__get_mutvar") }. - -set_mutvar(_, _) --> - { private_builtin__sorry("store__set_mutvar") }. - :- pred store__unsafe_new_uninitialized_mutvar(generic_mutvar(T, S), S, S) <= store(S). :- mode store__unsafe_new_uninitialized_mutvar(out, di, uo) is det. @@ -316,9 +303,6 @@ set_mutvar(_, _) --> S = S0; "). -unsafe_new_uninitialized_mutvar(_) --> - { private_builtin__sorry("unsafe_new_uninitialized_mutvar") }. - store__new_cyclic_mutvar(Func, MutVar) --> store__unsafe_new_uninitialized_mutvar(MutVar), { Value = apply(Func, MutVar) }, @@ -334,9 +318,6 @@ store__new_cyclic_mutvar(Func, MutVar) --> S = S0; "). -new_ref(_, _) --> - { private_builtin__sorry("store__new_ref") }. - copy_ref_value(Ref, Val) --> /* XXX need to deep-copy non-atomic types */ unsafe_ref_value(Ref, Val). @@ -354,9 +335,6 @@ copy_ref_value(Ref, Val) --> S = S0; "). -store__unsafe_ref_value(_, _) --> - { private_builtin__sorry("store__unsafe_ref_value") }. - ref_functor(Ref, Functor, Arity) --> unsafe_ref_value(Ref, Val), { functor(Val, Functor, Arity) }. @@ -465,28 +443,12 @@ ref_functor(Ref, Functor, Arity) --> "). :- pragma foreign_proc("C", - extract_ref_value(S::di, Ref::in, Val::out), + extract_ref_value(_S::di, Ref::in, Val::out), [will_not_call_mercury, promise_pure], " - /* XXX mention S to avoid warning. */ Val = * (MR_Word *) Ref; "). -arg_ref(_, _, _) --> - { private_builtin__sorry("store__arg_ref") }. - -new_arg_ref(_, _, _) --> - { private_builtin__sorry("store__new_arg_ref") }. - -set_ref(_, _) --> - { private_builtin__sorry("store__set_ref") }. - -set_ref_value(_, _) --> - { private_builtin__sorry("store__set_ref_value") }. - -extract_ref_value(_, _, _) :- - private_builtin__sorry("store__extract_ref_value"). - %-----------------------------------------------------------------------------% :- pragma foreign_proc("C", @@ -509,11 +471,96 @@ extract_ref_value(_, _, _) :- S = S0; }"). -unsafe_arg_ref(_, _, _) --> - { private_builtin__sorry("store__unsafe_arg_ref") }. - -unsafe_new_arg_ref(_, _, _) --> - { private_builtin__sorry("store__unsafe_new_arg_ref") }. - -%-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% + +:- pragma foreign_proc("MC++", store__do_init(_S0::uo), + [will_not_call_mercury, promise_pure], ""). + +:- pragma foreign_proc("MC++", new_mutvar(_Val::in, _Mutvar::out, + _S0::di, _S::uo), [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", get_mutvar(_Mutvar::in, _Val::out, + _S0::di, _S::uo), [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", set_mutvar(_Mutvar::in, _Val::in, + _S0::di, _S::uo), [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", unsafe_new_uninitialized_mutvar( + _Mutvar::out, _S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", new_ref(_Val::di, _Ref::out, _S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", unsafe_ref_value(_Ref::in, _Val::uo, + _S0::di, _S::uo), [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", + arg_ref(_Ref::in, _ArgNum::in, _ArgRef::out, _S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + +:- pragma foreign_proc("MC++", + new_arg_ref(_Val::di, _ArgNum::in, _ArgRef::out, _S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + +:- pragma foreign_proc("MC++", + set_ref(_Ref::in, _ValRef::in, _S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", + set_ref_value(_Ref::in, _Val::di, _S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", + extract_ref_value(_S::di, _Ref::in, _Val::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", + unsafe_arg_ref(_Ref::in, _Arg::in, _ArgRef::out, _S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + +:- pragma foreign_proc("MC++", + unsafe_new_arg_ref(_Val::di, _Arg::in, _ArgRef::out, + _S0::di, _S::uo), [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + + + diff --git a/library/string.m b/library/string.m index 6f1fb8c1e..1929ce65f 100644 --- a/library/string.m +++ b/library/string.m @@ -696,7 +696,6 @@ string__from_char_list(CharList, Str) :- :- mode string__to_char_list(out, in) is det. */ -:- pragma promise_pure(string__to_char_list/2). :- pragma foreign_proc("C", string__to_char_list(Str::in, CharList::out), [will_not_call_mercury, promise_pure, thread_safe], "{ MR_ConstString p = Str + strlen(Str); @@ -744,50 +743,12 @@ string__from_char_list(CharList, Str) :- Str[size] = '\\0'; }"). -:- pragma foreign_proc("MC++", string__to_char_list(Str::in, CharList::out), - [will_not_call_mercury, promise_pure, thread_safe], "{ - MR_Integer length, i; - MR_Word tmp; - MR_Word prev; - - length = Str->get_Length(); - - MR_list_nil(prev); - - for (i = length - 1; i >= 0; i--) { - MR_list_cons(tmp, __box(Str->get_Chars(i)), prev); - prev = tmp; - } - CharList = tmp; -}"). - -:- pragma foreign_proc("MC++", string__to_char_list(Str::out, CharList::in), - [will_not_call_mercury, promise_pure, thread_safe], "{ - System::Text::StringBuilder *tmp; - MR_Char c; - - tmp = new System::Text::StringBuilder(); - while (1) { - if (MR_list_is_cons(CharList)) { - c = System::Convert::ToChar(MR_list_head(CharList)); - tmp->Append(c); - CharList = MR_list_tail(CharList); - } else { - break; - } - } - Str = tmp->ToString(); -}"). - -string__to_char_list(_, _) :- - private_builtin__sorry("string__to_char_list"). - /*-----------------------------------------------------------------------*/ % -% We implement from_rev_char_list using list__reverse and -% from_char_list, but the optimized implementation in C below is there -% for efficiency since it improves the overall speed of parsing by about 7%. +% We could implement from_rev_char_list using list__reverse and from_char_list, +% but the optimized implementation in C below is there for efficiency since +% it improves the overall speed of parsing by about 7%. % :- pragma foreign_proc("C", string__from_rev_char_list(Chars::in, Str::out), [will_not_call_mercury, promise_pure, thread_safe], " @@ -828,6 +789,41 @@ string__to_char_list(_, _) :- } }"). +:- pragma foreign_proc("MC++", string__to_char_list(Str::in, CharList::out), + [will_not_call_mercury, promise_pure, thread_safe], "{ + MR_Integer length, i; + MR_Word tmp; + MR_Word prev; + + length = Str->get_Length(); + + MR_list_nil(prev); + + for (i = length - 1; i >= 0; i--) { + MR_list_cons(tmp, __box(Str->get_Chars(i)), prev); + prev = tmp; + } + CharList = tmp; +}"). + +:- pragma foreign_proc("MC++", string__to_char_list(Str::out, CharList::in), + [will_not_call_mercury, promise_pure, thread_safe], "{ + System::Text::StringBuilder *tmp; + MR_Char c; + + tmp = new System::Text::StringBuilder(); + while (1) { + if (MR_list_is_cons(CharList)) { + c = System::Convert::ToChar(MR_list_head(CharList)); + tmp->Append(c); + CharList = MR_list_tail(CharList); + } else { + break; + } + } + Str = tmp->ToString(); +}"). + string__from_rev_char_list(Chars::in, Str::out) :- Str = string__from_char_list(list__reverse(Chars)). @@ -982,27 +978,6 @@ string__append_list(Lists, string__append_list(Lists)). Str[len] = '\\0'; }"). -:- pragma foreign_proc("C#", - string__append_list(Strs::in) = (Str::uo), - [will_not_call_mercury, promise_pure, thread_safe], " -{ - System.Text.StringBuilder tmp = new System.Text.StringBuilder(); - - while (mercury.runtime.LowLevelData.list_is_cons(Strs)) { - tmp.Append(mercury.runtime.LowLevelData.list_get_head(Strs)); - Strs = mercury.runtime.LowLevelData.list_get_tail(Strs); - } - Str = tmp.ToString(); -} -"). - -string__append_list(Strs::in) = (Str::uo) :- - ( Strs = [X | Xs] -> - Str = X ++ append_list(Xs) - ; - Str = "" - ). - % Implementation of string__join_list that uses C as this % minimises the amount of garbage created. :- pragma foreign_proc("C", string__join_list(Sep::in, Strs::in) = (Str::uo), @@ -1050,6 +1025,27 @@ string__append_list(Strs::in) = (Str::uo) :- Str[len] = '\\0'; }"). +:- pragma foreign_proc("C#", + string__append_list(Strs::in) = (Str::uo), + [will_not_call_mercury, promise_pure, thread_safe], " +{ + System.Text.StringBuilder tmp = new System.Text.StringBuilder(); + + while (mercury.runtime.LowLevelData.list_is_cons(Strs)) { + tmp.Append(mercury.runtime.LowLevelData.list_get_head(Strs)); + Strs = mercury.runtime.LowLevelData.list_get_tail(Strs); + } + Str = tmp.ToString(); +} +"). + +string__append_list(Strs::in) = (Str::uo) :- + ( Strs = [X | Xs] -> + Str = X ++ append_list(Xs) + ; + Str = "" + ). + :- pragma foreign_proc("C#", string__join_list(Sep::in, Strs::in) = (Str::uo), [will_not_call_mercury, promise_pure, thread_safe], " @@ -1068,15 +1064,6 @@ string__append_list(Strs::in) = (Str::uo) :- Str = tmpStr.ToString(); }"). -string__join_list(_Sep, []) = "". -string__join_list(Sep, [S | Ss]) = S ++ string__join_list_2(Sep, Ss). - -:- func string__join_list_2(string, list(string)) = string. - -string__join_list_2(_Sep, []) = "". -string__join_list_2(Sep, [S | Ss]) = - Sep ++ S ++ string__join_list_2(Sep, Ss). - %-----------------------------------------------------------------------------% % Note - string__hash is also defined in code/imp.h @@ -1129,9 +1116,6 @@ string__combine_hash(H0, X, H) :- Index = WholeString->IndexOf(SubString); }"). -string__sub_string_search(_, _, _) :- - private_builtin__sorry("string__sub_string_search"). - %-----------------------------------------------------------------------------% % This predicate has been optimised to produce the least memory @@ -1502,8 +1486,6 @@ make_format(Flags, MaybeWidth, MaybePrec, LengthMod, Spec) = [will_not_call_mercury, promise_pure, thread_safe], " SUCCESS_INDICATOR = MR_FALSE; "). -using_sprintf :- - private_builtin__sorry("string__using_sprintf"). % Construct a format string suitable to passing to sprintf. @@ -1578,8 +1560,6 @@ make_format_dotnet(_Flags, MaybeWidth, MaybePrec, _LengthMod, Spec0) = String :- [will_not_call_mercury, promise_pure, thread_safe], "{ LengthModifier = """"; }"). -int_length_modifer = _ :- - private_builtin__sorry("int_length_modifer"). % Create a string from a float using the format string. @@ -1598,8 +1578,6 @@ int_length_modifer = _ :- [will_not_call_mercury, promise_pure, thread_safe], "{ Str = System.String.Format(FormatStr, Val); }"). -format_float(_, _) = _ :- - private_builtin__sorry("format_float"). % Create a string from a int using the format string. % Note it is the responsibility of the caller to ensure that the @@ -1617,8 +1595,6 @@ format_float(_, _) = _ :- [will_not_call_mercury, promise_pure, thread_safe], "{ Str = System.String.Format(FormatStr, Val); }"). -format_int(_, _) = _ :- - private_builtin__sorry("format_int"). % Create a string from a string using the format string. % Note it is the responsibility of the caller to ensure that the @@ -1634,8 +1610,6 @@ format_int(_, _) = _ :- [will_not_call_mercury, promise_pure, thread_safe], "{ Str = System.String.Format(FormatStr, Val); }"). -format_string(_, _) = _ :- - private_builtin__sorry("format_string"). % Create a string from a char using the format string. % Note it is the responsibility of the caller to ensure that the @@ -1653,8 +1627,7 @@ format_string(_, _) = _ :- [will_not_call_mercury, promise_pure, thread_safe], "{ Str = System.String.Format(FormatStr, Val); }"). -format_char(_, _) = _ :- - private_builtin__sorry("format_char"). + %-----------------------------------------------------------------------------% @@ -1686,10 +1659,6 @@ format_char(_, _) = _ :- FloatString = System::Convert::ToString(FloatVal); }"). -string__float_to_string(_, _) :- - private_builtin__sorry("string__float_to_string"). - - % Beware that the implementation of string__format depends % on the details of what string__float_to_f_string/2 outputs. @@ -1704,15 +1673,6 @@ string__float_to_string(_, _) :- strcpy(FloatString, buf); }"). -:- pragma foreign_proc("MC++", - string__float_to_f_string(FloatVal::in, FloatString::out), - [will_not_call_mercury, promise_pure, thread_safe], "{ - FloatString = System::Convert::ToString(FloatVal); -}"). - -string__float_to_f_string(_, _) :- - private_builtin__sorry("string__float_to_f_string"). - :- pragma foreign_proc("C", string__to_float(FloatString::in, FloatVal::out), [will_not_call_mercury, promise_pure, thread_safe], "{ @@ -1731,6 +1691,12 @@ string__float_to_f_string(_, _) :- FloatVal = tmpf; }"). +:- pragma foreign_proc("MC++", + string__float_to_f_string(FloatVal::in, FloatString::out), + [will_not_call_mercury, promise_pure, thread_safe], "{ + FloatString = System::Convert::ToString(FloatVal); +}"). + :- pragma foreign_proc("MC++", string__to_float(FloatString::in, FloatVal::out), [will_not_call_mercury, promise_pure, thread_safe], "{ @@ -1742,9 +1708,6 @@ string__float_to_f_string(_, _) :- } }"). -string__to_float(_, _) :- - private_builtin__sorry("string__to_float"). - /*-----------------------------------------------------------------------*/ /* @@ -1839,10 +1802,6 @@ string__to_float(_, _) :- Str = tmp->ToString(); }"). -:- pragma promise_pure(string__to_int_list/2). -string__to_int_list(_, _) :- - private_builtin__sorry("string__to_int_list"). - /*-----------------------------------------------------------------------*/ @@ -1858,8 +1817,6 @@ string__to_int_list(_, _) :- [will_not_call_mercury, promise_pure, thread_safe], " SUCCESS_INDICATOR = (Str->IndexOf(Ch) != -1); "). -string__contains_char(_, _) :- - private_builtin__sorry("string__contains_char"). /*-----------------------------------------------------------------------*/ @@ -1896,8 +1853,6 @@ string__contains_char(_, _) :- Ch = Str->get_Chars(Index); } "). -string__index(_, _, _) :- - private_builtin__sorry("string__index"). /*-----------------------------------------------------------------------*/ @@ -1911,8 +1866,6 @@ string__index(_, _, _) :- [will_not_call_mercury, promise_pure, thread_safe], " Ch = Str->get_Chars(Index); "). -string__unsafe_index(_, _, _) :- - private_builtin__sorry("string__unsafe_index"). /*-----------------------------------------------------------------------*/ @@ -1963,9 +1916,6 @@ string__unsafe_index(_, _, _) :- } "). -string__set_char(_, _, _, _) :- - private_builtin__sorry("string__set_char"). - /* :- pred string__set_char(char, int, string, string). :- mode string__set_char(in, in, di, uo) is semidet. @@ -2018,8 +1968,6 @@ string__set_char(_, _, _, _) :- System::Convert::ToString(Ch), Str0->Substring(Index + 1)); "). -string__unsafe_set_char(_, _, _, _) :- - private_builtin__sorry("string__unsafe_set_char"). /* :- pred string__unsafe_set_char(char, int, string, string). @@ -2073,10 +2021,6 @@ string__unsafe_set_char(_, _, _, _) :- Length = Str->get_Length(); "). -:- pragma promise_pure(string__length/2). -string__length(_, _) :- - private_builtin__sorry("string__length"). - /*-----------------------------------------------------------------------*/ :- pragma promise_pure(string__append/3). @@ -2108,9 +2052,6 @@ string__append(S1::out, S2::out, S3::in) :- SUCCESS_INDICATOR = S3->Equals(System::String::Concat(S1, S2)); }"). -string__append_iii(_, _, _) :- - private_builtin__sorry("string__append_iii"). - :- pred string__append_ioi(string::in, string::out, string::in) is semidet. :- pragma foreign_proc("C", @@ -2145,9 +2086,6 @@ string__append_iii(_, _, _) :- } }"). -string__append_ioi(_, _, _) :- - private_builtin__sorry("string__append_ioi"). - :- pred string__append_iio(string::in, string::in, string::uo) is det. :- pragma foreign_proc("C", @@ -2167,9 +2105,6 @@ string__append_ioi(_, _, _) :- S3 = System::String::Concat(S1, S2); }"). -string__append_iio(_, _, _) :- - private_builtin__sorry("string__append_iio"). - :- pred string__append_ooi(string::out, string::out, string::in) is multi. string__append_ooi(S1, S2, S3) :- @@ -2213,9 +2148,6 @@ string__append_ooi_2(NextS1Len, S3Len, S1, S2, S3) :- S2 = S3->Substring(S1Len); "). -string__append_ooi_3(_, _, _, _, _) :- - private_builtin__sorry("string__append_ooi_3"). - /*-----------------------------------------------------------------------*/ /* @@ -2282,8 +2214,7 @@ strchars(I, End, Str) = SubString = Str->Substring(Start, Count); }"). -string__unsafe_substring(_, _, _, _) :- - private_builtin__sorry("string__unsafe_substring"). + /* :- pred string__split(string, int, string, string). @@ -2338,8 +2269,6 @@ string__unsafe_substring(_, _, _, _) :- } }"). -string__split(_, _, _, _) :- - private_builtin__sorry("string__split"). /*-----------------------------------------------------------------------*/ @@ -2486,10 +2415,6 @@ string__split(_, _, _, _) :- }"). -:- pragma promise_pure(string__first_char/3). -string__first_char(_, _, _) :- - private_builtin__sorry("string__first_char"). - %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Ralph Becket 27/04/99 diff --git a/library/table_builtin.m b/library/table_builtin.m index 187b438d0..231fde6b2 100644 --- a/library/table_builtin.m +++ b/library/table_builtin.m @@ -181,7 +181,7 @@ :- pragma foreign_proc("C", table_simple_is_complete(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -201,7 +201,7 @@ :- pragma foreign_proc("C", table_simple_has_succeeded(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -220,7 +220,7 @@ :- pragma foreign_proc("C", table_simple_has_failed(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -239,7 +239,7 @@ :- pragma foreign_proc("C", table_simple_is_active(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -258,7 +258,7 @@ :- pragma foreign_proc("C", table_simple_is_inactive(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -277,7 +277,7 @@ :- pragma foreign_proc("C", table_simple_mark_as_succeeded(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -293,7 +293,7 @@ :- pragma foreign_proc("C", table_simple_mark_as_failed(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -309,7 +309,7 @@ :- pragma foreign_proc("C", table_simple_mark_as_active(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -325,7 +325,7 @@ :- pragma foreign_proc("C", table_simple_mark_as_inactive(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -340,46 +340,69 @@ "). -:- pragma promise_semipure(table_simple_is_complete/1). -table_simple_is_complete(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_is_complete"). -:- pragma promise_semipure(table_simple_has_succeeded/1). -table_simple_has_succeeded(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_has_succeeded"). +:- pragma foreign_proc("MC++", + table_simple_is_complete(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -:- pragma promise_semipure(table_simple_has_failed/1). -table_simple_has_failed(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_has_failed"). +:- pragma foreign_proc("MC++", + table_simple_has_succeeded(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -:- pragma promise_semipure(table_simple_is_active/1). -table_simple_is_active(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_is_active"). +:- pragma foreign_proc("MC++", + table_simple_has_failed(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -:- pragma promise_semipure(table_simple_is_inactive/1). -table_simple_is_inactive(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_is_inactive"). +:- pragma foreign_proc("MC++", + table_simple_is_active(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_simple_mark_as_succeeded(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_mark_as_succeeded"). +:- pragma foreign_proc("MC++", + table_simple_is_inactive(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_simple_mark_as_failed(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_mark_as_failed"). +:- pragma foreign_proc("MC++", + table_simple_mark_as_succeeded(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_simple_mark_as_active(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_mark_as_active"). +:- pragma foreign_proc("MC++", + table_simple_mark_as_failed(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_simple_mark_as_inactive(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_simple_mark_as_inactive"). +:- pragma foreign_proc("MC++", + table_simple_mark_as_active(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", + table_simple_mark_as_inactive(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). %-----------------------------------------------------------------------------% @@ -476,7 +499,7 @@ table_simple_mark_as_inactive(_) :- :- pragma foreign_proc("C", table_io_in_range(T::out, Counter::out, Start::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " if (MR_io_tabling_enabled) { MR_Unsigned old_counter; @@ -507,7 +530,7 @@ table_simple_mark_as_inactive(_) :- "). :- pragma foreign_proc("C", table_io_has_occurred(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -528,16 +551,24 @@ table_simple_mark_as_inactive(_) :- S = S0; "). -table_io_in_range(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_io_in_range"). +:- pragma foreign_proc("MC++", + table_io_in_range(_T::out, _Counter::out, _Start::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_io_has_occurred(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_io_has_occurred"). +:- pragma foreign_proc("MC++", table_io_has_occurred(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_io_copy_io_state(_, _) :- - private_builtin__sorry("table_io_copy_io_state"). +:- pragma foreign_proc("MC++", table_io_copy_io_state(_S0::di, _S::uo), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). %-----------------------------------------------------------------------------% @@ -608,7 +639,7 @@ table_io_copy_io_state(_, _) :- :- pragma foreign_proc("C", table_nondet_setup(T0::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " #ifndef MR_USE_MINIMAL_MODEL MR_fatal_error(""minimal model code entered when not enabled""); @@ -670,9 +701,12 @@ table_io_copy_io_state(_, _) :- #endif /* MR_USE_MINIMAL_MODEL */ "). -table_nondet_setup(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_nondet_setup"). +:- pragma foreign_proc("MC++", + table_nondet_setup(_T0::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). % The definitions of these two predicates are in the runtime system, % in runtime/mercury_tabling.c. @@ -702,7 +736,7 @@ XXX :- external stops us from using this */ :- pragma foreign_proc("C", - table_nondet_is_complete(T::in), [will_not_call_mercury], " + table_nondet_is_complete(T::in), [will_not_call_mercury, promise_pure], " #ifdef MR_USE_MINIMAL_MODEL MR_TrieNode table; @@ -716,7 +750,7 @@ XXX :- external stops us from using this :- pragma foreign_proc("C", table_nondet_is_active(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " #ifdef MR_USE_MINIMAL_MODEL MR_TrieNode table; @@ -731,7 +765,7 @@ XXX :- external stops us from using this :- pragma foreign_proc("C", table_nondet_mark_as_active(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " #ifdef MR_USE_MINIMAL_MODEL MR_TrieNode table; @@ -748,7 +782,7 @@ XXX :- external stops us from using this :- pragma foreign_proc("C", table_nondet_get_ans_table(T::in, AT::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " #ifdef MR_USE_MINIMAL_MODEL MR_TrieNode table; @@ -763,7 +797,7 @@ XXX :- external stops us from using this :- pragma foreign_proc("C", table_nondet_answer_is_not_duplicate(T::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " #ifndef MR_USE_MINIMAL_MODEL MR_fatal_error(""minimal model code entered when not enabled""); @@ -788,7 +822,7 @@ XXX :- external stops us from using this :- pragma foreign_proc("C", table_nondet_new_ans_slot(T::in, Slot::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " #ifndef MR_USE_MINIMAL_MODEL MR_fatal_error(""minimal model code entered when not enabled""); @@ -860,7 +894,7 @@ table_nondet_return_all_ans_2(CurNode0, Answer) :- is det. :- pragma foreign_proc("C", pickup_answer_list(T::in, CurNode::out), - [will_not_call_mercury], " + [will_not_call_mercury, promise_pure], " #ifdef MR_USE_MINIMAL_MODEL MR_TrieNode table; @@ -881,7 +915,7 @@ table_nondet_return_all_ans_2(CurNode0, Answer) :- :- pragma foreign_proc("C", return_next_answer(CurNode0::in, AnswerBlock::out, CurNode::out), - [will_not_call_mercury], " + [will_not_call_mercury, promise_pure], " #ifdef MR_USE_MINIMAL_MODEL MR_AnswerList cur_node0; @@ -898,41 +932,59 @@ table_nondet_return_all_ans_2(CurNode0, Answer) :- #endif "). -:- pragma promise_semipure(table_nondet_is_complete/1). -table_nondet_is_complete(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_nondet_is_complete"). +:- pragma foreign_proc("MC++", + table_nondet_is_complete(_T::in), [will_not_call_mercury, promise_pure], " + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -:- pragma promise_semipure(table_nondet_is_active/1). -table_nondet_is_active(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_nondet_is_active"). - -table_nondet_mark_as_active(_) :- - impure private_builtin__imp, - private_builtin__imp("table_nondet_mark_as_active"). +:- pragma foreign_proc("MC++", + table_nondet_is_active(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_nondet_get_ans_table(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_nondet_get_ans_table"). +:- pragma foreign_proc("MC++", + table_nondet_mark_as_active(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_nondet_answer_is_not_duplicate(_) :- - impure private_builtin__imp, - private_builtin__sorry("table_nondet_answer_is_not_duplicate"). +:- pragma foreign_proc("MC++", + table_nondet_get_ans_table(_T::in, _AT::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_nondet_new_ans_slot(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_nondet_new_ans_slot"). +:- pragma foreign_proc("MC++", + table_nondet_answer_is_not_duplicate(_T::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -:- pragma promise_semipure(pickup_answer_list/2). -pickup_answer_list(_, _) :- - impure private_builtin__imp, - private_builtin__sorry("pickup_answer_list"). +:- pragma foreign_proc("MC++", + table_nondet_new_ans_slot(_T::in, _Slot::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -:- pragma promise_semipure(return_next_answer/3). -return_next_answer(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("return_next_answer"). +:- pragma foreign_proc("MC++", + pickup_answer_list(_T::in, _CurNode::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", + return_next_answer(_CurNode0::in, _AnswerBlock::out, _CurNode::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). %-----------------------------------------------------------------------------% @@ -1089,7 +1141,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); "). :- pragma foreign_proc("C", table_lookup_insert_int(T0::in, I::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1100,7 +1152,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_lookup_insert_start_int(T0::in, S::in, I::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1112,7 +1164,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_lookup_insert_char(T0::in, C::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1123,7 +1175,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_lookup_insert_string(T0::in, S::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1134,7 +1186,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_lookup_insert_float(T0::in, F::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1145,7 +1197,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_lookup_insert_enum(T0::in, R::in, V::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1156,7 +1208,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_lookup_insert_user(T0::in, V::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1167,7 +1219,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_lookup_insert_poly(T0::in, V::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0, table; @@ -1178,7 +1230,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_save_int_ans(T::in, Offset::in, I::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1188,7 +1240,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_save_char_ans(T::in, Offset::in, C::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1198,7 +1250,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_save_string_ans(T::in, Offset::in, S::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1209,7 +1261,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_save_float_ans(T::in, Offset::in, F::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1225,7 +1277,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_save_io_state_ans(T::in, Offset::in, S::ui), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1236,7 +1288,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_save_any_ans(T::in, Offset::in, V::in), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1244,10 +1296,9 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); MR_TABLE_SAVE_ANSWER(table, Offset, V, TypeInfo_for_T); "). -:- pragma promise_semipure(table_restore_int_ans/3). :- pragma foreign_proc("C", table_restore_int_ans(T::in, Offset::in, I::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1255,10 +1306,9 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); I = (MR_Integer) MR_TABLE_GET_ANSWER(table, Offset); "). -:- pragma promise_semipure(table_restore_char_ans/3). :- pragma foreign_proc("C", table_restore_char_ans(T::in, Offset::in, C::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1266,10 +1316,9 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); C = (MR_Char) MR_TABLE_GET_ANSWER(table, Offset); "). -:- pragma promise_semipure(table_restore_string_ans/3). :- pragma foreign_proc("C", table_restore_string_ans(T::in, Offset::in, S::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1277,10 +1326,9 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); S = (MR_String) MR_TABLE_GET_ANSWER(table, Offset); "). -:- pragma promise_semipure(table_restore_float_ans/3). :- pragma foreign_proc("C", table_restore_float_ans(T::in, Offset::in, F::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1292,10 +1340,9 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); #endif "). -:- pragma promise_semipure(table_restore_io_state_ans/3). :- pragma foreign_proc("C", table_restore_io_state_ans(T::in, Offset::in, V::uo), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1303,10 +1350,9 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); V = (MR_Word) MR_TABLE_GET_ANSWER(table, Offset); "). -:- pragma promise_semipure(table_restore_any_ans/3). :- pragma foreign_proc("C", table_restore_any_ans(T::in, Offset::in, V::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table; @@ -1316,7 +1362,7 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_IO_STATE); :- pragma foreign_proc("C", table_create_ans_block(T0::in, Size::in, T::out), - [will_not_call_mercury], + [will_not_call_mercury, promise_pure], " MR_TrieNode table0; @@ -1329,98 +1375,165 @@ table_loopcheck_error(Message) :- error(Message). :- pragma foreign_proc("C", - table_report_statistics, [will_not_call_mercury], " + table_report_statistics, [will_not_call_mercury, promise_pure], " MR_table_report_statistics(stderr); "). -table_lookup_insert_int(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_int"). +:- pragma foreign_proc("MC++", + table_lookup_insert_int(_T0::in, _I::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_lookup_insert_start_int(_, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_start_int"). +:- pragma foreign_proc("MC++", + table_lookup_insert_start_int(_T0::in, _S::in, _I::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_lookup_insert_char(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_char"). +:- pragma foreign_proc("MC++", + table_lookup_insert_char(_T0::in, _C::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_lookup_insert_string(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_string"). +:- pragma foreign_proc("MC++", + table_lookup_insert_string(_T0::in, _S::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_lookup_insert_float(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_float"). +:- pragma foreign_proc("MC++", + table_lookup_insert_float(_T0::in, _F::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_lookup_insert_enum(_, _, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_enum"). +:- pragma foreign_proc("MC++", + table_lookup_insert_enum(_T0::in, _R::in, _V::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_lookup_insert_user(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_user"). +:- pragma foreign_proc("MC++", + table_lookup_insert_user(_T0::in, _V::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_lookup_insert_poly(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_lookup_insert_poly"). +:- pragma foreign_proc("MC++", + table_lookup_insert_poly(_T0::in, _V::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_save_int_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_save_int_ans"). +:- pragma foreign_proc("MC++", + table_save_int_ans(_T::in, _Offset::in, _I::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_save_char_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_save_char_ans"). +:- pragma foreign_proc("MC++", + table_save_char_ans(_T::in, _Offset::in, _C::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_save_string_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_save_string_ans"). +:- pragma foreign_proc("MC++", + table_save_string_ans(_T::in, _Offset::in, _S::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_save_float_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_save_float_ans"). +:- pragma foreign_proc("MC++", + table_save_float_ans(_T::in, _Offset::in, _F::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_save_io_state_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_save_io_state_ans"). +:- pragma foreign_proc("MC++", + table_save_io_state_ans(_T::in, _Offset::in, _S::ui), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_save_any_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_save_any_ans"). -table_restore_int_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_restore_int_ans"). +:- pragma foreign_proc("MC++", + table_save_any_ans(_T::in, _Offset::in, _V::in), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_restore_char_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_restore_char_ans"). +:- pragma foreign_proc("MC++", + table_restore_int_ans(_T::in, _Offset::in, _I::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_restore_string_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_restore_string_ans"). +:- pragma foreign_proc("MC++", + table_restore_char_ans(_T::in, _Offset::in, _C::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_restore_float_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_restore_float_ans"). +:- pragma foreign_proc("MC++", + table_restore_string_ans(_T::in, _Offset::in, _S::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_restore_io_state_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_restore_io_state_ans"). +:- pragma foreign_proc("MC++", + table_restore_float_ans(_T::in, _Offset::in, _F::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_restore_any_ans(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_restore_any_ans"). +:- pragma foreign_proc("MC++", + table_restore_io_state_ans(_T::in, _Offset::in, _V::uo), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_create_ans_block(_, _, _) :- - impure private_builtin__imp, - private_builtin__sorry("table_create_ans_block"). +:- pragma foreign_proc("MC++", + table_restore_any_ans(_T::in, _Offset::in, _V::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). -table_report_statistics :- - impure private_builtin__imp, - private_builtin__sorry("table_report_statistics"). +:- pragma foreign_proc("MC++", + table_create_ans_block(_T0::in, _Size::in, _T::out), + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). + +:- pragma foreign_proc("MC++", + table_report_statistics, + [will_not_call_mercury, promise_pure], +" + mercury::runtime::Errors::SORRY(""foreign code for this function""); +"). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/library/time.m b/library/time.m index 3d45207e7..4800e3138 100644 --- a/library/time.m +++ b/library/time.m @@ -194,8 +194,12 @@ time__clock(Result, IO0, IO) :- Ret = (MR_Integer) clock(); update_io(IO0, IO); }"). -time__c_clock(_) --> - { private_builtin__sorry("time__c_clock") }. +:- pragma foreign_proc("MC++", time__c_clock(_Ret::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). + %-----------------------------------------------------------------------------% @@ -212,8 +216,11 @@ time__clocks_per_sec = Val :- "{ Ret = (MR_Integer) CLOCKS_PER_SEC; }"). -time__c_clocks_per_sec(_) :- - private_builtin__sorry("time__c_clocks_per_sec"). +:- pragma foreign_proc("MC++", time__c_clocks_per_sec(_Ret::out), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %-----------------------------------------------------------------------------% @@ -251,8 +258,13 @@ time__times(Tms, Result, IO0, IO) :- #endif update_io(IO0, IO); }"). -time__c_times(_, _, _, _, _) --> - { private_builtin__sorry("time__c_times") }. +:- pragma foreign_proc("MC++", + time__c_times(_Ret::out, _Ut::out, _St::out, _CUt::out, + _CSt::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %-----------------------------------------------------------------------------% @@ -278,8 +290,12 @@ time__time(Result, IO0, IO) :- Ret = (MR_Integer) time(NULL); update_io(IO0, IO); }"). -time__c_time(_) --> - { private_builtin__sorry("time__c_time") }. +:- pragma foreign_proc("MC++", + time__c_time(_Ret::out, _IO0::di, _IO::uo), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %-----------------------------------------------------------------------------% @@ -297,8 +313,12 @@ time__difftime(T1, T0) = Diff :- "{ Diff = (MR_Float) difftime((time_t) T1, (time_t) T0); }"). -time__c_difftime(_, _, _) :- - private_builtin__sorry("time__c_difftime"). +:- pragma foreign_proc("MC++", + time__c_difftime(_T1::in, _T0::in, _Diff::out), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %-----------------------------------------------------------------------------% @@ -336,8 +356,14 @@ time__localtime(Time) = TM :- YD = (MR_Integer) p->tm_yday; N = (MR_Integer) p->tm_isdst; }"). -time__c_localtime(_, _, _, _, _, _, _, _, _, _) :- - private_builtin__sorry("time__c_localtime"). + +:- pragma foreign_proc("MC++", + time__c_localtime(_Time::in, _Yr::out, _Mnt::out, _MD::out, _Hrs::out, + _Min::out, _Sec::out, _YD::out, _WD::out, _N::out), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %:- func time__gmtime(time_t) = tm. @@ -374,8 +400,14 @@ time__gmtime(Time) = TM :- YD = (MR_Integer) p->tm_yday; N = (MR_Integer) p->tm_isdst; }"). -time__c_gmtime(_, _, _, _, _, _, _, _, _, _) :- - private_builtin__sorry("time__c_gmtime"). + +:- pragma foreign_proc("MC++", + time__c_gmtime(_Time::in, _Yr::out, _Mnt::out, _MD::out, _Hrs::out, + _Min::out, _Sec::out, _YD::out, _WD::out, _N::out), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). :- func int_to_maybe_dst(int) = maybe(dst). @@ -419,8 +451,14 @@ time__mktime(TM) = Time :- Time = (MR_Integer) mktime(&t); }"). -time__c_mktime(_, _, _, _, _, _, _, _, _, _) :- - private_builtin__sorry("time__c_mktime"). + +:- pragma foreign_proc("MC++", + time__c_mktime(_Yr::in, _Mnt::in, _MD::in, _Hrs::in, + _Min::in, _Sec::in, _YD::in, _WD::in, _N::in, _Time::out), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). :- func maybe_dst_to_int(maybe(dst)) = int. @@ -467,8 +505,14 @@ time__asctime(TM) = Str :- MR_make_aligned_string_copy(Str, s); }"). -time__c_asctime(_, _, _, _, _, _, _, _, _, _) :- - private_builtin__sorry("time__c_asctime"). + +:- pragma foreign_proc("MC++", + time__c_asctime(_Yr::in, _Mnt::in, _MD::in, _Hrs::in, + _Min::in, _Sec::in, _YD::in, _WD::in, _N::in, _Str::out), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %-----------------------------------------------------------------------------% @@ -493,8 +537,13 @@ time__ctime(Time) = Str :- MR_make_aligned_string_copy(Str, s); }"). -time__c_ctime(_, _) :- - private_builtin__sorry("time__c_ctime"). + +:- pragma foreign_proc("MC++", + time__c_ctime(_Time::in, _Str::out), + [will_not_call_mercury, promise_pure], +"{ + mercury::runtime::Errors::SORRY(""foreign code for this function""); +}"). %-----------------------------------------------------------------------------% :- end_module time. diff --git a/library/type_desc.m b/library/type_desc.m index ed2f69cfb..cbfcc70d8 100644 --- a/library/type_desc.m +++ b/library/type_desc.m @@ -477,10 +477,9 @@ do_compare__type_desc_0_0( % Prototypes and type definitions. :- pragma foreign_proc("C", - type_of(Value::unused) = (TypeInfo::out), + type_of(_Value::unused) = (TypeInfo::out), [will_not_call_mercury, thread_safe, promise_pure], "{ - /* Value */ TypeInfo = TypeInfo_for_T; /* @@ -499,35 +498,26 @@ do_compare__type_desc_0_0( }"). :- pragma foreign_proc("C#", - type_of(Value::unused) = (TypeInfo::out), + type_of(_Value::unused) = (TypeInfo::out), [will_not_call_mercury, thread_safe, promise_pure], " - // Value TypeInfo = TypeInfo_for_T; "). -type_of(_) = _ :- - private_builtin__sorry("type_of"). - :- pragma foreign_proc("C", - has_type(Arg::unused, TypeInfo::in), + has_type(_Arg::unused, TypeInfo::in), [will_not_call_mercury, thread_safe, promise_pure], " - /* Arg */ TypeInfo_for_T = TypeInfo; "). :- pragma foreign_proc("C#", - has_type(Arg::unused, TypeInfo::in), + has_type(_Arg::unused, TypeInfo::in), [will_not_call_mercury, thread_safe, promise_pure], " - // Arg TypeInfo_for_T = TypeInfo; "). -has_type(_, _) :- - private_builtin__sorry("has_type"). - % Export this function in order to use it in runtime/mercury_trace_external.c :- pragma export(type_name(in) = out, "ML_type_name"). @@ -637,8 +627,13 @@ det_make_type(TypeCtor, ArgTypes) = Type :- TypeCtor = (MR_Word) MR_make_type_ctor_desc(type_info, type_ctor_info); }"). -type_ctor(_) = _ :- - private_builtin__sorry("type_ctor"). +:- pragma foreign_proc("C#", + type_ctor(_TypeInfo::in) = (_TypeCtor::out), + [will_not_call_mercury, thread_safe, promise_pure], +"{ + mercury.runtime.Errors.SORRY(""foreign code for type_ctor""); + _TypeCtor = null; +}"). :- pragma foreign_proc("C", type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out),