[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