[m-rev.] diff: update purity handling in stdlib code

[Julien Fischer]

Branches: main

Update the handling of purity in some standard library code.

library/type_desc.m:
 	For the function make_type/2.:
 	    - use a promise_equivalent_caluses/1 pragma in place of a
               promise_pure pragma.
    	    - attch the purity information using foreign_proc attributes.
 	    - group all the clauses for the (in, in) = out mode together.

library/benchmarking.m:
library/io.m:
 	Use promise_semipure foreign_proc attributes in place of
 	promise_semipure pragmas.

Julien.

Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.87
diff -u -r1.87 benchmarking.m
--- library/benchmarking.m	21 May 2011 11:59:17 -0000	1.87
+++ library/benchmarking.m	16 Jun 2011 05:23:01 -0000
@@ -1128,17 +1128,15 @@

  :- 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("Java",
      ref_value(Ref::in, X::out),
-    [will_not_call_mercury],
+    [promise_semipure, will_not_call_mercury],
  "
      X = Ref.value;
  ").
Index: library/io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.463
diff -u -r1.463 io.m
--- library/io.m	20 May 2011 04:16:52 -0000	1.463
+++ library/io.m	16 Jun 2011 05:26:34 -0000
@@ -10020,12 +10020,10 @@
  #include <stdlib.h> /* for getenv() and putenv() */
  ").

-:- pragma promise_semipure(io.getenv/2).
-
  :- pragma foreign_proc("C",
      io.getenv(Var::in, Value::out),
-    [will_not_call_mercury, tabled_for_io, does_not_affect_liveness,
-        no_sharing],
+    [promise_semipure, will_not_call_mercury, tabled_for_io,
+        does_not_affect_liveness, no_sharing],
  "
      Value = getenv(Var);
      SUCCESS_INDICATOR = (Value != 0);
@@ -10033,7 +10031,7 @@

  :- pragma foreign_proc("C#",
      io.getenv(Var::in, Value::out),
-    [will_not_call_mercury, tabled_for_io],
+    [promise_semipure, will_not_call_mercury, tabled_for_io],
  "
      Value = System.Environment.GetEnvironmentVariable(Var);
      SUCCESS_INDICATOR = (Value != null);
@@ -10041,7 +10039,7 @@

  :- pragma foreign_proc("Java",
      io.getenv(Var::in, Value::out),
-    [will_not_call_mercury, tabled_for_io, may_not_duplicate],
+    [promise_semipure, will_not_call_mercury, tabled_for_io, may_not_duplicate],
  "
      Value = System.getenv(Var);
      SUCCESS_INDICATOR = (Value != null);
@@ -10049,7 +10047,7 @@

  :- pragma foreign_proc("Erlang",
      io.getenv(Var::in, Value::out),
-    [will_not_call_mercury, tabled_for_io],
+    [promise_semipure, will_not_call_mercury, tabled_for_io],
  "
      case os:getenv(binary_to_list(Var)) of
          false ->
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.72
diff -u -r1.72 type_desc.m
--- library/type_desc.m	25 May 2011 02:02:52 -0000	1.72
+++ library/type_desc.m	16 Jun 2011 05:21:46 -0000
@@ -856,15 +856,15 @@

  %-----------------------------------------------------------------------------%

-% This is the forwards mode of make_type/1: given a type constructor and
+% This is the forwards mode of make_type/2: given a type constructor and
  % a list of argument types, check that the length of the argument types
  % matches the arity of the type constructor, and if so, use the type
  % constructor to construct a new type with the specified arguments.

-:- pragma promise_pure(make_type/2).
+:- pragma promise_equivalent_clauses(make_type/2).
  :- pragma foreign_proc("C",
      make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out),
-    [will_not_call_mercury, thread_safe, will_not_modify_trail],
+    [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail],
  "{
      MR_TypeCtorDesc type_ctor_desc;
      MR_TypeCtorInfo type_ctor_info;
@@ -899,7 +899,7 @@

  :- pragma foreign_proc("C#",
      make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out),
-    [will_not_call_mercury, thread_safe, will_not_modify_trail,
+    [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail,
          may_not_duplicate],
  "{
      runtime.PseudoTypeInfo[] args =
@@ -926,7 +926,7 @@

  :- pragma foreign_proc("Java",
      make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out),
-    [will_not_call_mercury, thread_safe, will_not_modify_trail,
+    [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail,
          may_not_duplicate],
  "{
      PseudoTypeInfo[] as = new PseudoTypeInfo[TypeCtorDesc.arity];
@@ -950,6 +950,14 @@
      }
  }").

+make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out) :-
+    ( erlang_rtti_implementation.is_erlang_backend ->
+        erlang_rtti_implementation.make_type_desc(TypeCtorDesc, ArgTypes,
+            TypeDesc)
+    ;
+        private_builtin.sorry("make_type(in, in) = out")
+    ).
+
      /*
      ** This is the reverse mode of make_type: given a type,
      ** split it up into a type constructor and a list of
@@ -958,7 +966,7 @@

  :- pragma foreign_proc("C",
      make_type(TypeCtorDesc::out, ArgTypes::out) = (TypeDesc::in),
-    [will_not_call_mercury, thread_safe, will_not_modify_trail],
+    [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail],
  "{
      MR_TypeCtorDesc type_ctor_desc;
      MR_TypeInfo     type_info;
@@ -972,21 +980,14 @@
      MR_restore_transient_registers();
  }").

-make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out) :-
-    ( erlang_rtti_implementation.is_erlang_backend ->
-        erlang_rtti_implementation.make_type_desc(TypeCtorDesc, ArgTypes,
-            TypeDesc)
-    ;
-        private_builtin.sorry("make_type(in, in) = out")
-    ).
-
  make_type(_TypeCtorDesc::out, _ArgTypes::out) = (_TypeDesc::in) :-
      private_builtin.sorry("make_type(out, out) = in").

  :- pragma foreign_proc("C",
      type_ctor_name_and_arity(TypeCtorDesc::in, TypeCtorModuleName::out,
          TypeCtorName::out, TypeCtorArity::out),
-    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+    [will_not_call_mercury, thread_safe, promise_pure,
+        will_not_modify_trail],
  "{
      MR_TypeCtorDesc type_ctor_desc;

@@ -1017,6 +1018,8 @@
      }
  }").

+%-----------------------------------------------------------------------------%
+
  type_ctor_name_and_arity(TypeCtorDesc, ModuleName, TypeCtorName,
          TypeCtorArity) :-
      ( erlang_rtti_implementation.is_erlang_backend ->

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------