[m-rev.] [reuse] diff: move printing/parsing routines to new file

Nancy Mazur Nancy.Mazur at cs.kuleuven.ac.be
Fri Jun 25 16:22:22 AEST 2004


Hi,


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


Estimated hours taken: 3
Branches: reuse

Move all the parsing and printing routines of selectors and datastructures to
a new module "prog_io_pasr", which is a submodule of parse_tree. 

prog_io_pasr.m:
	(new file) 
 	New file that is meant to contain all the printing and parsing routines
	for the public types used for the possible alias and structure reuse
	analysis. At this stage, only the printing and parsing routines for
	selectors and datastructs were moved. 

pa_alias.m:
pa_alias_as.m:
pa_datastruct.m:
pa_selector.m:
parse_tree.m:
sr_data.m:
	Effect of moving the printing/parsing routines for selectors and
	datastructs to the new module.


Index: pa_alias.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias.m,v
retrieving revision 1.1.2.19
diff -u -r1.1.2.19 pa_alias.m
--- pa_alias.m	11 Jun 2004 02:56:52 -0000	1.1.2.19
+++ pa_alias.m	25 Jun 2004 06:10:11 -0000
@@ -61,6 +61,7 @@
 :- import_module hlds__hlds_data.
 :- import_module hlds__hlds_llds.
 :- import_module parse_tree__mercury_to_mercury.
+:- import_module parse_tree__prog_io_pasr.
 :- import_module possible_alias__pa_datastruct.
 :- import_module possible_alias__pa_selector.
 :- import_module possible_alias__pa_sr_util.
@@ -71,15 +72,17 @@
 % printing routines
 %-------------------------------------------------------------------%
 
-print(ProcInfo, PredInfo, FrontString, EndString, Alias0) -->
-	{ Alias0 = D1 - D2 },
-	io__write_string(FrontString),
-	io__write_string("pair("),
-	pa_datastruct__print(PredInfo, ProcInfo, D1),
-	io__write_string(" , "),
-	pa_datastruct__print(PredInfo, ProcInfo, D2),
-	io__write_string(") "),
-	io__write_string(EndString).
+print(ProcInfo, PredInfo, FrontString, EndString, Alias0, !IO) :- 
+	proc_info_varset(ProcInfo, ProgVarSet),
+	pred_info_typevarset(PredInfo, TypeVarSet), 
+	Alias0 = D1 - D2,
+	io__write_string(FrontString, !IO),
+	io__write_string("pair(", !IO),
+	print_datastruct(ProgVarSet, TypeVarSet, D1, !IO),
+	io__write_string(" , ", !IO),
+	print_datastruct(ProgVarSet, TypeVarSet, D2, !IO),
+	io__write_string(") ", !IO),
+	io__write_string(EndString, !IO).
 
 %-------------------------------------------------------------------%
 % parsing routines
@@ -95,8 +98,8 @@
 			(
 				Args = [ First, Second ]
 			->
-				pa_datastruct__parse_term(First, D1),
-				pa_datastruct__parse_term(Second, D2),
+				parse_datastruct(First, D1),
+				parse_datastruct(Second, D2),
 				A = D1 - D2
 			;
 				list__length(Args, L),
Index: pa_alias_as.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_alias_as.m,v
retrieving revision 1.1.2.37
diff -u -r1.1.2.37 pa_alias_as.m
--- pa_alias_as.m	25 Jun 2004 02:33:49 -0000	1.1.2.37
+++ pa_alias_as.m	25 Jun 2004 06:10:18 -0000
@@ -329,6 +329,7 @@
 :- import_module check_hlds__type_util.
 :- import_module hlds__hlds_llds.
 :- import_module parse_tree__mercury_to_mercury.
+:- import_module parse_tree__prog_io_pasr.
 :- import_module possible_alias__pa_alias.
 :- import_module possible_alias__pa_alias_as__pa_alias_set.
 :- import_module possible_alias__pa_selector. 
@@ -1277,10 +1278,10 @@
 		tvarset::in, string::out) is det.
 alias_to_user_declared_alias(Alias, ProgVarSet, TypeVarSet, String):- 
 	Alias = Data0 - Data1, 
