[m-rev.] diff: ignore higher order terms in sharing analysis

[Peter Wang]

Branches: main

compiler/structure_sharing.domain.m:
	Replace `arg_has_primitive_type' by `var_has_unsharable_type' as we
	don't try to reuse the memory of some non-atomic types as well, e.g.
	higher order terms, typeinfos, etc.

	Ignore unifications which construct higher order terms in structure
	sharing analysis.

Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.23
diff -u -r1.23 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m	21 Jan 2008 05:23:32 -0000	1.23
+++ compiler/structure_sharing.domain.m	23 Jan 2008 23:44:06 -0000
@@ -443,16 +443,21 @@
         = Sharing :-
     (
         Unification = construct(Var, ConsId, Args0, _, _, _, _),
-        list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
-            _TypeInfoArgs, Args),
-        number_args(Args, NumberedArgs),
-        some [!SharingSet] (
-            !:SharingSet = sharing_set_init,
-            list.foldl(add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
-                NumberedArgs, !SharingSet),
-            create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId,
-                NumberedArgs, !SharingSet),
-            Sharing = wrap(!.SharingSet)
+        ( var_has_unsharable_type(ModuleInfo, ProcInfo, Var) ->
+            Sharing = sharing_as_init
+        ;
+            list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
+                _TypeInfoArgs, Args),
+            number_args(Args, NumberedArgs),
+            some [!SharingSet] (
+                !:SharingSet = sharing_set_init,
+                list.foldl(
+                    add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
+                    NumberedArgs, !SharingSet),
+                create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId,
+                    NumberedArgs, !SharingSet),
+                Sharing = wrap(!.SharingSet)
+            )
         )
     ;
         Unification = deconstruct(Var, ConsId, Args0, _, _, _),
@@ -468,7 +473,7 @@
         )
     ;
         Unification = assign(X, Y),
-        ( arg_has_primitive_type(ModuleInfo, ProcInfo, X) ->
+        ( var_has_unsharable_type(ModuleInfo, ProcInfo, X) ->
             Sharing = sharing_as_init
         ;
             new_entry(ModuleInfo, ProcInfo,
@@ -505,7 +510,7 @@
     sharing_set::in, sharing_set::out) is det.

 add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId, N - Arg, !Sharing) :-
-    ( arg_has_primitive_type(ModuleInfo, ProcInfo, Arg) ->
+    ( var_has_unsharable_type(ModuleInfo, ProcInfo, Arg) ->
         true
     ;
         Data1 = datastruct_init_with_pos(Var, ConsId, N),
@@ -513,13 +518,33 @@
         new_entry(ModuleInfo, ProcInfo, Data1 - Data2, !Sharing)
     ).

-:- pred arg_has_primitive_type(module_info::in, proc_info::in,
+:- pred var_has_unsharable_type(module_info::in, proc_info::in,
     prog_var::in) is semidet.

-arg_has_primitive_type(ModuleInfo, ProcInfo, Var):-
+var_has_unsharable_type(ModuleInfo, ProcInfo, Var):-
     proc_info_get_vartypes(ProcInfo, VarTypes),
     map.lookup(VarTypes, Var, Type),
-    type_is_atomic(ModuleInfo, 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.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------