[m-rev.] [reuse] for review: preparing the field of annoting more specific aliases

[Nancy Mazur]

Hi Peter, 

adding the alias-bits is a bit trickier than I thought... especially
wrt renaming... I'm a bit stuck in how to rename the foreign_code
attributes within make_hlds... at least I think that's where
the renaming should occur ... : 
	- after having read in the pragma-information, 
	- it's in make_hlds that this pragma-information is 
	  processed and finally stored in the clauses-info... so that's
	  why renaming should be done there (so that the expressed
	  aliases are renamed to the formal variables and type-variables... )

That's work for tomorrow though... as I don't fully understand what's
going in clauses_info_add_pragma_foreign_code... 

Nancy


===================================================================


Estimated hours taken: 4
Branches: reuse

Alias-annotations in pragma_foreign_code is now either: 
	- no_aliasing
	- unknown_aliasing
	- or alias(MaybeTypes, AliasList)
such that
	MaybeTypes = yes( Full List of the types of the variables involved
			in the foreign code)
		   = no
	AliasList = list of aliases expressed as
			cel(Var, TypeSelectorList) - cel(OtherVar, OterSel)

At this moment, the analysis system (pa_alias_as__extend_foreign_code)
will only deal correcty with `no_aliasing' or `unknown_aliasing'
(so nothing is changed wrt peter's changes), but the field is prepared. 

pa_alias_as.m:
prog_data.m:
prog_io_pragma.m:
	Deal with new user-alias-annotations. 


Index: pa_alias_as.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias_as.m,v
retrieving revision 1.1.2.16
diff -u -r1.1.2.16 pa_alias_as.m
--- pa_alias_as.m	2001/03/21 13:19:43	1.1.2.16
+++ pa_alias_as.m	2001/03/21 21:57:40
@@ -156,6 +156,12 @@
 :- pred parse_read_aliases_from_single_term(term(T), alias_as).
 :- mode parse_read_aliases_from_single_term(in, out) is det.
 
+:- pred parse_user_declared_aliases(term, aliasing).
+:- mode parse_user_declared_aliases(in, out) is semidet.
+
+:- pred to_user_declared_aliases(aliasing, string). 
+:- mode to_user_declared_aliases(in, out) is det.
+
 	% Live = live(IN_USE,LIVE_0,ALIASES).
 	% compute the live-set based upon an initial IN_USE set, 
 	% and a list of aliases.
@@ -479,12 +485,18 @@
 	remove_all_unique_vars(HLDS, Trios, NonUniqueVars), 
 	% keep only the output vars
 	collect_all_output_vars(HLDS, NonUniqueVars, OutputVars), 
-%	collect_all_input_vars(HLDS, NonUniqueVars, InputVars), 
 	(
+		aliasing(Attrs, UserDefinedAlias),
+		UserDefinedAlias = aliasing(_MaybeTypes, UserAlias),
+		% XXX at the moment we handle only bottom aliases
+		% In order to deal with plain aliases, renaming
+		% has to be done in the make-hlds-stage...
+		UserAlias = bottom
+	->
+		Alias = Alias0
+	;	
 		(
 			OutputVars = [] 
-		;
-			aliasing(Attrs, no_aliasing)
 %		; 
 %			% XXXXXXXXXXXXXXXXX !!
 %			OutputVars = [_], InputVars = []
@@ -506,14 +518,9 @@
 		; 
 
 			goal_info_get_context(GoalInfo, Context), 
-			term__context_line(Context, ContextLine), 
-			term__context_file(Context, ContextFile), 
-			string__int_to_string(ContextLine, ContextLineS), 
-
+			format_context(Context, ContextStr), 
 			string__append_list(["pragma_foreign_code:",
-						" (",ContextFile, ":", 
-						ContextLineS, ")"], Msg), 
-			
+						" (",ContextStr, ")"], Msg), 
 			pa_alias_as__top(Alias0, Msg, Alias)
 		)
 	).
@@ -634,9 +641,9 @@
 	).
 		
 
-%-------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 % printing routines
-%-------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
 	% MaybeAs = yes(Alias_as) -> print out Alias_as
 	%         = no		   -> print "not available"
@@ -705,9 +712,9 @@
 	).
 
 
-%-------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 % parsing routines
-%-------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
 parse_read_aliases(LISTTERM ,AS):- 
 	(
@@ -743,11 +750,9 @@
 		; 
 			CONS = "top"
 		->
-			term__context_line(Context, ContextLine), 
-			term__context_file(Context, ContextFile), 
-			string__int_to_string(ContextLine, ContextLineS), 
+			format_context(Context, ContextString), 
 			string__append_list(["imported top (", 
-				ContextFile, ":", ContextLineS, ")"], 
+				ContextString, ")"], 
 					Msg),
 			top(Msg, AS)
 		;