-	pa_datastruct__to_user_declared(Data0, ProgVarSet, TypeVarSet, 
-			Data0String), 
-	pa_datastruct__to_user_declared(Data1, ProgVarSet, TypeVarSet,
-			Data1String),
+	prog_io_pasr__to_user_declared_datastruct(ProgVarSet, TypeVarSet, 
+			Data0, Data0String), 
+	prog_io_pasr__to_user_declared_datastruct(ProgVarSet, TypeVarSet,
+			Data1, Data1String),
 	string__append_list([Data0String, " - ", Data1String],
 			String). 
 		
Index: pa_datastruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_datastruct.m,v
retrieving revision 1.1.2.12
diff -u -r1.1.2.12 pa_datastruct.m
--- pa_datastruct.m	11 Jun 2004 02:56:53 -0000	1.1.2.12
+++ pa_datastruct.m	25 Jun 2004 06:10:19 -0000
@@ -26,7 +26,7 @@
 :- import_module hlds__hlds_pred.
 :- import_module parse_tree__prog_data.
 
-:- import_module map, io, term.
+:- import_module map, term.
 
 %-------------------------------------------------------------------%
 %-- exported types
@@ -78,16 +78,6 @@
 :- pred rename_types(term__substitution(tvar_type)::in, 
 		datastruct::in, datastruct::out) is det. 
 
-	% Printing routines
-:- pred print(pred_info::in, proc_info::in, datastruct::in, 
-		io__state::di, io__state::uo) is det.
-
-:- pred to_user_declared(datastruct::in, prog_varset::in, 
-		tvarset::in, string::out) is det. 
-
-	% Parsing routines
-:- pred parse_term(term(T)::in, datastruct::out) is det.
-
 :- pred normalize_wti(module_info::in, proc_info::in, 
 		datastruct::in, datastruct::out) is det.
 
@@ -104,6 +94,7 @@
 :- implementation.
 
 :- import_module check_hlds__type_util.
+:- import_module parse_tree__prog_io_pasr.
 :- import_module possible_alias__pa_selector.
 
 :- import_module string, varset, require, list.
@@ -161,61 +152,6 @@
 
 init(V, Sel, Dout) :- 
 	Dout = selected_cel(V, Sel). 
-
-print(PredInfo, ProcInfo, D) --> 
-	{ D = selected_cel(ProgVar, SEL) },
-	{ proc_info_varset(ProcInfo, ProgVarset) },
-	{ varset__lookup_name(ProgVarset, ProgVar, ProgName) },
-	io__write_string("cel("),
-	io__write_string(ProgName), 
-	io__write_string(", "),
-	{ pred_info_typevarset(PredInfo, TypeVarSet) }, 
-	pa_selector__print(SEL, TypeVarSet),
-	io__write_string(")").
-
-to_user_declared(Data, ProgVarSet, TypeVarSet, String):- 
-	Data = selected_cel(ProgVar, Selector), 
-	varset__lookup_name(ProgVarSet, ProgVar, ProgName), 
-	pa_selector__to_user_declared(Selector, TypeVarSet, 
-			SelectorString), 
-	string__append_list(["cel(", ProgName, ", ", SelectorString, ")"], 
-		String). 
-
-parse_term(TERM, Data) :- 
-   (
-      TERM = term__functor(term__atom(CONS), Args, _)
-   ->
-      (
-         CONS = "cel"
-      ->
-         (
-            Args = [ VarTerm, SelectorTerm ]
-         ->
-           (
-              VarTerm = term__variable(VAR)
-	   ->
-	      term__coerce_var(VAR, PROGVAR),
-	      pa_selector__parse_term(SelectorTerm, SELECTOR),
-	      Data = selected_cel(PROGVAR, SELECTOR)
-	   ;
-	      error("(pa_datastruct) parse_term: wrong term. variable, should be functor")
-	   )
-	 ;
-	   list__length(Args, L),
-	   string__int_to_string(L, LS),
-	   string__append_list(["(pa_datastruct) parse_term: wrong number of arguments. cel/",LS,
-	   			"should be cel/2"],Msg),
-	   error(Msg)
-	 )
-      ;
-         string__append_list(["(pa_datastruct) parse_term: wrong constructor. `",CONS,
-	 			"' should be `cel'"],Msg),
-	   error(Msg)
-      )
-   ;
-      error("(pa_datastruct) parse_term: term not a functor")
-   ).
-
 
 normalize_wti(HLDS, ProcInfo, Din, Dout):-
 	proc_info_vartypes(ProcInfo, VarTypes), 
