[m-rev.] diff: term_to_type/2 and type_to_term/2 for version_arrays

[Julien Fischer]

Branches: main
Make io.read, term_to_type and type_to_term support version arrays.

library/term.m:
 	Implement conversion of terms to version arrays and vice versa.

tests/hard_coded/Mmakefile:
tests/hard_coded/type_to_term.{m,exp}:
 	Add a test for the above and also test the special cases
 	for term_to_type and type_to_term more thoroughly than we
 	were.

Julien.

Index: library/term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.133
diff -u -r1.133 term.m
--- library/term.m	3 May 2011 04:35:01 -0000	1.133
+++ library/term.m	21 May 2011 17:00:32 -0000
@@ -466,6 +466,7 @@
  :- import_module int.
  :- import_module require.
  :- import_module string.
+:- import_module version_array.

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

@@ -600,6 +601,27 @@
          ArgResult = error(Error),
          Result = error(Error)
      ).
+term_to_univ_special_case("version_array", "version_array", [ElemType],
+        Term, _Type, PrevContext, Result) :-
+    % We handle version arrays in pretty much the same way as normal
+    % arrays.
+    Term = functor(atom("version_array"), [ArgList], TermContext),
+    has_type(Elem, ElemType),
+    ListType = type_of([Elem]),
+    ArgContext = arg_context(atom("version_array"), 1, TermContext),
+    NewContext = [ArgContext | PrevContext],
+    try_term_to_univ_2(ArgList, ListType, NewContext, ArgResult),
+    (
+        ArgResult = ok(ListUniv),
+        has_type(Elem2, ElemType),
+        same_type(List, [Elem2]),
+        det_univ_to_type(ListUniv, List),
+        Array = version_array(List),
+        Result = ok(univ(Array))
+    ;
+        ArgResult = error(Error),
+        Result = error(Error)
+    ).
  term_to_univ_special_case("builtin", "c_pointer", _, _, _, _, _) :-
      fail.
  term_to_univ_special_case("univ", "univ", [], Term, _, _, Result) :-
@@ -740,6 +762,15 @@
      array.to_list(Array, List),
      type_to_term(List, ArgsTerm).

+univ_to_term_special_case("version_array", "version_array", [ElemType],
+        Univ, Context, Term) :-
+    Term = functor(atom("version_array"), [ArgsTerm], Context),
+    has_type(Elem, ElemType),
+    same_type(List, [Elem]),
+    det_univ_to_type(Univ, Array),
+    List = version_array.to_list(Array),
+    type_to_term(List, ArgsTerm).
+
  :- pred univ_list_to_term_list(list(univ)::in, list(term(T))::out) is det.

  univ_list_to_term_list([], []).
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.402
diff -u -r1.402 Mmakefile
--- tests/hard_coded/Mmakefile	3 May 2011 04:31:19 -0000	1.402
+++ tests/hard_coded/Mmakefile	23 May 2011 14:27:39 -0000
@@ -288,6 +288,7 @@
  	type_qual \
  	type_spec_ho_term \
  	type_spec_modes \
+	type_to_term \
  	type_to_term_bug \
  	uc_export_enum \
  	unicode_test \
