[m-rev.] for review: delay partial instantiations pass

Peter Wang wangp at students.csse.unimelb.edu.au
Thu Jun 21 13:57:26 AEST 2007


Estimated hours taken: 30
Branches: main

Add a post-processing pass directly after mode checking that tries to transform
procedures to avoid intermediate partially instantiated data structures.  The
Erlang backend in particular cannot handle partially instantiated data
structures.

compiler/delay_partial_inst.m:
	New module.

compiler/check_hlds.m:
	Import delay_partial_inst.m

compiler/modes.m:
	Call the delay partial instantiations pass after mode checking succeeds
	if it is enabled.

compiler/options.m:
	Add a new internal option `--delay-partial-instantiations', disabled by
	default.

compiler/handle_options.m:
	Make Erlang target imply --delay-partial-instantiations.

compiler/notes/compiler_design.html:
	Mention delay_partial_inst.m

tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/delay_partial_test.exp:
tests/hard_coded/delay_partial_test.m:
tests/hard_coded/delay_partial_test2.exp:
tests/hard_coded/delay_partial_test2.m:
	Add test cases for --delay-partial-instantiations.

compiler/goal_util.m:
	Fix a comment.

Index: compiler/check_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_hlds.m,v
retrieving revision 1.18
diff -u -r1.18 check_hlds.m
--- compiler/check_hlds.m	1 Nov 2006 06:32:48 -0000	1.18
+++ compiler/check_hlds.m	21 Jun 2007 03:55:12 -0000
@@ -32,6 +32,7 @@
 % Mode analysis
 %:- module mode_analysis.
    :- include_module delay_info.
+   :- include_module delay_partial_inst.
    :- include_module inst_match.
    :- include_module inst_util.
    :- include_module mode_constraint_robdd.
Index: compiler/delay_partial_inst.m
===================================================================
RCS file: compiler/delay_partial_inst.m
diff -N compiler/delay_partial_inst.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ compiler/delay_partial_inst.m	21 Jun 2007 03:55:12 -0000
@@ -0,0 +1,491 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 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.
+%-----------------------------------------------------------------------------%
+%
+% File: delay_partial_inst.m.
+% Author: wangp.
+%
+% This module runs just after mode analysis on mode-correct procedures and
+% tries to transform procedures to avoid intermediate partially instantiated
+% data structures.  The Erlang backend in particular cannot handle partially
+% instantiated data structures (we cannot use destructive update to further
+% instantiate data structures since all values are immutable).
+%
+% There are two situations.  An implied mode call, e.g.
+%
+%       p(f(_, _))
+%
+% looks like this after mode checking:
+%
+%       X := f(V_1, V_2),       % partially instantiated
+%       p(Y),
+%       X ?= Y
+%
+% We transform it to this more obvious sequence which doesn't need the
+% partially instantiated data structure:
+%
+%       p(Y),
+%       Y ?= f(_, _)
+%
+% The other situation is if the user writes code that constructs data
+% structures with free variables, e.g.
+%
+%       :- type t
+%           --->    t(
+%                       a :: int,
+%                       b :: int
+%                   ).
+%
+%       F ^ a = 1,
+%       F ^ b = 2
+%
+% After mode checking we get:
+%
+%       V_1 = 1,
+%       F := t(V_1, V_2),       % ground, free
+%       V_3 = 2,
+%       F => t(V_4, V_3)        % ground, ground
+%
+% Whereas we would like to see this:
+%
+%       V_1 = 1,
+%       V_2 = 2,
+%       F := t(V_1, V_2)
+%
+%-----------------------------------------------------------------------------%
+%
+% ALGORITHM
+%
+% The idea is to remove unifications that produce partially instantiated data
+% structures (as the mode checker can't be counted on to move these), and keep
+% track of variables which are bound to top-level functors with free arguments.
+% In place of the unifications we remove, we insert the unifications for the
+% sub-components which are ground.  Only once the variable is ground, because
+% all its sub-components are ground, do we construct the top-level data
+% structure.
+%
+% The algorithm makes a single forward pass over each procedure.  When we see
+% unification that binds a variable V to a functor f/n with at least one free
+% argument, we add an entry to the "construction map" and delete the
+% unification.  The construction map records that V was bound to f/n.  We also
+% create new "canonical" variables for each of the arguments.
+%
+% When we later see a deconstruction unification of V we first unify each
+% argument in the deconstruction with its corresponding "canonical" variable.
+% This way we can always use the canonical variables when it comes time to
+% reconstruct V, so we don't need to keep track of aliases.  If the mode of the
+% deconstruction unification indicates that V should be ground at end of the
+% deconstruction, we insert a construction unification using the canonical
+% variables, in place of the deconstruction, and delete V's entry from the
+% construction map now.  Otherwise, if V is not ground, we just delete the
+% deconstruction unification.
+%
+% To handle the problem with implied mode calls, we look for complicated
+% `can_fail' unifications that have V on the left-hand side.  We transform them
+% as in the example above, i.e. instead of unifying a ground variable G with a
+% partially instantiated V, we unify G with the functor that V is bound to.
+%
+% After transforming all the procedures, we requantify and rerun mode analysis,
+% which should do the rest.
+%
+%-----------------------------------------------------------------------------%
+
+:- module check_hlds.delay_partial_inst.
+:- interface.
+
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+
+:- import_module io.
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+:- pred delay_partial_inst_preds(list(pred_id)::in, list(pred_id)::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.inst_match.
+:- import_module check_hlds.mode_util.
+:- import_module hlds.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.instmap.
+:- import_module hlds.passes_aux.
+:- import_module hlds.quantification.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+
+:- import_module bool.
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module set.
+:- import_module string.
+:- import_module svmap.
+
+%-----------------------------------------------------------------------------%
+
+:- type delay_partial_inst_info
+    --->    delay_partial_inst_info(
+                % Read-only.
+                dpi_module_info :: module_info,
+
+                % Read-write.
+                dpi_varset      :: prog_varset,
+                dpi_vartypes    :: vartypes,
+                dpi_changed     :: bool
+            ).
+
+:- type construct_map == map(prog_var, reconstruction_info).
+
+:- type reconstruction_info
+    --->    reconstruction_info(cons_id, prog_vars).
+
+%-----------------------------------------------------------------------------%
+
+delay_partial_inst_preds([], [], !ModuleInfo, !IO).
+delay_partial_inst_preds([PredId | PredIds], ChangedPreds, !ModuleInfo, !IO) :-
+    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+    ProcIds = pred_info_non_imported_procids(PredInfo),
+    list.foldl3(delay_partial_inst_proc(PredId), ProcIds, !ModuleInfo,
+        no, Changed, !IO),
+    (
+        Changed = yes,
+        delay_partial_inst_preds(PredIds, ChangedPreds0, !ModuleInfo, !IO),
+        ChangedPreds = [PredId | ChangedPreds0]
+    ;
+        Changed = no,
+        delay_partial_inst_preds(PredIds, ChangedPreds, !ModuleInfo, !IO)
+    ).
+
+:- pred delay_partial_inst_proc(pred_id::in, proc_id::in,
+    module_info::in, module_info::out, bool::in, bool::out, io::di, io::uo)
+    is det.
+
+delay_partial_inst_proc(PredId, ProcId, !ModuleInfo, !Changed, !IO) :-
+    write_proc_progress_message("% Delaying partial instantiations in ",
+        PredId, ProcId, !.ModuleInfo, !IO),
+    module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId, PredInfo,
+        ProcInfo0),
+    delay_partial_inst_proc_2(!.ModuleInfo, ProcInfo0, MaybeProcInfo),
+    (
+        MaybeProcInfo = yes(ProcInfo),
+        module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+            !ModuleInfo),
+        !:Changed = yes
+    ;
+        MaybeProcInfo = no
+    ).
+
+:- pred delay_partial_inst_proc_2(module_info::in, proc_info::in,
+    maybe(proc_info)::out) is det.
+
+delay_partial_inst_proc_2(ModuleInfo, !.ProcInfo, MaybeProcInfo) :-
+    proc_info_get_varset(!.ProcInfo, VarSet),
+    proc_info_get_vartypes(!.ProcInfo, VarTypes),
+    DelayInfo0 = delay_partial_inst_info(ModuleInfo, VarSet, VarTypes, no),
+
+    proc_info_get_initial_instmap(!.ProcInfo, ModuleInfo, InstMap0),
+    proc_info_get_goal(!.ProcInfo, Goal0),
+
+    delay_partial_inst_in_goal(InstMap0, Goal0, Goal, map.init, _ConstructMap,
+        DelayInfo0, DelayInfo),
+
+    (if DelayInfo ^ dpi_changed = yes then
+        proc_info_set_goal(Goal, !ProcInfo),
+        proc_info_set_varset(DelayInfo ^ dpi_varset, !ProcInfo),
+        proc_info_set_vartypes(DelayInfo ^ dpi_vartypes, !ProcInfo),
+        requantify_proc(!ProcInfo),
+        MaybeProcInfo = yes(!.ProcInfo)
+    else
+        MaybeProcInfo = no
+    ).
+
+:- pred delay_partial_inst_in_goal(instmap::in, hlds_goal::in, hlds_goal::out,
+    construct_map::in, construct_map::out,
+    delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
+
+delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap, !DelayInfo) :-
+    Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+    (
+        GoalExpr0 = conj(ConjType, Goals0),
+        delay_partial_inst_in_conj(InstMap0, Goals0, Goals, !ConstructMap,
+            !DelayInfo),
+        Goal = hlds_goal(conj(ConjType, Goals), GoalInfo0)
+    ;
+        GoalExpr0 = disj(Goals0),
+        %
+        % We need to thread the construct map through the disjunctions for when
+        % a variable becomes partially constructed in the disjunction.  Each
+        % disjunct should be using the same entry for that variable in the
+        % construct map.
+        %
+        % XXX we depend on the fact that (it seems) after mode checking a
+        % variable won't become ground in each of the disjuncts, but rather
+        % will become ground after the disjunction as a whole.  Otherwise
+        % entries could be removed from the construct map in earlier disjuncts
+        % that should be visible in later disjuncts.
+        %
+        delay_partial_inst_in_goals(InstMap0, Goals0, Goals, !ConstructMap,
+            !DelayInfo),
+        Goal = hlds_goal(disj(Goals), GoalInfo0)
+    ;
+        GoalExpr0 = negation(NegGoal0),
+        delay_partial_inst_in_goal(InstMap0, NegGoal0, NegGoal,
+            !.ConstructMap, _, !DelayInfo),
+        Goal = hlds_goal(negation(NegGoal), GoalInfo0)
+    ;
+        GoalExpr0 = switch(Var, CanFail, Cases0),
+        delay_partial_inst_in_cases(InstMap0, Cases0, Cases, !ConstructMap,
+            !DelayInfo),
+        Goal = hlds_goal(switch(Var, CanFail, Cases), GoalInfo0)
+    ;
+        GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+        update_instmap(Cond0, InstMap0, InstMapThen),
+        delay_partial_inst_in_goal(InstMap0, Cond0, Cond, !ConstructMap,
+            !DelayInfo),
+        delay_partial_inst_in_goal(InstMapThen, Then0, Then, !ConstructMap,
+            !DelayInfo),
+        delay_partial_inst_in_goal(InstMap0, Else0, Else, !ConstructMap,
+            !DelayInfo),
+        Goal = hlds_goal(if_then_else(Vars, Cond, Then, Else), GoalInfo0)
+    ;
+        GoalExpr0 = scope(Reason, SubGoal0),
+        delay_partial_inst_in_goal(InstMap0, SubGoal0, SubGoal,
+            !.ConstructMap, _, !DelayInfo),
+        Goal = hlds_goal(scope(Reason, SubGoal), GoalInfo0)
+    ;
+        GoalExpr0 = unify(LHS, RHS0, Mode, Unify, Context),
+        (
+            Unify = construct(Var, ConsId, Args, UniModes, _, _, _),
+            (if
+                % Is this construction of the form
+                %   V = f(A1, A2, A3, ...)
+                % and at least one of the arguments is free?
+                %
+                ConsId = cons(_, _),
+                ModuleInfo = !.DelayInfo ^ dpi_module_info,
+                some [RhsAfter] (
+                    list.member(_ -> _ - RhsAfter, UniModes),
+                    inst_is_free(ModuleInfo, RhsAfter)
+                )
+            then
+                % Add an entry for Var to the construct map if it doesn't exist
+                % already, otherwise look up the canonical variables.
+                (if
+                    search_construct_map(!.ConstructMap, Var, ConsId,
+                        CanonVars0)
+                then
+                    CanonVars = CanonVars0
+                else
+                    create_canonical_variables(Args, CanonVars, !DelayInfo),
+                    ReconstructInfo = reconstruction_info(ConsId, CanonVars),
+                    svmap.det_insert(Var, ReconstructInfo, !ConstructMap)
+                ),
+
+                % Unify the canonical variables and corresponding ground
+                % arguments (if any).
+                goal_info_get_context(GoalInfo0, ProgContext),
+                SubUnifyGoals = list.filter_map_corresponding3(
+                    maybe_unify_var_with_ground_var(ModuleInfo, ProgContext),
+                    CanonVars, Args, UniModes),
+                conj_list_to_goal(SubUnifyGoals, GoalInfo0, Goal),
+
+                % Mark the procedure as changed.
+                !DelayInfo ^ dpi_changed := yes
+
+            else if
+                % Tranform lambda goals as well.  Non-local variables in lambda
+                % goals must be ground so we don't carry the construct map into
+                % the lambda goal.
+                RHS0 = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod,
+                    NonLocals, LambdaQuantVars, Modues, Detism, LambdaGoal0)
+            then
+                delay_partial_inst_in_goal(InstMap0, LambdaGoal0, LambdaGoal,
+                    map.init, _ConstructMap, !DelayInfo),
+                RHS = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod,
+                    NonLocals, LambdaQuantVars, Modues, Detism, LambdaGoal),
+                GoalExpr = unify(LHS, RHS, Mode, Unify, Context),
+                Goal = hlds_goal(GoalExpr, GoalInfo0)
+            else
+                Goal = Goal0
+            )
+        ;
+            Unify = deconstruct(Var, ConsId, DeconArgs, UniModes,
+                _CanFail, _CanCGC),
+            (if
+                search_construct_map(!.ConstructMap, Var, ConsId, CanonArgs)
+            then
+                % Unify each ground argument with the corresponding canonical
+                % variable.
+                ModuleInfo = !.DelayInfo ^ dpi_module_info,
+                goal_info_get_context(GoalInfo0, ProgContext),
+                SubUnifyGoals = list.filter_map_corresponding3(
+                    maybe_unify_var_with_ground_var(ModuleInfo, ProgContext),
+                    CanonArgs, DeconArgs, UniModes),
+
+                % Construct Var if it should be ground now.
+                Mode = LHS_Mode - _RHS_Mode,
+                FinalInst = mode_get_final_inst(ModuleInfo, LHS_Mode),
+                (if inst_is_ground(ModuleInfo, FinalInst) then
+                    construct_functor(Var, ConsId, CanonArgs, ConstructGoal),
+                    % Delete the variable on the LHS from the construct map
+                    % since it has been constructed.
+                    svmap.delete(Var, !ConstructMap),
+                    ConjList = SubUnifyGoals ++ [ConstructGoal]
+                else
+                    ConjList = SubUnifyGoals
+                ),
+                conj_list_to_goal(ConjList, GoalInfo0, Goal)
+            else
+                Goal = Goal0
+            )
+        ;
+            Unify = complicated_unify(_UniMode, CanFail, _TypeInfos),
+            %
+            % Deal with tests generated for calls to implied modes.
+            %
+            %       LHS := f(_),
+            %       p(RHS),
+            %       LHS ?= RHS
+            %   ===>
+            %       p(RHS),
+            %       RHS ?= f(_),
+            %       LHS := RHS
+            %
+            % XXX I have not seen a case where the LHS and RHS are swapped
+            % but we should handle that if it comes up.
+            %
+            (if
+                CanFail = can_fail,
+                RHS0 = rhs_var(RHSVar),
+                map.search(!.ConstructMap, LHS, ReconstructInfo),
+                ReconstructInfo = reconstruction_info(ConsId, CanonArgs)
+            then
+                goal_info_get_context(GoalInfo0, ProgContext),
+                create_pure_atomic_complicated_unification(RHSVar,
+                    rhs_functor(ConsId, no, CanonArgs),
+                    ProgContext, umc_explicit, [], TestGoal),
+                create_pure_atomic_complicated_unification(LHS, RHS0,
+                    ProgContext, umc_implicit("delay_partial_inst"), [],
+                    AssignGoal),
+                conjoin_goals(TestGoal, AssignGoal, Goal)
+            else
+                Goal = Goal0
+            )
+        ;
+            ( Unify = assign(_, _)
+            ; Unify = simple_test(_, _)
+            ),
+            Goal = Goal0
+        )
+    ;
+        ( GoalExpr0 = generic_call(_, _, _, _)
+        ; GoalExpr0 = plain_call(_, _, _, _, _, _)
+        ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+        ),
+        Goal = Goal0
+    ;
+        GoalExpr0 = shorthand(_),
+        % These should have been expanded out by now.
+        unexpected(this_file,
+            "delay_partial_inst_in_goal: unexpected shorthand")
+    ).
+
+:- pred search_construct_map(construct_map::in, prog_var::in, cons_id::in,
+    prog_vars::out) is semidet.
+
+search_construct_map(ConstructMap, Var, ExpectConsId, CanonVars) :-
+    map.search(ConstructMap, Var, reconstruction_info(ConsId, CanonVars)),
+    % It doesn't seem like this could happen, and we couldn't really handle it
+    % anyway.
+    expect(unify(ConsId, ExpectConsId), this_file,
+        "search_construct_map: unexpected cons id").
+
+:- pred create_canonical_variables(prog_vars::in, prog_vars::out,
+    delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
+
+create_canonical_variables(OrigVars, CanonVars, !DelayInfo) :-
+    VarSet0 = !.DelayInfo ^ dpi_varset,
+    VarTypes0 = !.DelayInfo ^ dpi_vartypes,
+    create_variables(OrigVars, VarSet0, VarTypes0,
+        VarSet0, VarSet, VarTypes0, VarTypes, map.init, Subn),
+    MustRename = yes,
+    rename_var_list(MustRename, Subn, OrigVars, CanonVars),
+    !DelayInfo ^ dpi_varset := VarSet,
+    !DelayInfo ^ dpi_vartypes := VarTypes.
+
+:- func maybe_unify_var_with_ground_var(module_info::in, prog_context::in,
+    prog_var::in, prog_var::in, uni_mode::in) = (hlds_goal::out) is semidet.
+
+maybe_unify_var_with_ground_var(ModuleInfo, Context, LhsVar, RhsVar, ArgMode)
+        = Goal :-
+    ArgMode = (_ - _ -> Inst - _),
+    inst_is_ground(ModuleInfo, Inst),
+    create_pure_atomic_complicated_unification(LhsVar, rhs_var(RhsVar),
+        Context, umc_implicit("delay_partial_inst"), [], Goal).
+
+%-----------------------------------------------------------------------------%
+
+:- pred delay_partial_inst_in_conj(instmap::in,
+    list(hlds_goal)::in, list(hlds_goal)::out,
+    construct_map::in, construct_map::out,
+    delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
+
+delay_partial_inst_in_conj(_, [], [], !ConstructMap, !DelayInfo).
+delay_partial_inst_in_conj(InstMap0, [Goal0 | Goals0], Goals, !ConstructMap,
+        !DelayInfo) :-
+    delay_partial_inst_in_goal(InstMap0, Goal0, Goal1, !ConstructMap,
+        !DelayInfo),
+    update_instmap(Goal0, InstMap0, InstMap1),
+    delay_partial_inst_in_conj(InstMap1, Goals0, Goals1, !ConstructMap,
+        !DelayInfo),
+    goal_to_conj_list(Goal1, Goal1List),
+    Goals = Goal1List ++ Goals1.
+
+:- pred delay_partial_inst_in_goals(instmap::in,
+    list(hlds_goal)::in, list(hlds_goal)::out,
+    construct_map::in, construct_map::out,
+    delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
+
+delay_partial_inst_in_goals(_, [], [], !ConstructMap, !DelayInfo).
+delay_partial_inst_in_goals(InstMap0,
+        [Goal0 | Goals0], [Goal | Goals], !ConstructMap, !DelayInfo) :-
+    delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap,
+        !DelayInfo),
+    delay_partial_inst_in_goals(InstMap0, Goals0, Goals, !ConstructMap,
+        !DelayInfo).
+
+:- pred delay_partial_inst_in_cases(instmap::in,
+    list(case)::in, list(case)::out, construct_map::in, construct_map::out,
+    delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
+
+delay_partial_inst_in_cases(_, [], [], !ConstructMap, !DelayInfo).
+delay_partial_inst_in_cases(InstMap0,
+        [case(Cons, Goal0) | Cases0], [case(Cons, Goal) | Cases],
+        !ConstructMap, !DelayInfo) :-
+    delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap,
+        !DelayInfo),
+    delay_partial_inst_in_cases(InstMap0, Cases0, Cases, !ConstructMap,
+        !DelayInfo).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "delay_partial_inst.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module delay_partial_inst.
+%-----------------------------------------------------------------------------%
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.147
diff -u -r1.147 goal_util.m
--- compiler/goal_util.m	13 Apr 2007 04:56:38 -0000	1.147
+++ compiler/goal_util.m	21 Jun 2007 03:55:12 -0000
@@ -92,9 +92,8 @@
 :- pred rename_var(bool::in, map(var(V), var(V))::in,
     var(V)::in, var(V)::out) is det.
 
-    % create_variables(OldVariables, OldVarset, InitialVarTypes,
-    %   InitialSubstitution, OldVarTypes, OldVarNames,  NewVarset,
-    %   NewVarTypes, NewSubstitution):
+    % create_variables(OldVariables, OldVarNames, OldVarTypes,
+    %   !Varset, !VarTypes, !Subn):
     %
     % create_variables takes a list of variables, a varset, and map
     % from vars to types and an initial substitution, and creates new instances
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.302
diff -u -r1.302 handle_options.m
--- compiler/handle_options.m	13 Jun 2007 02:48:38 -0000	1.302
+++ compiler/handle_options.m	21 Jun 2007 03:55:12 -0000
@@ -631,6 +631,7 @@
         %   - gc_method `automatic' and no heap reclamation on failure
         %     because GC is handled automatically by the Erlang
         %     implementation.
+        %   - delay-partial-instantiations
 
         ( 
             Target = target_erlang,
@@ -639,6 +640,8 @@
             globals.set_option(reclaim_heap_on_nondet_failure, bool(no),
                 !Globals),
             globals.set_option(reclaim_heap_on_semidet_failure, bool(no),
+                !Globals),
+            globals.set_option(delay_partial_instantiations, bool(yes),
                 !Globals)
         ;
             ( Target = target_c
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.357
diff -u -r1.357 modes.m
--- compiler/modes.m	28 May 2007 01:06:19 -0000	1.357
+++ compiler/modes.m	21 Jun 2007 03:55:12 -0000
@@ -348,6 +348,7 @@
 
 :- import_module check_hlds.clause_to_proc.
 :- import_module check_hlds.delay_info.
+:- import_module check_hlds.delay_partial_inst.
 :- import_module check_hlds.inst_match.
 :- import_module check_hlds.inst_util.
 :- import_module check_hlds.mode_debug.
@@ -409,18 +410,34 @@
     globals.io_lookup_int_option(mode_inference_iteration_limit,
         MaxIterations, !IO),
     modecheck_to_fixpoint(PredIds, MaxIterations, WhatToCheck,
-        MayChangeCalledProc, !ModuleInfo, UnsafeToContinue, !IO),
+        MayChangeCalledProc, !ModuleInfo, UnsafeToContinue0, !IO),
     (
         WhatToCheck = check_unique_modes,
         write_mode_inference_messages(PredIds, yes, !.ModuleInfo, !IO),
-        check_eval_methods(!ModuleInfo, !IO)
+        check_eval_methods(!ModuleInfo, !IO),
+        UnsafeToContinue = UnsafeToContinue0
     ;
         WhatToCheck = check_modes,
         (
-            UnsafeToContinue = yes,
-            write_mode_inference_messages(PredIds, no, !.ModuleInfo, !IO)
+            UnsafeToContinue0 = yes,
+            write_mode_inference_messages(PredIds, no, !.ModuleInfo, !IO),
+            UnsafeToContinue = yes
         ;
-            UnsafeToContinue = no
+            UnsafeToContinue0 = no,
+            globals.io_lookup_bool_option(delay_partial_instantiations,
+                DelayPartialInstantiations, !IO),
+            (
+                DelayPartialInstantiations = yes,
+                delay_partial_inst_preds(PredIds, ChangedPreds, !ModuleInfo,
+                    !IO),
+                % --delay-partial-instantiations requires mode checking to be
+                % run again.
+                modecheck_to_fixpoint(ChangedPreds, MaxIterations, WhatToCheck,
+                    MayChangeCalledProc, !ModuleInfo, UnsafeToContinue, !IO)
+            ;
+                DelayPartialInstantiations = no,
+                UnsafeToContinue = no
+            )
         )
     ).
 
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.567
diff -u -r1.567 options.m
--- compiler/options.m	19 Jun 2007 04:20:45 -0000	1.567
+++ compiler/options.m	21 Jun 2007 03:55:12 -0000
@@ -407,6 +407,8 @@
 
     ;       mutable_always_boxed
 
+    ;       delay_partial_instantiations
+
     % Options for internal use only (setting these options to non-default
     % values can result in programs that do not link, or programs that dump
     % core)
@@ -1154,6 +1156,7 @@
     body_typeinfo_liveness              -   bool(no),
     can_compare_constants_as_ints       -   bool(no),
     mutable_always_boxed                -   bool(yes),
+    delay_partial_instantiations        -   bool(no),
     special_preds                       -   bool(yes),
     type_ctor_info                      -   bool(yes),
     type_ctor_layout                    -   bool(yes),
@@ -1919,6 +1922,7 @@
 long_option("body-typeinfo-liveness",   body_typeinfo_liveness).
 long_option("can-compare-constants-as-ints",    can_compare_constants_as_ints).
 long_option("mutable-always-boxed", mutable_always_boxed).
+long_option("delay-partial-instantiations", delay_partial_instantiations).
 long_option("special-preds",        special_preds).
 long_option("type-ctor-info",       type_ctor_info).
 long_option("type-ctor-layout",     type_ctor_layout).
@@ -3966,6 +3970,10 @@
 %       "(This option is not for general use.)",
 %       For documentation, see the comment in the type declaration.
 
+        % This is a developer only option.
+%       "--delay-partial-instantiations",
+%       "(This option is not for general use.)",
+%       For documentation, see delay_partial_inst.m
     ]).
 
 :- pred options_help_code_generation(io::di, io::uo) is det.
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.129
diff -u -r1.129 compiler_design.html
--- compiler/notes/compiler_design.html	28 May 2007 03:13:53 -0000	1.129
+++ compiler/notes/compiler_design.html	21 Jun 2007 03:55:12 -0000
@@ -764,6 +764,9 @@
 	  of the compiler)
 	<li> mode_debug.m contains utility code for tracing the actions
 	  of the mode checker.
+	<li> delay_partial_inst.m adds a post-processing pass on mode-correct
+	  procedures to avoid creating intermediate, partially instantiated
+	  data structures.
 	</ul>
 	<p>
 
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.25
diff -u -r1.25 Mercury.options
--- tests/hard_coded/Mercury.options	15 Jan 2007 02:50:58 -0000	1.25
+++ tests/hard_coded/Mercury.options	21 Jun 2007 03:55:12 -0000
@@ -7,6 +7,8 @@
 MCFLAGS-constraint	=	--constraint-propagation --enable-termination
 MCFLAGS-constraint_order =	--constraint-propagation --enable-termination
 MCFLAGS-deforest_cc_bug =	--deforestation
+MCFLAGS-delay_partial_test =    --delay-partial-instantiations
+MCFLAGS-delay_partial_test2 =   --delay-partial-instantiations
 MCFLAGS-lp		=	--intermodule-optimization -O3
 MCFLAGS-boyer		=	--infer-all
 MCFLAGS-float_consistency =	--optimize-constant-propagation
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.323
diff -u -r1.323 Mmakefile
--- tests/hard_coded/Mmakefile	14 Jun 2007 02:41:48 -0000	1.323
+++ tests/hard_coded/Mmakefile	21 Jun 2007 03:55:12 -0000
@@ -46,6 +46,8 @@
 	deep_copy_bug \
 	deep_copy_exist \
 	deforest_cc_bug \
+	delay_partial_test \
+	delay_partial_test2 \
 	dense_lookup_switch \
 	dense_lookup_switch2 \
 	dense_lookup_switch3 \
Index: tests/hard_coded/delay_partial_test.exp
===================================================================
RCS file: tests/hard_coded/delay_partial_test.exp
diff -N tests/hard_coded/delay_partial_test.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/delay_partial_test.exp	21 Jun 2007 03:55:12 -0000
@@ -0,0 +1,4 @@
+implied mode call 1 ok
+implied mode call 2 ok
+blah(42, 43, 'x')
+{blah(-42, -42, 'x'), blah(43, -42, 'x')}
Index: tests/hard_coded/delay_partial_test.m
===================================================================
RCS file: tests/hard_coded/delay_partial_test.m
diff -N tests/hard_coded/delay_partial_test.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/delay_partial_test.m	21 Jun 2007 03:55:12 -0000
@@ -0,0 +1,91 @@
+% Test the --delay-partial-instantiations option.
+
+:- module delay_partial_test.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char.
+:- import_module int.
+
+%-----------------------------------------------------------------------------%
+
+:- type t
+    --->    f(int)
+    ;       g(int, int)
+    ;       h(t, t).
+
+:- type blah
+    --->    blah(
+                a :: int,
+                b :: int,
+                c :: char
+            ).
+
+main(!IO) :-
+    test1(!IO),
+    test2(!IO),
+    test3(!IO),
+    test4(!IO).
+
+% Test implied mode calls.
+
+:- pred test1(io::di, io::uo) is det.
+
+test1(!IO) :-
+    (if foo(h(_, _)) then
+        io.write_string("implied mode call 1 ok\n", !IO)
+    else
+        io.write_string("implied mode call 1 bad\n", !IO)
+    ).
+
+:- pred test2(io::di, io::uo) is det.
+
+test2(!IO) :-
+    (if foo(g(_, _)) then
+        io.write_string("implied mode call 2 bad\n", !IO)
+    else
+        io.write_string("implied mode call 2 ok\n", !IO)
+    ).
+
+% Test constructing things.
+
+:- pred test3(io::di, io::uo) is det.
+
+test3(!IO) :-
+    Foo ^ a = 42,
+    Foo ^ b = 43,
+    Foo ^ c = 'x',
+    io.print(Foo, !IO),
+    io.nl(!IO).
+
+:- pred test4(io::di, io::uo) is det.
+
+test4(!IO) :-
+    Bar ^ b = Baz ^ b,
+    Baz ^ c = X,
+    Bar ^ a = Bar ^ b,
+    (if foo(f(_)) then
+        X = Bar ^ c,
+        Bar ^ c = 'x'
+    else
+        X = 'z',
+        Bar ^ c = 'y'
+    ),
+    Baz ^ a = 43,
+    Baz ^ b = -42,
+    io.print({Bar, Baz}, !IO),
+    io.nl(!IO).
+
+:- pred foo(t::out) is multi.
+:- pragma no_inline(foo/1).
+
+foo(f(42)).
+foo(h(f(43), g(44, 45))).
+
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
Index: tests/hard_coded/delay_partial_test2.exp
===================================================================
RCS file: tests/hard_coded/delay_partial_test2.exp
diff -N tests/hard_coded/delay_partial_test2.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/delay_partial_test2.exp	21 Jun 2007 03:55:12 -0000
@@ -0,0 +1,2 @@
+t(2, 2)
+t(3, 3)
Index: tests/hard_coded/delay_partial_test2.m
===================================================================
RCS file: tests/hard_coded/delay_partial_test2.m
diff -N tests/hard_coded/delay_partial_test2.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/delay_partial_test2.m	21 Jun 2007 03:55:12 -0000
@@ -0,0 +1,82 @@
+% Test the --delay-partial-instantiations option with disjunctions.
+
+:- module delay_partial_test2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    ( foo(2, Y) ->
+        io.print(Y, !IO),
+        io.nl(!IO)
+    ;
+        io.print("foo failed\n", !IO)
+    ),
+    ( bar(3, Y2) ->
+        io.print(Y2, !IO),
+        io.nl(!IO)
+    ;
+        io.print("bar failed\n", !IO)
+    ).
+
+:- type t
+    --->    t(
+                a :: int,
+                b :: int
+            ).
+
+:- pred foo(int::in, t::out) is nondet.
+:- pragma no_inline(foo/2).
+
+foo(X, Y) :-
+    U ^ b = U ^ a - 1,
+    Y ^ b = Z,
+    (
+        X = 1,
+        Y ^ a = Z,
+        Z = U ^ b
+    ;
+        int.even(X),
+        Z = U ^ a,
+        Y ^ a = U ^ a
+    ;
+        int.odd(X),
+        Z = U ^ a,
+        Y ^ a = X
+    ),
+    U ^ a = X.
+
+:- pred bar(int::in, t::out) is nondet.
+:- pragma no_inline(bar/2).
+
+bar(X, Y) :-
+    Y ^ a = Z,      % constructed outside
+    U ^ b = U ^ a - 1,
+    (
+        X = 1,
+        Z = U ^ b,
+        Y ^ b = Z   % ground inside
+    ;
+        int.even(X),
+        Z = U ^ a,
+        Y ^ b = 2   % ground inside
+    ;
+        int.odd(X),
+        Z = U ^ a,
+        Y ^ b = 3   % ground inside
+    ),
+    U ^ a = X.
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
--------------------------------------------------------------------------
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