Index: pa_selector.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_selector.m,v
retrieving revision 1.1.2.16
diff -u -r1.1.2.16 pa_selector.m
--- pa_selector.m	11 Jun 2004 02:56:53 -0000	1.1.2.16
+++ pa_selector.m	25 Jun 2004 06:10:22 -0000
@@ -18,7 +18,7 @@
 :- import_module hlds__hlds_module.
 :- import_module parse_tree__prog_data.
 
-:- import_module list, int, io, term.
+:- import_module list, int, term.
 
 %-------------------------------------------------------------------%
 %-- exported types
@@ -69,12 +69,6 @@
 :- pred rename_types(term__substitution(tvar_type)::in, 
 		selector::in, selector::out) is det.
 
-:- pred print(selector::in, tvarset::in, 
-		io__state::di, io__state::uo) is det. 
-:- pred to_user_declared(selector::in, tvarset::in, string::out) is det. 
-
-:- pred parse_term(term(T)::in, selector::out) is det.
-
 	% normalize with type information
 :- pred normalize_wti(module_info::in, (type)::in, selector::in,
 		selector::out) is det.
@@ -97,6 +91,7 @@
 :- import_module hlds__hlds_pred.
 :- import_module parse_tree__mercury_to_mercury.
 :- import_module parse_tree__prog_io.
+:- import_module parse_tree__prog_io_pasr.
 :- import_module parse_tree__prog_out.
 
 :- import_module require, string, std_util, bool.
@@ -156,127 +151,6 @@
 		US = ts(Type)
 	).
 	