@@ -786,7 +791,94 @@
                 error("(pa_alias_as) parse_list_alias_term: term is not a functor")
 	).
 
+%-----------------------------------------------------------------------------%
+% user declared aliases
+%-----------------------------------------------------------------------------%
+
+parse_user_declared_aliases(term__functor(term__atom("no_aliasing"), [], _),
+                Aliasing):-
+        pa_alias_as__init(BottomAlias),
+	Aliasing = aliasing(no, BottomAlias). 
+parse_user_declared_aliases(term__functor(term__atom("unknown_aliasing"), 
+				[], Context), Aliasing):-
+	format_context(Context, ContextString), 
+	string__append_list(["user declared top (", ContextString, ")"], Msg),
+        pa_alias_as__top(Msg, TopAlias), 
+	Aliasing = aliasing(no, TopAlias). 
+parse_user_declared_aliases(term__functor(term__atom("alias"), 
+		[TypesTerm,AliasTerm], _), Aliasing):-
+	(
+		TypesTerm = term__functor(term__atom("yes"), 
+					ListTypesTerms, _), 
+		list__map(term__coerce, ListTypesTerms, Types), 
+		MaybeTypes = yes(Types)
+	;
+		TypesTerm = term__functor(term__atom("no"),[],_), 
+		MaybeTypes = no
+	), 
+	parse_user_declared_aliases_2(AliasTerm, AliasAs), 
+	Aliasing = aliasing(MaybeTypes, AliasAs). 
+
+:- pred format_context(term__context::in, string::out) is det.
+format_context(Context, String):- 
+	term__context_line(Context, ContextLine), 
+	term__context_file(Context, ContextFile), 
+	string__int_to_string(ContextLine, ContextLineS), 
+	string__append_list([ContextFile, ":", ContextLineS], 
+			String).
+
+:- pred parse_user_declared_aliases_2(term::in, alias_as::out) is det.
+parse_user_declared_aliases_2(ListTerm, AliasAS):- 
+	(
+		parse_list_term(ListTerm, AllTerms)
+	-> 
+		list__map(parse_single_user_declared_alias, 
+				AllTerms, AliasList),
+		pa_alias_set__from_pair_alias_list(AliasList, AliasSet),
+		wrap(AliasSet, AliasAS)
+	;
+		error("(pa_alias_as) parse_user_declared_aliases_2: term not a functor")
+	).
+
+:- pred parse_list_term(term::in, list(term)::out) is semidet.
+parse_list_term(ListTerm, Terms):- 
+	ListTerm = term__functor(term__atom(Cons), Args, _), 
+	(
+		Cons = "."
+	->
+		Args = [FirstTerm, RestTerm],
+		parse_list_term(RestTerm, RestList), 
+		Terms = [FirstTerm | RestList]
+	;
+		Cons = "[]"
+	->
+		Terms = []
+	; 
+		fail
+	). 
+
+:- pred parse_single_user_declared_alias(term::in, alias::out) is det.
+parse_single_user_declared_alias(Term, Alias):- 
+	(
+		Term = term__functor(term__atom("-"), [Left, Right], _)
+	->
+		% Left and Right have shape "cel(ProgVar, Selectors)"
+		pa_datastruct__parse_term(Left, LeftData), 
+		pa_datastruct__parse_term(Right, RightData), 
+		Alias = LeftData - RightData
+	;
+		error("(pa_alias_as) parse_single_user_declared_alias: wrong functor.")
+	).
+		
+to_user_declared_aliases(aliasing(_, bottom), "no_aliasing"). 
+to_user_declared_aliases(aliasing(_, top(_)), "unknown_aliasing").
+to_user_declared_aliases(aliasing(_, real_as(_)), "alias([])"). 
+
+%-----------------------------------------------------------------------------%
 
+%-----------------------------------------------------------------------------%
+% Extra 
+%-----------------------------------------------------------------------------%
 :- pred wrap(pa_alias_set__alias_set, alias_as).
 :- mode wrap(in, out) is det.
 
@@ -837,6 +929,7 @@
 	pa_alias_set__apply_widening(ModuleInfo, ProcInfo, 
 			AliasSet0, AliasSet), 
 	A = real_as(AliasSet).
