[m-rev.] diff: implement array.m in erlang
Peter Ross
pro at missioncriticalit.com
Thu Jun 7 17:53:55 AEST 2007
Hi,
===================================================================
Estimated hours taken: 1
Branches: main
Implement the array module in erlang.
compiler/erl_rtti.m:
compiler/erlang_rtti.m:
Handle RTTI for an array.
library/array.m:
Erlang implementation of arrays.
library/erlang_rtti_implementation.m:
Handle deconstruct of arrays.
Index: compiler/erl_rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/erl_rtti.m,v
retrieving revision 1.11
diff -u -r1.11 erl_rtti.m
--- compiler/erl_rtti.m 5 Jun 2007 07:59:35 -0000 1.11
+++ compiler/erl_rtti.m 7 Jun 2007 07:50:25 -0000
@@ -113,6 +113,12 @@
->
D = erlang_list
;
+ ModuleName = unqualified("array"),
+ TypeName = "array",
+ Arity = 1
+ ->
+ D = erlang_array
+ ;
D = erlang_type_ctor_details_2(Details)
).
@@ -568,6 +574,8 @@
elds_term(make_enum_alternative("etcr_dummy")).
erlang_type_ctor_rep(erlang_list) =
elds_term(make_enum_alternative("etcr_list")).
+erlang_type_ctor_rep(erlang_array) =
+ elds_term(make_enum_alternative("etcr_array")).
erlang_type_ctor_rep(erlang_eqv(_)) =
elds_term(make_enum_alternative("etcr_eqv")).
erlang_type_ctor_rep(erlang_builtin(builtin_ctor_int)) =
@@ -716,6 +724,7 @@
;
% The types don't require any extra information
( Details = erlang_list
+ ; Details = erlang_array
; Details = erlang_builtin(_)
; Details = erlang_impl_artifact(_)
; Details = erlang_foreign
Index: compiler/erlang_rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/erlang_rtti.m,v
retrieving revision 1.4
diff -u -r1.4 erlang_rtti.m
--- compiler/erlang_rtti.m 5 Jun 2007 07:59:35 -0000 1.4
+++ compiler/erlang_rtti.m 7 Jun 2007 07:50:25 -0000
@@ -83,6 +83,9 @@
% Mercury lists are represented as erlang lists
; erlang_list
+ %
+ ; erlang_array
+
; erlang_eqv(
% XXX why is it a pseudo type info
eeqv_type :: rtti_maybe_pseudo_type_info
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.154
diff -u -r1.154 array.m
--- library/array.m 15 May 2007 02:38:23 -0000 1.154
+++ library/array.m 7 Jun 2007 07:50:25 -0000
@@ -522,6 +522,13 @@
succeeded = false;
").
+:- pragma foreign_proc("Erlang",
+ bounds_checks,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = true
+").
+
%-----------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
@@ -621,6 +628,19 @@
Array = null;
").
+:- pragma foreign_proc("Erlang",
+ array.init_2(Size::in, Item::in, Array::array_uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Array = erlang:make_tuple(Size, Item)
+").
+:- pragma foreign_proc("Erlang",
+ array.make_empty_array(Array::array_uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Array = {}
+").
+
:- pragma foreign_proc("Java",
array.init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -659,6 +679,14 @@
Min = 0;
").
+:- pragma foreign_proc("Erlang",
+ array.min(Array::in, Min::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ % Array not used
+ Min = 0
+").
+
:- pragma foreign_proc("Java",
array.min(_Array::in, Min::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -684,6 +712,12 @@
Max = -1;
}
").
+:- pragma foreign_proc("Erlang",
+ array.max(Array::in, Max::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Max = size(Array) - 1
+").
:- pragma foreign_proc("Java",
array.max(Array::in, Max::out),
@@ -721,6 +755,13 @@
}
").
+:- pragma foreign_proc("Erlang",
+ array.size(Array::in, Max::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Max = size(Array)
+").
+
:- pragma foreign_proc("Java",
array.size(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -791,6 +832,13 @@
Item = Array.GetValue(Index);
}").
+:- pragma foreign_proc("Erlang",
+ array.unsafe_lookup(Array::in, Index::in, Item::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Item = element(Index + 1, Array)
+").
+
:- pragma foreign_proc("Java",
array.unsafe_lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -827,6 +875,13 @@
Array = Array0;
}").
+:- pragma foreign_proc("Erlang",
+ array.unsafe_set(Array0::array_di, Index::in, Item::in, Array::array_uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Array = setelement(Index, Array0, Item)
+").
+
:- pragma foreign_proc("Java",
array.unsafe_set(Array0::array_di, Index::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -923,6 +978,23 @@
}
").
+:- pragma foreign_proc("Erlang",
+ array.resize(Array0::array_di, Size::in, Item::in, Array::array_uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ InitialSize = size(Array0),
+ List = tuple_to_list(Array0),
+ if
+ Size < InitialSize ->
+ Array = list_to_tuple(lists:sublist(List, Size));
+ Size > InitialSize ->
+ Array = list_to_tuple(lists:append(List,
+ lists:duplicate(Size - InitialSize, Item)));
+ true ->
+ Array = Array0
+ end
+").
+
:- pragma foreign_proc("Java",
array.resize(Array0::array_di, Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1020,6 +1092,13 @@
System.Array.Copy(Array0, Array, Size);
").
+:- pragma foreign_proc("Erlang",
+ array.shrink_2(Array0::array_di, Size::in, Array::array_uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Array = list_to_tuple(lists:sublist(tuple_to_list(Array0), Size))
+").
+
:- pragma foreign_proc("Java",
array.shrink_2(Array0::array_di, Size::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1085,6 +1164,13 @@
Array = System.Array.CreateInstance(Array0.GetType().GetElementType(),
Array0.Length);
System.Array.Copy(Array0, Array, Array0.Length);
+").
+
+:- pragma foreign_proc("Erlang",
+ array.copy(Array0::in, Array::array_uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Array = Array0
").
:- pragma foreign_proc("Java",
Index: library/erlang_rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/erlang_rtti_implementation.m,v
retrieving revision 1.8
diff -u -r1.8 erlang_rtti_implementation.m
--- library/erlang_rtti_implementation.m 5 Jun 2007 07:59:35 -0000 1.8
+++ library/erlang_rtti_implementation.m 7 Jun 2007 07:50:25 -0000
@@ -57,10 +57,12 @@
:- implementation.
+:- import_module array.
:- import_module int.
:- import_module require.
:- import_module string.
:- import_module term_io.
+:- import_module type_desc.
%
% A type_info can be represented in one of three ways
@@ -88,6 +90,7 @@
---> etcr_du
; etcr_dummy
; etcr_list
+ ; etcr_array
; etcr_eqv
; etcr_int
; etcr_float
@@ -367,6 +370,25 @@
Arguments = []
)
;
+ TypeCtorRep = etcr_array,
+
+ % Constrain the T in array(T) to the correct element type.
+ type_ctor_and_args(type_of(Term), _, Args),
+ ( Args = [ElemType] ->
+ has_type(Elem, ElemType),
+ same_array_elem_type(Array, Elem)
+ ;
+ error("An array which doesn't have a type_ctor arg")
+ ),
+
+ det_dynamic_cast(Term, Array),
+
+ Functor = "<<array>>",
+ Arity = array.size(Array),
+ Arguments = array.foldr(
+ (func(Elem, List) = [univ(Elem) | List]),
+ Array, [])
+ ;
TypeCtorRep = etcr_eqv,
EqvTypeInfo = collapse_equivalences(TypeInfo),
EqvTypeCtorInfo = EqvTypeInfo ^ type_ctor_info,
@@ -420,29 +442,39 @@
Arity = 0,
Arguments = []
;
- ( TypeCtorRep = etcr_pred
- ; TypeCtorRep = etcr_func
- ; TypeCtorRep = etcr_ref
- ; TypeCtorRep = etcr_type_desc
- ; TypeCtorRep = etcr_pseudo_type_desc
- ; TypeCtorRep = etcr_type_ctor_desc
- ; TypeCtorRep = etcr_type_info
- ; TypeCtorRep = etcr_type_ctor_info
- ; TypeCtorRep = etcr_typeclass_info
- ; TypeCtorRep = etcr_base_typeclass_info
+ ( TypeCtorRep = etcr_pred,
+ Name = "<<predicate>>"
+ ; TypeCtorRep = etcr_func,
+ Name = "<<function>>"
+ ; TypeCtorRep = etcr_ref,
+ Name = "<<reference>>"
+ ; TypeCtorRep = etcr_type_desc,
+ Name = "<<typedesc>>"
+ ; TypeCtorRep = etcr_pseudo_type_desc,
+ Name = "<<pseudotypedesc>>"
+ ; TypeCtorRep = etcr_type_ctor_desc,
+ Name = "<<typectordesc>>"
+ ; TypeCtorRep = etcr_type_info,
+ Name = "<<typeinfo>>"
+ ; TypeCtorRep = etcr_type_ctor_info,
+ Name = "<<typectorinfo>>"
+ ; TypeCtorRep = etcr_typeclass_info,
+ Name = "<<typeclassinfo>>"
+ ; TypeCtorRep = etcr_base_typeclass_info,
+ Name = "<<basetypeclassinfo>>"
),
(
NonCanon = do_not_allow,
- error("do_not_allow")
+ error("attempt to deconstruct noncanonical term")
;
NonCanon = canonicalize,
- Functor = "<<" ++ string(TypeCtorRep) ++ ">>",
+ Functor = Name,
Arity = 0,
Arguments = []
;
% XXX this needs to be fixed
NonCanon = include_details_cc,
- Functor = "<<" ++ string(TypeCtorRep) ++ ">>",
+ Functor = Name,
Arity = 0,
Arguments = []
)
@@ -585,6 +617,10 @@
ArgTypeInfo = TypeInfo ^ var_arity_type_info_index(Loc),
SubTerm = get_subterm(ArgTypeInfo, Term, Loc, 0),
Univ = univ(SubTerm).
+
+:- pred same_array_elem_type(array(T)::unused, T::unused) is det.
+
+same_array_elem_type(_, _).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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