Index: tests/hard_coded/type_to_term.exp
===================================================================
RCS file: tests/hard_coded/type_to_term.exp
diff -N tests/hard_coded/type_to_term.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/type_to_term.exp	23 May 2011 14:27:13 -0000
@@ -0,0 +1,16 @@
+Term: 'A'
+Type: A
+Term: 42
+Type: 42
+Term: 12345.6789
+Type: 12345.6789
+Term: "abcdefghijklmnopqrstuvwxyz"
+Type: abcdefghijklmnopqrstuvwxyz
+Term: "<24:10AFBD>"
+Type: <24:10AFBD>
+Term: type_info(list : list(int : int))
+Type: <<term_to_type/2 failed>> (as expected)
+Term: array([1, 2, 3])
+Type: array([1, 2, 3])
+Term: version_array([1, 2, 3])
+Type: version_array([1, 2, 3])
Index: tests/hard_coded/type_to_term.m
===================================================================
RCS file: tests/hard_coded/type_to_term.m
diff -N tests/hard_coded/type_to_term.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/type_to_term.m	23 May 2011 14:27:13 -0000
@@ -0,0 +1,128 @@
+% Test various special cases for type_to_term/2 and term_to_type/2.
+%
+:- module type_to_term.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module array.
+:- import_module bitmap.
+:- import_module list.
+:- import_module require.
+:- import_module term.
+:- import_module term_io.
+:- import_module type_desc.
+:- import_module univ.
+:- import_module varset.
+:- import_module version_array.
+
+main(!IO) :-
+	varset.init(VarSet),
+
+	% Test handling of characters
+	%
+	Char = 'A',
+	type_to_term(Char, CharTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, CharTerm, !IO),
+	io.nl(!IO),
+	det_term_to_type(CharTerm, CharValue : character),
+	io.write_string("Type: ", !IO),
+	io.write_char(CharValue, !IO),
+	io.nl(!IO),
+
+	% Test handling of ints.
+	%
+	Int = 42,
+	type_to_term(Int, IntTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, IntTerm, !IO),
+	io.nl(!IO),
+	det_term_to_type(IntTerm, IntValue : int),
+	io.write_string("Type: ", !IO),
+	io.write_int(IntValue, !IO),
+	io.nl(!IO),
+
+	% Test handling of floats.
+	%
+	Float = 12345.6789,
+	type_to_term(Float, FloatTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, FloatTerm, !IO),
+	io.nl(!IO),
+	det_term_to_type(FloatTerm, FloatValue : float),
+	io.write_string("Type: ", !IO),
+	io.write_float(FloatValue, !IO),
+	io.nl(!IO),
+ 
+	% Test handling of strings.
+	%
+	String = "abcdefghijklmnopqrstuvwxyz",
+	type_to_term(String, StringTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, StringTerm, !IO),
+	io.nl(!IO),
+	det_term_to_type(StringTerm, StringValue : string),
+	io.write_string("Type: ", !IO),
+	io.write_string(StringValue, !IO),
+	io.nl(!IO),
+
+	% Ttest handling of bitmaps.
+	%
+	( if Bitmap0 = bitmap.from_string("<24:10AFBD>") then
+		Bitmap = Bitmap0
+	   else
+		error("bitmap.from_string/1 failed")
+	),
+	type_to_term(Bitmap, BitmapTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, BitmapTerm, !IO),
+	io.nl(!IO),
+	det_term_to_type(BitmapTerm, BitmapValue : bitmap),
+	io.write_string("Type: ", !IO),
+	io.write_string(bitmap.to_string(BitmapValue), !IO),
+	io.nl(!IO),
+ 
+	% Test handling of type_descs.
+	%
+	TypeDesc = type_of([1, 2, 3]),
+	type_to_term(TypeDesc, TypeDescTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, TypeDescTerm, !IO),
+	io.nl(!IO),
+	% We don't currently support converting terms to type_descs.
+	io.write_string("Type: ", !IO),
+	( if term_to_type(TypeDescTerm, TypeDescValue : type_desc) then
+	   io.write(TypeDescValue, !IO)
+	  else
+	   io.write_string("<<term_to_type/2 failed>> (as expected)", !IO)
+	),
+	io.nl(!IO),
+
+	% Test handling of arrays.
+	%
+	Array = array([1, 2, 3]),
+	type_to_term(Array, ArrayTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, ArrayTerm, !IO),
+	io.nl(!IO),
+	det_term_to_type(ArrayTerm, ArrayValue : array(int)),
+	io.write_string("Type: ", !IO),
+	io.write(ArrayValue, !IO),
+	io.nl(!IO),
+
+	% Test handling of version arrays.
+	%
+	VArray = version_array([1, 2, 3]),
+	type_to_term(VArray, VArrayTerm : term(generic)),
+	io.write_string("Term: ", !IO),
+	term_io.write_term(VarSet, VArrayTerm, !IO),
+	io.nl(!IO),
+	det_term_to_type(VArrayTerm, VArrayValue : version_array(int)),
+	io.write_string("Type: ", !IO),
+	io.write(VArrayValue, !IO),
+	io.nl(!IO).
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------