[m-rev.] diff: don't reuse cells to construct certain types

[Peter Wang]

Branches: main

compiler/structure_reuse.direct.choose_reuse.m:
	Prevent direct structure reuse from reusing cells to construct
	typeinfos, higher order terms and other types that it shouldn't.

compiler/ctgc.util.m:
compiler/structure_sharing.domain.m:
	Rename `var_has_unsharable_type' to `var_has_non_reusable_type' which
	is what was meant.  Move it into ctgc.util as it is shared by
	structure sharing and structure reuse analyses.

Index: compiler/ctgc.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.15
diff -u -r1.15 ctgc.util.m
--- compiler/ctgc.util.m	21 Jan 2008 05:23:31 -0000	1.15
+++ compiler/ctgc.util.m	29 Jan 2008 02:59:32 -0000
@@ -52,11 +52,23 @@
 :- func get_type_substitution(module_info, pred_proc_id, list(mer_type),
     tvarset, head_type_params) = tsubst.
 
+    % var_has_non_reusable_type(ModuleInfo, ProcInfo, Var).
+    %
+    % Succeed iff Var is of a type for which we don't support structure reuse.
+    %
+:- pred var_has_non_reusable_type(module_info::in, proc_info::in,
+    prog_var::in) is semidet.
+
+    % Succeed iff type is one for which we support structure reuse.
+    %
+:- pred type_is_reusable(module_info::in, mer_type::in) is semidet.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
+:- import_module check_hlds.type_util.
 :- import_module libs.compiler_util.
 :- import_module parse_tree.prog_type.
 :- import_module parse_tree.prog_type_subst.
@@ -163,6 +175,36 @@
 
 %-----------------------------------------------------------------------------%
 
+var_has_non_reusable_type(ModuleInfo, ProcInfo, Var):-
+    proc_info_get_vartypes(ProcInfo, VarTypes),
+    map.lookup(VarTypes, Var, Type),
+    not type_is_reusable(ModuleInfo, Type).
+
+type_is_reusable(ModuleInfo, Type) :-
+    TypeCat = classify_type(ModuleInfo, Type),
+    type_category_is_reusable(TypeCat) = yes.
+
+:- func type_category_is_reusable(type_category) = bool.
+
+type_category_is_reusable(type_cat_int) = no.
+type_category_is_reusable(type_cat_char) = no.
+type_category_is_reusable(type_cat_string) = no.
+type_category_is_reusable(type_cat_float) = no.
+type_category_is_reusable(type_cat_higher_order) = no.
+type_category_is_reusable(type_cat_tuple) = yes.
+type_category_is_reusable(type_cat_enum) = no.
+type_category_is_reusable(type_cat_foreign_enum) = no.
+type_category_is_reusable(type_cat_dummy) = no.
+type_category_is_reusable(type_cat_variable) = no.
+type_category_is_reusable(type_cat_type_info) = no.
+type_category_is_reusable(type_cat_type_ctor_info) = no.
+type_category_is_reusable(type_cat_typeclass_info) = no.
+type_category_is_reusable(type_cat_base_typeclass_info) = no.
+type_category_is_reusable(type_cat_void) = no.
+type_category_is_reusable(type_cat_user_ctor) = yes.
+
+%-----------------------------------------------------------------------------%
+
 :- func this_file = string.
 
 this_file = "ctgc.util.m".
Index: compiler/structure_reuse.direct.choose_reuse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.choose_reuse.m,v
retrieving revision 1.12
diff -u -r1.12 structure_reuse.direct.choose_reuse.m
--- compiler/structure_reuse.direct.choose_reuse.m	14 Jan 2008 04:43:25 -0000	1.12
+++ compiler/structure_reuse.direct.choose_reuse.m	29 Jan 2008 02:59:34 -0000
@@ -791,7 +791,11 @@
         GoalExpr = unify(_, _, _, Unification, _),
         (
             Unification = construct(Var, Cons, Args, _, _, _, _),
-                % Is the construction still looking for reuse-possibilities...
+
+            map.lookup(Background ^ vartypes, Var, VarType),
+            type_is_reusable(Background ^ module_info, VarType),
+
+            % Is the construction still looking for reuse-possibilities...
             empty_reuse_description(goal_info_get_reuse(GoalInfo))
 
         ->
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.25
diff -u -r1.25 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m	25 Jan 2008 00:45:03 -0000	1.25
+++ compiler/structure_sharing.domain.m	29 Jan 2008 02:59:35 -0000
@@ -445,7 +445,7 @@
         = Sharing :-
     (
         Unification = construct(Var, ConsId, Args0, _, _, _, _),
-        ( var_has_unsharable_type(ModuleInfo, ProcInfo, Var) ->
+        ( var_has_non_reusable_type(ModuleInfo, ProcInfo, Var) ->
             Sharing = sharing_as_init
         ;
             list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
@@ -475,7 +475,7 @@
         )
     ;
         Unification = assign(X, Y),
-        ( var_has_unsharable_type(ModuleInfo, ProcInfo, X) ->
+        ( var_has_non_reusable_type(ModuleInfo, ProcInfo, X) ->
             Sharing = sharing_as_init
         ;
             new_entry(ModuleInfo, ProcInfo,
@@ -512,7 +512,7 @@
     sharing_set::in, sharing_set::out) is det.
 
 add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId, N - Arg, !Sharing) :-
-    ( var_has_unsharable_type(ModuleInfo, ProcInfo, Arg) ->
+    ( var_has_non_reusable_type(ModuleInfo, ProcInfo, Arg) ->
         true
     ;
         Data1 = datastruct_init_with_pos(Var, ConsId, N),
@@ -520,34 +520,6 @@
         new_entry(ModuleInfo, ProcInfo, Data1 - Data2, !Sharing)
     ).
 
-:- pred var_has_unsharable_type(module_info::in, proc_info::in,
-    prog_var::in) is semidet.
-
-var_has_unsharable_type(ModuleInfo, ProcInfo, Var):-
-    proc_info_get_vartypes(ProcInfo, VarTypes),
-    map.lookup(VarTypes, Var, Type),
-    TypeCat = classify_type(ModuleInfo, Type),
-    type_category_is_sharable(TypeCat) = no.
-
-:- func type_category_is_sharable(type_category) = bool.
-
-type_category_is_sharable(type_cat_int) = no.
-type_category_is_sharable(type_cat_char) = no.
-type_category_is_sharable(type_cat_string) = no.
-type_category_is_sharable(type_cat_float) = no.
-type_category_is_sharable(type_cat_higher_order) = no.
-type_category_is_sharable(type_cat_tuple) = yes.
-type_category_is_sharable(type_cat_enum) = no.
-type_category_is_sharable(type_cat_foreign_enum) = no.
-type_category_is_sharable(type_cat_dummy) = no.
-type_category_is_sharable(type_cat_variable) = no.
-type_category_is_sharable(type_cat_type_info) = no.
-type_category_is_sharable(type_cat_type_ctor_info) = no.
-type_category_is_sharable(type_cat_typeclass_info) = no.
-type_category_is_sharable(type_cat_base_typeclass_info) = no.
-type_category_is_sharable(type_cat_void) = no.
-type_category_is_sharable(type_cat_user_ctor) = yes.
-
     % When two positions within the constructed term refer to the same variable,
     % this must be recorded as an extra sharing pair.
     % E.g.: X = f(Y,Y), then the sharing between f/1 and f/2 must be recorded.

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------