[m-dev.] diff: fix bug in Aditi interface

[Simon Taylor]

Estimated hours taken: 0.5

Aditi does not have a builtin character type, so the code
to read tuples returned by Aditi needs to allow integers
where characters are expected.

extras/aditi/aditi.m:
	Call io__read_from_string_with_int_instead_of_char instead
	of io__read_from_string.

library/io.m:
	Add io__read_from_string_with_int_instead_of_char, for
	use by extras/aditi/aditi.m.

library/term.m:
	Add term_to_type_with_int_instead_of_char, for use by
	io__read_from_string_with_int_instead_of_char.

Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.206
diff -u -u -r1.206 io.m
--- library/io.m	2000/09/20 12:12:35	1.206
+++ library/io.m	2000/10/10 05:26:51
@@ -1087,12 +1087,22 @@
 :- pred io__write_univ(univ, io__state, io__state).
 :- mode io__write_univ(in, di, uo) is det.
 
+% This is the same as io__read_from_string, except that an integer
+% is allowed where a character is expected. This is needed by
+% extras/aditi/aditi.m because Aditi does not have a builtin
+% character type.
+
+:- pred io__read_from_string_with_int_instead_of_char(string, string, int,
+			io__read_result(T), posn, posn).
+:- mode io__read_from_string_with_int_instead_of_char(in, in, in,
+			out, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 :- import_module map, dir, term, term_io, varset, require, benchmarking, array.
-:- import_module int, parser, exception.
+:- import_module bool, int, parser, exception.
 :- use_module table_builtin.
 
 :- type io__state ---> io__state(c_pointer).
@@ -1718,20 +1728,48 @@
 io__read(Result) -->
 	term_io__read_term(ReadResult),
 	io__get_line_number(LineNumber),
-	{ io__process_read_term(ReadResult, LineNumber, Result) }.
+	{ IntInsteadOfChar = no },
+	{ io__process_read_term(IntInsteadOfChar, ReadResult, LineNumber,
+		Result) }.
+
+io__read_from_string_with_int_instead_of_char(FileName, String, Len, Result,
+		Posn0, Posn) :-
+	IntInsteadOfChar = yes,
+	io__read_from_string(IntInsteadOfChar, FileName, String, Len, Result,
+		Posn0, Posn).
 
 io__read_from_string(FileName, String, Len, Result, Posn0, Posn) :-
-	parser__read_term_from_string(FileName, String, Len, Posn0, Posn, ReadResult),
+	IntInsteadOfChar = no,
+	io__read_from_string(IntInsteadOfChar, FileName, String, Len,
+		Result, Posn0, Posn). 
+
+:- pred io__read_from_string(bool, string, string, int, io__read_result(T),
+				posn, posn).
+:- mode io__read_from_string(in, in, in, in, out, in, out) is det.
+
+io__read_from_string(IntInsteadOfChar, FileName, String, Len,
+		Result, Posn0, Posn) :-
+	parser__read_term_from_string(FileName, String, Len,
+		Posn0, Posn, ReadResult),
 	Posn = posn(LineNumber, _, _),
-	io__process_read_term(ReadResult, LineNumber, Result).
+	io__process_read_term(IntInsteadOfChar, ReadResult, LineNumber, Result).
 
-:- pred io__process_read_term(read_term, int, io__read_result(T)).
-:- mode io__process_read_term(in, in, out) is det.
+:- pred io__process_read_term(bool, read_term, int, io__read_result(T)).
+:- mode io__process_read_term(in, in, in, out) is det.
 
-io__process_read_term(ReadResult, LineNumber, Result) :-
+io__process_read_term(IntInsteadOfChar, ReadResult, LineNumber, Result) :-
 	(	
 		ReadResult = term(_VarSet, Term),
-		( term_to_type(Term, Type) ->
+		( 
+			(
+				IntInsteadOfChar = yes,
+				term_to_type_with_int_instead_of_char(Term,
+					Type)
+			;
+				IntInsteadOfChar = no,
+				term_to_type(Term, Type)
+			)
+		->
 			Result = ok(Type)
 		;
 			( \+ term__is_ground(Term) ->
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.93
diff -u -u -r1.93 term.m
--- library/term.m	2000/03/24 10:27:42	1.93
+++ library/term.m	2000/10/10 05:26:51
@@ -327,6 +327,14 @@
 
 :- interface.
 
+% This is the same as term_to_type, except that an integer
+% is allowed where a character is expected. This is needed by 
+% extras/aditi/aditi.m because Aditi does not have a builtin
+% character type.
+
+:- pred term__term_to_type_with_int_instead_of_char(term(U), T).
+:- mode term__term_to_type_with_int_instead_of_char(in, out) is semidet.
+
 	% This predidicate is being phased out, because of the problem
 	% mentioned in the "BEWARE:" below.
 :- pragma obsolete(term__compare/4).
@@ -345,7 +353,7 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module std_util, require, array, int, string.
+:- import_module bool, char, std_util, require, array, int, string.
 
 %-----------------------------------------------------------------------------%
 
@@ -359,8 +367,20 @@
 term__term_to_type(Term, Val) :-
 	term__try_term_to_type(Term, ok(Val)).
 
+term__term_to_type_with_int_instead_of_char(Term, Val) :-
+	IntInsteadOfChar = yes,
+	term__try_term_to_type(IntInsteadOfChar, Term, ok(Val)).
+
 term__try_term_to_type(Term, Result) :-
-	term__try_term_to_univ(Term, type_of(ValTypedVar), UnivResult),
+	IntInsteadOfChar = no,
+	term__try_term_to_type(IntInsteadOfChar, Term, Result).
+
+:- pred term__try_term_to_type(bool, term(U), term_to_type_result(T, U)).
+:- mode term__try_term_to_type(in, in, out) is det.
+
+term__try_term_to_type(IntInsteadOfChar, Term, Result) :-
+	term__try_term_to_univ(IntInsteadOfChar, Term,
+		type_of(ValTypedVar), UnivResult),
 	(
 		UnivResult = ok(Univ),
 		det_univ_to_type(Univ, Val),
@@ -371,23 +391,23 @@
 		Result = error(Error)
 	).
 
-:- pred term__try_term_to_univ(term(T)::in, type_desc::in,
+:- pred term__try_term_to_univ(bool::in, term(T)::in, type_desc::in,
 		term_to_type_result(univ, T)::out) is det.
 
-term__try_term_to_univ(Term, Type, Result) :-
-	term__try_term_to_univ_2(Term, Type, [], Result).
+term__try_term_to_univ(IntInsteadOfChar, Term, Type, Result) :-
+	term__try_term_to_univ_2(IntInsteadOfChar, Term, Type, [], Result).
 	
-:- pred term__try_term_to_univ_2(term(T)::in, type_desc::in,
+:- pred term__try_term_to_univ_2(bool::in, term(T)::in, type_desc::in,
 		term_to_type_context::in,
 		term_to_type_result(univ, T)::out) is det.
 
-term__try_term_to_univ_2(term__variable(Var), _Type, Context,
+term__try_term_to_univ_2(_, term__variable(Var), _Type, Context,
 		error(mode_error(Var, Context))).
-term__try_term_to_univ_2(Term, Type, Context, Result) :-
+term__try_term_to_univ_2(IntInsteadOfChar, Term, Type, Context, Result) :-
 	Term = term__functor(Functor, ArgTerms, TermContext),
 	(
 		type_ctor_and_args(Type, TypeCtor, TypeArgs),
-		term__term_to_univ_special_case(
+		term__term_to_univ_special_case(IntInsteadOfChar,
 			type_ctor_module_name(TypeCtor),
 			type_ctor_name(TypeCtor), 
 			TypeArgs, Term, Type, Context, SpecialCaseResult)
@@ -397,8 +417,8 @@
 		Functor = term__atom(FunctorName),
 		list__length(ArgTerms, Arity),
 		find_functor(Type, FunctorName, Arity, FunctorNumber, ArgTypes),
-		term__term_list_to_univ_list(ArgTerms, ArgTypes,
-			Functor, 1, Context, TermContext, ArgsResult)
+		term__term_list_to_univ_list(IntInsteadOfChar, ArgTerms,
+			ArgTypes, Functor, 1, Context, TermContext, ArgsResult)
 	->
 		(
 			ArgsResult = ok(ArgValues),
@@ -418,31 +438,38 @@
 		Result = error(type_error(Term, Type, TermContext, RevContext))
 	).
 
-:- pred term__term_to_univ_special_case(string::in, string::in, 
+:- pred term__term_to_univ_special_case(bool::in, string::in, string::in, 
 		list(type_desc)::in, 
 		term(T)::in(bound(term__functor(ground, ground, ground))),
 		type_desc::in, term_to_type_context::in,
 		term_to_type_result(univ, T)::out) is semidet.
 
-term__term_to_univ_special_case("builtin", "character", [],
+term__term_to_univ_special_case(IntInsteadOfChar, "builtin", "character", [],
 		Term, _, _, ok(Univ)) :-
-	Term = term__functor(term__atom(FunctorName), [], _),
-	string__first_char(FunctorName, Char, ""),
+	(
+		IntInsteadOfChar = no,
+		Term = term__functor(term__atom(FunctorName), [], _),
+		string__first_char(FunctorName, Char, "")
+	;
+		IntInsteadOfChar = yes,
+		Term = term__functor(term__integer(Int), [], _),
+		char__to_int(Char, Int)
+	),
 	type_to_univ(Char, Univ).
-term__term_to_univ_special_case("builtin", "int", [],
+term__term_to_univ_special_case(_, "builtin", "int", [],
 		Term, _, _, ok(Univ)) :-
 	Term = term__functor(term__integer(Int), [], _),
 	type_to_univ(Int, Univ).
-term__term_to_univ_special_case("builtin", "string", [],
+term__term_to_univ_special_case(_, "builtin", "string", [],
 		Term, _, _, ok(Univ)) :-
 	Term = term__functor(term__string(String), [], _),
 	type_to_univ(String, Univ).
-term__term_to_univ_special_case("builtin", "float", [],
+term__term_to_univ_special_case(_, "builtin", "float", [],
 		Term, _, _, ok(Univ)) :-
 	Term = term__functor(term__float(Float), [], _),
 	type_to_univ(Float, Univ).
-term__term_to_univ_special_case("array", "array", [ElemType], Term, _Type,
-		PrevContext, Result) :-
+term__term_to_univ_special_case(IntInsteadOfChar, "array", "array", [ElemType],
+		Term, _Type, PrevContext, Result) :-
 	%
 	% arrays are represented as terms of the form
 	%	array([elem1, elem2, ...])
@@ -457,7 +484,8 @@
 	ListType = type_of([Elem]),
 	ArgContext = arg_context(term__atom("array"), 1, TermContext),
 	NewContext = [ArgContext | PrevContext],
-	term__try_term_to_univ_2(ArgList, ListType, NewContext, ArgResult),
+	term__try_term_to_univ_2(IntInsteadOfChar, ArgList, ListType,
+		NewContext, ArgResult),
 	(
 		ArgResult = ok(ListUniv),
 		has_type(Elem2, ElemType),
@@ -469,10 +497,11 @@
 		ArgResult = error(Error),
 		Result = error(Error)
 	).
-term__term_to_univ_special_case("builtin", "c_pointer", _, _, _, 
+term__term_to_univ_special_case(_, "builtin", "c_pointer", _, _, _, 
 		_, _) :-
 	fail.
-term__term_to_univ_special_case("std_util", "univ", [], Term, _, _, Result) :-
+term__term_to_univ_special_case(_, "std_util", "univ", [],
+		Term, _, _, Result) :-
 	% Implementing this properly would require keeping a
 	% global table mapping from type names to type_infos
 	% for all of the types in the program...
@@ -496,24 +525,27 @@
 	% like all the other results returned from this procedure.
 	Result = ok(univ(Univ)).
 
-term__term_to_univ_special_case("std_util", "type_info", _, _, _, _, _) :-
+term__term_to_univ_special_case(_, "std_util", "type_info", _, _, _, _, _) :-
 	% ditto
 	fail.
 
-:- pred term__term_list_to_univ_list(list(term(T))::in, list(type_desc)::in,
-		term__const::in, int::in, term_to_type_context::in,
-		term__context::in, term_to_type_result(list(univ), T)::out)
-		is semidet.
-term__term_list_to_univ_list([], [], _, _, _, _, ok([])).
-term__term_list_to_univ_list([ArgTerm|ArgTerms], [Type|Types],
-		Functor, ArgNum, PrevContext, TermContext, Result) :-
+:- pred term__term_list_to_univ_list(bool::in, list(term(T))::in,
+		list(type_desc)::in, term__const::in, int::in,
+		term_to_type_context::in, term__context::in,
+		term_to_type_result(list(univ), T)::out) is semidet.
+term__term_list_to_univ_list(_, [], [], _, _, _, _, ok([])).
+term__term_list_to_univ_list(IntInsteadOfChar, [ArgTerm|ArgTerms],
+		[Type|Types], Functor, ArgNum, PrevContext,
+		TermContext, Result) :-
 	ArgContext = arg_context(Functor, ArgNum, TermContext),
 	NewContext = [ArgContext | PrevContext],
-	term__try_term_to_univ_2(ArgTerm, Type, NewContext, ArgResult),
+	term__try_term_to_univ_2(IntInsteadOfChar, ArgTerm, Type,
+		NewContext, ArgResult),
 	(
 		ArgResult = ok(Arg),
-		term__term_list_to_univ_list(ArgTerms, Types, Functor,
-			ArgNum + 1, PrevContext, TermContext, RestResult),
+		term__term_list_to_univ_list(IntInsteadOfChar, ArgTerms, Types,
+			Functor, ArgNum + 1, PrevContext,
+			TermContext, RestResult),
 		(
 			RestResult = ok(Rest),
 			Result = ok([Arg | Rest])
Index: extras/aditi/aditi.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/aditi/aditi.m,v
retrieving revision 1.12
diff -u -u -r1.12 aditi.m
--- extras/aditi/aditi.m	2000/06/27 05:39:53	1.12
+++ extras/aditi/aditi.m	2000/10/10 05:26:20
@@ -1434,7 +1434,7 @@
 		"MADITI__read_attr_from_string").
 
 aditi__read_attr_from_string(String, MaxPos, Thing, Posn0, Posn, Status) :-
-	io__read_from_string("Aditi tuple", String,
+	io__read_from_string_with_int_instead_of_char("Aditi tuple", String,
 		MaxPos, Result, Posn0, Posn),
 	( Result = ok(Thing0) ->
 		Thing = Thing0,
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------