-print(Selector, ProgVarSet) -->
-	io__write_string("["),
-	io__write_list(Selector, ",", print_unit_selector(ProgVarSet)),
-	io__write_string("]").
-
-:- pred print_unit_selector(tvarset::in, unit_sel::in, 
-		io__state::di, io__state::uo) is det.
-
-print_unit_selector(_ProgVarSet, ns(Cons, Index)) -->
-	{ hlds_data__cons_id_arity(Cons, Arity) },
-	io__write_string("sel("),
-	mercury_output_cons_id(Cons, needs_brackets),
-	io__write_string(","),
-	io__write_int(Arity),
-	io__write_string(","),
-	io__write_int(Index),
-	io__write_string(")").
-print_unit_selector(ProgVarSet, ts(Type)) --> 
-	io__write_string("typesel("), 
-	mercury_output_term(Type, ProgVarSet, bool__no), 
-	io__write_string(")").
-
-to_user_declared(Selector, TVarSet, String):- 
-	(
-		Selector = []
-	-> 
-		String = "[]"
-	; 
-		to_user_declared_2(Selector, TVarSet, String2), 
-		string__append_list(["[", String2, "]"], String)
-	). 
-
-:- pred to_user_declared_2(selector::in, tvarset::in, string::out) is det.
-
-to_user_declared_2([], _, "").
-to_user_declared_2([First | Rest], TVarSet, String):- 
-	us_to_user_declared(First, TVarSet, FirstString), 
-	(
-		Rest = []
-	->
-		String = FirstString
-	;
-		to_user_declared_2(Rest, TVarSet, RestString), 
-		string__append_list([FirstString, ", ", RestString], 
-			String)
-	). 
-
-:- pred us_to_user_declared(unit_sel::in, tvarset::in, string::out) is det.
-us_to_user_declared(ns(_,_), _, _):- 
-	require__error("(pa_selector) us_to_user_declared: only type-selectors are allowed in user-alias-declaration.").
-us_to_user_declared(ts(Type), TVarSet, 
-		mercury_type_to_string(TVarSet, Type)). 
-
-parse_term(Term, Sel):- 
-	(
-		Term = term__functor(term__atom(Cons), Args, _)
-	->
-		(
-			Cons = "[|]",
-			Args = [ First , Rest ]
-		->
-			parse_unit_selector(First, US),
-			parse_term(Rest, SelRest),
-			Sel = [ US | SelRest ]
-		;
-			Sel = []
-		)
-	;
-		error("(pa_selector) parse_term: term not a functor")
-	).
-
-:- pred parse_unit_selector(term(T)::in, unit_sel::out) is det.
-
-parse_unit_selector(Term, US):- 
-   (
-      Term = term__functor(term__atom(Cons), Args, _)
-   ->
-      (
-         Cons = "sel",
-         Args = [ ConsTerm, ArityTerm, PosTerm ]
-      ->
-         (
-            prog_io__sym_name_and_args(ConsTerm, ConsID_SN, ConsID_Args),
-            ConsID_Args = [],
-	    ArityTerm = term__functor(term__integer(Arity), _, _),
-            PosTerm = term__functor(term__integer(Pos), _, _)
-         ->
-	    ConsID = cons(ConsID_SN, Arity),
-	    US = ns(ConsID, Pos)
-	 ;
-	    ConsTerm = term__functor(term__integer(X), _, _)
-	 ->
-	    ConsID = int_const(X), 
-	    US = ns(ConsID, 0)
-	 ;
-	    ConsTerm = term__functor(term__float(X), _, _)
-	 ->
-	    ConsID = float_const(X),
-	    US = ns(ConsID, 0)
-	 ;
-	    ConsTerm = term__functor(term__string(S), _, _)
-	 ->
-	    ConsID = string_const(S),
-	    US = ns(ConsID, 0)
-	 ;
-	    error("(pa_selector) parse_unit_selector: unknown cons_id in unit selector")
-	 )
-      ; 
-	 
-         Cons = "typesel",
-	 Args = [ TypeSelectorTerm ]
-      ->
- 	 term__coerce(TypeSelectorTerm, TypeSelector), 
-	 US = ts(TypeSelector)
-      ;
-	 error("(pa_selector) parse_unit_selector: top constructor should be sel/3 or typesel/1.")
-      )
-   ;
-      error("(pa_selector) parse_unit_selector: term not a functor")
-   ).
-
 
 normalize_wti(HLDS, VarType, Sel0, Sel):-
 	(
Index: parse_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/parse_tree.m,v
retrieving revision 1.2.2.1
diff -u -r1.2.2.1 parse_tree.m
--- parse_tree.m	11 Sep 2002 07:36:11 -0000	1.2.2.1
+++ parse_tree.m	25 Jun 2004 06:10:22 -0000
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 2002 The University of Melbourne.
+% Copyright (C) 2002,2004 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -25,6 +25,9 @@
 :- include_module prog_io.
    :- include_module prog_io_goal, prog_io_dcg, prog_io_pragma.
    :- include_module prog_io_typeclass, prog_io_util.
+   % parsing/printing of possible aliases (pa) and 
+   % structure reuse information (sr).
+   :- include_module prog_io_pasr.
 
 % Pretty-printers.
 :- include_module prog_out, mercury_to_mercury.
Index: prog_io_pasr.m
===================================================================
RCS file: prog_io_pasr.m
diff -N prog_io_pasr.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ prog_io_pasr.m	25 Jun 2004 06:10:23 -0000
@@ -0,0 +1,249 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2004 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% This module contains the printing and parsing routines for the public types
+% used for the possible-alias and structure reuse analysis. 
+% author: nancy
+
+:- module parse_tree__prog_io_pasr.
+
+:- interface. 
+
+:- import_module parse_tree__prog_data.
+
+:- import_module io, term.
+
+%-----------------------------------------------------------------------------%
+% Printing routines. 
+%-----------------------------------------------------------------------------%
+% 
+% 1. selectors. 
+:- pred print_selector(tvarset::in, selector::in, io__state::di, 
+		io__state::uo) is det.
+
+% 2. datastructs.
+:- pred print_datastruct(prog_varset::in, tvarset::in, datastruct::in, 
+		io__state::di, io__state::uo) is det.
+%-----------------------------------------------------------------------------%
+% Transform to string routines. 
+
+% 1. selectors
+	% The same as print_selector, yet returns a string instead of printing
+	% the result to stdout. 
+:- pred selector_to_string(tvarset::in, selector::in, string::out) is det.
+
+	% User declared selectors are constrained to type selectors only. Hence
+	% this procedure will give an error when a normal selector is
+	% encountered. 
+:- pred to_user_declared_selector(tvarset::in, selector::in, 
+		string::out) is det. 
+
+% 2. datastructs. 
+:- pred to_user_declared_datastruct(prog_varset::in, tvarset::in, 
+		datastruct::in, string::out) is det. 
+
+%-----------------------------------------------------------------------------%
+% Parsing routines. 
+%-----------------------------------------------------------------------------%
+
+% 1. selectors. 
+:- pred parse_selector(term(T)::in, selector::out) is det.
+% 2. datastructs. 
+:- pred parse_datastruct(term(T)::in, datastruct::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation. 
+
+:- import_module hlds. 
+:- import_module hlds__hlds_data.
+:- import_module parse_tree__mercury_to_mercury.
+:- import_module parse_tree__prog_io.
+
+:- import_module string, list, require, bool, varset. 
+
+%-----------------------------------------------------------------------------%
+print_selector(TVarSet, Selector, !IO) :-
+	selector_to_string(TVarSet, Selector, String), 
+	io__write_string(String, !IO). 
+
+print_datastruct(ProgVarSet, TypeVarSet, DataStruct, !IO) :- 
+	varset__lookup_name(ProgVarSet, DataStruct^sc_var, VarName),
+	io__write_strings(["cel(", VarName, ", "], !IO), 
+	print_selector(TypeVarSet, DataStruct^sc_selector, !IO),
+	io__write_string(")", !IO).
+
+%-----------------------------------------------------------------------------%
+to_user_declared_selector(TVarSet, Selector, String):- 
+	(
+		Selector = []
+	-> 
+		String = "[]"
+	; 
+		list__map(us_to_user_declared(TVarSet), 
+			Selector, SelectorStrings), 
+		string__append_list(["[", 
+			string__join_list(",", SelectorStrings), 
+			"]"], String)
+	). 
+
+selector_to_string(TVarSet, Selector, String):- 
+	(
+		Selector = []
+	-> 
+		String = "[]"
+	; 
+		list__map(us_to_string(TVarSet), 
+			Selector, SelectorStrings), 
+		string__append_list(["[", 
+			string__join_list(",", SelectorStrings), 
+			"]"], String)
+	). 
+
+:- pred us_to_string(tvarset::in, unit_sel::in, string::out) is det.
+us_to_string(_, ns(ConsId, Index), StringSelector):- 
+	hlds_data__cons_id_arity(ConsId, Arity), 
+	string__append_list(["sel(",
+		mercury_cons_id_to_string(ConsId, needs_brackets),
+		",", 
+		int_to_string(Arity), 
+		",",
+		int_to_string(Index), 
+		")"], StringSelector).
+
+us_to_string(TVarSet, ts(TypeSel), StringSelector):- 
+	string__append_list(["typesel(", 
+		mercury_term_to_string(TypeSel, TVarSet, bool__no),
+		")"], StringSelector).
+
+:- pred us_to_user_declared(tvarset::in, unit_sel::in, string::out) is det.
+us_to_user_declared(_, ns(_, _), _):- 
+	Msg = "(pa_selector) us_to_user_declared, expected type-selectors.",
+	require__error(Msg). 
+us_to_user_declared(TVarSet, ts(Type), String) :- 
+	String = mercury_type_to_string(TVarSet, Type). 
+
+%-----------------------------------------------------------------------------%
+% 2. datastructs. 
+to_user_declared_datastruct(ProgVarSet, TypeVarSet, Data, String):- 
+	Data = selected_cel(ProgVar, Selector), 
+	varset__lookup_name(ProgVarSet, ProgVar, ProgName), 
+	to_user_declared_selector(TypeVarSet, Selector,
+			SelectorString), 
+	string__append_list(["cel(", ProgName, ", ", SelectorString, ")"], 
+		String). 
+
+
+%-----------------------------------------------------------------------------%
+% Parsing routines. 
+%-----------------------------------------------------------------------------%
+% 
+% 1. selectors.
+parse_selector(Term, Sel):- 
+	(
+		Term = term__functor(term__atom(Cons), Args, _)
+	->
+		(
+			Cons = "[|]",
+			Args = [ First , Rest ]
+		->
+			parse_unit_selector(First, US),
+			parse_selector(Rest, SelRest),
+			Sel = [ US | SelRest ]
+		;
+			Sel = []
+		)
+	;
+		error("(prog_io_pasr) parse_selector: term not a functor")
+	).
+
+:- pred parse_unit_selector(term(T)::in, unit_sel::out) is det.
+
+parse_unit_selector(Term, US):- 
+   (
+      Term = term__functor(term__atom(Cons), Args, _)
+   ->
+      (
+         Cons = "sel",
+         Args = [ ConsTerm, ArityTerm, PosTerm ]
+      ->
+         (
+            prog_io__sym_name_and_args(ConsTerm, ConsID_SN, ConsID_Args),
+            ConsID_Args = [],
+	    ArityTerm = term__functor(term__integer(Arity), _, _),
+            PosTerm = term__functor(term__integer(Pos), _, _)
+         ->
+	    ConsID = cons(ConsID_SN, Arity),
+	    US = ns(ConsID, Pos)
+	 ;
+	    ConsTerm = term__functor(term__integer(X), _, _)
+	 ->
+	    ConsID = int_const(X), 
+	    US = ns(ConsID, 0)
+	 ;
+	    ConsTerm = term__functor(term__float(X), _, _)
+	 ->
+	    ConsID = float_const(X),
+	    US = ns(ConsID, 0)
+	 ;
+	    ConsTerm = term__functor(term__string(S), _, _)
+	 ->
+	    ConsID = string_const(S),
+	    US = ns(ConsID, 0)
+	 ;
+	    error("(prog_io_pasr) parse_unit_selector: unknown cons_id in unit selector")
+	 )
+      ; 
+	 
+         Cons = "typesel",
+	 Args = [ TypeSelectorTerm ]
+      ->
+ 	 term__coerce(TypeSelectorTerm, TypeSelector), 
+	 US = ts(TypeSelector)
+      ;
+	 error("(prog_io_pasr) parse_unit_selector: top constructor should be sel/3 or typesel/1.")
+      )
+   ;
+      error("(prog_io_pasr) parse_unit_selector: term not a functor")
+   ).
+
+%-----------------------------------------------------------------------------%
+% 2. datastructs. 
+parse_datastruct(TERM, Data) :- 
+   (
+      TERM = term__functor(term__atom(CONS), Args, _)
+   ->
+      (
+         CONS = "cel"
+      ->
+         (
+            Args = [ VarTerm, SelectorTerm ]
+         ->
+           (
+              VarTerm = term__variable(VAR)
+	   ->
+	      term__coerce_var(VAR, PROGVAR),
+	      parse_selector(SelectorTerm, SELECTOR),
+	      Data = selected_cel(PROGVAR, SELECTOR)
+	   ;
+	      error("(prog_io_pasr) parse_datastruct: wrong term. variable, should be functor")
+	   )
+	 ;
+	   list__length(Args, L),
+	   string__int_to_string(L, LS),
+	   string__append_list(["(prog_io_pasr) parse_datastruct: wrong number of arguments. cel/",LS,
+	   			"should be cel/2"],Msg),
+	   error(Msg)
+	 )
+      ;
+         string__append_list(["(pa_datastruct) parse_term: wrong constructor. `",CONS,
+	 			"' should be `cel'"],Msg),
+	   error(Msg)
+      )
+   ;
+      error("(prog_io_pasr) parse_datastruct: term not a functor")
+   ).
+
Index: sr_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_data.m,v
retrieving revision 1.1.2.26
diff -u -r1.1.2.26 sr_data.m
--- sr_data.m	25 Jun 2004 02:33:52 -0000	1.1.2.26
+++ sr_data.m	25 Jun 2004 06:10:45 -0000
@@ -187,6 +187,7 @@
 :- import_module hlds__instmap. 
 :- import_module parse_tree__mercury_to_mercury.
 :- import_module parse_tree__prog_io.
+:- import_module parse_tree__prog_io_pasr.
 :- import_module parse_tree__prog_io_util.
 :- import_module parse_tree__prog_out.
 :- import_module possible_alias__pa_alias_as.
@@ -349,12 +350,14 @@
 reuse_condition_print(_, _, always) -->
 	io__write_string("always").
 reuse_condition_print(ProcInfo, PredInfo, condition(Nodes, LUiH, LAiH)) -->
+	{ proc_info_varset(ProcInfo, ProgVarSet) }, 
+	{ pred_info_typevarset(PredInfo, TypeVarSet) },
 	{ set__to_sorted_list(Nodes, NodesList) }, 
 	io__write_string("condition("),
 		% write out the list of headvar-nodes involved
 	io__write_string("["),
 	io__write_list(NodesList, ",", 
-			pa_datastruct__print(PredInfo, ProcInfo)), 
+			print_datastruct(ProgVarSet, TypeVarSet)), 
 	io__write_string("], "),	
 
 		% write out LUiH, list of prog_vars
@@ -668,7 +671,7 @@
 			Cons = "[|]",
 			Args = [First, Rest]
 		->
-			pa_datastruct__parse_term(First, D1),
+			parse_datastruct(First, D1),
 			nodes_parse(Rest, D2),
 			Datastructs = [D1 | D2]
 		;


-- 
nancy.mazur at cs.kuleuven.ac.be ------------ Katholieke Universiteit Leuven -
tel: +32-16-327596 - fax: +32-16-327996 ------- Dept. of Computer Science -
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list