+
 %-----------------------------------------------------------------------------%
 % computing LIVE_SET
 %-----------------------------------------------------------------------------%
Index: prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.58.2.8
diff -u -r1.58.2.8 prog_data.m
--- prog_data.m	2001/03/21 13:19:45	1.58.2.8
+++ prog_data.m	2001/03/21 21:57:41
@@ -535,6 +535,7 @@
 		% `pragma_c_code_attribute's.
 :- type pragma_foreign_code_attributes.
 
+
 :- pred default_attributes(foreign_language, pragma_foreign_code_attributes).
 :- mode default_attributes(in, out) is det.
 
@@ -592,9 +593,14 @@
 	--->	not_tabled_for_io
 	;	tabled_for_io.
 
-:- type aliasing
-	--->	no_aliasing
-	;	unknown_aliasing.
+% :- type aliasing
+%	--->	no_aliasing
+%	;	unknown_aliasing.
+:- type aliasing 
+	---> 	aliasing(maybe(list(type)), % this is only needed when the
+					    % user expresses aliases in terms
+					    % of type-variables.
+			 pa_alias_as__alias_as). 
 
 :- type pragma_var    
 	--->	pragma_var(prog_var, string, mode).
@@ -987,7 +993,9 @@
 
 default_attributes(Language, 
 	attributes(Language, may_call_mercury, not_thread_safe, 
-		not_tabled_for_io, unknown_aliasing)).
+		not_tabled_for_io, Aliasing)):-
+	pa_alias_as__top("Default top", TopAlias), 
+	Aliasing = aliasing(no, TopAlias).
 
 may_call_mercury(Attrs, Attrs ^ may_call_mercury).
 
@@ -1040,14 +1048,8 @@
 	;
 		TabledForIO = not_tabled_for_io,
 		TabledForIOStr = "not_tabled_for_io"
-	),
-	(
-		Aliasing = no_aliasing,
-		AliasingStr = "no_aliasing"
-	;
-		Aliasing = unknown_aliasing,
-		AliasingStr = "unknown_aliasing"
 	),
+	to_user_declared_aliases(Aliasing, AliasingStr), 
 	StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr,
 			AliasingStr].
 
Index: prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.23.2.7
diff -u -r1.23.2.7 prog_io_pragma.m
--- prog_io_pragma.m	2001/03/21 13:19:49	1.23.2.7
+++ prog_io_pragma.m	2001/03/21 21:57:41
@@ -1175,7 +1175,7 @@
 	--->	may_call_mercury(may_call_mercury)
 	;	thread_safe(thread_safe)
 	;	tabled_for_io(tabled_for_io)
-	;	aliasing(aliasing).
+	;	collected_aliasing(aliasing).
 
 :- pred parse_pragma_foreign_code_attributes_term(foreign_language, term, 
 		pragma_foreign_code_attributes).
@@ -1216,12 +1216,16 @@
 	;
 		Attributes3 = Attributes2
 	),
-	( list__member(aliasing(no_aliasing), AttrList) ->
-		( list__member(aliasing(unknown_aliasing), AttrList) ->
+	( list__filter(
+			pred(C::in) is semidet :- 
+				C = collected_aliasing(_), 
+			AttrList, 
+			AliasInfo), AliasInfo \= [] ->
+		( AliasInfo = [collected_aliasing(Aliasing)] ->
+			set_aliasing(Attributes3, Aliasing, Attributes)
+		;
 			% XXX an error message would be nice
 			fail
-		;
-			set_aliasing(Attributes3, no_aliasing, Attributes)
 		)
 	;
 		Attributes = Attributes3
@@ -1260,7 +1264,7 @@
 	; parse_tabled_for_io(Term, TabledForIo) ->
 		Flag = tabled_for_io(TabledForIo)
 	; parse_aliasing(Term, Aliasing) ->
-		Flag = aliasing(Aliasing)
+		Flag = collected_aliasing(Aliasing)
 	;
 		fail
 	).
@@ -1296,10 +1300,8 @@
 :- pred parse_aliasing(term, aliasing).
 :- mode parse_aliasing(in, out) is semidet.
 
-parse_aliasing(term__functor(term__atom("no_aliasing"), [], _),
-	no_aliasing).
-parse_aliasing(term__functor(term__atom("unknown_aliasing"), [], _),
-	unknown_aliasing).
+parse_aliasing(Term, Aliasing):- 
+	pa_alias_as__parse_user_declared_aliases(Term, Aliasing). 
 
 % parse a pragma foreign_code declaration
 

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------