[m-rev.] diff: [CTGC] be less conservative at generic calls

Peter Wang novalazy at gmail.com
Mon Jun 16 14:51:36 AEST 2008


Branches: main

Try to retain structure sharing information when we come across a generic
call.  If the arguments to the call are all inputs then we can deduce that no
new sharing is introduced.  If the call has output arguments but all of them
are of types that we can't reuse (e.g. atomic types) then for our purposes no
sharing is introduced.

compiler/structure_reuse.direct.detect_garbage.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
	At generic calls, check the types and modes of the arguments to see if
	we can avoid `top' sharing.

compiler/structure_sharing.domain.m:
	Add predicate to check if we can predict bottom sharing from a call's
	argument types and modes.

compiler/ctgc.util.m:
	Rename `type_is_reusable' to `top_cell_may_be_reusable' to be clear
	about what it means.

	Export `type_needs_sharing_analysis'.  Make it fail for dummy types.

compiler/structure_reuse.direct.choose_reuse.m:
	Conform to predicate renaming.

compiler/mercury_compile.m:
	Call loop invariant hoisting when making `.analysis' and `.trans_opt'
	files if structure reuse is enabled.  This prevents different
	structure reuse results between the .analysis/.trans_opt and .c files.
	The differing results could lead one module to call a reuse procedure
	inside another module, which isn't actually defined in the .c file.

tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/reuse_ho.exp:
tests/hard_coded/reuse_ho.m:
	Add a test case.

Index: compiler/ctgc.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.20
diff -u -p -p -r1.20 ctgc.util.m
--- compiler/ctgc.util.m	17 Apr 2008 04:21:50 -0000	1.20
+++ compiler/ctgc.util.m	16 Jun 2008 04:47:41 -0000
@@ -60,9 +60,15 @@
 :- pred var_needs_sharing_analysis(module_info::in, proc_info::in,
     prog_var::in) is semidet.
 
-    % Succeed iff type is one for which we support structure reuse.
+    % Succeed iff the type is one for which we need to consider structure
+    % sharing.
     %
-:- pred type_is_reusable(module_info::in, mer_type::in) is semidet.
+:- pred type_needs_sharing_analysis(module_info::in, mer_type::in) is semidet.
+
+    % Succeed iff values of the given type may have a top-level cell
+    % that could be reused.
+    %
+:- pred top_cell_may_be_reusable(module_info::in, mer_type::in) is semidet.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -177,8 +183,6 @@ var_needs_sharing_analysis(ModuleInfo, P
     map.lookup(VarTypes, Var, Type),
     type_needs_sharing_analysis(ModuleInfo, Type).
 
-:- pred type_needs_sharing_analysis(module_info::in, mer_type::in) is semidet.
-
 type_needs_sharing_analysis(ModuleInfo, Type) :-
     TypeCat = classify_type(ModuleInfo, Type),
     type_category_needs_sharing_analysis(TypeCat) = yes.
@@ -193,25 +197,25 @@ type_category_needs_sharing_analysis(Cto
         ; CtorCat = ctor_cat_builtin_dummy
         ; CtorCat = ctor_cat_void
         ; CtorCat = ctor_cat_system(_)
+        ; CtorCat = ctor_cat_user(cat_user_direct_dummy)
         ),
         NeedsSharingAnalysis = no
     ;
         ( CtorCat = ctor_cat_variable
         ; CtorCat = ctor_cat_tuple
-        ; CtorCat = ctor_cat_user(_)
+        ; CtorCat = ctor_cat_user(cat_user_notag)
+        ; CtorCat = ctor_cat_user(cat_user_general)
         ),
         NeedsSharingAnalysis = yes
     ).
 
-%-----------------------------------------------------------------------------%
-
-type_is_reusable(ModuleInfo, Type) :-
+top_cell_may_be_reusable(ModuleInfo, Type) :-
     TypeCat = classify_type(ModuleInfo, Type),
-    type_category_is_reusable(TypeCat) = yes.
+    type_category_top_cell_may_be_reusable(TypeCat) = yes.
 
