[m-rev.] diff: mercury versions of library pragma foreign_procs
Peter Ross
pro at missioncriticalit.com
Thu Jun 13 23:46:09 AEST 2002
Hi,
For Simon to review.
===================================================================
Estimated hours taken: 20
Branches: main
configure.in:
Test that the option --bug-intermod-2002-06-13 exists. This signifies
that the a bug in intermodule optimization for predicates which are
defined as both mercury and foreign code clauses.
library/array.m:
library/benchmarking.m:
library/builtin.m:
library/char.m:
library/construct.m:
library/deconstruct.m:
library/float.m:
library/gc.m:
library/int.m:
library/io.m:
library/library.m:
library/math.m:
library/private_builtin.m:
library/profiling_builtin.m:
library/rtti_implementation.m:
library/sparse_bitset.m:
library/std_util.m:
library/store.m:
library/table_builtin.m:
library/time.m:
library/type_desc.m:
Define a mercury version of every pragma foreign_proc.
Remove any foreign_procs which are not implemented yet.
interdiff:
diff -u library/array.m library/array.m
--- library/array.m
+++ library/array.m
@@ -726,6 +726,7 @@
").
bounds_checks :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__bounds_checks").
%-----------------------------------------------------------------------------%
@@ -790,14 +791,15 @@
").
array__init_2(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__init_2").
array__make_empty_array(_) :-
+ % This version is only for if there is not a foreign_proc version.
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,7 +826,9 @@
Min = 0;
").
+:- pragma promise_pure(array__min/2).
array__min(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__min").
:- pragma promise_pure(array__max/2).
@@ -850,6 +854,7 @@
").
array__max(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__max").
array__bounds(Array, Min, Max) :-
@@ -858,7 +863,6 @@
%-----------------------------------------------------------------------------%
-:- 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,7 +885,9 @@
Max = Array.Length;
").
+:- pragma promise_pure(array__size/2).
array__size(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__size").
%-----------------------------------------------------------------------------%
@@ -918,7 +924,6 @@
:- 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,7 +949,9 @@
Item = Array.GetValue(Index);
}").
+:- pragma promise_pure(array__unsafe_lookup/3).
array__unsafe_lookup(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__unsafe_lookup").
%-----------------------------------------------------------------------------%
@@ -977,6 +984,7 @@
}").
array__unsafe_set(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__unsafe_set").
%-----------------------------------------------------------------------------%
@@ -1057,6 +1065,7 @@
").
array__resize(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__resize").
%-----------------------------------------------------------------------------%
@@ -1123,6 +1132,7 @@
").
array__shrink_2(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__shrink_2").
%-----------------------------------------------------------------------------%
@@ -1185,6 +1195,7 @@
:- pragma promise_pure(array__copy/2).
array__copy(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("array__copy").
%-----------------------------------------------------------------------------%
diff -u library/benchmarking.m library/benchmarking.m
--- library/benchmarking.m
+++ library/benchmarking.m
@@ -90,10 +90,12 @@
").
report_stats :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("report_stats").
report_full_memory_stats :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("report_full_memory_stats").
@@ -647,29 +649,25 @@
( 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
+/* XXX Can't seem to get this to work -- perhaps Diagnositcs isn't yet
+ * available in Beta 1 of the .NET framework.
:- pragma foreign_proc("MC++",
get_user_cpu_miliseconds(_Time::out), [will_not_call_mercury],
"
// This won't return the elapsed time since program start,
// as it begins timing after the first call.
// For computing time differences it should be fine.
- // Time = (int) (1000 * System::Diagnostics::Counter::GetElapsed());
- // XXX Can't seem to get this to work -- perhaps Diagnositcs isn't
- // yet available in Beta 1 of the .NET frameworks.
-
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
+ Time = (int) (1000 * System::Diagnostics::Counter::GetElapsed());
").
*/
get_user_cpu_miliseconds(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("get_user_cpu_miliseconds").
@@ -686,12 +684,10 @@
").
:- 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.
@@ -702,12 +698,13 @@
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(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("benchmaring__do_nothing").
@@ -727,6 +724,7 @@
* (MR_Integer *) Ref = X;
").
new_int_reference(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("benchmarking__new_int_reference").
@@ -744,6 +742,7 @@
X = * (MR_Integer *) Ref;
").
ref_value(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("benchmarking__ref_value").
@@ -754,6 +753,7 @@
* (MR_Integer *) Ref = X;
").
update_ref(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("benchmarking__update_ref").
diff -u library/builtin.m library/builtin.m
--- library/builtin.m
+++ library/builtin.m
@@ -285,6 +285,7 @@
[will_not_call_mercury, thread_safe],
"Y = X;").
cc_cast(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("builtin__cc_cast").
@@ -311,6 +312,7 @@
[will_not_call_mercury, thread_safe],
"Y = X;").
cc_cast_io(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("builtin__cc_cast_io").
diff -u library/char.m library/char.m
--- library/char.m
+++ library/char.m
@@ -459,6 +459,7 @@
:- pragma promise_pure(char__to_int/2).
char__to_int(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("char__to_int").
@@ -475,6 +476,7 @@
").
char__max_char_value(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("char__max_char_value").
%-----------------------------------------------------------------------------%
diff -u library/construct.m library/construct.m
--- library/construct.m
+++ library/construct.m
@@ -103,6 +103,7 @@
}").
num_functors(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("construct__num_functors").
:- pragma foreign_proc("C",
@@ -159,6 +160,7 @@
}").
get_functor(_, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("construct__get_functor").
get_functor(TypeDesc, I, Functor, Arity, TypeInfoList, ArgNameList) :-
@@ -187,6 +189,7 @@
").
null(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("construct__null").
:- pred get_functor_2(type_desc__type_desc::in, int::in, string::out, int::out,
@@ -248,6 +251,7 @@
}").
get_functor_2(_, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("construct__get_functor_2").
:- pragma foreign_proc("C",
@@ -305,6 +309,7 @@
}").
get_functor_ordinal(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("construct__get_functor_ordinal").
:- pragma foreign_proc("C",
@@ -514,6 +519,7 @@
}").
construct(_, _, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("construct__construct").
construct_tuple(Args) =
@@ -564,4 +570,5 @@
}").
construct_tuple_2(_, _, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("construct__construct_tuple_2").
diff -u library/deconstruct.m library/deconstruct.m
--- library/deconstruct.m
+++ library/deconstruct.m
@@ -409,10 +409,12 @@
}").
functor_dna(_Term::in, _Functor::out, _Arity::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__functor_dna/3").
functor_can(Term::in, Functor::out, Arity::out) :-
rtti_implementation__deconstruct(Term, Functor, Arity, _Arguments).
functor_idcc(_Term::in, _Functor::out, _Arity::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__functor_idcc/3").
%-----------------------------------------------------------------------------%
@@ -550,18 +552,23 @@
}").
univ_arg_dna(_Term::in, _Index::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_arg_dna/3").
univ_arg_can(Term::in, Index::in, Arg::out) :-
rtti_implementation__deconstruct(Term, _Functor, _Arity, Arguments),
list__index0(Arguments, Index, Arg).
univ_arg_idcc(_Term::in, _Index::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_arg_idcc/3").
univ_named_arg_dna(_Term::in, _Name::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_named_arg_dna/3").
univ_named_arg_can(_Term::in, _Name::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_named_arg_can/3").
univ_named_arg_idcc(_Term::in, _Name::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_named_arg_idcc/3").
%-----------------------------------------------------------------------------%
@@ -726,14 +733,17 @@
}").
deconstruct_dna(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__deconstruct_dna/4").
deconstruct_can(Term::in, Functor::out, Arity::out, Arguments::out) :-
rtti_implementation__deconstruct(Term, Functor, Arity, Arguments).
deconstruct_idcc(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__deconstruct_idcc/4").
limited_deconstruct_dna(_Term::in, _MaxArity::in,
_Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__limited_deconstruct_dna/5").
limited_deconstruct_can(Term::in, MaxArity::in,
Functor::out, Arity::out, Arguments::out) :-
@@ -741,6 +751,7 @@
Arity =< MaxArity.
limited_deconstruct_idcc(_Term::in, _MaxArity::in,
_Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__limited_deconstruct_idcc/5").
%-----------------------------------------------------------------------------%
@@ -817,6 +828,7 @@
}").
get_notag_functor_info(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__get_notag_functor_info").
% Given a value of an arbitrary type, succeed if its type is defined
@@ -859,6 +871,7 @@
}").
get_equiv_functor_info(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("get_equiv_functor_info").
% Given a value of an arbitrary type, succeed if it is an enum type,
@@ -889,6 +902,7 @@
}").
get_enum_functor_info(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__get_enum_functor_info").
% Given a value of an arbitrary type, succeed if it is a general du type
@@ -990,4 +1004,5 @@
}").
get_du_functor_info(_, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("get_du_functor_info").
reverted:
--- library/exception.m 10 Jun 2002 09:05:19 -0000
+++ library/exception.m 7 Jun 2002 00:48:51 -0000 1.63
@@ -1102,6 +1102,7 @@
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 -u library/float.m library/float.m
--- library/float.m
+++ library/float.m
@@ -247,6 +247,7 @@
").
domain_checks :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__domain_checks").
%---------------------------------------------------------------------------%
@@ -270,6 +271,7 @@
Ceil = System.Convert.ToInt32(System.Math.Ceiling(X));
").
float__ceiling_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__ceiling_to_int").
% float__floor_to_int(X) returns the
@@ -285,6 +287,7 @@
Floor = System.Convert.ToInt32(System.Math.Floor(X));
").
float__floor_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__floor_to_int").
% float__round_to_int(X) returns the integer closest to X.
@@ -300,6 +303,7 @@
Round = System.Convert.ToInt32(System.Math.Floor(X + 0.5));
").
float__round_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__round_to_int").
% float__truncate_to_int(X) returns the integer closest
@@ -315,6 +319,7 @@
Trunc = System.Convert.ToInt32(X);
").
float__truncate_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__truncate_to_int").
%---------------------------------------------------------------------------%
@@ -412,6 +417,7 @@
H = F.GetHashCode();
").
float__hash(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__hash").
%---------------------------------------------------------------------------%
@@ -451,6 +457,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"Max = System.Double.MaxValue;").
float__max = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__max").
% Minimum normalised floating-point number */
@@ -461,6 +468,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"Min = System.Double.MinValue;").
float__min = _ :=
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__min").
% Smallest x such that x \= 1.0 + x
@@ -471,6 +479,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"Eps = System.Double.Epsilon;").
float__epsilon = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__epsilon").
% Radix of the floating-point representation.
@@ -478,6 +487,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"Radix = ML_FLOAT_RADIX;").
float__radix = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__radix").
% The number of base-radix digits in the mantissa.
@@ -485,6 +495,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"MantDig = ML_FLOAT_MANT_DIG;").
float__mantissa_digits = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__mantissa_digits").
% Minimum negative integer such that:
@@ -494,6 +505,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"MinExp = ML_FLOAT_MIN_EXP;").
float__min_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__min_exponent").
% Maximum integer such that:
@@ -503,6 +515,7 @@
[will_not_call_mercury, promise_pure, thread_safe],
"MaxExp = ML_FLOAT_MAX_EXP;").
float__max_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("float__max_exponent").
%---------------------------------------------------------------------------%
diff -u library/gc.m library/gc.m
--- library/gc.m
+++ library/gc.m
@@ -54,6 +54,7 @@
#endif
").
garbage_collect :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("garbage_collect").
diff -u library/int.m library/int.m
--- library/int.m
+++ library/int.m
@@ -344,6 +344,7 @@
").
domain_checks :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("domain_checks").
:- pragma inline(floor_to_multiple_of_bits_per_int/1).
@@ -508,6 +509,7 @@
FloatVal = (MR_Float) IntVal;
").
int__to_float(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("int__to_float").
%-----------------------------------------------------------------------------%
@@ -563,7 +565,6 @@
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;
@@ -586,12 +587,15 @@
").
int__max_int(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("int__max_int").
int__min_int(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("int__min_int").
int__bits_per_int(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("int__bits_per_int").
int__quot_bits_per_int(Int::in) = (Result::out) :-
@@ -603,6 +607,5 @@
int__rem_bits_per_int(Int::in) = (Result::out) :-
Result = Int rem int__bits_per_int.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
diff -u library/io.m library/io.m
--- library/io.m
+++ library/io.m
@@ -1604,6 +1604,7 @@
").
io__read_line_as_string_2(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__read_line_as_string_2") }.
io__read_file(Result) -->
@@ -1781,6 +1782,7 @@
}").
io__clear_err(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__clear_err") }.
@@ -1814,7 +1816,6 @@
ML_maybe_make_err_msg(RetVal != 0, ""read failed: "",
MR_PROC_LABEL, RetStr);
-
update_io(IO0, IO);
}").
@@ -1828,9 +1829,9 @@
}").
ferror(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("ferror") }.
-
% io__make_err_msg(MessagePrefix, Message):
% `Message' is an error message obtained by looking up the
@@ -1847,14 +1848,14 @@
}").
:- 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(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__make_err_msg") }.
@@ -1917,6 +1918,7 @@
}").
io__stream_file_size(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__stream_file_size") }.
@@ -1958,6 +1960,7 @@
}").
io__file_modification_time_2(_, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__file_modification_time_2") }.
%-----------------------------------------------------------------------------%
@@ -1980,6 +1983,7 @@
}").
io__alloc_buffer(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("io__alloc_buffer").
:- pred io__resize_buffer(buffer::di, int::in, int::in, buffer::uo) is det.
@@ -2022,6 +2026,7 @@
}").
io__resize_buffer(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("io__resize_buffer").
:- pred io__buffer_to_string(buffer::di, int::in, string::uo) is det.
@@ -2034,6 +2039,7 @@
}").
io__buffer_to_string(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("io__buffer_to_string/3").
:- pred io__buffer_to_string(buffer::di, string::uo) is det.
@@ -2045,6 +2051,7 @@
}").
io__buffer_to_string(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("io__buffer_to_string/2").
:- pred io__read_into_buffer(stream::in, buffer::di, int::in, int::in,
@@ -2064,11 +2071,12 @@
Buffer = (MR_Word) buffer;
Pos = Pos0 + items_read;
-
update_io(IO0, IO);
}").
+
io__read_into_buffer(_, _, _, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__read_into_buffer") }.
%-----------------------------------------------------------------------------%
@@ -2978,9 +2986,11 @@
").
io__get_stream_names(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__get_stream_names") }.
io__set_stream_names(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_stream_names") }.
:- pred io__delete_stream_name(io__stream, io__state, io__state).
@@ -3041,9 +3051,11 @@
").
io__set_globals(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_globals") }.
io__get_globals(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__get_globals") }.
io__progname_base(DefaultName, PrognameBase) -->
@@ -3088,6 +3100,7 @@
").
io__get_stream_id(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("io__get_stream_id").
%-----------------------------------------------------------------------------%
@@ -3207,27 +3220,7 @@
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], "
- ascii_encoder = new System::Text::ASCIIEncoding();
- update_io(IO0, IO);
-").
-
-io__stream_init -->
- { private_builtin__sorry("io__stream_init") }.
+io__gc_init(_, _) --> [].
:- pred io__insert_std_stream_names(io__state, io__state).
:- mode io__insert_std_stream_names(di, uo) is det.
@@ -3969,12 +3962,15 @@
}").
io__read_char_code(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__read_char_code") }.
io__putback_char(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__putback_char") }.
io__putback_byte(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__putback_byte") }.
/* output predicates - with output to mercury_current_text_output */
@@ -4136,27 +4132,35 @@
").
io__write_string(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_string") }.
io__write_char(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_char") }.
io__write_int(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_int") }.
io__write_float(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_float") }.
io__write_byte(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_byte") }.
io__write_bytes(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_bytes") }.
io__flush_output -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__flush_output") }.
io__flush_binary_output -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__flush_binary_output") }.
/* moving about binary streams */
@@ -4212,9 +4216,11 @@
}").
io__seek_binary_2(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__seek_binary_2") }.
io__binary_stream_offset(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__binary_stream_offset") }.
/* output predicates - with output to the specified stream */
@@ -4402,27 +4408,35 @@
}").
io__write_string(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_string") }.
io__write_char(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_char") }.
io__write_int(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_int") }.
io__write_float(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_float") }.
io__write_byte(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_byte") }.
io__write_bytes(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__write_bytes") }.
io__flush_output(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__flush_output") }.
io__flush_binary_output(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__flush_binary_output") }.
/* stream predicates */
@@ -4549,7 +4563,7 @@
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],
@@ -4839,78 +4853,103 @@
").
io__stdin_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__stdin_stream") }.
io__stdout_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__stdout_stream") }.
io__stderr_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__stderr_stream") }.
io__stdin_binary_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__stdin_binary_stream") }.
io__stdout_binary_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__stdout_binary_stream") }.
io__input_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__input_stream") }.
io__output_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__output_stream") }.
io__binary_input_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__binary_input_stream") }.
io__binary_output_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__binary_output_stream") }.
io__get_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__get_line_number") }.
io__get_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__get_line_number") }.
io__set_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_line_number") }.
io__set_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_line_number") }.
io__get_output_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__get_output_line_number") }.
io__get_output_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__get_output_line_number") }.
io__set_output_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_output_line_number") }.
io__set_output_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_output_line_number") }.
io__current_input_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__current_input_stream") }.
io__current_output_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__current_output_stream") }.
io__current_binary_input_stream(_) -->
- { private_builtin__sorry(io__current_binary_input_stream) }.
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__current_binary_input_stream") }.
io__current_binary_output_stream(_) -->
- { private_builtin__sorry(io__current_binary_output_stream) }.
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__current_binary_output_stream") }.
io__set_input_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_input_stream") }.
io__set_output_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_output_stream") }.
io__set_binary_input_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_binary_input_stream") }.
io__set_binary_output_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_binary_output_stream") }.
/* stream open/close predicates */
@@ -4942,6 +4981,7 @@
").
io__do_open(_, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__do_open") }.
io__close_input(Stream) -->
@@ -4977,6 +5017,7 @@
").
io__close_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__close_stream") }.
/* miscellaneous predicates */
@@ -5004,65 +5045,14 @@
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.
+:- pragma foreign_proc("C",
+ io__command_line_arguments(Args::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_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.
-:- 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,
@@ -5106,12 +5096,64 @@
+ 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.
- update_io(IO0, IO);
+% 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++",
@@ -5144,7 +5186,7 @@
update_io(IO0, IO);
").
-/*
+/* XXX Implementation needs to be finished.
:- pragma foreign_proc("MC++",
io__call_system_code(Command::in, Status::out, _Msg::out,
IO0::di, IO::uo),
@@ -5163,15 +5205,19 @@
*/
io__command_line_arguments(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__command_line_arguments") }.
io__get_exit_status(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__get_exit_status") }.
io__set_exit_status(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__set_exit_status") }.
io__call_system_code(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__call_system_code") }.
/*---------------------------------------------------------------------------*/
@@ -5208,10 +5254,12 @@
").
io__getenv(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("io__getenv").
io__putenv(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("io__putenv").
@@ -5332,6 +5380,7 @@
}").
io__do_make_temp(_, _, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__do_make_temp") }.
/*---------------------------------------------------------------------------*/
@@ -5403,7 +5452,7 @@
update_io(IO0, IO);
}").
-/*
+/* XXX Implementation needs to be finished.
:- pragma foreign_proc("MC++",
io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
IO0::di, IO::uo),
@@ -5419,6 +5468,7 @@
*/
io__remove_file_2(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__remove_file_2") }.
io__rename_file(OldFileName, NewFileName, Result, IO0, IO) :-
@@ -5445,6 +5495,7 @@
}").
io__rename_file_2(_, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("io__rename_file_2") }.
/*---------------------------------------------------------------------------*/
diff -u library/library.m library/library.m
--- library/library.m
+++ library/library.m
@@ -77,6 +77,7 @@
").
library__version(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("library__version").
%---------------------------------------------------------------------------%
diff -u library/math.m library/math.m
--- library/math.m
+++ library/math.m
@@ -265,8 +265,9 @@
").
domain_checks :-
+ % This version is only for if there is not a foreign_proc version.
semidet_succeed,
- private__builtin__sorry("domain_checks").
+ private_builtin__sorry("domain_checks").
%
% Mathematical constants from math.m
@@ -282,7 +283,8 @@
Pi = System.Math.PI;
").
math__pi = _ :-
- private__builtin__sorry("math__pi").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__pi").
% Base of natural logarithms
:- pragma foreign_proc("C", math__e = (E::out),
@@ -294,7 +296,8 @@
E = System.Math.E;
").
math__e = _ :-
- private__builtin__sorry("math__e").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__e").
%
% math__ceiling(X) = Ceil is true if Ceil is the smallest integer
@@ -311,7 +314,8 @@
Ceil = System.Math.Ceiling(Num);
").
math__ceiling(_) = _ :-
- private__builtin__sorry("math__ceiling").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__ceiling").
%
% math__floor(X) = Floor is true if Floor is the largest integer
@@ -328,7 +332,8 @@
Floor = System.Math.Floor(Num);
").
math__floor(_) = _ :-
- private__builtin__sorry("math__floor").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__floor").
%
% math__round(X) = Round is true if Round is the integer
@@ -348,7 +353,8 @@
Rounded = System.Math.Floor(Num+0.5);
").
math__round(_) = _ :-
- private__builtin__sorry("math__round").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__round").
%
% math__truncate(X) = Trunc is true if Trunc is the integer
@@ -381,7 +387,8 @@
SquareRoot = System.Math.Sqrt(X);
").
math__sqrt_2(_) = _ :-
- private__builtin__sorry("math__sqrt_2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__sqrt_2").
%
% math__solve_quadratic(A, B, C) = Roots is true if Roots are
@@ -459,7 +466,8 @@
Res = System.Math.Pow(X, Y);
").
math__pow_2(_, _) = _ :-
- private__builtin__sorry("math__pow_2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__pow_2").
%
@@ -475,7 +483,8 @@
Exp = System.Math.Exp(X);
").
math__exp(_) = _ :-
- private__builtin__sorry("math__exp").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__exp").
%
% math__ln(X) = Log is true if Log is the natural logarithm
@@ -502,7 +511,8 @@
Log = System.Math.Log(X);
").
math__ln_2(_) = _ :-
- private__builtin__sorry("math__ln_2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__ln_2").
%
% math__log10(X) = Log is true if Log is the logarithm to
@@ -529,7 +539,8 @@
Log10 = System.Math.Log10(X);
").
math__log10_2(_) = _ :-
- private__builtin__sorry("math__log10_2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__log10_2").
%
% math__log2(X) = Log is true if Log is the logarithm to
@@ -556,7 +567,8 @@
Log2 = System.Math.Log(X) / ML_FLOAT_LN2;
").
math__log2_2(_) = _ :-
- private__builtin__sorry("math__log2_2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__log2_2").
%
% math__log(B, X) = Log is true if Log is the logarithm to
@@ -591,6 +603,7 @@
Log = System.Math.Log(X,B);
").
math__log_2(_, _) = _ -
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("math__log_2").
@@ -606,7 +619,8 @@
Sin = System.Math.Sin(X);
").
math__sin(_) = _ :-
- private__builtin__sorry("math__sin").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__sin").
%
@@ -621,7 +635,8 @@
Cos = System.Math.Cos(X);
").
math__cos(_) = _ :-
- private__builtin__sorry("math__cos").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__cos").
%
% math__tan(X) = Tan is true if Tan is the tangent of X.
@@ -635,7 +650,8 @@
Tan = System.Math.Tan(X);
").
math__tan(_) = _ :-
- private__builtin__sorry("math__tan").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__tan").
%
% math__asin(X) = ASin is true if ASin is the inverse
@@ -667,7 +683,8 @@
ASin = System.Math.Asin(X);
").
math__asin_2(_) = _ :-
- private__builtin__sorry("math__asin_2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__asin_2").
%
% math__acos(X) = ACos is true if ACos is the inverse
@@ -699,7 +716,8 @@
ACos = System.Math.Acos(X);
").
math__acos_2(_) = _ :-
- private__builtin__sorry("math__acos_2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__acos_2").
%
@@ -715,7 +733,8 @@
ATan = System.Math.Atan(X);
").
math__atan(_) = _ :-
- private__builtin__sorry("math__atan").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__atan").
%
% math__atan2(Y, X) = ATan is true if ATan is the inverse
@@ -730,7 +749,8 @@
ATan2 = System.Math.Atan2(Y, X);
").
math__atan2(_, _) = _ :-
- private__builtin__sorry("math__atan2").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__atan2").
%
% math__sinh(X) = Sinh is true if Sinh is the hyperbolic
@@ -745,7 +765,8 @@
Sinh = System.Math.Sinh(X);
").
math__sinh(_) = _ :-
- private__builtin__sorry("math__sinh").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__sinh").
%
% math__cosh(X) = Cosh is true if Cosh is the hyperbolic
@@ -760,7 +781,8 @@
Cosh = System.Math.Cosh(X);
").
math__cosh(_) = _ :-
- private__builtin__sorry("math__cosh").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__cosh").
%
% math__tanh(X) = Tanh is true if Tanh is the hyperbolic
@@ -775,7 +797,8 @@
Tanh = System.Math.Tanh(X);
").
math__tanh(_) = _ :-
- private__builtin__sorry("math__tanh").
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__tanh").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
diff -u library/private_builtin.m library/private_builtin.m
--- library/private_builtin.m
+++ library/private_builtin.m
@@ -169,9 +169,11 @@
"
Res = System::String::Compare(S1, S2);
").
+
builtin_strcmp(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
sorry("builtin_strcmp").
-
+
builtin_unify_float(F, F).
builtin_compare_float(R, F1, F2) :-
@@ -879,15 +881,19 @@
").
type_info_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
sorry("type_info_from_typeclass_info").
unconstrained_type_info_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
sorry("unconstrained_type_info_from_typeclass_info").
superclass_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
sorry("superclass_from_typeclass_info").
instance_constraint_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
sorry("instance_constraint_from_typeclass_info").
diff -u library/profiling_builtin.m library/profiling_builtin.m
--- library/profiling_builtin.m
+++ library/profiling_builtin.m
@@ -1621,6 +1621,8 @@
:- import_module std_util.
+% These versions are only for if there is not a foreign_proc version.
+
prepare_for_normal_call(_) :-
impure private_builtin__imp,
private_builtin__sorry("prepare_for_normal_call").
diff -u library/rtti_implementation.m library/rtti_implementation.m
--- library/rtti_implementation.m
+++ library/rtti_implementation.m
@@ -127,22 +127,21 @@
:- 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(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("get_type_info").
%-----------------------------------------------------------------------------%
@@ -896,6 +895,7 @@
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.
@@ -1093,6 +1093,7 @@
").
get_type_ctor_info(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("get_type_ctor_info").
@@ -1114,6 +1115,7 @@
SUCCESS_INDICATOR = (T1 == T2);
").
same_pointer_value_untyped(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("same_pointer_value_untyped").
%-----------------------------------------------------------------------------%
@@ -1404,6 +1406,7 @@
Arity = tci->MR_type_ctor_arity;
").
type_ctor_arity(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_arity").
:- some [P] func type_ctor_unify_pred(type_ctor_info) = P.
@@ -1422,6 +1425,7 @@
UnifyPred = (MR_Integer) tci->MR_type_ctor_unify_pred;
").
type_ctor_unify_pred(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_unify_pred").
:- some [P] func type_ctor_compare_pred(type_ctor_info) = P.
@@ -1440,6 +1444,7 @@
UnifyPred = (MR_Integer) tci->MR_type_ctor_compare_pred;
").
type_ctor_compare_pred(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_compare_pred").
@@ -1462,6 +1467,7 @@
TypeCtorRep = MR_type_ctor_rep(tci);
").
type_ctor_rep(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_rep").
@@ -1485,10 +1491,9 @@
").
type_ctor_module_name(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_module_name").
-
-
:- func type_ctor_name(type_ctor_info) = string.
@@ -1507,6 +1512,7 @@
").
type_ctor_name(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_name").
:- func type_layout(type_ctor_info) = type_layout.
@@ -1527,6 +1533,7 @@
").
type_layout(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_layout").
:- pragma foreign_proc("C",
@@ -1543,6 +1550,7 @@
").
unsafe_cast(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("unsafe_cast").
%-----------------------------------------------------------------------------%
diff -u library/sparse_bitset.m library/sparse_bitset.m
--- library/sparse_bitset.m
+++ library/sparse_bitset.m
@@ -793,6 +793,7 @@
}").
make_bitset_elem(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("make_bitset_elem").
%-----------------------------------------------------------------------------%
diff -u library/std_util.m library/std_util.m
--- library/std_util.m
+++ library/std_util.m
@@ -1065,6 +1065,7 @@
").
get_registers(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("get_registers").
:- impure pred check_for_floundering(trail_ptr::in) is det.
@@ -1089,6 +1090,7 @@
").
check_for_floundering(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("check_for_floundering").
%
@@ -1115,6 +1117,7 @@
").
discard_trail_ticket :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("discard_trail_ticket").
%
@@ -1151,6 +1154,7 @@
").
swap_heap_and_solutions_heap :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("swap_heap_and_solutions_heap").
%
@@ -1236,6 +1240,7 @@
").
partial_deep_copy(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("partial_deep_copy").
%
@@ -1266,6 +1271,7 @@
").
reset_solutions_heap(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("reset_solutions_heap").
@@ -1373,10 +1379,13 @@
").
new_mutvar(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("new_mutvar").
get_mutvar(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("get_mutvar").
set_mutvar(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("set_mutvar").
%%% end_module mutvar.
@@ -1462,13 +1471,12 @@
"Y = X;").
semidet_succeed :-
- private_builtin__sorry("semidet_succeed").
+ true.
semidet_fail :-
- private_builtin__sorry("semidet_fail").
+ fail.
:- pragma promise_pure(cc_multi_equal/2).
-cc_multi_equal(_, _) :-
- private_builtin__sorry("cc_multi_equal").
+cc_multi_equal(X, X).
%-----------------------------------------------------------------------------%
diff -u library/store.m library/store.m
--- library/store.m
+++ library/store.m
@@ -250,11 +250,11 @@
:- 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 */").
+:- pragma foreign_proc("C", store__do_init(_S0::uo),
+ [will_not_call_mercury, promise_pure], "").
store__do_init(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("store__do_init").
/*
@@ -297,12 +297,15 @@
").
new_mutvar(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__new_mutvar") }.
get_mutvar(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__get_mutvar") }.
set_mutvar(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__set_mutvar") }.
:- pred store__unsafe_new_uninitialized_mutvar(generic_mutvar(T, S),
@@ -317,6 +320,7 @@
").
unsafe_new_uninitialized_mutvar(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("unsafe_new_uninitialized_mutvar") }.
store__new_cyclic_mutvar(Func, MutVar) -->
@@ -335,6 +339,7 @@
").
new_ref(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__new_ref") }.
copy_ref_value(Ref, Val) -->
@@ -355,6 +360,7 @@
").
store__unsafe_ref_value(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__unsafe_ref_value") }.
ref_functor(Ref, Functor, Arity) -->
@@ -465,26 +471,30 @@
").
:- 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(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__arg_ref") }.
new_arg_ref(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__new_arg_ref") }.
set_ref(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__set_ref") }.
set_ref_value(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__set_ref_value") }.
extract_ref_value(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("store__extract_ref_value").
%-----------------------------------------------------------------------------%
@@ -510,10 +520,10 @@
}").
unsafe_arg_ref(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__unsafe_arg_ref") }.
unsafe_new_arg_ref(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("store__unsafe_new_arg_ref") }.
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
diff -u library/string.m library/string.m
--- library/string.m
+++ library/string.m
@@ -89,10 +89,10 @@
:- pred string__first_char(string, char, string).
:- mode string__first_char(in, in, in) is semidet. % implied
-:- mode string__first_char(in, out, in) is semidet. % implied
-:- mode string__first_char(in, in, out) is semidet. % implied
-:- mode string__first_char(in, out, out) is semidet.
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(in, uo, in) is semidet. % implied
+:- mode string__first_char(in, in, uo) is semidet. % implied
+:- mode string__first_char(in, uo, uo) is semidet.
+:- mode string__first_char(uo, in, in) is det.
% string__first_char(String, Char, Rest) is true iff
% Char is the first character of String, and Rest is the
% remainder.
@@ -142,8 +142,8 @@
:- func string__to_char_list(string) = list(char).
:- pred string__to_char_list(string, list(char)).
-:- mode string__to_char_list(in, out) is det.
-:- mode string__to_char_list(out, in) is det.
+:- mode string__to_char_list(in, uo) is det.
+:- mode string__to_char_list(uo, in) is det.
:- func string__from_char_list(list(char)) = string.
:- pred string__from_char_list(list(char), string).
@@ -461,7 +461,6 @@
:- import_module bool, std_util, int, float, require.
:- pred string__to_int_list(string, list(int)).
-:- mode string__to_int_list(out, in) is det.
:- mode string__to_int_list(in, out) is det.
string__replace(String, SubString0, SubString1, StringOut) :-
@@ -623,17 +622,16 @@
string__split(String, LeftCount, _LeftString, RightString).
string__remove_suffix(A, B, C) :-
- string__to_int_list(A, LA),
- string__to_int_list(B, LB),
- string__to_int_list(C, LC),
+ string__to_char_list(A, LA),
+ string__to_char_list(B, LB),
+ string__to_char_list(C, LC),
list__remove_suffix(LA, LB, LC).
string__prefix(String, Prefix) :-
string__append(Prefix, _, String).
string__char_to_string(Char, String) :-
- string__to_int_list(String, [Code]),
- char__to_int(Char, Code).
+ string__to_char_list(String, [Char]).
string__int_to_string(N, Str) :-
string__int_to_base_string(N, 10, Str).
@@ -692,12 +690,12 @@
/*
:- pred string__to_char_list(string, list(char)).
-:- mode string__to_char_list(in, out) is det.
-:- mode string__to_char_list(out, in) is det.
+:- mode string__to_char_list(in, uo) is det.
+:- mode string__to_char_list(uo, in) is det.
*/
:- pragma promise_pure(string__to_char_list/2).
-:- pragma foreign_proc("C", string__to_char_list(Str::in, CharList::out),
+:- pragma foreign_proc("C", string__to_char_list(Str::in, CharList::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
MR_ConstString p = Str + strlen(Str);
CharList = MR_list_empty_msg(MR_PROC_LABEL);
@@ -708,9 +706,9 @@
}
}").
-:- pragma foreign_proc("C", string__to_char_list(Str::out, CharList::in),
+:- pragma foreign_proc("C", string__to_char_list(Str::uo, CharList::in),
[will_not_call_mercury, promise_pure, thread_safe], "{
- /* mode (out, in) is det */
+ /* mode (uo, in) is det */
MR_Word char_list_ptr;
size_t size;
/*
@@ -744,7 +742,7 @@
Str[size] = '\\0';
}").
-:- pragma foreign_proc("MC++", string__to_char_list(Str::in, CharList::out),
+:- pragma foreign_proc("MC++", string__to_char_list(Str::in, CharList::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
MR_Integer length, i;
MR_Word tmp;
@@ -761,7 +759,7 @@
CharList = tmp;
}").
-:- pragma foreign_proc("MC++", string__to_char_list(Str::out, CharList::in),
+:- pragma foreign_proc("MC++", string__to_char_list(Str::uo, CharList::in),
[will_not_call_mercury, promise_pure, thread_safe], "{
System::Text::StringBuilder *tmp;
MR_Char c;
@@ -779,15 +777,27 @@
Str = tmp->ToString();
}").
-string__to_char_list(_, _) :-
- private_builtin__sorry("string__to_char_list").
+string__to_char_list(Str::in, CharList::uo) :-
+ ( string__first_char(Str, First, Rest) ->
+ string__to_char_list(Rest, CharList0),
+ CharList = [First | CharList0]
+ ;
+ CharList = []
+ ).
+string__to_char_list(Str::uo, CharList::in) :-
+ ( CharList = [],
+ Str = ""
+ ; CharList = [C | Cs],
+ string__to_char_list(Str0, Cs),
+ Str = string__char_to_string(C) ++ Str0
+ ).
/*-----------------------------------------------------------------------*/
%
-% 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 +838,41 @@
}
}").
+:- 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 +1027,6 @@
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),
@@ -1051,6 +1075,27 @@
}").
:- 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 +1113,6 @@
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,8 +1165,19 @@
Index = WholeString->IndexOf(SubString);
}").
-string__sub_string_search(_, _, _) :-
- private_builtin__sorry("string__sub_string_search").
+string__sub_string_search(String, SubString, Index) :-
+ string__sub_string_search_2(String, SubString, 0, Index).
+
+:- pred sub_string_search_2(string::in, string::in,
+ int::in, int::out) is semidet.
+
+sub_string_search_2(String, SubString, CurrentIndex, Index) :-
+ ( string__prefix(String, SubString) ->
+ Index = CurrentIndex
+ ;
+ string__first_char(String, _, Rest),
+ sub_string_search_2(Rest, SubString, CurrentIndex + 1, Index)
+ ).
%-----------------------------------------------------------------------------%
@@ -1503,6 +1550,7 @@
SUCCESS_INDICATOR = MR_FALSE;
").
using_sprintf :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__using_sprintf").
@@ -1579,6 +1627,7 @@
LengthModifier = """";
}").
int_length_modifer = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("int_length_modifer").
@@ -1599,6 +1648,7 @@
Str = System.String.Format(FormatStr, Val);
}").
format_float(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("format_float").
% Create a string from a int using the format string.
@@ -1618,6 +1668,7 @@
Str = System.String.Format(FormatStr, Val);
}").
format_int(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("format_int").
% Create a string from a string using the format string.
@@ -1635,6 +1686,7 @@
Str = System.String.Format(FormatStr, Val);
}").
format_string(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("format_string").
% Create a string from a char using the format string.
@@ -1654,6 +1706,7 @@
Str = System.String.Format(FormatStr, Val);
}").
format_char(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("format_char").
%-----------------------------------------------------------------------------%
@@ -1687,6 +1740,7 @@
}").
string__float_to_string(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__float_to_string").
@@ -1711,6 +1765,7 @@
}").
string__float_to_f_string(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__float_to_f_string").
:- pragma foreign_proc("C",
@@ -1732,6 +1787,12 @@
}").
:- 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], "{
SUCCESS_INDICATOR = MR_TRUE;
@@ -1743,6 +1804,7 @@
}").
string__to_float(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__to_float").
/*-----------------------------------------------------------------------*/
@@ -1750,9 +1812,7 @@
/*
:- pred string__to_int_list(string, list(int)).
:- mode string__to_int_list(in, out) is det.
-:- mode string__to_int_list(out, in) is det.
*/
-
:- pragma foreign_proc("C",
string__to_int_list(Str::in, IntList::out),
[will_not_call_mercury, promise_pure, thread_safe], "{
@@ -1764,45 +1824,6 @@
MR_PROC_LABEL);
}
}").
-
-:- pragma foreign_proc("C",
- string__to_int_list(Str::out, IntList::in),
- [will_not_call_mercury, promise_pure, thread_safe], "{
- /* mode (out, in) is det */
- MR_Word int_list_ptr;
- size_t size;
- MR_Word str_ptr;
-/*
-** loop to calculate list length + sizeof(MR_Word) in `size' using list in
-** `int_list_ptr'
-*/
- size = sizeof(MR_Word);
- int_list_ptr = IntList;
- while (! MR_list_is_empty(int_list_ptr)) {
- size++;
- int_list_ptr = MR_list_tail(int_list_ptr);
- }
-/*
-** allocate (length + 1) bytes of heap space for string
-** i.e. (length + 1 + sizeof(MR_Word) - 1) / sizeof(MR_Word) words
-*/
- MR_allocate_aligned_string_msg(Str, size, MR_PROC_LABEL);
-
-/*
-** loop to copy the characters from the int_list to the string
-*/
- size = 0;
- int_list_ptr = IntList;
- while (! MR_list_is_empty(int_list_ptr)) {
- Str[size++] = MR_list_head(int_list_ptr);
- int_list_ptr = MR_list_tail(int_list_ptr);
- }
-/*
-** null terminate the string
-*/
- Str[size] = '\\0';
-}").
-
:- pragma foreign_proc("MC++",
string__to_int_list(Str::in, IntList::out),
[will_not_call_mercury, promise_pure, thread_safe], "{
@@ -1820,29 +1841,9 @@
}
IntList = tmp;
}").
-
-:- pragma foreign_proc("MC++",
- string__to_int_list(Str::out, IntList::in),
- [will_not_call_mercury, promise_pure, thread_safe], "{
- System::Text::StringBuilder *tmp;
-
- tmp = new System::Text::StringBuilder();
- while (1) {
- if (System::Convert::ToInt32(IntList->GetValue(0))) {
- tmp->Append(System::Convert::ToChar(
- IntList->GetValue(1)));
- IntList = dynamic_cast<MR_Word>(IntList->GetValue(2));
- } else {
- break;
- }
- }
- Str = tmp->ToString();
-}").
-
-:- pragma promise_pure(string__to_int_list/2).
-string__to_int_list(_, _) :-
- private_builtin__sorry("string__to_int_list").
-
+string__to_int_list(String, IntList) :-
+ string__to_char_list(String, CharList),
+ IntList = list__map(char__to_int, CharList).
/*-----------------------------------------------------------------------*/
@@ -1858,8 +1859,13 @@
[will_not_call_mercury, promise_pure, thread_safe], "
SUCCESS_INDICATOR = (Str->IndexOf(Ch) != -1);
").
-string__contains_char(_, _) :-
- private_builtin__sorry("string__contains_char").
+string__contains_char(String, Char) :-
+ string__first_char(String, FirstChar, RestOfString),
+ ( FirstChar = Char ->
+ true
+ ;
+ string__contains_char(RestOfString, Char)
+ ).
/*-----------------------------------------------------------------------*/
@@ -1896,8 +1902,13 @@
Ch = Str->get_Chars(Index);
}
").
-string__index(_, _, _) :-
- private_builtin__sorry("string__index").
+string__index(Str, Index, Char) :-
+ string__first_char(Str, First, Rest),
+ ( Index = 0 ->
+ Char = First
+ ;
+ string__index(Rest, Index - 1, Char)
+ ).
/*-----------------------------------------------------------------------*/
@@ -1912,6 +1923,7 @@
Ch = Str->get_Chars(Index);
").
string__unsafe_index(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__unsafe_index").
/*-----------------------------------------------------------------------*/
@@ -1962,9 +1974,10 @@
SUCCESS_INDICATOR = MR_TRUE;
}
").
-
-string__set_char(_, _, _, _) :-
- private_builtin__sorry("string__set_char").
+string__set_char(Ch, Index, Str0, Str) :-
+ string__to_char_list(Str0, List0),
+ list__replace_nth(List0, Index + 1, Ch, List),
+ string__to_char_list(Str, List).
/*
:- pred string__set_char(char, int, string, string).
@@ -2019,6 +2032,7 @@
Str0->Substring(Index + 1));
").
string__unsafe_set_char(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__unsafe_set_char").
/*
@@ -2074,8 +2088,20 @@
").
:- pragma promise_pure(string__length/2).
-string__length(_, _) :-
- private_builtin__sorry("string__length").
+string__length(Str::in, Len::uo) :-
+ string__length_2(Str, Len).
+string__length(Str0::ui, Len::uo) :-
+ copy(Str0, Str),
+ string__length_2(Str, Len).
+
+:- pred string__length_2(string::in, int::uo) is det.
+string__length_2(Str, Length) :-
+ ( string__first_char(Str, _First, Rest) ->
+ string__length(Rest, Length0),
+ Length = Length0 + 1
+ ;
+ Length = 0
+ ).
/*-----------------------------------------------------------------------*/
@@ -2108,8 +2134,8 @@
SUCCESS_INDICATOR = S3->Equals(System::String::Concat(S1, S2));
}").
-string__append_iii(_, _, _) :-
- private_builtin__sorry("string__append_iii").
+string__append_iii(X, Y, Z) :-
+ string__mercury_append(X, Y, Z).
:- pred string__append_ioi(string::in, string::out, string::in) is semidet.
@@ -2145,8 +2171,8 @@
}
}").
-string__append_ioi(_, _, _) :-
- private_builtin__sorry("string__append_ioi").
+string__append_ioi(X, Y, Z) :-
+ string__mercury_append(X, Y, Z).
:- pred string__append_iio(string::in, string::in, string::uo) is det.
@@ -2167,8 +2193,8 @@
S3 = System::String::Concat(S1, S2);
}").
-string__append_iio(_, _, _) :-
- private_builtin__sorry("string__append_iio").
+string__append_iio(X, Y, Z) :-
+ string__mercury_append(X, Y, Z).
:- pred string__append_ooi(string::out, string::out, string::in) is multi.
@@ -2213,8 +2239,20 @@
S2 = S3->Substring(S1Len);
").
-string__append_ooi_3(_, _, _, _, _) :-
- private_builtin__sorry("string__append_ooi_3").
+string__append_ooi_3(S1Len, _S3Len, S1, S2, S3) :-
+ string__split(S3, S1Len, S1, S2).
+
+:- pred string__mercury_append(string, string, string).
+:- mode string__mercury_append(in, in, in) is semidet. % implied
+:- mode string__mercury_append(in, uo, in) is semidet.
+:- mode string__mercury_append(in, in, uo) is det.
+:- mode string__mercury_append(uo, uo, in) is multi.
+
+string__mercury_append(X, Y, Z) :-
+ string__to_char_list(X, XList),
+ string__to_char_list(Y, YList),
+ string__to_char_list(Z, ZList),
+ list__append(XList, YList, ZList).
/*-----------------------------------------------------------------------*/
@@ -2283,6 +2321,7 @@
}").
string__unsafe_substring(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__unsafe_substring").
/*
@@ -2338,18 +2377,36 @@
}
}").
-string__split(_, _, _, _) :-
- private_builtin__sorry("string__split").
+string__split(Str, Count, Left, Right) :-
+ ( Count =< 0 ->
+ Left = "",
+ Right = Str
+ ;
+ string__to_char_list(Str, List),
+ Len = list__length(List),
+ ( Count > Len ->
+ Num = Len
+ ;
+ Num = Count
+ ),
+ ( list__split_list(Num, List, LeftList, RightList) ->
+ string__to_char_list(Left, LeftList),
+ string__to_char_list(Right, RightList)
+ ;
+ error("string__split")
+ )
+ ).
+
/*-----------------------------------------------------------------------*/
/*
:- pred string__first_char(string, char, string).
:- mode string__first_char(in, in, in) is semidet. % implied
-:- mode string__first_char(in, out, in) is semidet. % implied
-:- mode string__first_char(in, in, out) is semidet. % implied
-:- mode string__first_char(in, out, out) is semidet.
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(in, uo, in) is semidet. % implied
+:- mode string__first_char(in, in, uo) is semidet. % implied
+:- mode string__first_char(in, uo, uo) is semidet.
+:- mode string__first_char(uo, in, in) is det.
% string__first_char(String, Char, Rest) is true iff
% Char is the first character of String, and Rest is the
% remainder.
@@ -2379,16 +2436,16 @@
").
/*
-:- mode string__first_char(in, out, in) is semidet. % implied
+:- mode string__first_char(in, uo, in) is semidet. % implied
*/
:- pragma foreign_proc("C",
- string__first_char(Str::in, First::out, Rest::in),
+ string__first_char(Str::in, First::uo, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "
First = Str[0];
SUCCESS_INDICATOR = (First != '\\0' && strcmp(Str + 1, Rest) == 0);
").
:- pragma foreign_proc("MC++",
- string__first_char(Str::in, First::out, Rest::in),
+ string__first_char(Str::in, First::uo, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "
MR_Integer len = Str->get_Length();
if (len > 0) {
@@ -2401,10 +2458,10 @@
").
/*
-:- mode string__first_char(in, in, out) is semidet. % implied
+:- mode string__first_char(in, in, uo) is semidet. % implied
*/
:- pragma foreign_proc("C",
- string__first_char(Str::in, First::in, Rest::out),
+ string__first_char(Str::in, First::in, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
if (Str[0] != First || First == '\\0') {
SUCCESS_INDICATOR = MR_FALSE;
@@ -2421,7 +2478,7 @@
}
}").
:- pragma foreign_proc("MC++",
- string__first_char(Str::in, First::in, Rest::out),
+ string__first_char(Str::in, First::in, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
MR_Integer len = Str->get_Length();
if (len > 0) {
@@ -2433,10 +2490,10 @@
}").
/*
-:- mode string__first_char(in, out, out) is semidet.
+:- mode string__first_char(in, uo, uo) is semidet.
*/
:- pragma foreign_proc("C",
- string__first_char(Str::in, First::out, Rest::out),
+ string__first_char(Str::in, First::uo, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
First = Str[0];
if (First == '\\0') {
@@ -2454,7 +2511,7 @@
}
}").
:- pragma foreign_proc("MC++",
- string__first_char(Str::in, First::out, Rest::out),
+ string__first_char(Str::in, First::uo, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
if (Str->get_Length() == 0) {
SUCCESS_INDICATOR = MR_FALSE;
@@ -2467,10 +2524,10 @@
/*
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(uo, in, in) is det.
*/
:- pragma foreign_proc("C",
- string__first_char(Str::out, First::in, Rest::in),
+ string__first_char(Str::uo, First::in, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "{
size_t len = strlen(Rest) + 1;
MR_allocate_aligned_string_msg(Str, len, MR_PROC_LABEL);
@@ -2478,7 +2535,7 @@
strcpy(Str + 1, Rest);
}").
:- pragma foreign_proc("MC++",
- string__first_char(Str::out, First::in, Rest::in),
+ string__first_char(Str::uo, First::in, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "{
MR_String FirstStr;
FirstStr = new System::String(First, 1);
@@ -2488,6 +2545,7 @@
:- pragma promise_pure(string__first_char/3).
string__first_char(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("string__first_char").
%-----------------------------------------------------------------------------%
diff -u library/table_builtin.m library/table_builtin.m
--- library/table_builtin.m
+++ library/table_builtin.m
@@ -342,45 +342,53 @@
:- pragma promise_semipure(table_simple_is_complete/1).
table_simple_is_complete(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_is_complete").
:- pragma promise_semipure(table_simple_has_succeeded/1).
table_simple_has_succeeded(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_has_succeeded").
:- pragma promise_semipure(table_simple_has_failed/1).
table_simple_has_failed(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_has_failed").
:- pragma promise_semipure(table_simple_is_active/1).
table_simple_is_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_is_active").
:- pragma promise_semipure(table_simple_is_inactive/1).
table_simple_is_inactive(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_is_inactive").
table_simple_mark_as_succeeded(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_mark_as_succeeded").
table_simple_mark_as_failed(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_mark_as_failed").
table_simple_mark_as_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_mark_as_active").
table_simple_mark_as_inactive(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_simple_mark_as_inactive").
-
%-----------------------------------------------------------------------------%
:- interface.
@@ -529,14 +537,17 @@
").
table_io_in_range(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_io_in_range").
table_io_has_occurred(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_io_has_occurred").
table_io_copy_io_state(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("table_io_copy_io_state").
%-----------------------------------------------------------------------------%
@@ -671,6 +682,7 @@
").
table_nondet_setup(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_nondet_setup").
@@ -900,37 +912,45 @@
:- pragma promise_semipure(table_nondet_is_complete/1).
table_nondet_is_complete(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_nondet_is_complete").
:- pragma promise_semipure(table_nondet_is_active/1).
table_nondet_is_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_nondet_is_active").
table_nondet_mark_as_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
- private_builtin__imp("table_nondet_mark_as_active").
+ private_builtin__sorry("table_nondet_mark_as_active").
table_nondet_get_ans_table(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_nondet_get_ans_table").
table_nondet_answer_is_not_duplicate(_) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_nondet_answer_is_not_duplicate").
table_nondet_new_ans_slot(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_nondet_new_ans_slot").
:- pragma promise_semipure(pickup_answer_list/2).
pickup_answer_list(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("pickup_answer_list").
:- pragma promise_semipure(return_next_answer/3).
return_next_answer(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("return_next_answer").
@@ -1244,10 +1264,9 @@
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_semipure],
"
MR_TrieNode table;
@@ -1255,10 +1274,9 @@
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_semipure],
"
MR_TrieNode table;
@@ -1266,10 +1284,9 @@
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_semipure],
"
MR_TrieNode table;
@@ -1277,10 +1294,9 @@
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_semipure],
"
MR_TrieNode table;
@@ -1292,10 +1308,9 @@
#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_semipure],
"
MR_TrieNode table;
@@ -1303,10 +1318,9 @@
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_semipure],
"
MR_TrieNode table;
@@ -1329,96 +1343,118 @@
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(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_int").
table_lookup_insert_start_int(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_start_int").
table_lookup_insert_char(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_char").
table_lookup_insert_string(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_string").
table_lookup_insert_float(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_float").
table_lookup_insert_enum(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_enum").
table_lookup_insert_user(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_user").
table_lookup_insert_poly(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_lookup_insert_poly").
table_save_int_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_save_int_ans").
table_save_char_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_save_char_ans").
table_save_string_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_save_string_ans").
table_save_float_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_save_float_ans").
table_save_io_state_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_save_io_state_ans").
table_save_any_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_save_any_ans").
table_restore_int_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_restore_int_ans").
table_restore_char_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_restore_char_ans").
table_restore_string_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_restore_string_ans").
table_restore_float_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_restore_float_ans").
table_restore_io_state_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_restore_io_state_ans").
table_restore_any_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_restore_any_ans").
table_create_ans_block(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_create_ans_block").
table_report_statistics :-
+ % This version is only for if there is not a foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_report_statistics").
diff -u library/time.m library/time.m
--- library/time.m
+++ library/time.m
@@ -195,6 +195,7 @@
update_io(IO0, IO);
}").
time__c_clock(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("time__c_clock") }.
%-----------------------------------------------------------------------------%
@@ -213,6 +214,7 @@
Ret = (MR_Integer) CLOCKS_PER_SEC;
}").
time__c_clocks_per_sec(_) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("time__c_clocks_per_sec").
%-----------------------------------------------------------------------------%
@@ -252,6 +254,7 @@
update_io(IO0, IO);
}").
time__c_times(_, _, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("time__c_times") }.
@@ -279,6 +282,7 @@
update_io(IO0, IO);
}").
time__c_time(_) -->
+ % This version is only for if there is not a foreign_proc version.
{ private_builtin__sorry("time__c_time") }.
%-----------------------------------------------------------------------------%
@@ -298,6 +302,7 @@
Diff = (MR_Float) difftime((time_t) T1, (time_t) T0);
}").
time__c_difftime(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("time__c_difftime").
%-----------------------------------------------------------------------------%
@@ -337,6 +342,7 @@
N = (MR_Integer) p->tm_isdst;
}").
time__c_localtime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("time__c_localtime").
@@ -375,6 +381,7 @@
N = (MR_Integer) p->tm_isdst;
}").
time__c_gmtime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("time__c_gmtime").
:- func int_to_maybe_dst(int) = maybe(dst).
@@ -420,6 +427,7 @@
Time = (MR_Integer) mktime(&t);
}").
time__c_mktime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("time__c_mktime").
:- func maybe_dst_to_int(maybe(dst)) = int.
@@ -468,6 +476,7 @@
MR_make_aligned_string_copy(Str, s);
}").
time__c_asctime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("time__c_asctime").
%-----------------------------------------------------------------------------%
@@ -494,6 +503,7 @@
MR_make_aligned_string_copy(Str, s);
}").
time__c_ctime(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("time__c_ctime").
%-----------------------------------------------------------------------------%
diff -u library/type_desc.m library/type_desc.m
--- library/type_desc.m
+++ library/type_desc.m
@@ -477,10 +477,9 @@
% 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,33 +498,32 @@
}").
:- 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(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
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(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("has_type").
% Export this function in order to use it in runtime/mercury_trace_external.c
@@ -638,6 +636,7 @@
}").
type_ctor(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor").
:- pragma foreign_proc("C",
@@ -711,6 +710,7 @@
}").
make_type(_TypeCtorDesc::in, _ArgTypes::in) = (_TypeDesc::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("make_type/2 forward mode.").
/*
@@ -736,6 +736,7 @@
}").
make_type(_TypeCtorDesc::out, _ArgTypes::out) = (_TypeDesc::in) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("make_type/2 reverse mode").
:- pragma foreign_proc("C",
@@ -774,6 +775,7 @@
type_ctor_name_and_arity(_TypeCtorDesc::in, _ModuleName::out,
_TypeCtorName::out, _TypeCtorArity::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_name_and_arity/4").
%-----------------------------------------------------------------------------%
only in patch2:
--- configure.in 21 May 2002 14:47:41 -0000 1.309
+++ configure.in 13 Jun 2002 13:27:05 -0000
@@ -120,16 +120,13 @@
").
EOF
if
- # Test for the `--generate-mmc-deps' and
- # `--no-mercury-stdlib-dir' options.
+ # Test for the `--bug-intermod-2002-06-13' option.
echo $BOOTSTRAP_MC conftest >&AC_FD_CC 2>&1 &&
$BOOTSTRAP_MC \
- --generate-mmc-deps \
+ --bug-intermod-2002-06-13 \
--halt-at-warn $link_static_opt conftest \
</dev/null >&AC_FD_CC 2>&1 &&
- test "`./conftest 2>&1 | tr -d '\015'`" = "Hello, world" &&
- $BOOTSTRAP_MC --output-grade-string --no-mercury-stdlib-dir \
- </dev/null >&AC_FD_CC 2>&1
+ test "`./conftest 2>&1 | tr -d '\015'`" = "Hello, world"
then
AC_MSG_RESULT(yes)
else
Full diff:
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.309
diff -u -r1.309 configure.in
--- configure.in 21 May 2002 14:47:41 -0000 1.309
+++ configure.in 13 Jun 2002 13:27:05 -0000
@@ -120,16 +120,13 @@
").
EOF
if
- # Test for the `--generate-mmc-deps' and
- # `--no-mercury-stdlib-dir' options.
+ # Test for the `--bug-intermod-2002-06-13' option.
echo $BOOTSTRAP_MC conftest >&AC_FD_CC 2>&1 &&
$BOOTSTRAP_MC \
- --generate-mmc-deps \
+ --bug-intermod-2002-06-13 \
--halt-at-warn $link_static_opt conftest \
</dev/null >&AC_FD_CC 2>&1 &&
- test "`./conftest 2>&1 | tr -d '\015'`" = "Hello, world" &&
- $BOOTSTRAP_MC --output-grade-string --no-mercury-stdlib-dir \
- </dev/null >&AC_FD_CC 2>&1
+ test "`./conftest 2>&1 | tr -d '\015'`" = "Hello, world"
then
AC_MSG_RESULT(yes)
else
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.108
diff -u -r1.108 array.m
--- library/array.m 12 Jun 2002 06:46:29 -0000 1.108
+++ library/array.m 13 Jun 2002 13:27:08 -0000
@@ -725,6 +725,10 @@
#endif
").
+bounds_checks :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__bounds_checks").
+
%-----------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
@@ -786,12 +790,13 @@
}
").
-:- 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__init_2(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__init_2").
+
+array__make_empty_array(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__make_empty_array").
%-----------------------------------------------------------------------------%
@@ -821,6 +826,12 @@
Min = 0;
").
+:- pragma promise_pure(array__min/2).
+array__min(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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], "
@@ -842,6 +853,9 @@
Max = Array.Length - 1;
").
+array__max(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__max").
array__bounds(Array, Min, Max) :-
array__min(Array, Min),
@@ -871,6 +885,10 @@
Max = Array.Length;
").
+:- pragma promise_pure(array__size/2).
+array__size(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__size").
%-----------------------------------------------------------------------------%
@@ -931,6 +949,10 @@
Item = Array.GetValue(Index);
}").
+:- pragma promise_pure(array__unsafe_lookup/3).
+array__unsafe_lookup(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__unsafe_lookup").
%-----------------------------------------------------------------------------%
@@ -961,6 +983,9 @@
Array = Array0;
}").
+array__unsafe_set(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__unsafe_set").
%-----------------------------------------------------------------------------%
@@ -1039,6 +1064,9 @@
}
").
+array__resize(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__resize").
%-----------------------------------------------------------------------------%
@@ -1103,6 +1131,9 @@
System.Array.Copy(Array0, Array, Size);
").
+array__shrink_2(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__shrink_2").
%-----------------------------------------------------------------------------%
@@ -1162,13 +1193,10 @@
System.Array.Copy(Array0, Array, Array0.Length);
").
-:- 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;
-").
+:- pragma promise_pure(array__copy/2).
+array__copy(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("array__copy").
%-----------------------------------------------------------------------------%
Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.49
diff -u -r1.49 benchmarking.m
--- library/benchmarking.m 12 Jun 2002 06:46:30 -0000 1.49
+++ library/benchmarking.m 13 Jun 2002 13:27:08 -0000
@@ -76,30 +76,28 @@
"). % end pragma foreign_decl
:- pragma foreign_proc("C", report_stats,
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
ML_report_stats();
").
:- pragma foreign_proc("C", report_full_memory_stats,
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
#ifdef MR_MPROF_PROFILE_MEMORY
ML_report_full_memory_stats();
#endif
").
-:- pragma foreign_proc("MC++", report_stats,
- [will_not_call_mercury, promise_pure],
-"
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
-
-:- pragma foreign_proc("MC++", report_full_memory_stats,
- [will_not_call_mercury, promise_pure],
-"
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
+report_stats :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("report_stats").
+
+report_full_memory_stats :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("report_full_memory_stats").
%-----------------------------------------------------------------------------%
@@ -656,18 +654,22 @@
"
Time = MR_get_user_cpu_miliseconds();
").
+/* XXX Can't seem to get this to work -- perhaps Diagnositcs isn't yet
+ * available in Beta 1 of the .NET framework.
:- pragma foreign_proc("MC++",
get_user_cpu_miliseconds(_Time::out), [will_not_call_mercury],
"
// This won't return the elapsed time since program start,
// as it begins timing after the first call.
// For computing time differences it should be fine.
- // Time = (int) (1000 * System::Diagnostics::Counter::GetElapsed());
- // XXX Can't seem to get this to work -- perhaps Diagnositcs isn't
- // yet available in Beta 1 of the .NET frameworks.
-
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
+ Time = (int) (1000 * System::Diagnostics::Counter::GetElapsed());
").
+*/
+
+get_user_cpu_miliseconds(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("get_user_cpu_miliseconds").
/*
** To prevent the C compiler from optimizing the benchmark code
@@ -691,14 +693,20 @@
** 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;
+ static volatile MR_Word ML_benchmarking_dummy_word;
ML_benchmarking_dummy_word = (MR_Word) X;
-*/
").
+*/
+
+do_nothing(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("benchmaring__do_nothing").
%-----------------------------------------------------------------------------%
@@ -715,12 +723,10 @@
MR_incr_hp(Ref, 1);
* (MR_Integer *) Ref = X;
").
-:- pragma foreign_proc("MC++",
- new_int_reference(_X::in, _Ref::out), [will_not_call_mercury],
-"
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
-
+new_int_reference(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("benchmarking__new_int_reference").
:- impure pred incr_ref(int_reference::in) is det.
incr_ref(Ref) :-
@@ -729,16 +735,16 @@
:- 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, promise_semipure],
+ [will_not_call_mercury],
"
X = * (MR_Integer *) Ref;
").
-:- 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"");
-").
+ref_value(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("benchmarking__ref_value").
:- impure pred update_ref(int_reference::in, T::in) is det.
:- pragma inline(update_ref/2).
@@ -746,9 +752,9 @@
update_ref(Ref::in, X::in), [will_not_call_mercury], "
* (MR_Integer *) Ref = X;
").
-:- pragma foreign_proc("MC++",
- update_ref(_Ref::in, _X::in), [will_not_call_mercury], "
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
+update_ref(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("benchmarking__update_ref").
%-----------------------------------------------------------------------------%
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.73
diff -u -r1.73 builtin.m
--- library/builtin.m 12 Jun 2002 06:46:30 -0000 1.73
+++ library/builtin.m 13 Jun 2002 13:27:09 -0000
@@ -284,6 +284,10 @@
(Y :: out(pred(out) is semidet)),
[will_not_call_mercury, thread_safe],
"Y = X;").
+cc_cast(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("builtin__cc_cast").
:- pragma promise_pure(promise_only_solution_io/4).
promise_only_solution_io(Pred, X) -->
@@ -307,6 +311,10 @@
(Y :: out(pred(out, di, uo) is det)),
[will_not_call_mercury, thread_safe],
"Y = X;").
+cc_cast_io(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("builtin__cc_cast_io").
%-----------------------------------------------------------------------------%
Index: library/char.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/char.m,v
retrieving revision 1.37
diff -u -r1.37 char.m
--- library/char.m 12 Jun 2002 06:46:31 -0000 1.37
+++ library/char.m 13 Jun 2002 13:27:09 -0000
@@ -457,6 +457,12 @@
SUCCESS_INDICATOR = (Character == Int);
").
+:- pragma promise_pure(char__to_int/2).
+char__to_int(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("char__to_int").
+
+
% We used unsigned character codes, so the minimum character code
% is always zero.
@@ -469,13 +475,9 @@
Max = UCHAR_MAX;
").
-:- 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"");
-").
-
-
+char__max_char_value(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("char__max_char_value").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.5
diff -u -r1.5 construct.m
--- library/construct.m 12 Jun 2002 06:46:32 -0000 1.5
+++ library/construct.m 13 Jun 2002 13:27:09 -0000
@@ -102,6 +102,10 @@
MR_restore_transient_registers();
}").
+num_functors(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("construct__num_functors").
+
:- pragma foreign_proc("C",
get_functor(TypeDesc::in, FunctorNumber::in, FunctorName::out,
Arity::out, TypeInfoList::out),
@@ -155,6 +159,10 @@
SUCCESS_INDICATOR = success;
}").
+get_functor(_, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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).
@@ -180,6 +188,10 @@
SUCCESS_INDICATOR = (S == NULL);
").
+null(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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.
@@ -238,14 +250,9 @@
SUCCESS_INDICATOR = success;
}").
-:- 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;
-").
+get_functor_2(_, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("construct__get_functor_2").
:- pragma foreign_proc("C",
get_functor_ordinal(TypeDesc::in, FunctorNumber::in, Ordinal::out),
@@ -301,6 +308,10 @@
SUCCESS_INDICATOR = success;
}").
+get_functor_ordinal(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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],
@@ -507,40 +518,9 @@
SUCCESS_INDICATOR = success;
}").
-:- 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(_, _, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("construct__construct").
construct_tuple(Args) =
construct_tuple_2(Args,
@@ -589,10 +569,6 @@
MR_new_univ_on_hp(Term, type_info, new_data);
}").
-:- 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;
-}").
+construct_tuple_2(_, _, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("construct__construct_tuple_2").
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.11
diff -u -r1.11 deconstruct.m
--- library/deconstruct.m 12 Jun 2002 06:46:32 -0000 1.11
+++ library/deconstruct.m 13 Jun 2002 13:27:10 -0000
@@ -409,10 +409,12 @@
}").
functor_dna(_Term::in, _Functor::out, _Arity::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__functor_dna/3").
functor_can(Term::in, Functor::out, Arity::out) :-
rtti_implementation__deconstruct(Term, Functor, Arity, _Arguments).
functor_idcc(_Term::in, _Functor::out, _Arity::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__functor_idcc/3").
%-----------------------------------------------------------------------------%
@@ -550,18 +552,23 @@
}").
univ_arg_dna(_Term::in, _Index::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_arg_dna/3").
univ_arg_can(Term::in, Index::in, Arg::out) :-
rtti_implementation__deconstruct(Term, _Functor, _Arity, Arguments),
list__index0(Arguments, Index, Arg).
univ_arg_idcc(_Term::in, _Index::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_arg_idcc/3").
univ_named_arg_dna(_Term::in, _Name::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_named_arg_dna/3").
univ_named_arg_can(_Term::in, _Name::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_named_arg_can/3").
univ_named_arg_idcc(_Term::in, _Name::in, _Arg::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstruct__univ_named_arg_idcc/3").
%-----------------------------------------------------------------------------%
@@ -726,14 +733,17 @@
}").
deconstruct_dna(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__deconstruct_dna/4").
deconstruct_can(Term::in, Functor::out, Arity::out, Arguments::out) :-
rtti_implementation__deconstruct(Term, Functor, Arity, Arguments).
deconstruct_idcc(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__deconstruct_idcc/4").
limited_deconstruct_dna(_Term::in, _MaxArity::in,
_Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__limited_deconstruct_dna/5").
limited_deconstruct_can(Term::in, MaxArity::in,
Functor::out, Arity::out, Arguments::out) :-
@@ -741,6 +751,7 @@
Arity =< MaxArity.
limited_deconstruct_idcc(_Term::in, _MaxArity::in,
_Functor::out, _Arity::out, _Arguments::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("deconstuct__limited_deconstruct_idcc/5").
%-----------------------------------------------------------------------------%
@@ -816,12 +827,9 @@
}
}").
-:- 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"");
-").
+get_notag_functor_info(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("deconstruct__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
@@ -862,12 +870,9 @@
}
}").
-:- 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"");
-").
+get_equiv_functor_info(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("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.
@@ -896,12 +901,9 @@
}
}").
-:- 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"");
-}").
+get_enum_functor_info(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("deconstruct__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
@@ -1001,10 +1003,6 @@
}
}").
-:- 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"");
-").
+get_du_functor_info(_, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("get_du_functor_info").
Index: library/float.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/float.m,v
retrieving revision 1.46
diff -u -r1.46 float.m
--- library/float.m 12 Jun 2002 06:46:33 -0000 1.46
+++ library/float.m 13 Jun 2002 13:27:10 -0000
@@ -245,6 +245,11 @@
SUCCESS_INDICATOR = MR_TRUE;
#endif
").
+
+domain_checks :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__domain_checks").
+
%---------------------------------------------------------------------------%
%
% Conversion functions
@@ -265,6 +270,9 @@
"
Ceil = System.Convert.ToInt32(System.Math.Ceiling(X));
").
+float__ceiling_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__ceiling_to_int").
% float__floor_to_int(X) returns the
% largest integer not greater than X.
@@ -278,6 +286,9 @@
"
Floor = System.Convert.ToInt32(System.Math.Floor(X));
").
+float__floor_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ 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.
@@ -291,6 +302,9 @@
"
Round = System.Convert.ToInt32(System.Math.Floor(X + 0.5));
").
+float__round_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ 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|.
@@ -304,6 +318,9 @@
"
Trunc = System.Convert.ToInt32(X);
").
+float__truncate_to_int(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__truncate_to_int").
%---------------------------------------------------------------------------%
%
@@ -399,6 +416,9 @@
"
H = F.GetHashCode();
").
+float__hash(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__hash").
%---------------------------------------------------------------------------%
%
@@ -436,7 +456,9 @@
:- pragma foreign_proc("C#", float__max = (Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"Max = System.Double.MaxValue;").
-
+float__max = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__max").
% Minimum normalised floating-point number */
:- pragma foreign_proc("C", float__min = (Min::out),
@@ -445,6 +467,9 @@
:- pragma foreign_proc("C#", float__min = (Min::out),
[will_not_call_mercury, promise_pure, thread_safe],
"Min = System.Double.MinValue;").
+float__min = _ :=
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__min").
% Smallest x such that x \= 1.0 + x
:- pragma foreign_proc("C", float__epsilon = (Eps::out),
@@ -453,26 +478,25 @@
:- pragma foreign_proc("C#", float__epsilon = (Eps::out),
[will_not_call_mercury, promise_pure, thread_safe],
"Eps = System.Double.Epsilon;").
+float__epsilon = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ 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;").
-:- 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;
-").
+float__radix = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__radix").
% 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;").
-:- 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;
-").
+float__mantissa_digits = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__mantissa_digits").
% Minimum negative integer such that:
% radix ** (min_exponent - 1)
@@ -480,11 +504,9 @@
:- pragma foreign_proc("C", float__min_exponent = (MinExp::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MinExp = ML_FLOAT_MIN_EXP;").
-:- 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;
-").
+float__min_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__min_exponent").
% Maximum integer such that:
% radix ** (max_exponent - 1)
@@ -492,13 +514,9 @@
:- pragma foreign_proc("C", float__max_exponent = (MaxExp::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MaxExp = ML_FLOAT_MAX_EXP;").
-
-:- 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;
-").
-
+float__max_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("float__max_exponent").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: library/gc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/gc.m,v
retrieving revision 1.10
diff -u -r1.10 gc.m
--- library/gc.m 12 Jun 2002 06:46:33 -0000 1.10
+++ library/gc.m 13 Jun 2002 13:27:10 -0000
@@ -53,9 +53,10 @@
MR_garbage_collect();
#endif
").
-:- pragma foreign_proc("MC++", garbage_collect, [will_not_call_mercury], "
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
+garbage_collect :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("garbage_collect").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: library/int.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/int.m,v
retrieving revision 1.86
diff -u -r1.86 int.m
--- library/int.m 12 Jun 2002 06:46:34 -0000 1.86
+++ library/int.m 13 Jun 2002 13:27:11 -0000
@@ -343,6 +343,10 @@
#endif
").
+domain_checks :-
+ % This version is only for if there is not a foreign_proc version.
+ 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),
@@ -504,6 +508,9 @@
"
FloatVal = (MR_Float) IntVal;
").
+int__to_float(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("int__to_float").
%-----------------------------------------------------------------------------%
@@ -578,6 +585,18 @@
[will_not_call_mercury, promise_pure, thread_safe], "
Bits = ML_BITS_PER_INT;
").
+
+int__max_int(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("int__max_int").
+
+int__min_int(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("int__min_int").
+
+int__bits_per_int(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("int__bits_per_int").
int__quot_bits_per_int(Int::in) = (Result::out) :-
Result = Int // int__bits_per_int.
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.258
diff -u -r1.258 io.m
--- library/io.m 12 Jun 2002 06:46:34 -0000 1.258
+++ library/io.m 13 Jun 2002 13:27:13 -0000
@@ -1603,14 +1603,9 @@
update_io(IO0, IO);
").
-:- 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_line_as_string_2(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__read_line_as_string_2") }.
io__read_file(Result) -->
io__input_stream(Stream),
@@ -1763,7 +1758,7 @@
:- 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],
"{
@@ -1774,6 +1769,7 @@
} 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),
@@ -1785,6 +1781,10 @@
update_io(IO0, IO);
}").
+io__clear_err(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { 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.
@@ -1802,7 +1802,7 @@
% 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],
"{
@@ -1816,6 +1816,7 @@
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,6 +1828,9 @@
update_io(IO0, IO);
}").
+ferror(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("ferror") }.
% io__make_err_msg(MessagePrefix, Message):
% `Message' is an error message obtained by looking up the
@@ -1836,10 +1840,11 @@
:- 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++",
@@ -1849,6 +1854,10 @@
Msg = System::String::Concat(Msg0, MR_io_exception->Message);
}").
+make_err_msg(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__make_err_msg") }.
+
%-----------------------------------------------------------------------------%
@@ -1868,7 +1877,7 @@
").
:- 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],
"{
@@ -1891,6 +1900,7 @@
#else
Size = -1;
#endif
+ update_io(IO0, IO);
}").
:- pragma foreign_proc("MC++", io__stream_file_size(Stream::in, Size::out,
@@ -1907,6 +1917,11 @@
update_io(IO0, IO);
}").
+io__stream_file_size(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__stream_file_size") }.
+
+
io__file_modification_time(File, Result) -->
io__file_modification_time_2(File, Status, Msg, Time),
{ Status = 1 ->
@@ -1944,12 +1959,9 @@
}").
-:- 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"");
-}").
+io__file_modification_time_2(_, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__file_modification_time_2") }.
%-----------------------------------------------------------------------------%
@@ -1970,6 +1982,10 @@
MR_PROC_LABEL, ""io:buffer/0"");
}").
+io__alloc_buffer(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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,
@@ -2009,6 +2025,10 @@
Buffer = (MR_Word) buffer;
}").
+io__resize_buffer(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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),
@@ -2018,6 +2038,9 @@
Str[Len] = '\\0';
}").
+io__buffer_to_string(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("io__buffer_to_string/3").
:- pred io__buffer_to_string(buffer::di, string::uo) is det.
:- pragma foreign_proc("C",
@@ -2027,13 +2050,16 @@
Str = (MR_String) Buffer;
}").
+io__buffer_to_string(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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],
"{
@@ -2045,49 +2071,13 @@
Buffer = (MR_Word) buffer;
Pos = Pos0 + items_read;
+ update_io(IO0, IO);
}").
-:- 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"");
-}").
+io__read_into_buffer(_, _, _, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__read_into_buffer") }.
%-----------------------------------------------------------------------------%
@@ -2995,6 +2985,14 @@
update_io(IO0, IO);
").
+io__get_stream_names(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__get_stream_names") }.
+
+io__set_stream_names(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { 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.
@@ -3052,6 +3050,14 @@
update_io(IOState0, IOState);
").
+io__set_globals(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_globals") }.
+
+io__get_globals(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__get_globals") }.
+
io__progname_base(DefaultName, PrognameBase) -->
io__progname(DefaultName, Progname),
{ dir__basename(Progname, PrognameBase) }.
@@ -3093,7 +3099,9 @@
Id = mf->id;
").
-
+io__get_stream_id(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("io__get_stream_id").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -3212,21 +3220,7 @@
ascii_encoder = new System::Text::ASCIIEncoding();
").
-:- pred io__stream_init(io__state, io__state).
-:- mode io__stream_init(di, uo) is det.
-
-:- pragma foreign_proc("MC++",
- io__stream_init(IO0::di, IO::uo), [will_not_call_mercury,
- promise_pure], "
- ascii_encoder = new System::Text::ASCIIEncoding();
- update_io(IO0, IO);
-").
-
-:- pragma foreign_proc("C",
- io__stream_init(IO0::di, IO::uo), [will_not_call_mercury,
- promise_pure], "
- update_io(IO0, IO);
-").
+io__gc_init(_, _) --> [].
:- pred io__insert_std_stream_names(io__state, io__state).
:- mode io__insert_std_stream_names(di, uo) is det.
@@ -3967,6 +3961,17 @@
update_io(IO0, IO);
}").
+io__read_char_code(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__read_char_code") }.
+
+io__putback_char(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__putback_char") }.
+
+io__putback_byte(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__putback_byte") }.
/* output predicates - with output to mercury_current_text_output */
@@ -4126,6 +4131,37 @@
update_io(IO0, IO);
").
+io__write_string(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_string") }.
+
+io__write_char(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_char") }.
+
+io__write_int(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_int") }.
+
+io__write_float(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_float") }.
+
+io__write_byte(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_byte") }.
+
+io__write_bytes(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_bytes") }.
+
+io__flush_output -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__flush_output") }.
+
+io__flush_binary_output -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__flush_binary_output") }.
/* moving about binary streams */
@@ -4158,8 +4194,7 @@
mercury_io_error(stream,
""io__seek_binary_2: unseekable stream"");
}
-
- IO = IO0;
+ update_io(IO0, IO);
}").
:- pragma foreign_proc("C",
@@ -4177,29 +4212,16 @@
mercury_io_error(stream,
""io__binary_stream_offset: untellable stream"");
}
- IO = IO0;
-}").
-
-:- 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;
+ update_io(IO0, IO);
}").
+io__seek_binary_2(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__seek_binary_2") }.
+
+io__binary_stream_offset(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__binary_stream_offset") }.
/* output predicates - with output to the specified stream */
@@ -4385,6 +4407,37 @@
update_io(IO0, IO);
}").
+io__write_string(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_string") }.
+
+io__write_char(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_char") }.
+
+io__write_int(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_int") }.
+
+io__write_float(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_float") }.
+
+io__write_byte(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_byte") }.
+
+io__write_bytes(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__write_bytes") }.
+
+io__flush_output(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__flush_output") }.
+
+io__flush_binary_output(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__flush_binary_output") }.
/* stream predicates */
@@ -4799,6 +4852,105 @@
update_io(IO0, IO);
").
+io__stdin_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__stdin_stream") }.
+
+io__stdout_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__stdout_stream") }.
+
+io__stderr_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__stderr_stream") }.
+
+io__stdin_binary_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__stdin_binary_stream") }.
+
+io__stdout_binary_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__stdout_binary_stream") }.
+
+io__input_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__input_stream") }.
+
+io__output_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__output_stream") }.
+
+io__binary_input_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__binary_input_stream") }.
+
+io__binary_output_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__binary_output_stream") }.
+
+io__get_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__get_line_number") }.
+
+io__get_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__get_line_number") }.
+
+io__set_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_line_number") }.
+
+io__set_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_line_number") }.
+
+io__get_output_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__get_output_line_number") }.
+
+io__get_output_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__get_output_line_number") }.
+
+io__set_output_line_number(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_output_line_number") }.
+
+io__set_output_line_number(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_output_line_number") }.
+
+io__current_input_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__current_input_stream") }.
+
+io__current_output_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__current_output_stream") }.
+
+io__current_binary_input_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__current_binary_input_stream") }.
+
+io__current_binary_output_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__current_binary_output_stream") }.
+
+io__set_input_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_input_stream") }.
+
+io__set_output_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_output_stream") }.
+
+io__set_binary_input_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_binary_input_stream") }.
+
+io__set_binary_output_stream(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_binary_output_stream") }.
/* stream open/close predicates */
@@ -4828,6 +4980,10 @@
update_io(IO0, IO);
").
+io__do_open(_, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__do_open") }.
+
io__close_input(Stream) -->
io__delete_stream_name(Stream),
io__close_stream(Stream).
@@ -4860,12 +5016,11 @@
update_io(IO0, IO);
").
-/* miscellaneous predicates */
+io__close_stream(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__close_stream") }.
-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.
+/* miscellaneous predicates */
:- pragma foreign_proc("C",
io__progname(DefaultProgname::in, PrognameOut::out, IO0::di, IO::uo),
@@ -4945,6 +5100,11 @@
").
+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 ->
@@ -5026,6 +5186,7 @@
update_io(IO0, IO);
").
+/* XXX Implementation needs to be finished.
:- pragma foreign_proc("MC++",
io__call_system_code(Command::in, Status::out, _Msg::out,
IO0::di, IO::uo),
@@ -5041,25 +5202,31 @@
Status = NULL;
update_io(IO0, IO);
").
+*/
-io__current_input_stream(_::out, _::di, _::uo) :-
- private_builtin__sorry("io__current_input_stream/3").
-
-io__current_output_stream(_::out, _::di, _::uo) :-
- private_builtin__sorry("io__current_output_stream/3").
-
-io__current_binary_input_stream(_::out, _::di, _::uo) :-
- private_builtin__sorry("io__current_binary_input_stream/3").
-
-io__current_binary_output_stream(_::out, _::di, _::uo) :-
- private_builtin__sorry("io__current_binary_output_stream/3").
+io__command_line_arguments(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__command_line_arguments") }.
+
+io__get_exit_status(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__get_exit_status") }.
+
+io__set_exit_status(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__set_exit_status") }.
+
+io__call_system_code(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__call_system_code") }.
/*---------------------------------------------------------------------------*/
/* 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, promise_semipure, tabled_for_io],
+ [will_not_call_mercury, tabled_for_io],
"{
Value = getenv(Var);
SUCCESS_INDICATOR = (Value != 0);
@@ -5072,7 +5239,7 @@
").
:- pragma foreign_proc("MC++", io__getenv(Var::in, Value::out),
- [will_not_call_mercury, promise_semipure, tabled_for_io],
+ [will_not_call_mercury, tabled_for_io],
"{
Value = System::Environment::GetEnvironmentVariable(Var);
SUCCESS_INDICATOR = (Value != 0);
@@ -5086,6 +5253,15 @@
SUCCESS_INDICATOR = 0;
").
+io__getenv(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("io__getenv").
+
+io__putenv(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("io__putenv").
/*---------------------------------------------------------------------------*/
@@ -5203,15 +5379,9 @@
update_io(IO0, IO);
}").
-:- 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);
-}").
-
+io__do_make_temp(_, _, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__do_make_temp") }.
/*---------------------------------------------------------------------------*/
@@ -5282,6 +5452,7 @@
update_io(IO0, IO);
}").
+/* XXX Implementation needs to be finished.
:- pragma foreign_proc("MC++",
io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
IO0::di, IO::uo),
@@ -5294,7 +5465,11 @@
RetStr = """";
update_io(IO0, IO);
}").
+*/
+io__remove_file_2(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { 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),
@@ -5319,16 +5494,9 @@
update_io(IO0, IO);
}").
-:- 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);
-}").
-
+io__rename_file_2(_, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("io__rename_file_2") }.
/*---------------------------------------------------------------------------*/
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.63
diff -u -r1.63 library.m
--- library/library.m 12 Jun 2002 06:46:36 -0000 1.63
+++ library/library.m 13 Jun 2002 13:27:13 -0000
@@ -76,5 +76,9 @@
Version = MR_VERSION "", configured for "" MR_FULLARCH;
").
+library__version(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("library__version").
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: library/math.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/math.m,v
retrieving revision 1.40
diff -u -r1.40 math.m
--- library/math.m 12 Jun 2002 06:46:36 -0000 1.40
+++ library/math.m 13 Jun 2002 13:27:14 -0000
@@ -264,6 +264,11 @@
#endif
").
+domain_checks :-
+ % This version is only for if there is not a foreign_proc version.
+ semidet_succeed,
+ private_builtin__sorry("domain_checks").
+
%
% Mathematical constants from math.m
%
@@ -277,6 +282,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Pi = System.Math.PI;
").
+math__pi = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__pi").
% Base of natural logarithms
:- pragma foreign_proc("C", math__e = (E::out),
@@ -287,6 +295,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
E = System.Math.E;
").
+math__e = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__e").
%
% math__ceiling(X) = Ceil is true if Ceil is the smallest integer
@@ -302,6 +313,9 @@
"
Ceil = System.Math.Ceiling(Num);
").
+math__ceiling(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__ceiling").
%
% math__floor(X) = Floor is true if Floor is the largest integer
@@ -317,6 +331,9 @@
"
Floor = System.Math.Floor(Num);
").
+math__floor(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__floor").
%
% math__round(X) = Round is true if Round is the integer
@@ -335,6 +352,9 @@
// Unfortunately they are better (round to nearest even number).
Rounded = System.Math.Floor(Num+0.5);
").
+math__round(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__round").
%
% math__truncate(X) = Trunc is true if Trunc is the integer
@@ -366,7 +386,9 @@
[thread_safe, promise_pure], "
SquareRoot = System.Math.Sqrt(X);
").
-
+math__sqrt_2(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__sqrt_2").
%
% math__solve_quadratic(A, B, C) = Roots is true if Roots are
@@ -443,6 +465,9 @@
[thread_safe, promise_pure], "
Res = System.Math.Pow(X, Y);
").
+math__pow_2(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__pow_2").
%
@@ -457,6 +482,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Exp = System.Math.Exp(X);
").
+math__exp(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__exp").
%
% math__ln(X) = Log is true if Log is the natural logarithm
@@ -482,6 +510,9 @@
[thread_safe, promise_pure], "
Log = System.Math.Log(X);
").
+math__ln_2(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__ln_2").
%
% math__log10(X) = Log is true if Log is the logarithm to
@@ -507,6 +538,9 @@
[thread_safe, promise_pure], "
Log10 = System.Math.Log10(X);
").
+math__log10_2(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__log10_2").
%
% math__log2(X) = Log is true if Log is the logarithm to
@@ -532,6 +566,9 @@
[thread_safe, promise_pure], "
Log2 = System.Math.Log(X) / ML_FLOAT_LN2;
").
+math__log2_2(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__log2_2").
%
% math__log(B, X) = Log is true if Log is the logarithm to
@@ -565,6 +602,9 @@
[thread_safe, promise_pure], "
Log = System.Math.Log(X,B);
").
+math__log_2(_, _) = _ -
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__log_2").
%
@@ -578,6 +618,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Sin = System.Math.Sin(X);
").
+math__sin(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__sin").
%
@@ -591,6 +634,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Cos = System.Math.Cos(X);
").
+math__cos(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__cos").
%
% math__tan(X) = Tan is true if Tan is the tangent of X.
@@ -603,6 +649,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Tan = System.Math.Tan(X);
").
+math__tan(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__tan").
%
% math__asin(X) = ASin is true if ASin is the inverse
@@ -633,6 +682,9 @@
[thread_safe, promise_pure], "
ASin = System.Math.Asin(X);
").
+math__asin_2(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__asin_2").
%
% math__acos(X) = ACos is true if ACos is the inverse
@@ -663,6 +715,9 @@
[thread_safe, promise_pure], "
ACos = System.Math.Acos(X);
").
+math__acos_2(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__acos_2").
%
@@ -677,6 +732,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
ATan = System.Math.Atan(X);
").
+math__atan(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__atan").
%
% math__atan2(Y, X) = ATan is true if ATan is the inverse
@@ -690,6 +748,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "
ATan2 = System.Math.Atan2(Y, X);
").
+math__atan2(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__atan2").
%
% math__sinh(X) = Sinh is true if Sinh is the hyperbolic
@@ -703,6 +764,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Sinh = System.Math.Sinh(X);
").
+math__sinh(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__sinh").
%
% math__cosh(X) = Cosh is true if Cosh is the hyperbolic
@@ -716,6 +780,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Cosh = System.Math.Cosh(X);
").
+math__cosh(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__cosh").
%
% math__tanh(X) = Tanh is true if Tanh is the hyperbolic
@@ -729,6 +796,9 @@
[will_not_call_mercury, promise_pure, thread_safe],"
Tanh = System.Math.Tanh(X);
").
+math__tanh(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("math__tanh").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.103
diff -u -r1.103 private_builtin.m
--- library/private_builtin.m 12 Jun 2002 06:46:37 -0000 1.103
+++ library/private_builtin.m 13 Jun 2002 13:27:15 -0000
@@ -169,8 +169,11 @@
"
Res = System::String::Compare(S1, S2);
").
-
+builtin_strcmp(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ sorry("builtin_strcmp").
+
builtin_unify_float(F, F).
builtin_compare_float(R, F1, F2) :-
@@ -876,6 +879,22 @@
TypeClassInfo =
MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
").
+
+type_info_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ sorry("type_info_from_typeclass_info").
+
+unconstrained_type_info_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ sorry("unconstrained_type_info_from_typeclass_info").
+
+superclass_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ sorry("superclass_from_typeclass_info").
+
+instance_constraint_from_typeclass_info(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ sorry("instance_constraint_from_typeclass_info").
%-----------------------------------------------------------------------------%
Index: library/profiling_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/profiling_builtin.m,v
retrieving revision 1.7
diff -u -r1.7 profiling_builtin.m
--- library/profiling_builtin.m 12 Jun 2002 06:46:39 -0000 1.7
+++ library/profiling_builtin.m 13 Jun 2002 13:27:15 -0000
@@ -1619,292 +1619,181 @@
#undef MR_REC_DEPTH_BODY
}").
-:- 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"");
-}").
+:- import_module std_util.
+
+% These versions are only for if there is not a foreign_proc version.
+
+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").
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.18
diff -u -r1.18 rtti_implementation.m
--- library/rtti_implementation.m 12 Jun 2002 06:46:39 -0000 1.18
+++ library/rtti_implementation.m 13 Jun 2002 13:27:15 -0000
@@ -140,6 +140,10 @@
TypeInfo = TypeInfo_for_T;
").
+get_type_info(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("get_type_info").
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1088,6 +1092,10 @@
(MR_TypeInfo) TypeInfo);
").
+get_type_ctor_info(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ 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.
@@ -1106,7 +1114,9 @@
"
SUCCESS_INDICATOR = (T1 == T2);
").
-
+same_pointer_value_untyped(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("same_pointer_value_untyped").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1395,6 +1405,9 @@
MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
Arity = tci->MR_type_ctor_arity;
").
+type_ctor_arity(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_ctor_arity").
:- some [P] func type_ctor_unify_pred(type_ctor_info) = P.
:- pragma foreign_proc("C#",
@@ -1411,6 +1424,9 @@
MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
UnifyPred = (MR_Integer) tci->MR_type_ctor_unify_pred;
").
+type_ctor_unify_pred(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_ctor_unify_pred").
:- some [P] func type_ctor_compare_pred(type_ctor_info) = P.
:- pragma foreign_proc("C#",
@@ -1427,6 +1443,9 @@
MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
UnifyPred = (MR_Integer) tci->MR_type_ctor_compare_pred;
").
+type_ctor_compare_pred(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_ctor_compare_pred").
@@ -1447,6 +1466,9 @@
MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
TypeCtorRep = MR_type_ctor_rep(tci);
").
+type_ctor_rep(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_ctor_rep").
:- func type_ctor_module_name(type_ctor_info) = string.
@@ -1468,7 +1490,9 @@
Name = (MR_String) MR_type_ctor_module_name(tci);
").
-
+type_ctor_module_name(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_ctor_module_name").
:- func type_ctor_name(type_ctor_info) = string.
@@ -1487,6 +1511,9 @@
Name = (MR_String) MR_type_ctor_name(tci);
").
+type_ctor_name(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_ctor_name").
:- func type_layout(type_ctor_info) = type_layout.
@@ -1505,6 +1532,10 @@
TypeLayout = (MR_Word) &(MR_type_ctor_layout(tci));
").
+type_layout(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_layout").
+
:- pragma foreign_proc("C",
unsafe_cast(VarIn::in) = (VarOut::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1517,6 +1548,10 @@
"
VarOut = VarIn;
").
+
+unsafe_cast(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("unsafe_cast").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/sparse_bitset.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/sparse_bitset.m,v
retrieving revision 1.14
diff -u -r1.14 sparse_bitset.m
--- library/sparse_bitset.m 12 Jun 2002 06:46:39 -0000 1.14
+++ library/sparse_bitset.m 13 Jun 2002 13:27:16 -0000
@@ -792,6 +792,10 @@
mercury.runtime.LowLevelData.set_MR_Word_field(Pair, 2, B);
}").
+make_bitset_elem(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("make_bitset_elem").
+
%-----------------------------------------------------------------------------%
init(init).
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.270
diff -u -r1.270 std_util.m
--- library/std_util.m 12 Jun 2002 06:46:40 -0000 1.270
+++ library/std_util.m 13 Jun 2002 13:27:17 -0000
@@ -1064,6 +1064,10 @@
").
+get_registers(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("get_registers").
+
:- impure pred check_for_floundering(trail_ptr::in) is det.
:- pragma foreign_proc("C",
@@ -1085,6 +1089,10 @@
#endif
").
+check_for_floundering(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("check_for_floundering").
+
%
% Discard the topmost trail ticket.
%
@@ -1108,6 +1116,10 @@
#endif
").
+discard_trail_ticket :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("discard_trail_ticket").
+
%
% Swap the heap with the solutions heap
%
@@ -1141,6 +1153,10 @@
*/
").
+swap_heap_and_solutions_heap :-
+ % This version is only for if there is not a foreign_proc version.
+ 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
@@ -1223,6 +1239,10 @@
NewVal = OldVal;
").
+partial_deep_copy(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("partial_deep_copy").
+
%
% reset_solutions_heap(SolutionsHeapPtr):
% Reset the solutions heap pointer to the specified value,
@@ -1233,7 +1253,7 @@
:- pragma foreign_proc("C",
reset_solutions_heap(SolutionsHeapPtr::in),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
#ifdef MR_RECLAIM_HP_ON_FAILURE
MR_sol_hp = (MR_Word *) SolutionsHeapPtr;
@@ -1242,7 +1262,7 @@
:- pragma foreign_proc("MC++",
reset_solutions_heap(_SolutionsHeapPtr::in),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
/*
** For the IL back-end, we don't have a separate `solutions heap'.
@@ -1250,6 +1270,11 @@
*/
").
+reset_solutions_heap(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("reset_solutions_heap").
+
%-----------------------------------------------------------------------------%
%%% :- module mutvar.
@@ -1353,6 +1378,16 @@
Ref[0] = X;
").
+new_mutvar(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("new_mutvar").
+get_mutvar(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("get_mutvar").
+set_mutvar(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("set_mutvar").
+
%%% end_module mutvar.
%-----------------------------------------------------------------------------%
@@ -1434,6 +1469,14 @@
cc_multi_equal(X::di, Y::uo),
[will_not_call_mercury, thread_safe, promise_pure],
"Y = X;").
+
+semidet_succeed :-
+ true.
+semidet_fail :-
+ fail.
+
+:- pragma promise_pure(cc_multi_equal/2).
+cc_multi_equal(X, X).
%-----------------------------------------------------------------------------%
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.33
diff -u -r1.33 store.m
--- library/store.m 12 Jun 2002 06:46:43 -0000 1.33
+++ library/store.m 13 Jun 2002 13:27:18 -0000
@@ -253,6 +253,10 @@
:- pragma foreign_proc("C", store__do_init(_S0::uo),
[will_not_call_mercury, promise_pure], "").
+store__do_init(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("store__do_init").
+
/*
Note -- the syntax for the operations on stores
might be nicer if we used some new operators, e.g.
@@ -292,6 +296,18 @@
S = S0;
").
+new_mutvar(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__new_mutvar") }.
+
+get_mutvar(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__get_mutvar") }.
+
+set_mutvar(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { 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.
@@ -303,6 +319,10 @@
S = S0;
").
+unsafe_new_uninitialized_mutvar(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("unsafe_new_uninitialized_mutvar") }.
+
store__new_cyclic_mutvar(Func, MutVar) -->
store__unsafe_new_uninitialized_mutvar(MutVar),
{ Value = apply(Func, MutVar) },
@@ -318,6 +338,10 @@
S = S0;
").
+new_ref(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__new_ref") }.
+
copy_ref_value(Ref, Val) -->
/* XXX need to deep-copy non-atomic types */
unsafe_ref_value(Ref, Val).
@@ -335,6 +359,10 @@
S = S0;
").
+store__unsafe_ref_value(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__unsafe_ref_value") }.
+
ref_functor(Ref, Functor, Arity) -->
unsafe_ref_value(Ref, Val),
{ functor(Val, Functor, Arity) }.
@@ -449,6 +477,26 @@
Val = * (MR_Word *) Ref;
").
+arg_ref(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__arg_ref") }.
+
+new_arg_ref(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__new_arg_ref") }.
+
+set_ref(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__set_ref") }.
+
+set_ref_value(_, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__set_ref_value") }.
+
+extract_ref_value(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("store__extract_ref_value").
+
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
@@ -471,96 +519,11 @@
S = S0;
}").
-%-----------------------------------------------------------------------------%
-
-:- 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"");
-}").
-
-
+unsafe_arg_ref(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__unsafe_arg_ref") }.
+
+unsafe_new_arg_ref(_, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("store__unsafe_new_arg_ref") }.
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.170
diff -u -r1.170 string.m
--- library/string.m 12 Jun 2002 06:46:44 -0000 1.170
+++ library/string.m 13 Jun 2002 13:27:19 -0000
@@ -89,10 +89,10 @@
:- pred string__first_char(string, char, string).
:- mode string__first_char(in, in, in) is semidet. % implied
-:- mode string__first_char(in, out, in) is semidet. % implied
-:- mode string__first_char(in, in, out) is semidet. % implied
-:- mode string__first_char(in, out, out) is semidet.
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(in, uo, in) is semidet. % implied
+:- mode string__first_char(in, in, uo) is semidet. % implied
+:- mode string__first_char(in, uo, uo) is semidet.
+:- mode string__first_char(uo, in, in) is det.
% string__first_char(String, Char, Rest) is true iff
% Char is the first character of String, and Rest is the
% remainder.
@@ -142,8 +142,8 @@
:- func string__to_char_list(string) = list(char).
:- pred string__to_char_list(string, list(char)).
-:- mode string__to_char_list(in, out) is det.
-:- mode string__to_char_list(out, in) is det.
+:- mode string__to_char_list(in, uo) is det.
+:- mode string__to_char_list(uo, in) is det.
:- func string__from_char_list(list(char)) = string.
:- pred string__from_char_list(list(char), string).
@@ -461,7 +461,6 @@
:- import_module bool, std_util, int, float, require.
:- pred string__to_int_list(string, list(int)).
-:- mode string__to_int_list(out, in) is det.
:- mode string__to_int_list(in, out) is det.
string__replace(String, SubString0, SubString1, StringOut) :-
@@ -623,17 +622,16 @@
string__split(String, LeftCount, _LeftString, RightString).
string__remove_suffix(A, B, C) :-
- string__to_int_list(A, LA),
- string__to_int_list(B, LB),
- string__to_int_list(C, LC),
+ string__to_char_list(A, LA),
+ string__to_char_list(B, LB),
+ string__to_char_list(C, LC),
list__remove_suffix(LA, LB, LC).
string__prefix(String, Prefix) :-
string__append(Prefix, _, String).
string__char_to_string(Char, String) :-
- string__to_int_list(String, [Code]),
- char__to_int(Char, Code).
+ string__to_char_list(String, [Char]).
string__int_to_string(N, Str) :-
string__int_to_base_string(N, 10, Str).
@@ -692,11 +690,12 @@
/*
:- pred string__to_char_list(string, list(char)).
-:- mode string__to_char_list(in, out) is det.
-:- mode string__to_char_list(out, in) is det.
+:- mode string__to_char_list(in, uo) is det.
+:- mode string__to_char_list(uo, in) is det.
*/
-:- pragma foreign_proc("C", string__to_char_list(Str::in, CharList::out),
+:- pragma promise_pure(string__to_char_list/2).
+:- pragma foreign_proc("C", string__to_char_list(Str::in, CharList::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
MR_ConstString p = Str + strlen(Str);
CharList = MR_list_empty_msg(MR_PROC_LABEL);
@@ -707,9 +706,9 @@
}
}").
-:- pragma foreign_proc("C", string__to_char_list(Str::out, CharList::in),
+:- pragma foreign_proc("C", string__to_char_list(Str::uo, CharList::in),
[will_not_call_mercury, promise_pure, thread_safe], "{
- /* mode (out, in) is det */
+ /* mode (uo, in) is det */
MR_Word char_list_ptr;
size_t size;
/*
@@ -743,6 +742,56 @@
Str[size] = '\\0';
}").
+:- pragma foreign_proc("MC++", string__to_char_list(Str::in, CharList::uo),
+ [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::uo, 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(Str::in, CharList::uo) :-
+ ( string__first_char(Str, First, Rest) ->
+ string__to_char_list(Rest, CharList0),
+ CharList = [First | CharList0]
+ ;
+ CharList = []
+ ).
+string__to_char_list(Str::uo, CharList::in) :-
+ ( CharList = [],
+ Str = ""
+ ; CharList = [C | Cs],
+ string__to_char_list(Str0, Cs),
+ Str = string__char_to_string(C) ++ Str0
+ ).
+
/*-----------------------------------------------------------------------*/
%
@@ -1116,6 +1165,20 @@
Index = WholeString->IndexOf(SubString);
}").
+string__sub_string_search(String, SubString, Index) :-
+ string__sub_string_search_2(String, SubString, 0, Index).
+
+:- pred sub_string_search_2(string::in, string::in,
+ int::in, int::out) is semidet.
+
+sub_string_search_2(String, SubString, CurrentIndex, Index) :-
+ ( string__prefix(String, SubString) ->
+ Index = CurrentIndex
+ ;
+ string__first_char(String, _, Rest),
+ sub_string_search_2(Rest, SubString, CurrentIndex + 1, Index)
+ ).
+
%-----------------------------------------------------------------------------%
% This predicate has been optimised to produce the least memory
@@ -1486,6 +1549,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "
SUCCESS_INDICATOR = MR_FALSE;
").
+using_sprintf :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("string__using_sprintf").
% Construct a format string suitable to passing to sprintf.
@@ -1560,6 +1626,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "{
LengthModifier = """";
}").
+int_length_modifer = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("int_length_modifer").
% Create a string from a float using the format string.
@@ -1578,6 +1647,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "{
Str = System.String.Format(FormatStr, Val);
}").
+format_float(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ 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
@@ -1595,6 +1667,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "{
Str = System.String.Format(FormatStr, Val);
}").
+format_int(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ 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
@@ -1610,6 +1685,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "{
Str = System.String.Format(FormatStr, Val);
}").
+format_string(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ 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
@@ -1627,7 +1705,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "{
Str = System.String.Format(FormatStr, Val);
}").
-
+format_char(_, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("format_char").
%-----------------------------------------------------------------------------%
@@ -1659,6 +1739,11 @@
FloatString = System::Convert::ToString(FloatVal);
}").
+string__float_to_string(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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.
@@ -1673,6 +1758,16 @@
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(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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], "{
@@ -1708,14 +1803,16 @@
}
}").
+string__to_float(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("string__to_float").
+
/*-----------------------------------------------------------------------*/
/*
:- pred string__to_int_list(string, list(int)).
:- mode string__to_int_list(in, out) is det.
-:- mode string__to_int_list(out, in) is det.
*/
-
:- pragma foreign_proc("C",
string__to_int_list(Str::in, IntList::out),
[will_not_call_mercury, promise_pure, thread_safe], "{
@@ -1727,45 +1824,6 @@
MR_PROC_LABEL);
}
}").
-
-:- pragma foreign_proc("C",
- string__to_int_list(Str::out, IntList::in),
- [will_not_call_mercury, promise_pure, thread_safe], "{
- /* mode (out, in) is det */
- MR_Word int_list_ptr;
- size_t size;
- MR_Word str_ptr;
-/*
-** loop to calculate list length + sizeof(MR_Word) in `size' using list in
-** `int_list_ptr'
-*/
- size = sizeof(MR_Word);
- int_list_ptr = IntList;
- while (! MR_list_is_empty(int_list_ptr)) {
- size++;
- int_list_ptr = MR_list_tail(int_list_ptr);
- }
-/*
-** allocate (length + 1) bytes of heap space for string
-** i.e. (length + 1 + sizeof(MR_Word) - 1) / sizeof(MR_Word) words
-*/
- MR_allocate_aligned_string_msg(Str, size, MR_PROC_LABEL);
-
-/*
-** loop to copy the characters from the int_list to the string
-*/
- size = 0;
- int_list_ptr = IntList;
- while (! MR_list_is_empty(int_list_ptr)) {
- Str[size++] = MR_list_head(int_list_ptr);
- int_list_ptr = MR_list_tail(int_list_ptr);
- }
-/*
-** null terminate the string
-*/
- Str[size] = '\\0';
-}").
-
:- pragma foreign_proc("MC++",
string__to_int_list(Str::in, IntList::out),
[will_not_call_mercury, promise_pure, thread_safe], "{
@@ -1783,25 +1841,9 @@
}
IntList = tmp;
}").
-
-:- pragma foreign_proc("MC++",
- string__to_int_list(Str::out, IntList::in),
- [will_not_call_mercury, promise_pure, thread_safe], "{
- System::Text::StringBuilder *tmp;
-
- tmp = new System::Text::StringBuilder();
- while (1) {
- if (System::Convert::ToInt32(IntList->GetValue(0))) {
- tmp->Append(System::Convert::ToChar(
- IntList->GetValue(1)));
- IntList = dynamic_cast<MR_Word>(IntList->GetValue(2));
- } else {
- break;
- }
- }
- Str = tmp->ToString();
-}").
-
+string__to_int_list(String, IntList) :-
+ string__to_char_list(String, CharList),
+ IntList = list__map(char__to_int, CharList).
/*-----------------------------------------------------------------------*/
@@ -1817,6 +1859,13 @@
[will_not_call_mercury, promise_pure, thread_safe], "
SUCCESS_INDICATOR = (Str->IndexOf(Ch) != -1);
").
+string__contains_char(String, Char) :-
+ string__first_char(String, FirstChar, RestOfString),
+ ( FirstChar = Char ->
+ true
+ ;
+ string__contains_char(RestOfString, Char)
+ ).
/*-----------------------------------------------------------------------*/
@@ -1853,6 +1902,13 @@
Ch = Str->get_Chars(Index);
}
").
+string__index(Str, Index, Char) :-
+ string__first_char(Str, First, Rest),
+ ( Index = 0 ->
+ Char = First
+ ;
+ string__index(Rest, Index - 1, Char)
+ ).
/*-----------------------------------------------------------------------*/
@@ -1866,6 +1922,9 @@
[will_not_call_mercury, promise_pure, thread_safe], "
Ch = Str->get_Chars(Index);
").
+string__unsafe_index(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("string__unsafe_index").
/*-----------------------------------------------------------------------*/
@@ -1915,6 +1974,10 @@
SUCCESS_INDICATOR = MR_TRUE;
}
").
+string__set_char(Ch, Index, Str0, Str) :-
+ string__to_char_list(Str0, List0),
+ list__replace_nth(List0, Index + 1, Ch, List),
+ string__to_char_list(Str, List).
/*
:- pred string__set_char(char, int, string, string).
@@ -1968,6 +2031,9 @@
System::Convert::ToString(Ch),
Str0->Substring(Index + 1));
").
+string__unsafe_set_char(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("string__unsafe_set_char").
/*
:- pred string__unsafe_set_char(char, int, string, string).
@@ -2021,6 +2087,22 @@
Length = Str->get_Length();
").
+:- pragma promise_pure(string__length/2).
+string__length(Str::in, Len::uo) :-
+ string__length_2(Str, Len).
+string__length(Str0::ui, Len::uo) :-
+ copy(Str0, Str),
+ string__length_2(Str, Len).
+
+:- pred string__length_2(string::in, int::uo) is det.
+string__length_2(Str, Length) :-
+ ( string__first_char(Str, _First, Rest) ->
+ string__length(Rest, Length0),
+ Length = Length0 + 1
+ ;
+ Length = 0
+ ).
+
/*-----------------------------------------------------------------------*/
:- pragma promise_pure(string__append/3).
@@ -2052,6 +2134,9 @@
SUCCESS_INDICATOR = S3->Equals(System::String::Concat(S1, S2));
}").
+string__append_iii(X, Y, Z) :-
+ string__mercury_append(X, Y, Z).
+
:- pred string__append_ioi(string::in, string::out, string::in) is semidet.
:- pragma foreign_proc("C",
@@ -2086,6 +2171,9 @@
}
}").
+string__append_ioi(X, Y, Z) :-
+ string__mercury_append(X, Y, Z).
+
:- pred string__append_iio(string::in, string::in, string::uo) is det.
:- pragma foreign_proc("C",
@@ -2105,6 +2193,9 @@
S3 = System::String::Concat(S1, S2);
}").
+string__append_iio(X, Y, Z) :-
+ string__mercury_append(X, Y, Z).
+
:- pred string__append_ooi(string::out, string::out, string::in) is multi.
string__append_ooi(S1, S2, S3) :-
@@ -2148,6 +2239,21 @@
S2 = S3->Substring(S1Len);
").
+string__append_ooi_3(S1Len, _S3Len, S1, S2, S3) :-
+ string__split(S3, S1Len, S1, S2).
+
+:- pred string__mercury_append(string, string, string).
+:- mode string__mercury_append(in, in, in) is semidet. % implied
+:- mode string__mercury_append(in, uo, in) is semidet.
+:- mode string__mercury_append(in, in, uo) is det.
+:- mode string__mercury_append(uo, uo, in) is multi.
+
+string__mercury_append(X, Y, Z) :-
+ string__to_char_list(X, XList),
+ string__to_char_list(Y, YList),
+ string__to_char_list(Z, ZList),
+ list__append(XList, YList, ZList).
+
/*-----------------------------------------------------------------------*/
/*
@@ -2214,7 +2320,9 @@
SubString = Str->Substring(Start, Count);
}").
-
+string__unsafe_substring(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("string__unsafe_substring").
/*
:- pred string__split(string, int, string, string).
@@ -2269,16 +2377,36 @@
}
}").
+string__split(Str, Count, Left, Right) :-
+ ( Count =< 0 ->
+ Left = "",
+ Right = Str
+ ;
+ string__to_char_list(Str, List),
+ Len = list__length(List),
+ ( Count > Len ->
+ Num = Len
+ ;
+ Num = Count
+ ),
+ ( list__split_list(Num, List, LeftList, RightList) ->
+ string__to_char_list(Left, LeftList),
+ string__to_char_list(Right, RightList)
+ ;
+ error("string__split")
+ )
+ ).
+
/*-----------------------------------------------------------------------*/
/*
:- pred string__first_char(string, char, string).
:- mode string__first_char(in, in, in) is semidet. % implied
-:- mode string__first_char(in, out, in) is semidet. % implied
-:- mode string__first_char(in, in, out) is semidet. % implied
-:- mode string__first_char(in, out, out) is semidet.
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(in, uo, in) is semidet. % implied
+:- mode string__first_char(in, in, uo) is semidet. % implied
+:- mode string__first_char(in, uo, uo) is semidet.
+:- mode string__first_char(uo, in, in) is det.
% string__first_char(String, Char, Rest) is true iff
% Char is the first character of String, and Rest is the
% remainder.
@@ -2308,16 +2436,16 @@
").
/*
-:- mode string__first_char(in, out, in) is semidet. % implied
+:- mode string__first_char(in, uo, in) is semidet. % implied
*/
:- pragma foreign_proc("C",
- string__first_char(Str::in, First::out, Rest::in),
+ string__first_char(Str::in, First::uo, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "
First = Str[0];
SUCCESS_INDICATOR = (First != '\\0' && strcmp(Str + 1, Rest) == 0);
").
:- pragma foreign_proc("MC++",
- string__first_char(Str::in, First::out, Rest::in),
+ string__first_char(Str::in, First::uo, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "
MR_Integer len = Str->get_Length();
if (len > 0) {
@@ -2330,10 +2458,10 @@
").
/*
-:- mode string__first_char(in, in, out) is semidet. % implied
+:- mode string__first_char(in, in, uo) is semidet. % implied
*/
:- pragma foreign_proc("C",
- string__first_char(Str::in, First::in, Rest::out),
+ string__first_char(Str::in, First::in, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
if (Str[0] != First || First == '\\0') {
SUCCESS_INDICATOR = MR_FALSE;
@@ -2350,7 +2478,7 @@
}
}").
:- pragma foreign_proc("MC++",
- string__first_char(Str::in, First::in, Rest::out),
+ string__first_char(Str::in, First::in, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
MR_Integer len = Str->get_Length();
if (len > 0) {
@@ -2362,10 +2490,10 @@
}").
/*
-:- mode string__first_char(in, out, out) is semidet.
+:- mode string__first_char(in, uo, uo) is semidet.
*/
:- pragma foreign_proc("C",
- string__first_char(Str::in, First::out, Rest::out),
+ string__first_char(Str::in, First::uo, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
First = Str[0];
if (First == '\\0') {
@@ -2383,7 +2511,7 @@
}
}").
:- pragma foreign_proc("MC++",
- string__first_char(Str::in, First::out, Rest::out),
+ string__first_char(Str::in, First::uo, Rest::uo),
[will_not_call_mercury, promise_pure, thread_safe], "{
if (Str->get_Length() == 0) {
SUCCESS_INDICATOR = MR_FALSE;
@@ -2396,10 +2524,10 @@
/*
-:- mode string__first_char(out, in, in) is det.
+:- mode string__first_char(uo, in, in) is det.
*/
:- pragma foreign_proc("C",
- string__first_char(Str::out, First::in, Rest::in),
+ string__first_char(Str::uo, First::in, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "{
size_t len = strlen(Rest) + 1;
MR_allocate_aligned_string_msg(Str, len, MR_PROC_LABEL);
@@ -2407,13 +2535,18 @@
strcpy(Str + 1, Rest);
}").
:- pragma foreign_proc("MC++",
- string__first_char(Str::out, First::in, Rest::in),
+ string__first_char(Str::uo, First::in, Rest::in),
[will_not_call_mercury, promise_pure, thread_safe], "{
MR_String FirstStr;
FirstStr = new System::String(First, 1);
Str = System::String::Concat(FirstStr, Rest);
}").
+
+:- pragma promise_pure(string__first_char/3).
+string__first_char(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("string__first_char").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.16
diff -u -r1.16 table_builtin.m
--- library/table_builtin.m 12 Jun 2002 06:46:45 -0000 1.16
+++ library/table_builtin.m 13 Jun 2002 13:27:20 -0000
@@ -181,7 +181,7 @@
:- pragma foreign_proc("C",
table_simple_is_complete(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -201,7 +201,7 @@
:- pragma foreign_proc("C",
table_simple_has_succeeded(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -220,7 +220,7 @@
:- pragma foreign_proc("C",
table_simple_has_failed(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -239,7 +239,7 @@
:- pragma foreign_proc("C",
table_simple_is_active(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -258,7 +258,7 @@
:- pragma foreign_proc("C",
table_simple_is_inactive(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -277,7 +277,7 @@
:- pragma foreign_proc("C",
table_simple_mark_as_succeeded(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -293,7 +293,7 @@
:- pragma foreign_proc("C",
table_simple_mark_as_failed(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -309,7 +309,7 @@
:- pragma foreign_proc("C",
table_simple_mark_as_active(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -325,7 +325,7 @@
:- pragma foreign_proc("C",
table_simple_mark_as_inactive(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -340,70 +340,55 @@
").
-
-:- 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 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 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 foreign_proc("MC++",
- table_simple_is_active(_T::in),
- [will_not_call_mercury, promise_pure],
-"
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
+:- pragma promise_semipure(table_simple_is_complete/1).
+table_simple_is_complete(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_is_complete").
+
+:- pragma promise_semipure(table_simple_has_succeeded/1).
+table_simple_has_succeeded(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_has_succeeded").
+
+:- pragma promise_semipure(table_simple_has_failed/1).
+table_simple_has_failed(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_has_failed").
+
+:- pragma promise_semipure(table_simple_is_active/1).
+table_simple_is_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_is_active").
+
+:- pragma promise_semipure(table_simple_is_inactive/1).
+table_simple_is_inactive(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_is_inactive").
+
+table_simple_mark_as_succeeded(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_mark_as_succeeded").
+
+table_simple_mark_as_failed(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_mark_as_failed").
+
+table_simple_mark_as_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_mark_as_active").
+
+table_simple_mark_as_inactive(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_simple_mark_as_inactive").
%-----------------------------------------------------------------------------%
:- interface.
@@ -499,7 +484,7 @@
:- pragma foreign_proc("C",
table_io_in_range(T::out, Counter::out, Start::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
if (MR_io_tabling_enabled) {
MR_Unsigned old_counter;
@@ -530,7 +515,7 @@
").
:- pragma foreign_proc("C", table_io_has_occurred(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -551,24 +536,19 @@
S = S0;
").
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
+table_io_in_range(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_io_in_range").
+
+table_io_has_occurred(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_io_has_occurred").
+
+table_io_copy_io_state(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("table_io_copy_io_state").
%-----------------------------------------------------------------------------%
@@ -639,7 +619,7 @@
:- pragma foreign_proc("C",
table_nondet_setup(T0::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
#ifndef MR_USE_MINIMAL_MODEL
MR_fatal_error(""minimal model code entered when not enabled"");
@@ -701,12 +681,10 @@
#endif /* MR_USE_MINIMAL_MODEL */
").
-:- 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"");
-").
+table_nondet_setup(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_nondet_setup").
% The definitions of these two predicates are in the runtime system,
% in runtime/mercury_tabling.c.
@@ -736,7 +714,7 @@
*/
:- pragma foreign_proc("C",
- table_nondet_is_complete(T::in), [will_not_call_mercury, promise_pure], "
+ table_nondet_is_complete(T::in), [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -750,7 +728,7 @@
:- pragma foreign_proc("C",
table_nondet_is_active(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -765,7 +743,7 @@
:- pragma foreign_proc("C",
table_nondet_mark_as_active(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -782,7 +760,7 @@
:- pragma foreign_proc("C",
table_nondet_get_ans_table(T::in, AT::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -797,7 +775,7 @@
:- pragma foreign_proc("C",
table_nondet_answer_is_not_duplicate(T::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
#ifndef MR_USE_MINIMAL_MODEL
MR_fatal_error(""minimal model code entered when not enabled"");
@@ -822,7 +800,7 @@
:- pragma foreign_proc("C",
table_nondet_new_ans_slot(T::in, Slot::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
#ifndef MR_USE_MINIMAL_MODEL
MR_fatal_error(""minimal model code entered when not enabled"");
@@ -894,7 +872,7 @@
is det.
:- pragma foreign_proc("C", pickup_answer_list(T::in, CurNode::out),
- [will_not_call_mercury, promise_pure], "
+ [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -915,7 +893,7 @@
:- pragma foreign_proc("C",
return_next_answer(CurNode0::in, AnswerBlock::out, CurNode::out),
- [will_not_call_mercury, promise_pure], "
+ [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
MR_AnswerList cur_node0;
@@ -932,59 +910,49 @@
#endif
").
-:- 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 foreign_proc("MC++",
- table_nondet_is_active(_T::in),
- [will_not_call_mercury, promise_pure],
-"
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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 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 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"");
-").
+:- pragma promise_semipure(table_nondet_is_complete/1).
+table_nondet_is_complete(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_nondet_is_complete").
+
+:- pragma promise_semipure(table_nondet_is_active/1).
+table_nondet_is_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_nondet_is_active").
+
+table_nondet_mark_as_active(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_nondet_mark_as_active").
+
+table_nondet_get_ans_table(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_nondet_get_ans_table").
+
+table_nondet_answer_is_not_duplicate(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_nondet_answer_is_not_duplicate").
+
+table_nondet_new_ans_slot(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_nondet_new_ans_slot").
+
+:- pragma promise_semipure(pickup_answer_list/2).
+pickup_answer_list(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("pickup_answer_list").
+
+:- pragma promise_semipure(return_next_answer/3).
+return_next_answer(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("return_next_answer").
%-----------------------------------------------------------------------------%
@@ -1141,7 +1109,7 @@
").
:- pragma foreign_proc("C", table_lookup_insert_int(T0::in, I::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1152,7 +1120,7 @@
:- pragma foreign_proc("C",
table_lookup_insert_start_int(T0::in, S::in, I::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1164,7 +1132,7 @@
:- pragma foreign_proc("C",
table_lookup_insert_char(T0::in, C::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1175,7 +1143,7 @@
:- pragma foreign_proc("C",
table_lookup_insert_string(T0::in, S::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1186,7 +1154,7 @@
:- pragma foreign_proc("C",
table_lookup_insert_float(T0::in, F::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1197,7 +1165,7 @@
:- pragma foreign_proc("C",
table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1208,7 +1176,7 @@
:- pragma foreign_proc("C",
table_lookup_insert_user(T0::in, V::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1219,7 +1187,7 @@
:- pragma foreign_proc("C",
table_lookup_insert_poly(T0::in, V::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0, table;
@@ -1230,7 +1198,7 @@
:- pragma foreign_proc("C",
table_save_int_ans(T::in, Offset::in, I::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -1240,7 +1208,7 @@
:- pragma foreign_proc("C",
table_save_char_ans(T::in, Offset::in, C::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -1250,7 +1218,7 @@
:- pragma foreign_proc("C",
table_save_string_ans(T::in, Offset::in, S::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -1261,7 +1229,7 @@
:- pragma foreign_proc("C",
table_save_float_ans(T::in, Offset::in, F::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -1277,7 +1245,7 @@
:- pragma foreign_proc("C",
table_save_io_state_ans(T::in, Offset::in, S::ui),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -1288,7 +1256,7 @@
:- pragma foreign_proc("C",
table_save_any_ans(T::in, Offset::in, V::in),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table;
@@ -1298,7 +1266,7 @@
:- pragma foreign_proc("C",
table_restore_int_ans(T::in, Offset::in, I::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_semipure],
"
MR_TrieNode table;
@@ -1308,7 +1276,7 @@
:- pragma foreign_proc("C",
table_restore_char_ans(T::in, Offset::in, C::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_semipure],
"
MR_TrieNode table;
@@ -1318,7 +1286,7 @@
:- pragma foreign_proc("C",
table_restore_string_ans(T::in, Offset::in, S::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_semipure],
"
MR_TrieNode table;
@@ -1328,7 +1296,7 @@
:- pragma foreign_proc("C",
table_restore_float_ans(T::in, Offset::in, F::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_semipure],
"
MR_TrieNode table;
@@ -1342,7 +1310,7 @@
:- pragma foreign_proc("C",
table_restore_io_state_ans(T::in, Offset::in, V::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_semipure],
"
MR_TrieNode table;
@@ -1352,7 +1320,7 @@
:- pragma foreign_proc("C",
table_restore_any_ans(T::in, Offset::in, V::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_semipure],
"
MR_TrieNode table;
@@ -1362,7 +1330,7 @@
:- pragma foreign_proc("C",
table_create_ans_block(T0::in, Size::in, T::out),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury],
"
MR_TrieNode table0;
@@ -1380,160 +1348,115 @@
").
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
-
-:- 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"");
-").
+table_lookup_insert_int(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_int").
+
+table_lookup_insert_start_int(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_start_int").
+
+table_lookup_insert_char(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_char").
+
+table_lookup_insert_string(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_string").
+
+table_lookup_insert_float(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_float").
+
+table_lookup_insert_enum(_, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_enum").
+
+table_lookup_insert_user(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_user").
+
+table_lookup_insert_poly(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_lookup_insert_poly").
+
+table_save_int_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_save_int_ans").
+
+table_save_char_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_save_char_ans").
+
+table_save_string_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_save_string_ans").
+
+table_save_float_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_save_float_ans").
+
+table_save_io_state_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_save_io_state_ans").
+
+table_save_any_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_save_any_ans").
+
+table_restore_int_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_restore_int_ans").
+
+table_restore_char_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_restore_char_ans").
+
+table_restore_string_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_restore_string_ans").
+
+table_restore_float_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_restore_float_ans").
+
+table_restore_io_state_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_restore_io_state_ans").
+
+table_restore_any_ans(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_restore_any_ans").
+
+table_create_ans_block(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_create_ans_block").
+
+table_report_statistics :-
+ % This version is only for if there is not a foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_report_statistics").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/time.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/time.m,v
retrieving revision 1.26
diff -u -r1.26 time.m
--- library/time.m 12 Jun 2002 06:46:46 -0000 1.26
+++ library/time.m 13 Jun 2002 13:27:20 -0000
@@ -194,12 +194,9 @@
Ret = (MR_Integer) clock();
update_io(IO0, IO);
}").
-:- 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"");
-}").
-
+time__c_clock(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("time__c_clock") }.
%-----------------------------------------------------------------------------%
@@ -216,11 +213,9 @@
"{
Ret = (MR_Integer) 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"");
-}").
+time__c_clocks_per_sec(_) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("time__c_clocks_per_sec").
%-----------------------------------------------------------------------------%
@@ -258,13 +253,9 @@
#endif
update_io(IO0, IO);
}").
-:- 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"");
-}").
+time__c_times(_, _, _, _, _) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("time__c_times") }.
%-----------------------------------------------------------------------------%
@@ -290,12 +281,9 @@
Ret = (MR_Integer) time(NULL);
update_io(IO0, IO);
}").
-:- 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"");
-}").
+time__c_time(_) -->
+ % This version is only for if there is not a foreign_proc version.
+ { private_builtin__sorry("time__c_time") }.
%-----------------------------------------------------------------------------%
@@ -313,12 +301,9 @@
"{
Diff = (MR_Float) difftime((time_t) T1, (time_t) T0);
}").
-:- 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"");
-}").
+time__c_difftime(_, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("time__c_difftime").
%-----------------------------------------------------------------------------%
@@ -356,14 +341,9 @@
YD = (MR_Integer) p->tm_yday;
N = (MR_Integer) p->tm_isdst;
}").
-
-:- 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"");
-}").
+time__c_localtime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("time__c_localtime").
%:- func time__gmtime(time_t) = tm.
@@ -400,14 +380,9 @@
YD = (MR_Integer) p->tm_yday;
N = (MR_Integer) p->tm_isdst;
}").
-
-:- 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"");
-}").
+time__c_gmtime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("time__c_gmtime").
:- func int_to_maybe_dst(int) = maybe(dst).
@@ -451,14 +426,9 @@
Time = (MR_Integer) mktime(&t);
}").
-
-:- 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"");
-}").
+time__c_mktime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("time__c_mktime").
:- func maybe_dst_to_int(maybe(dst)) = int.
@@ -505,14 +475,9 @@
MR_make_aligned_string_copy(Str, s);
}").
-
-:- 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"");
-}").
+time__c_asctime(_, _, _, _, _, _, _, _, _, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("time__c_asctime").
%-----------------------------------------------------------------------------%
@@ -537,13 +502,9 @@
MR_make_aligned_string_copy(Str, s);
}").
-
-:- 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"");
-}").
+time__c_ctime(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("time__c_ctime").
%-----------------------------------------------------------------------------%
:- end_module time.
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.11
diff -u -r1.11 type_desc.m
--- library/type_desc.m 12 Jun 2002 06:46:46 -0000 1.11
+++ library/type_desc.m 13 Jun 2002 13:27:33 -0000
@@ -504,6 +504,10 @@
TypeInfo = TypeInfo_for_T;
").
+type_of(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_of").
+
:- pragma foreign_proc("C",
has_type(_Arg::unused, TypeInfo::in),
[will_not_call_mercury, thread_safe, promise_pure],
@@ -518,6 +522,10 @@
TypeInfo_for_T = TypeInfo;
").
+has_type(_, _) :-
+ % This version is only for if there is not a foreign_proc version.
+ 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").
@@ -627,13 +635,9 @@
TypeCtor = (MR_Word) MR_make_type_ctor_desc(type_info, type_ctor_info);
}").
-:- 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;
-}").
+type_ctor(_) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("type_ctor").
:- pragma foreign_proc("C",
type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out),
@@ -706,6 +710,7 @@
}").
make_type(_TypeCtorDesc::in, _ArgTypes::in) = (_TypeDesc::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("make_type/2 forward mode.").
/*
@@ -731,6 +736,7 @@
}").
make_type(_TypeCtorDesc::out, _ArgTypes::out) = (_TypeDesc::in) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("make_type/2 reverse mode").
:- pragma foreign_proc("C",
@@ -769,6 +775,7 @@
type_ctor_name_and_arity(_TypeCtorDesc::in, _ModuleName::out,
_TypeCtorName::out, _TypeCtorArity::out) :-
+ % This version is only for if there is not a foreign_proc version.
private_builtin__sorry("type_ctor_name_and_arity/4").
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list