[m-rev.] diff: add erlang foreign procs for some tests
Peter Wang
wangp at students.csse.unimelb.edu.au
Thu Aug 23 11:19:14 AEST 2007
Estimated hours taken: 1
Branches: main
tests/valid/big_foreign_type.m:
tests/par_conj/threads_hang.m:
tests/hard_coded/impure_foreign.m:
tests/hard_coded/mode_choice.m:
tests/hard_coded/user_compare.m:
tests/hard_coded/impure_prune.m:
tests/hard_coded/lp.m:
tests/hard_coded/impure_foreign2.m:
tests/hard_coded/any_call_hoist_bug.m:
tests/hard_coded/intermod_c_code2.m:
tests/hard_coded/impure_foreign3.m:
tests/hard_coded/equality_pred_which_requires_boxing.m:
Add Erlang foreign code pragmas for these tests.
Index: ./valid/big_foreign_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/big_foreign_type.m,v
retrieving revision 1.2
diff -u -r1.2 big_foreign_type.m
--- ./valid/big_foreign_type.m 7 Nov 2002 12:52:58 -0000 1.2
+++ ./valid/big_foreign_type.m 22 Aug 2007 06:33:57 -0000
@@ -7,15 +7,19 @@
:- type foo.
:- pragma foreign_type(c, foo, "struct Foo").
:- pragma foreign_type(il, foo, "class [big_foreign_type__csharp_code]Foo").
+:- pragma foreign_type(erlang, foo, "").
:- type foo2.
:- pragma foreign_type(c, foo2, "char").
:- pragma foreign_type(il, foo2, "valuetype [mscorlib]System.Char").
+:- pragma foreign_type(erlang, foo2, "").
:- type foo3.
:- pragma foreign_type(c, foo3, "double").
:- pragma foreign_type(il, foo3, "valuetype [mscorlib]System.Double").
+:- pragma foreign_type(erlang, foo3, "").
:- type foo4.
:- pragma foreign_type(c, foo4, "enum e").
:- pragma foreign_type(il, foo4, "valuetype [big_foreign_type__csharp_code]e").
+:- pragma foreign_type(erlang, foo4, "").
:- func bar(foo) = foo.
:- func bar2(foo2) = foo2.
@@ -63,6 +67,15 @@
:- pragma foreign_proc("C#", bar4(X::in) = (Y::out),
[will_not_call_mercury, promise_pure], "Y = X;").
+:- pragma foreign_proc("Erlang", bar(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = X").
+:- pragma foreign_proc("Erlang", bar2(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = X").
+:- pragma foreign_proc("Erlang", bar3(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = 2.0 * X").
+:- pragma foreign_proc("Erlang", bar4(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = X").
+
baz(X) = X.
baz2(X) = X.
baz3(X) = X.
Index: ./par_conj/threads_hang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/par_conj/threads_hang.m,v
retrieving revision 1.3
diff -u -r1.3 threads_hang.m
--- ./par_conj/threads_hang.m 11 Sep 2006 05:37:09 -0000 1.3
+++ ./par_conj/threads_hang.m 22 Aug 2007 06:32:16 -0000
@@ -45,3 +45,16 @@
"
alarm(Seconds);
").
+
+:- pragma foreign_proc("Erlang",
+ alarm(Seconds::in),
+ [will_not_call_mercury, thread_safe],
+"
+ F = fun() ->
+ receive
+ after Seconds * 1000 ->
+ throw(alarm)
+ end
+ end,
+ spawn_link(F)
+").
Index: ./hard_coded/impure_foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/impure_foreign.m,v
retrieving revision 1.2
diff -u -r1.2 impure_foreign.m
--- ./hard_coded/impure_foreign.m 28 Nov 2002 16:33:44 -0000 1.2
+++ ./hard_coded/impure_foreign.m 22 Aug 2007 06:05:33 -0000
@@ -51,6 +51,12 @@
"counter++; Val = counter;").
:- pragma foreign_proc("C#", incr(Val::out), [will_not_call_mercury],
"counter++; Val = counter;").
+:- pragma foreign_proc("Erlang", incr(Val::out), [will_not_call_mercury],
+ "case get(counter) of
+ undefined -> Val = 2;
+ C -> Val = C + 1
+ end,
+ put(counter, Val)").
:- semipure pred get(int::out) is det.
@@ -62,6 +68,12 @@
:- pragma foreign_proc("C#", get(Val::out),
[will_not_call_mercury, promise_semipure],
"Val = counter;").
+:- pragma foreign_proc("Erlang", get(Val::out),
+ [will_not_call_mercury, promise_semipure],
+ "Val = case get(counter) of
+ undefined -> 1;
+ C -> C
+ end").
:- pred unsafe_get(int::out) is det.
:- pragma promise_pure(unsafe_get/1).
Index: ./hard_coded/mode_choice.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/mode_choice.m,v
retrieving revision 1.4
diff -u -r1.4 mode_choice.m
--- ./hard_coded/mode_choice.m 25 Jun 2003 17:21:27 -0000 1.4
+++ ./hard_coded/mode_choice.m 22 Aug 2007 06:09:17 -0000
@@ -119,6 +119,9 @@
:- pragma foreign_proc("C#", mkany(S::out(any)), [promise_pure], "
S = null;
").
+:- pragma foreign_proc("Erlang", mkany(S::out(any)), [promise_pure], "
+ S = null
+").
% prefer in(any) over out(any)
% [i.e. any -> any beats free -> any]
Index: ./hard_coded/user_compare.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/user_compare.m,v
retrieving revision 1.2
diff -u -r1.2 user_compare.m
--- ./hard_coded/user_compare.m 26 Oct 2003 12:43:33 -0000 1.2
+++ ./hard_coded/user_compare.m 22 Aug 2007 06:19:55 -0000
@@ -55,6 +55,8 @@
equality is foreign_equals, comparison is foreign_compare.
:- pragma foreign_type(il, foreign, "int32") where
equality is foreign_equals, comparison is foreign_compare.
+:- pragma foreign_type(erlang, foreign, "") where
+ equality is foreign_equals, comparison is foreign_compare.
:- pred foreign_equals(foreign::in, foreign::in) is semidet.
:- pragma foreign_proc(c, foreign_equals(Foreign1::in, Foreign2::in),
@@ -65,6 +67,10 @@
[will_not_call_mercury, promise_pure],
"SUCCESS_INDICATOR = (Foreign1 == Foreign2);"
).
+:- pragma foreign_proc("Erlang", foreign_equals(Foreign1::in, Foreign2::in),
+ [will_not_call_mercury, promise_pure],
+"SUCCESS_INDICATOR = (Foreign1 =:= Foreign2)"
+).
:- pred foreign_compare `with_type` compare(foreign)
`with_inst` compare.
@@ -84,6 +90,15 @@
[will_not_call_mercury, promise_pure],
"Result = (Foreign1 < Foreign2 ? 1 : (Foreign1 == Foreign2 ? 0 : -1));"
).
+:- pragma foreign_proc("Erlang", foreign_compare_2(Result::out, Foreign1::in,
+ Foreign2::in),
+ [will_not_call_mercury, promise_pure],
+"Result = if
+ Foreign1 < Foreign2 -> 1;
+ Foreign1 =:= Foreign2 -> 0;
+ true -> -1
+end"
+).
:- func foreign(int) = foreign.
:- pragma foreign_proc(c, foreign(Int::in) = (Foreign::out),
@@ -94,3 +109,7 @@
[will_not_call_mercury, promise_pure],
"Foreign = Int;"
).
+:- pragma foreign_proc("Erlang", foreign(Int::in) = (Foreign::out),
+ [will_not_call_mercury, promise_pure],
+"Foreign = Int"
+).
Index: ./hard_coded/impure_prune.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/impure_prune.m,v
retrieving revision 1.4
diff -u -r1.4 impure_prune.m
--- ./hard_coded/impure_prune.m 10 Jul 2006 04:40:53 -0000 1.4
+++ ./hard_coded/impure_prune.m 22 Aug 2007 06:07:11 -0000
@@ -57,3 +57,18 @@
").
:- pragma foreign_proc("C#", set_counter(X::in), [], "counter = X;").
+:- pragma foreign_proc("Erlang",
+ get_counter(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = case get(counter) of
+ undefined -> 0;
+ C -> C
+ end
+").
+:- pragma foreign_proc("Erlang",
+ set_counter(X::in),
+ [will_not_call_mercury],
+"
+ put(counter, X)
+").
Index: ./hard_coded/lp.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/lp.m,v
retrieving revision 1.6
diff -u -r1.6 lp.m
--- ./hard_coded/lp.m 10 Jul 2006 04:40:54 -0000 1.6
+++ ./hard_coded/lp.m 22 Aug 2007 05:35:12 -0000
@@ -380,6 +380,12 @@
ldloc 'A'
stloc 'B'
").
+:- pragma foreign_proc("Erlang",
+ mkuniq(A::in, B::array_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ B = A
+").
%------------------------------------------------------------------------------%
Index: ./hard_coded/impure_foreign2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/impure_foreign2.m,v
retrieving revision 1.1
diff -u -r1.1 impure_foreign2.m
--- ./hard_coded/impure_foreign2.m 26 Apr 2005 07:38:03 -0000 1.1
+++ ./hard_coded/impure_foreign2.m 22 Aug 2007 06:03:23 -0000
@@ -55,6 +55,12 @@
"counter++; Val = counter;").
:- pragma foreign_proc("C#", incr(Val::out), [will_not_call_mercury],
"counter++; Val = counter;").
+:- pragma foreign_proc("Erlang", incr(Val::out), [will_not_call_mercury],
+ "case get(counter) of
+ undefined -> Val = 2;
+ C -> Val = C + 1
+ end,
+ put(counter, Val)").
:- semipure pred get(int::out) is det.
@@ -66,6 +72,12 @@
:- pragma foreign_proc("C#", get(Val::out),
[will_not_call_mercury, promise_semipure],
"Val = counter;").
+:- pragma foreign_proc("Erlang", get(Val::out),
+ [will_not_call_mercury, promise_semipure],
+ "Val = case get(counter) of
+ undefined -> 1;
+ C -> C
+ end").
:- pred unsafe_get(int::out) is det.
:- pragma promise_pure(unsafe_get/1).
Index: ./hard_coded/any_call_hoist_bug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/any_call_hoist_bug.m,v
retrieving revision 1.1
diff -u -r1.1 any_call_hoist_bug.m
--- ./hard_coded/any_call_hoist_bug.m 30 Jun 2006 12:51:55 -0000 1.1
+++ ./hard_coded/any_call_hoist_bug.m 22 Aug 2007 05:31:41 -0000
@@ -76,6 +76,12 @@
"
B = A;
").
+:- pragma foreign_proc("Erlang",
+ cast_to_ground(A::ia) = (B::out),
+ [promise_pure, will_not_call_mercury],
+"
+ B = A
+").
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
Index: ./hard_coded/intermod_c_code2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/intermod_c_code2.m,v
retrieving revision 1.3
diff -u -r1.3 intermod_c_code2.m
--- ./hard_coded/intermod_c_code2.m 10 Jul 2006 04:40:53 -0000 1.3
+++ ./hard_coded/intermod_c_code2.m 22 Aug 2007 06:08:22 -0000
@@ -22,4 +22,9 @@
U = T;
TypeInfo_for_U = TypeInfo_for_T;
}").
+:- pragma foreign_proc("Erlang", c_code_2(T::in, U::out), [promise_pure],
+"
+ U = T,
+ TypeInfo_for_U = TypeInfo_for_T
+").
Index: ./hard_coded/impure_foreign3.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/impure_foreign3.m,v
retrieving revision 1.1
diff -u -r1.1 impure_foreign3.m
--- ./hard_coded/impure_foreign3.m 26 Apr 2005 07:38:03 -0000 1.1
+++ ./hard_coded/impure_foreign3.m 22 Aug 2007 06:04:27 -0000
@@ -55,6 +55,12 @@
"counter++; Val = counter;").
:- pragma foreign_proc("C#", incr(Val::out), [will_not_call_mercury],
"counter++; Val = counter;").
+:- pragma foreign_proc("Erlang", incr(Val::out), [will_not_call_mercury],
+ "case get(counter) of
+ undefined -> Val = 2;
+ C -> Val = C + 1
+ end,
+ put(counter, Val)").
:- semipure pred get(int::out) is det.
@@ -66,6 +72,12 @@
:- pragma foreign_proc("C#", get(Val::out),
[will_not_call_mercury, promise_semipure],
"Val = counter;").
+:- pragma foreign_proc("Erlang", get(Val::out),
+ [will_not_call_mercury, promise_semipure],
+ "Val = case get(counter) of
+ undefined -> 1;
+ C -> C
+ end").
:- pred unsafe_get(int::out) is det.
:- pragma promise_pure(unsafe_get/1).
Index: ./hard_coded/equality_pred_which_requires_boxing.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/equality_pred_which_requires_boxing.m,v
retrieving revision 1.1
diff -u -r1.1 equality_pred_which_requires_boxing.m
--- ./hard_coded/equality_pred_which_requires_boxing.m 1 Dec 2003
22:31:36 -0000 1.1
+++ ./hard_coded/equality_pred_which_requires_boxing.m 22 Aug 2007
05:50:21 -0000
@@ -18,6 +18,8 @@
where equality is unify_ft.
:- pragma foreign_type(il, type_which_needs_boxing,
"valuetype [mscorlib]System.Double") where equality is unify_ft.
+:- pragma foreign_type(erlang, type_which_needs_boxing,
+ "") where equality is unify_ft.
:- type type_which_needs_boxing(T).
:- pragma foreign_type(c, type_which_needs_boxing(T), "double")
@@ -25,6 +27,8 @@
:- pragma foreign_type(il, type_which_needs_boxing(T),
"valuetype [mscorlib]System.Double")
where equality is unify_ft_T.
+:- pragma foreign_type(erlang, type_which_needs_boxing(T), "")
+ where equality is unify_ft_T.
main(!IO) :-
% Test a builtin type which requires boxing.
@@ -76,6 +80,9 @@
:- pragma foreign_proc("C#", create(X::in) = (Y::out), [promise_pure], "
Y = X;
").
+:- pragma foreign_proc("Erlang", create(X::in) = (Y::out), [promise_pure], "
+ Y = X
+").
:- func create_T(float) = type_which_needs_boxing(int).
:- pragma foreign_proc("C", create_T(X::in) = (Y::out), [promise_pure], "
@@ -84,6 +91,9 @@
:- pragma foreign_proc("C#", create_T(X::in) = (Y::out), [promise_pure], "
Y = X;
").
+:- pragma foreign_proc("Erlang", create_T(X::in) = (Y::out), [promise_pure], "
+ Y = X
+").
:- pred unify_ft(type_which_needs_boxing::in, type_which_needs_boxing::in)
is semidet.
@@ -93,6 +103,9 @@
:- pragma foreign_proc("C#", unify_ft(X::in, Y::in), [promise_pure], "
SUCCESS_INDICATOR = (X == Y);
").
+:- pragma foreign_proc("Erlang", unify_ft(X::in, Y::in), [promise_pure], "
+ SUCCESS_INDICATOR = (X =:= Y)
+").
:- pred unify_ft_T(type_which_needs_boxing(T)::in,
type_which_needs_boxing(T)::in) is semidet.
@@ -102,6 +115,9 @@
:- pragma foreign_proc("C#", unify_ft_T(X::in, Y::in), [promise_pure], "
SUCCESS_INDICATOR = (X == Y);
").
+:- pragma foreign_proc("Erlang", unify_ft_T(X::in, Y::in), [promise_pure], "
+ SUCCESS_INDICATOR = (X =:= Y)
+").
:- pragma no_inline(float_a/0).
:- func float_a = float.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list