-:- func type_category_is_reusable(type_ctor_category) = bool.
+:- func type_category_top_cell_may_be_reusable(type_ctor_category) = bool.
 
-type_category_is_reusable(CtorCat) = Reusable :-
+type_category_top_cell_may_be_reusable(CtorCat) = Reusable :-
     (
         ( CtorCat = ctor_cat_builtin(_)
         ; CtorCat = ctor_cat_higher_order
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.473
diff -u -p -p -r1.473 mercury_compile.m
--- compiler/mercury_compile.m	6 Jun 2008 02:18:05 -0000	1.473
+++ compiler/mercury_compile.m	16 Jun 2008 04:47:41 -0000
@@ -2437,6 +2437,8 @@ output_trans_opt_file(!.HLDS, !DumpInfo,
         maybe_dump_hlds(!.HLDS, 135, "higher_order", !DumpInfo, !IO),
         maybe_do_inlining(Verbose, Stats, !HLDS, !IO),
         maybe_dump_hlds(!.HLDS, 145, "inlining", !DumpInfo, !IO),
+        maybe_loop_inv(Verbose, Stats, !HLDS, !DumpInfo, !IO),
+        maybe_dump_hlds(!.HLDS, 150, "loop_inv", !DumpInfo, !IO),
         maybe_deforestation(Verbose, Stats, !HLDS, !IO),
         maybe_dump_hlds(!.HLDS, 155, "deforestation", !DumpInfo, !IO)
     ;
@@ -2491,6 +2493,8 @@ output_analysis_file(!.HLDS, !DumpInfo, 
         maybe_dump_hlds(!.HLDS, 135, "higher_order", !DumpInfo, !IO),
         maybe_do_inlining(Verbose, Stats, !HLDS, !IO),
         maybe_dump_hlds(!.HLDS, 145, "inlining", !DumpInfo, !IO),
+        maybe_loop_inv(Verbose, Stats, !HLDS, !DumpInfo, !IO),
+        maybe_dump_hlds(!.HLDS, 150, "loop_inv", !DumpInfo, !IO),
         maybe_deforestation(Verbose, Stats, !HLDS, !IO),
         maybe_dump_hlds(!.HLDS, 155, "deforestation", !DumpInfo, !IO)
     ;
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.16
diff -u -p -p -r1.16 structure_reuse.direct.choose_reuse.m
--- compiler/structure_reuse.direct.choose_reuse.m	28 May 2008 00:52:29 -0000	1.16
+++ compiler/structure_reuse.direct.choose_reuse.m	16 Jun 2008 04:47:42 -0000
@@ -799,7 +799,8 @@ find_match_in_goal_2(Background, Goal, !
             Unification = construct(Var, Cons, Args, _, _, _, _),
             (
                 map.lookup(Background ^ back_vartypes, Var, VarType),
-                type_is_reusable(Background ^ back_module_info, VarType),
+                top_cell_may_be_reusable(Background ^ back_module_info,
+                    VarType),
 
                 % Is the construction still looking for reuse-possibilities...
                 empty_reuse_description(goal_info_get_reuse(GoalInfo))
Index: compiler/structure_reuse.direct.detect_garbage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.detect_garbage.m,v
retrieving revision 1.18
diff -u -p -p -r1.18 structure_reuse.direct.detect_garbage.m
--- compiler/structure_reuse.direct.detect_garbage.m	28 May 2008 00:52:29 -0000	1.18
+++ compiler/structure_reuse.direct.detect_garbage.m	16 Jun 2008 04:47:42 -0000
@@ -116,12 +116,9 @@ determine_dead_deconstructions_2(Backgro
         lookup_sharing_and_comb(ModuleInfo, PredInfo, ProcInfo, SharingTable,
             PredId, ProcId, ActualVars, !SharingAs)
     ;
-        GoalExpr = generic_call(_GenDetails, _, _, _),
-        Context = goal_info_get_context(GoalInfo),
-        context_to_string(Context, ContextString),
-        !:SharingAs = sharing_as_top_sharing_accumulate(
-            top_cannot_improve("generic call (" ++ ContextString ++ ")"),
-            !.SharingAs)
+        GoalExpr = generic_call(GenDetails, CallArgs, Modes, _Detism),
+        determine_dead_deconstructions_generic_call(ModuleInfo, ProcInfo,
+            GenDetails, CallArgs, Modes, GoalInfo, !SharingAs)
     ;
         GoalExpr = unify(_, _, _, Unification, _),
         unification_verify_reuse(ModuleInfo, ProcInfo, GoalInfo, 
@@ -208,6 +205,42 @@ determine_dead_deconstructions_2_disj_go
     !:SharingAs = sharing_as_least_upper_bound(Background ^ module_info, 
         Background ^ proc_info, !.SharingAs, GoalSharing).
 
+:- pred determine_dead_deconstructions_generic_call(module_info::in,
+    proc_info::in, generic_call::in, prog_vars::in, list(mer_mode)::in,
+    hlds_goal_info::in, sharing_as::in, sharing_as::out) is det.
+
+determine_dead_deconstructions_generic_call(ModuleInfo, ProcInfo,
+        GenDetails, CallArgs, Modes, GoalInfo, !SharingAs) :-
+    (
+        ( GenDetails = higher_order(_, _, _, _)
+        ; GenDetails = class_method(_, _, _, _)
+        ),
+        proc_info_get_vartypes(ProcInfo, CallerVarTypes),
+        map.apply_to_list(CallArgs, CallerVarTypes, ActualTypes),
+        (
+            bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes,
+                ActualTypes)
+        ->
+            SetToTop = no
+        ;
+            SetToTop = yes
+        )
+    ;
+        ( GenDetails = event_call(_) % XXX too conservative
+        ; GenDetails = cast(_)
+        ),
+        SetToTop = yes
+    ),
+    (
+        SetToTop = yes,
+        Context = goal_info_get_context(GoalInfo),
+        context_to_string(Context, ContextString),
+        !:SharingAs = sharing_as_top_sharing_accumulate(
+            top_cannot_improve("generic call (" ++ ContextString ++ ")"),
+            !.SharingAs)
+    ;
+        SetToTop = no
+    ).
 
     % Verify whether the unification is a deconstruction in which the 
     % deconstructed data structure becomes garbage (under some reuse 
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.27
diff -u -p -p -r1.27 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m	5 Jun 2008 06:25:17 -0000	1.27
+++ compiler/structure_reuse.indirect.m	16 Jun 2008 04:47:42 -0000
@@ -479,14 +479,9 @@ indirect_reuse_analyse_goal(BaseInfo, !G
             CalleePredId, CalleeProcId, CalleeArgs, OldSharing, NewSharing),
         update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo)
     ;
-        GoalExpr0 = generic_call(_GenDetails, _, _, _),
-        Context = goal_info_get_context(GoalInfo0),
-        context_to_string(Context, ContextString),
-        Msg = "generic call (" ++ ContextString ++ ")",
-        OldSharing = !.IrInfo ^ sharing_as,
-        NewSharing = sharing_as_top_sharing_accumulate(top_cannot_improve(Msg),
-            OldSharing),
-        update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo)
+        GoalExpr0 = generic_call(GenDetails, CallArgs, Modes, _Detism),
+        indirect_reuse_analyse_generic_call(BaseInfo, GenDetails, CallArgs,
+            Modes, GoalInfo0, !IrInfo)
     ;
         GoalExpr0 = unify(_, _, _, Unification, _),
         % Record the statically constructed variables.
@@ -580,6 +575,47 @@ indirect_reuse_analyse_goal(BaseInfo, !G
         unexpected(this_file, "indirect_reuse_analyse_goal: shorthand")
     ).
 
+:- pred indirect_reuse_analyse_generic_call(ir_background_info::in,
+    generic_call::in, prog_vars::in, list(mer_mode)::in, hlds_goal_info::in,
+    ir_analysis_info::in, ir_analysis_info::out) is det.
+
+indirect_reuse_analyse_generic_call(BaseInfo, GenDetails, CallArgs, Modes,
+        GoalInfo, !IrInfo) :-
+    ModuleInfo = BaseInfo ^ module_info,
+    ProcInfo = BaseInfo ^ proc_info,
+    (
+        ( GenDetails = higher_order(_, _, _, _)
+        ; GenDetails = class_method(_, _, _, _)
+        ),
+        proc_info_get_vartypes(ProcInfo, CallerVarTypes),
+        map.apply_to_list(CallArgs, CallerVarTypes, ActualTypes),
+        (
+            bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes,
+                ActualTypes)
+        ->
+            SetToTop = no
+        ;
+            SetToTop = yes
+        )
+    ;
+        ( GenDetails = event_call(_) % XXX too conservative
+        ; GenDetails = cast(_)
+        ),
+        SetToTop = yes
+    ),
+    (
+        SetToTop = no
+    ;
+        SetToTop = yes,
+        Context = goal_info_get_context(GoalInfo),
+        context_to_string(Context, ContextString),
+        Msg = "generic call (" ++ ContextString ++ ")",
+        OldSharing = !.IrInfo ^ sharing_as,
+        NewSharing = sharing_as_top_sharing_accumulate(
+            top_cannot_improve(Msg), OldSharing),
+        update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo)
+    ).
+
     % Analyse each branch of a disjunction with respect to an input
     % ir_analysis_info, producing a resulting ir_analysis_info, and possibly
     % updating the state of the sr_fixpoint_table.
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.38
diff -u -p -p -r1.38 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m	13 Jun 2008 01:03:19 -0000	1.38
+++ compiler/structure_sharing.analysis.m	16 Jun 2008 04:47:42 -0000
@@ -608,12 +608,9 @@ analyse_goal(ModuleInfo, PredInfo, ProcI
             RenamedSharing, !.SharingAs),
         !:Status = lub(CalleeStatus, !.Status)
     ;
-        GoalExpr = generic_call(_GenDetails, _, _, _),
-        Context = goal_info_get_context(GoalInfo),
-        context_to_string(Context, ContextString),
-        !:SharingAs = sharing_as_top_sharing_accumulate(
-            top_cannot_improve("generic call (" ++ ContextString ++ ")"),
-            !.SharingAs)
+        GoalExpr = generic_call(GenDetails, CallArgs, Modes, _Detism),
+        analyse_generic_call(ModuleInfo, ProcInfo, GenDetails, CallArgs,
+            Modes, GoalInfo, !SharingAs)
     ;
         GoalExpr = unify(_, _, _, Unification, _),
         !:SharingAs = add_unify_sharing(ModuleInfo, ProcInfo, Unification,
@@ -750,6 +747,44 @@ lookup_sharing(ModuleInfo, SharingTable,
             Status, IsPredicted)
     ).
 
+:- pred analyse_generic_call(module_info::in, proc_info::in, generic_call::in,
+    prog_vars::in, list(mer_mode)::in, hlds_goal_info::in, sharing_as::in,
+    sharing_as::out) is det.
+
+analyse_generic_call(ModuleInfo, ProcInfo, GenDetails, CallArgs, Modes,
+        GoalInfo, !SharingAs) :-
+    (
+        ( GenDetails = higher_order(_, _, _, _)
+        ; GenDetails = class_method(_, _, _, _)
+        ),
+        proc_info_get_vartypes(ProcInfo, CallerVarTypes),
+        map.apply_to_list(CallArgs, CallerVarTypes, ActualTypes),
+        (
+            bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes,
+                ActualTypes)
+        ->
+            SetToTop = no
+        ;
+            SetToTop = yes
+        )
+    ;
+        ( GenDetails = event_call(_) % XXX too conservative
+        ; GenDetails = cast(_)
+        ),
+        SetToTop = yes
+    ),
+    (
+        SetToTop = yes,
+        Context = goal_info_get_context(GoalInfo),
+        context_to_string(Context, ContextString),
+        !:SharingAs = sharing_as_top_sharing_accumulate(
+            top_cannot_improve("generic call (" ++ ContextString ++ ")"),
+            !.SharingAs)
+    ;
+        SetToTop = no
+    ).
+
 %-----------------------------------------------------------------------------%
 
 :- pred update_sharing_in_table(ss_fixpoint_table::in, pred_proc_id::in,
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.36
diff -u -p -p -r1.36 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m	10 Jun 2008 05:40:14 -0000	1.36
+++ compiler/structure_sharing.domain.m	16 Jun 2008 04:47:43 -0000
@@ -283,6 +283,12 @@
 :- pred bottom_sharing_is_safe_approximation(module_info::in, pred_info::in,
     proc_info::in) is semidet.
 
+    % Succeeds if the sharing of a call can safely be approximated by
+    % "bottom", simply by looking at the modes and types of the arguments.
+    %
+:- pred bottom_sharing_is_safe_approximation_by_args(module_info::in,
+    list(mer_mode)::in, list(mer_type)::in) is semidet.
+
     % Load all the structure sharing information present in the HLDS into
     % a sharing table. 
     %
@@ -945,28 +951,29 @@ bottom_sharing_is_safe_approximation(Mod
         proc_info_get_headvars(ProcInfo, HeadVars),
         proc_info_get_argmodes(ProcInfo, Modes),
         proc_info_get_vartypes(ProcInfo, VarTypes),
-        list.map(map.lookup(VarTypes), HeadVars, Types),
-
-        ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
-
-        Test = (pred(Pair::in) is semidet :-
-            Pair = Mode - Type,
-
-            % Mode is not unique nor clobbered.
-            mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
-            \+ inst_is_unique(ModuleInfo, RightInst),
-            \+ inst_is_clobbered(ModuleInfo, RightInst),
+        map.apply_to_list(HeadVars, VarTypes, Types),
+        bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes, Types)
+    ).
 
-            % Mode is output.
-            mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
-            ArgMode = top_out,
+bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes, Types) :-
+    ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
+    Test = (pred(Pair::in) is semidet :-
+        Pair = Mode - Type,
+
+        % Mode is not unique nor clobbered.
+        mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
+        \+ inst_is_unique(ModuleInfo, RightInst),
+        \+ inst_is_clobbered(ModuleInfo, RightInst),
+
+        % Mode is output.
+        mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
+        ArgMode = top_out,
 
-            % Type is not primitive.
-            \+ type_is_atomic(ModuleInfo, Type)
-        ),
-        list.filter(Test, ModeTypePairs, TrueModeTypePairs),
-        TrueModeTypePairs = []
-    ).
+        % Type is one which we care about for structure sharing/reuse.
+        type_needs_sharing_analysis(ModuleInfo, Type)
+    ),
+    list.filter(Test, ModeTypePairs, TrueModeTypePairs),
+    TrueModeTypePairs = [].
 
 %-----------------------------------------------------------------------------%
 % Type: sharing_set.
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.34
diff -u -p -p -r1.34 Mercury.options
--- tests/hard_coded/Mercury.options	22 May 2008 04:11:29 -0000	1.34
+++ tests/hard_coded/Mercury.options	16 Jun 2008 04:47:43 -0000
@@ -37,6 +37,7 @@ MCFLAGS-intermod_type_qual =	--intermodu
 MCFLAGS-intermod_type_qual2 =	--intermodule-optimization
 MCFLAGS-intermod_multimode =	--intermodule-optimization
 MCFLAGS-intermod_multimode_main = --intermodule-optimization
+MCFLAGS-reuse_ho            =	--ctgc --no-optimise-higher-order
 MCFLAGS-sharing_comb	    =	--ctgc --structure-sharing-widening 2
 MCFLAGS-uncond_reuse	    =	--ctgc
 MCFLAGS-uncond_reuse_bad    =	--ctgc
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.353
diff -u -p -p -r1.353 Mmakefile
--- tests/hard_coded/Mmakefile	4 Jun 2008 03:10:20 -0000	1.353
+++ tests/hard_coded/Mmakefile	16 Jun 2008 04:47:43 -0000
@@ -356,6 +356,7 @@ ifeq "$(findstring debug,$(GRADE))" ""
 		bad_indirect_reuse2 \
 		bad_indirect_reuse2b \
 		bad_indirect_reuse3 \
+		reuse_ho \
 		sharing_comb \
 		uncond_reuse \
 		uncond_reuse_bad
Index: tests/hard_coded/reuse_ho.exp
===================================================================
RCS file: tests/hard_coded/reuse_ho.exp
diff -N tests/hard_coded/reuse_ho.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/reuse_ho.exp	16 Jun 2008 04:47:43 -0000
@@ -0,0 +1 @@
+addresses as expected
Index: tests/hard_coded/reuse_ho.m
===================================================================
RCS file: tests/hard_coded/reuse_ho.m
diff -N tests/hard_coded/reuse_ho.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/reuse_ho.m	16 Jun 2008 04:47:43 -0000
@@ -0,0 +1,125 @@
+% Try to retain structure sharing information when we encounter generic calls
+% whose output argument modes and types tell us they can't introduce more
+% sharing.
+
+:- module reuse_ho.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    % This higher order call should be predicted to have bottom sharing.
+    HO1 = ho1,
+    HO1(1, N),
+
+    % This method call should be predicted to have bottom sharing.
+    meth(2, M),
+
+    copy(foo(N, M), Foo1),
+    addr(Foo1, Foo1_Addr),
+
+    % Both indirect and direct reuse should occur here.
+    swap(Foo1, Tmp),
+    Tmp = foo(X, Y),
+    Foo2 = foo(Y, X),
+    addr(Foo2, Foo2_Addr),
+
+    % This higher-order call should cause sharing to become top.
+    HO2 = ho2(Foo2),
+    HO2(Foo3),
+    addr(Foo3, Foo3_Addr),
+
+    % Reuse should not occur.
+    swap(Foo3, Foo4),
+    addr(Foo4, Foo4_Addr),
+
+    % Reuse should not occur here either.
+    copy(foo(-1, -2), Foo5),
+    addr(Foo5, Foo5_Addr),
+    swap(Foo5, Foo6),
+    addr(Foo6, Foo6_Addr),
+
+    ( capable_grade($grade) ->
+        (
+            Foo1_Addr = Foo2_Addr,
+            Foo3_Addr \= Foo4_Addr,
+            Foo5_Addr \= Foo6_Addr
+        ->
+            io.write_string("addresses as expected\n", !IO)
+        ;
+            io.write_string("addresses NOT as expected\n", !IO)
+        )
+    ;
+        io.write_string("grade probably doesn't support reuse\n", !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- type foo
+    --->    foo(int, int).
+
+:- pred swap(foo::in, foo::out) is det.
+:- pragma no_inline(swap/2).
+
+swap(foo(X, Y), foo(Y, X)).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ho1(int::in, int::out) is det.
+
+ho1(N, N * 10).
+
+:- pred ho2(foo::in, foo::out) is det.
+
+ho2(X, X).
+
+%-----------------------------------------------------------------------------%
+
+:- typeclass tc(T) where [
+    pred meth(T::in, T::out) is det
+].
+
+:- instance tc(int) where [
+    meth(X, X)
+].
+
+%-----------------------------------------------------------------------------%
+
+% Only C grades for now.
+:- pred capable_grade(string::in) is semidet.
+
+capable_grade(Grade) :-
+    string.prefix(Grade, Prefix),
+    ( Prefix = "none"
+    ; Prefix = "reg"
+    ; Prefix = "jump"
+    ; Prefix = "asm"
+    ; Prefix = "fast"
+    ; Prefix = "hl"
+    ),
+    not string.sub_string_search(Grade, "debug", _),
+    not string.sub_string_search(Grade, "profdeep", _).
+
+:- pred addr(T::in, int::out) is cc_multi.
+
+:- pragma foreign_proc("C",
+    addr(T::in, Addr::out),
+    [will_not_call_mercury, promise_pure, thread_safe, no_sharing],
+"
+    Addr = (MR_Word) T;
+").
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et


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



More information about the reviews mailing list