[m-rev.] diff: minor style fixes
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Sep 22 16:15:03 AEST 2005
compiler/equiv_type_hlds.m:
compiler/higher_order.m:
compiler/mode_util.m:
Minor style fixes.
Zoltan.
Index: equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.18
diff -u -b -r1.18 equiv_type_hlds.m
--- equiv_type_hlds.m 2 Sep 2005 13:57:27 -0000 1.18
+++ equiv_type_hlds.m 20 Sep 2005 06:01:34 -0000
@@ -114,10 +114,9 @@
set_type_defn_in_exported_eqv(yes, Defn0, Defn),
map__det_update(!.TypeTable, TypeCtor, Defn, !:TypeTable)
;
- % We can get here for builtin `types' such as func. Since
- % their unify and compare preds are in the runtime system,
- % not generated by the compiler, marking them as exported
- % in the compiler is moot.
+ % We can get here for builtin `types' such as func. Since their unify
+ % and compare preds are in the runtime system, not generated by the
+ % compiler, marking them as exported in the compiler is moot.
true
).
@@ -227,8 +226,7 @@
!.Cache::in, !:Cache::out) is det :-
% XXX We don't have a valid tvarset here.
varset__init(TVarSet),
- replace_in_inst_name(EqvMap, Name0, Name,
- _, TVarSet, _, !Cache),
+ replace_in_inst_name(EqvMap, Name0, Name, _, TVarSet, _, !Cache),
P(T0, T, !Cache)
), AL0, AL, !Cache),
map__from_assoc_list(AL, Map).
@@ -371,10 +369,12 @@
!.Cache, no),
replace_info(!:ModuleInfo, !:PredInfo, !:ProcInfo, !:TVarSet,
_XXX, Recompute)),
- ( Changed = yes, proc_info_set_goal(Goal, !ProcInfo)
- ; Changed = no
+ (
+ Changed = yes,
+ proc_info_set_goal(Goal, !ProcInfo)
+ ;
+ Changed = no
),
-
(
Recompute = yes,
requantify_proc(!ProcInfo),
@@ -382,7 +382,6 @@
;
Recompute = no
),
-
pred_info_set_typevarset(!.TVarSet, !PredInfo)
).
@@ -637,7 +636,8 @@
{Changed0, TVarSet0, Cache0}, {Changed, TVarSet, Cache}),
(
Changed = yes,
- !:Info = (!.Info ^ tvarset := TVarSet) ^ inst_cache := Cache,
+ !:Info = !.Info ^ tvarset := TVarSet,
+ !:Info = !.Info ^ inst_cache := Cache,
goal_info_set_instmap_delta(InstMapDelta, GoalInfo0, GoalInfo),
Goal = GoalExpr - GoalInfo
;
@@ -672,8 +672,7 @@
replace_in_list(
(pred((Case0 @ case(ConsId, CaseGoal0))::in, Case::out,
CaseChanged::out, !.Info::in, !:Info::out) is det :-
- replace_in_goal(EqvMap, CaseGoal0, CaseGoal,
- CaseChanged, !Info),
+ replace_in_goal(EqvMap, CaseGoal0, CaseGoal, CaseChanged, !Info),
( CaseChanged = yes, Case = case(ConsId, CaseGoal)
; CaseChanged = no, Case = Case0
)
@@ -726,7 +725,8 @@
Cache0, Cache),
(
Changed = yes,
- !:Info = (!.Info ^ tvarset := TVarSet) ^ inst_cache := Cache,
+ !:Info = !.Info ^ tvarset := TVarSet,
+ !:Info = !.Info ^ inst_cache := Cache,
Goal = generic_call(A, B, Modes, D)
;
Changed = no,
@@ -740,11 +740,9 @@
map__lookup(VarTypes, Var, VarType),
classify_type(!.Info ^ module_info, VarType) = TypeCat,
(
- %
- % If this goal constructs a type_info for an equivalence
- % type, we need to expand that to make the type_info for
- % the expanded type. It's simpler to just recreate the
- % type-info from scratch.
+ % If this goal constructs a type_info for an equivalence type,
+ % we need to expand that to make the type_info for the expanded type.
+ % It's simpler to just recreate the type_info from scratch.
%
Goal0 ^ unify_kind = construct(_, ConsId, _, _, _, _, _),
ConsId = type_info_cell_constructor(TypeCtor),
@@ -769,10 +767,10 @@
poly_info_extract(PolyInfo, PredInfo0, PredInfo,
!.Info ^ proc_info, ProcInfo, ModuleInfo),
pred_info_typevarset(PredInfo, TVarSet),
- !:Info = (((!.Info ^ pred_info := PredInfo)
- ^ proc_info := ProcInfo)
- ^ module_info := ModuleInfo)
- ^ tvarset := TVarSet,
+ !:Info = !.Info ^ pred_info := PredInfo,
+ !:Info = !.Info ^ proc_info := ProcInfo,
+ !:Info = !.Info ^ module_info := ModuleInfo,
+ !:Info = !.Info ^ tvarset := TVarSet,
goal_util__rename_vars_in_goals(no,
map__from_assoc_list([TypeInfoVar - Var]), Goals0, Goals),
@@ -783,11 +781,9 @@
),
!:Info = !.Info ^ recompute := yes
;
- %
- % Check for a type_ctor_info for an equivalence type.
- % We can just remove these because after the code above
- % to fix up type_infos for equivalence types they can't
- % be used.
+ % Check for a type_ctor_info for an equivalence type. We can just
+ % remove these because after the code above to fix up type_infos
+ % for equivalence types they can't be used.
%
Goal0 ^ unify_kind = construct(_, ConsId, _, _, _, _, _),
ConsId = type_info_cell_constructor(TypeCtor),
@@ -807,15 +803,15 @@
TVarSet0, TVarSet1, Cache0, Cache1),
replace_in_mode(EqvMap, RMode0, RMode, Changed2,
TVarSet1, TVarSet, Cache1, Cache),
- !:Info = (!.Info ^ tvarset := TVarSet)
- ^ inst_cache := Cache,
+ !:Info = !.Info ^ tvarset := TVarSet,
+ !:Info = !.Info ^ inst_cache := Cache,
replace_in_unification(EqvMap, Goal0 ^ unify_kind, Unification,
Changed3, !Info),
Changed = Changed1 `or` Changed2 `or` Changed3,
(
Changed = yes,
- Goal = (Goal0 ^ unify_mode := LMode - RMode)
- ^ unify_kind := Unification
+ Goal1 = Goal0 ^ unify_mode := LMode - RMode,
+ Goal = Goal1 ^ unify_kind := Unification
;
Changed = no,
Goal = Goal0
@@ -893,6 +889,7 @@
% Replace equivalence types in a given type.
% The bool output is `yes' if anything changed.
+ %
:- pred replace_in_foreign_arg(eqv_map::in, foreign_arg::in, foreign_arg::out,
bool::out, tvarset::in, tvarset::out,
equiv_type_info::in, equiv_type_info::out) is det.
Index: higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.137
diff -u -b -r1.137 higher_order.m
--- higher_order.m 19 Sep 2005 07:26:23 -0000 1.137
+++ higher_order.m 20 Sep 2005 03:02:58 -0000
@@ -159,7 +159,7 @@
(
Requests = []
;
- Requests = [_|_],
+ Requests = [_ | _],
some [!PredProcsToFix] (
set.init(!:PredProcsToFix),
create_new_preds(Requests, [], NewPredList, !PredProcsToFix,
@@ -337,8 +337,8 @@
; multiple_values. % Multiple possible values,
% cannot specialise.
-:- type ho_params --->
- ho_params(
+:- type ho_params
+ ---> ho_params(
optimize_higher_order :: bool,
% Propagate higher-order constants.
type_spec :: bool,
@@ -348,12 +348,12 @@
size_limit :: int,
% Size limit on requested version.
arg_limit :: int
- % The maximum size of the higher-order arguments
- % of a specialized version.
+ % The maximum size of the higher-order
+ % arguments of a specialized version.
).
-:- type version_info --->
- version_info(
+:- type version_info
+ ---> version_info(
pred_proc_id,
% The procedure from the original program
% from which this version was created.
@@ -372,8 +372,8 @@
% terminate.
).
-:- type parent_version_info --->
- parent_version_info(
+:- type parent_version_info
+ ---> parent_version_info(
pred_proc_id,
% The procedure from the original program from which
% this parent was created.
@@ -382,8 +382,8 @@
% Depth of the higher_order_args for this version.
).
-:- type new_pred --->
- new_pred(
+:- type new_pred
+ ---> new_pred(
np_version_ppid :: pred_proc_id,
% version pred_proc_id
np_old_ppid :: pred_proc_id,
@@ -395,18 +395,22 @@
np_spec_args :: list(higher_order_arg),
% specialized args
np_unspec_actuals :: list(prog_var),
- % Unspecialised argument vars in caller.
+ % Unspecialised argument vars in
+ % caller.
np_extra_act_ti_vars :: list(tvar),
% Extra typeinfo tvars in caller.
np_unspec_act_types :: list(type),
- % Unspecialised argument types in requesting caller.
+ % Unspecialised argument types
+ % in requesting caller.
np_typeinfo_liveness :: bool,
- % Does the interface of the specialized version
- % use type-info liveness?
+ % Does the interface of the
+ % specialized version use type-info
+ % liveness?
np_call_tvarset :: tvarset,
% Caller's typevarset.
np_is_user_spec :: bool
- % Is this a user-specified type specialization?
+ % Is this a user-specified type
+ % specialization?
).
% Returned by traverse_goal.
@@ -455,8 +459,8 @@
map.init(PredVars0),
module_info_pred_proc_info(!.GlobalInfo ^ module_info,
PredId, ProcId, PredInfo0, ProcInfo0),
- Info0 = higher_order_info(!.GlobalInfo, PredVars0,
- proc(PredId, ProcId), PredInfo0, ProcInfo0, unchanged),
+ Info0 = higher_order_info(!.GlobalInfo, PredVars0, proc(PredId, ProcId),
+ PredInfo0, ProcInfo0, unchanged),
traverse_goal(MustRecompute, Info0, Info),
Info = higher_order_info(!:GlobalInfo, _, _, PredInfo, ProcInfo, _),
module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
@@ -509,19 +513,18 @@
recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3,
VarTypes, InstVarSet, InstMap, !ModuleInfo),
proc_info_set_goal(Goal3, !ProcInfo),
- !:Info = (!.Info ^ proc_info := !.ProcInfo)
- ^ global_info ^ module_info := !.ModuleInfo
+ !:Info = !.Info ^ proc_info := !.ProcInfo,
+ !:Info = !.Info ^ global_info ^ module_info := !.ModuleInfo
)
;
true
).
- % Traverses the goal collecting higher order variables for which
- % the value is known, and specializing calls and adding
- % specialization requests to the request_info structure.
- % The first time through the only predicate we can specialize
- % is call/N. The pred_proc_id is that of the current procedure,
- % used to find out which procedures need fixing up later.
+ % Traverses the goal collecting higher order variables for which the value
+ % is known, and specializing calls and adding specialization requests
+ % to the request_info structure. The first time through the only predicate
+ % we can specialize is call/N. The pred_proc_id is that of the current
+ % procedure, used to find out which procedures need fixing up later.
%
:- pred traverse_goal_2(hlds_goal::in, hlds_goal::out,
higher_order_info::in, higher_order_info::out) is det.
@@ -819,8 +822,7 @@
% We can specialize calls to call/N and class_method_call/N
% if the closure or typeclass_info has a known value.
(
- map.search(!.Info ^ pred_vars, PredVar,
- constant(ConsId, CurriedArgs)),
+ map.search(!.Info ^ pred_vars, PredVar, constant(ConsId, CurriedArgs)),
(
ConsId = pred_const(ShroudedPredProcId, _),
MaybeMethod = no
@@ -913,8 +915,8 @@
AllArgs),
list.append(ArgTypeInfoGoals, ArgTypeClassInfoGoals, ExtraGoals)
),
- !:Info = (!.Info ^ pred_info := CallerPredInfo)
- ^ proc_info := CallerProcInfo,
+ !:Info = !.Info ^ pred_info := CallerPredInfo,
+ !:Info = !.Info ^ proc_info := CallerProcInfo,
construct_specialized_higher_order_call(PredId, ProcId,
AllArgs, GoalInfo, Goal, !Info),
list.append(ExtraGoals, [Goal], Goals)
@@ -929,8 +931,7 @@
tvarset::in, tvarset::out) is semidet.
find_matching_instance_method([Instance | Instances], MethodNum, ClassTypes,
- PredId, ProcId, Constraints, UnconstrainedTVarTypes,
- !TVarSet) :-
+ PredId, ProcId, Constraints, UnconstrainedTVarTypes, !TVarSet) :-
(
instance_matches(ClassTypes, Instance, Constraints0,
UnconstrainedTVarTypes0, !TVarSet)
@@ -941,9 +942,8 @@
list.index1_det(ClassInterface, MethodNum,
hlds_class_proc(PredId, ProcId))
;
- find_matching_instance_method(Instances, MethodNum,
- ClassTypes, PredId, ProcId, Constraints,
- UnconstrainedTVarTypes, !TVarSet)
+ find_matching_instance_method(Instances, MethodNum, ClassTypes,
+ PredId, ProcId, Constraints, UnconstrainedTVarTypes, !TVarSet)
).
:- pred instance_matches(list(type)::in, hlds_instance_defn::in,
@@ -986,7 +986,7 @@
MakeResultType = polymorphism.build_typeclass_info_type,
get_typeclass_info_args(ModuleInfo, TypeClassInfoVar,
- "zero_instance_constraint_from_typeclass_info", MakeResultType,
+ "instance_constraint_from_typeclass_info", MakeResultType,
InstanceConstraints, Index, Goals, Vars, !ProcInfo).
% Build calls to
@@ -1004,7 +1004,7 @@
UnconstrainedTVarTypes, Index, Goals, Vars, !ProcInfo) :-
MakeResultType = polymorphism.build_type_info_type,
get_typeclass_info_args(ModuleInfo, TypeClassInfoVar,
- "zero_unconstrained_type_info_from_typeclass_info",
+ "unconstrained_type_info_from_typeclass_info",
MakeResultType, UnconstrainedTVarTypes,
Index, Goals, Vars, !ProcInfo).
@@ -1017,8 +1017,8 @@
Args, Index, Goals, Vars, !ProcInfo) :-
lookup_builtin_pred_proc_id(ModuleInfo, mercury_private_builtin_module,
PredName, predicate, 3, only_mode, ExtractArgPredId, ExtractArgProcId),
- get_typeclass_info_args_2(TypeClassInfoVar, ExtractArgPredId,
- ExtractArgProcId,
+ get_typeclass_info_args_2(TypeClassInfoVar,
+ ExtractArgPredId, ExtractArgProcId,
qualified(mercury_private_builtin_module, PredName),
MakeResultType, Args, Index, Goals, Vars, !ProcInfo).
@@ -1077,7 +1077,7 @@
Goal0 = call(CalledPred, CalledProc, Args0, IsBuiltin,
MaybeContext, _SymName0)
;
- unexpected(this_file, "higher_order.m: call expected")
+ unexpected(this_file, "maybe_specialize_call: expected call")
),
module_info_pred_proc_info(ModuleInfo0, CalledPred, CalledProc,
CalleePredInfo, CalleeProcInfo),
@@ -1112,9 +1112,9 @@
Goal = Goal0
;
CanRequest = yes,
- maybe_specialize_ordinary_call(CanRequest, CalledPred,
- CalledProc, CalleePredInfo, CalleeProcInfo, Args0,
- IsBuiltin, MaybeContext, GoalInfo, Result, !Info),
+ maybe_specialize_ordinary_call(CanRequest, CalledPred, CalledProc,
+ CalleePredInfo, CalleeProcInfo, Args0, IsBuiltin, MaybeContext,
+ GoalInfo, Result, !Info),
(
Result = specialized(ExtraTypeInfoGoals, Goal1),
goal_to_conj_list(Goal1 - GoalInfo, GoalList1),
@@ -1179,9 +1179,9 @@
CanRequest = no,
IsBuiltin = not_builtin,
MaybeContext = no,
- maybe_specialize_ordinary_call(CanRequest, PredId,
- ProcId, CalleePredInfo, CalleeProcInfo, Args1,
- IsBuiltin, MaybeContext, GoalInfo, Result, !Info),
+ maybe_specialize_ordinary_call(CanRequest, PredId, ProcId,
+ CalleePredInfo, CalleeProcInfo, Args1, IsBuiltin, MaybeContext,
+ GoalInfo, Result, !Info),
(
Result = specialized(ExtraTypeInfoGoals0, Goal1),
(
@@ -1208,9 +1208,8 @@
),
modes_to_uni_modes(ModuleInfo, CurriedArgModes,
CurriedArgModes, UniModes),
- %
+
% The dummy arguments can't be used anywhere.
- %
ProcInfo2 = !.Info ^ proc_info,
proc_info_vartypes(ProcInfo2, VarTypes2),
map.delete_list(VarTypes2, UncurriedArgs, VarTypes),
@@ -1224,16 +1223,15 @@
HowToConstruct, CellIsUnique, no_construct_sub_info),
Goal2 = unify(LVar, functor(NewConsId, no, NewArgs),
UniMode, Unify, Context),
- %
+
% Make sure any constants in the ExtraTypeInfoGoals are recorded.
- %
list.map_foldl(traverse_goal_2, ExtraTypeInfoGoals0,
ExtraTypeInfoGoals, !Info),
(
ExtraTypeInfoGoals = [],
Goal = Goal2
;
- ExtraTypeInfoGoals = [_|_],
+ ExtraTypeInfoGoals = [_ | _],
Goal = conj(ExtraTypeInfoGoals ++ [Goal2 - GoalInfo])
)
;
@@ -1292,7 +1290,6 @@
map.apply_to_list(Args0, VarTypes, ArgTypes),
% Check whether any typeclass constraints now match an instance.
- %
pred_info_get_class_context(CalleePredInfo, CalleeClassContext),
CalleeClassContext = constraints(CalleeUnivConstraints0, _),
pred_info_typevarset(CalleePredInfo, CalleeTVarSet),
@@ -1362,22 +1359,21 @@
PredVars, ArgNo, !HOArgs) :-
NextArg = ArgNo + 1,
(
- % We don't specialize arguments whose declared type is
- % polymorphic. The closure they pass cannot possibly be called
- % within the called predicate, since that predicate doesn't know
- % it's a closure (without some dodgy use of type_to_univ and
- % univ_to_type).
+ % We don't specialize arguments whose declared type is polymorphic.
+ % The closure they pass cannot possibly be called within the called
+ % predicate, since that predicate doesn't know it's a closure
+ % (without some dodgy use of type_to_univ and univ_to_type).
map.search(PredVars, Arg, constant(ConsId, CurriedArgs)),
- % We don't specialize based on int_consts (we only keep track
- % of them to interpret calls to the procedures which
- % extract fields from typeclass_infos).
+ % We don't specialize based on int_consts (we only keep track of them
+ % to interpret calls to the procedures which extract fields from
+ % typeclass_infos).
ConsId \= int_const(_),
( ConsId = pred_const(_, _) ->
- % If we don't have clauses for the callee, we can't
- % specialize any higher-order arguments. We may be
- % able to do user guided type specialization.
+ % If we don't have clauses for the callee, we can't specialize
+ % any higher-order arguments. We may be able to do user guided
+ % type specialization.
CalleeStatus \= imported(_),
CalleeStatus \= external(_),
type_is_higher_order(CalleeArgType)
@@ -1427,9 +1423,8 @@
% class constraints match an instance which was not matched before.
%
:- pred type_subst_makes_instance_known(module_info::in,
- list(prog_constraint)::in, tvarset::in, list(tvar)::in,
- list(type)::in, tvarset::in, existq_tvars::in, list(type)::in)
- is semidet.
+ list(prog_constraint)::in, tvarset::in, list(tvar)::in, list(type)::in,
+ tvarset::in, existq_tvars::in, list(type)::in) is semidet.
type_subst_makes_instance_known(ModuleInfo, CalleeUnivConstraints0, TVarSet0,
CallerHeadTypeParams, ArgTypes, CalleeTVarSet,
@@ -1438,9 +1433,8 @@
tvarset_merge_renaming(TVarSet0, CalleeTVarSet, TVarSet, TypeRenaming),
apply_variable_renaming_to_type_list(TypeRenaming, CalleeArgTypes0,
CalleeArgTypes1),
- %
+
% Substitute the types in the callee's class constraints.
- %
inlining.get_type_substitution(CalleeArgTypes1, ArgTypes,
CallerHeadTypeParams, CalleeExistQVars, TypeSubn),
apply_variable_renaming_to_prog_constraint_list(TypeRenaming,
@@ -1449,10 +1443,9 @@
CalleeUnivConstraints1, CalleeUnivConstraints),
assoc_list.from_corresponding_lists(CalleeUnivConstraints0,
CalleeUnivConstraints, CalleeUnivConstraintAL),
- %
+
% Go through each constraint in turn, checking whether any instances
% match which didn't before the substitution was applied.
- %
list.member(CalleeUnivConstraint0 - CalleeUnivConstraint,
CalleeUnivConstraintAL),
CalleeUnivConstraint0 = constraint(ClassName, ConstraintArgs0),
@@ -1484,36 +1477,36 @@
% added to the start of the argument list.
).
- % WARNING - do not filter out higher-order arguments from the
- % request returned by find_matching_version, otherwise some
- % type-infos that the call specialization code is expecting to
- % come from the curried arguments of the higher-order arguments
- % will not be present in the specialized argument list.
+ % WARNING - do not filter out higher-order arguments from the request
+ % returned by find_matching_version, otherwise some type-infos that the
+ % call specialization code is expecting to come from the curried arguments
+ % of the higher-order arguments will not be present in the specialized
+ % argument list.
%
:- pred find_matching_version(higher_order_info::in,
pred_id::in, proc_id::in, list(prog_var)::in, prog_context::in,
list(higher_order_arg)::in, bool::in, find_result::out) is det.
+find_matching_version(Info, CalledPred, CalledProc, Args0, Context,
+ HigherOrderArgs, IsUserSpecProc, Result) :-
% Args0 is the original list of arguments.
% Args is the original list of arguments with the curried arguments
% of known higher-order arguments added.
- %
-find_matching_version(Info, CalledPred, CalledProc, Args0, Context,
- HigherOrderArgs, IsUserSpecProc, Result) :-
+
ModuleInfo = Info ^ global_info ^ module_info,
NewPreds = Info ^ global_info ^ new_preds,
Caller = Info ^ pred_proc_id,
PredInfo = Info ^ pred_info,
ProcInfo = Info ^ proc_info,
Params = Info ^ global_info ^ ho_params,
- %
+
% WARNING - do not filter out higher-order arguments after this step,
% except when partially matching against a previously produced
% specialization, otherwise some type-infos that the call
% specialization code is expecting to come from the curried
% arguments of the higher-order arguments will not be present in the
% specialized argument list.
- %
+
get_extra_arguments(HigherOrderArgs, Args0, Args),
compute_extra_typeinfos(Info, Args, ExtraTypeInfoTVars),
@@ -1524,10 +1517,9 @@
Request = request(Caller, proc(CalledPred, CalledProc), Args0,
ExtraTypeInfoTVars, HigherOrderArgs, CallArgTypes,
yes, TVarSet, IsUserSpecProc, Context),
- %
+
% Check to see if any of the specialized versions of the called pred
% apply here.
- %
(
map.search(NewPreds, proc(CalledPred, CalledProc), Versions0),
set.to_sorted_list(Versions0, Versions),
@@ -1546,10 +1538,10 @@
module_info_pred_info(ModuleInfo, CalledPred, CalledPredInfo),
\+ pred_info_is_imported(CalledPredInfo),
(
- % This handles the predicates introduced by
- % check_typeclass.m to call the class methods for a
- % specific instance. Without this, user-specified
- % specialized versions of class methods won't be called.
+ % This handles the predicates introduced by check_typeclass.m
+ % to call the class methods for a specific instance. Without
+ % this, user-specified specialized versions of class methods
+ % won't be called.
UserTypeSpec = yes,
pred_info_get_markers(CalledPredInfo, Markers),
(
@@ -1575,8 +1567,7 @@
% type-info for `U'. This predicate works out which extra variables
% to pass in given the argument list for the call. This needs to be
% done even if --typeinfo-liveness is not set because the type-infos
- % may be needed when specializing calls inside the specialized
- % version.
+ % may be needed when specializing calls inside the specialized version.
%
:- pred compute_extra_typeinfos(higher_order_info::in,
list(prog_var)::in, list(tvar)::out) is det.
@@ -1644,8 +1635,9 @@
TypeInfoVars, TypeInfoGoals, PolyInfo0, PolyInfo),
poly_info_extract(PolyInfo, !.Info ^ pred_info, PredInfo,
!.Info ^ proc_info, ProcInfo, ModuleInfo),
- !:Info = ((!.Info ^ pred_info := PredInfo) ^ proc_info := ProcInfo)
- ^ global_info ^ module_info := ModuleInfo.
+ !:Info = !.Info ^ pred_info := PredInfo,
+ !:Info = !.Info ^ proc_info := ProcInfo,
+ !:Info = !.Info ^ global_info ^ module_info := ModuleInfo.
:- pred search_for_version(higher_order_info::in, ho_params::in,
module_info::in, request::in, list(new_pred)::in,
@@ -1687,9 +1679,9 @@
Versions, MaybeMatch0, Match)
).
- % Check whether the request has already been implemented by
- % the new_pred, maybe ordering the list of extra type_infos
- % in the caller predicate to match up with those in the caller.
+ % Check whether the request has already been implemented by the new_pred,
+ % maybe ordering the list of extra type_infos in the caller predicate
+ % to match up with those in the caller.
%
:- pred version_matches(ho_params::in, module_info::in, request::in,
new_pred::in, match::out) is semidet.
@@ -1706,9 +1698,8 @@
higher_order_args_match(RequestHigherOrderArgs,
VersionHigherOrderArgs, HigherOrderArgs, MatchIsPartial),
(
- % Don't accept partial matches unless the predicate is
- % imported or we are only doing user-guided type
- % specialization.
+ % Don't accept partial matches unless the predicate is imported
+ % or we are only doing user-guided type specialization.
MatchIsPartial = no,
PartialMatch = no
;
@@ -1732,12 +1723,13 @@
apply_variable_renaming_to_type_list(TVarRenaming, VersionArgTypes0,
VersionArgTypes),
type_list_subsumes(VersionArgTypes, CallArgTypes, TypeSubn),
- %
+
% Work out the types of the extra type-info variables that
% need to be passed to the specialized version.
%
% XXX kind inference:
% we assume all tvars have kind `star'
+
map__init(KindMap),
apply_variable_renaming_to_tvar_kind_map(TVarRenaming, KindMap,
RenamedKindMap),
@@ -1768,9 +1760,8 @@
( ArgNo1 = ArgNo2 ->
ConsId1 = ConsId2,
- RequestArg = higher_order_arg(_, _, NumArgs,
- CurriedArgs, CurriedArgTypes, CurriedArgRttiInfo,
- HOCurriedArgs1, _),
+ RequestArg = higher_order_arg(_, _, NumArgs, CurriedArgs,
+ CurriedArgTypes, CurriedArgRttiInfo, HOCurriedArgs1, _),
VersionArg = higher_order_arg(_, _, NumArgs,
_, _, _, HOCurriedArgs2, _),
higher_order_args_match(HOCurriedArgs1, HOCurriedArgs2,
@@ -1781,23 +1772,20 @@
NewHOCurriedArgs, RequestIsConst `and` VersionIsConst),
Args = [NewRequestArg | Args3]
;
- % type-info arguments present in the request may be missing
- % from the version if we are doing user-guided type
- % specialization.
- % All of the arguments in the version must be
- % present in the request for a match.
+ % Type-info arguments present in the request may be missing from the
+ % version if we are doing user-guided type specialization. All of the
+ % arguments in the version must be present in the request for a match.
ArgNo1 < ArgNo2,
- % All the higher-order arguments must be present in the
- % version otherwise we should create a new one.
+ % All the higher-order arguments must be present in the version
+ % otherwise we should create a new one.
ConsId1 \= pred_const(_, _),
PartialMatch = yes,
higher_order_args_match(Args1, [VersionArg | Args2], Args, _)
).
- % Add the curried arguments of the higher-order terms to the
- % argument list. The order here must match that generated by
- % construct_higher_order_terms.
+ % Add the curried arguments of the higher-order terms to the argument list.
+ % The order here must match that generated by construct_higher_order_terms.
%
:- pred get_extra_arguments(list(higher_order_arg)::in,
list(prog_var)::in, list(prog_var)::out) is det.
@@ -1815,8 +1803,8 @@
IsConst),
(
IsConst = yes,
- % If this argument is constant, all its sub-terms must be
- % constant, so there won't be anything more to add.
+ % If this argument is constant, all its sub-terms must be constant,
+ % so there won't be anything more to add.
get_extra_arguments_2(HOArgs, Args)
;
IsConst = no,
@@ -1827,9 +1815,8 @@
list.condense([CurriedArgs, ExtraCurriedArgs, Args1], Args)
).
- % If the right argument of an assignment is a higher order
- % term with a known value, we need to add an entry for
- % the left argument.
+ % If the right argument of an assignment is a higher order term with a
+ % known value, we need to add an entry for the left argument.
%
:- pred maybe_add_alias(prog_var::in, prog_var::in,
higher_order_info::in, higher_order_info::out) is det.
@@ -1908,8 +1895,8 @@
%-----------------------------------------------------------------------------%
- % Succeed if the called pred is "unify" or "compare" and
- % is specializable, returning a specialized goal.
+ % Succeed if the called pred is "unify" or "compare" and is specializable,
+ % returning a specialized goal.
%
:- pred specialize_special_pred(pred_id::in, proc_id::in, list(prog_var)::in,
maybe(call_unify_context)::in, hlds_goal_info::in, bool::in,
@@ -1930,14 +1917,14 @@
special_pred_get_type(SpecialId, Args, Var),
map.lookup(VarTypes, Var, SpecialPredType),
SpecialPredType \= variable(_, _),
- %
+
% Don't specialize tuple types -- the code to unify them only exists
% in the generic unification routine in the runtime.
% `private_builtin.builtin_unify_tuple/2' and
- % `private_builtin.builtin_compare_tuple/3' always abort. It might
- % be worth inlining complicated unifications of small tuples (or any
+ % `private_builtin.builtin_compare_tuple/3' always abort. It might be
+ % worth inlining complicated unifications of small tuples (or any
% other small type).
- %
+
SpecialPredType \= tuple(_, _),
Args = [TypeInfoVar | SpecialPredArgs],
@@ -1958,7 +1945,7 @@
% code is different in the two cases: here it is a call to a
% builtin predicate, perhaps preceded by casts; there it is a
% call to a compiler-generated predicate.
- %
+
specializeable_special_call(SpecialId, CalledProc),
type_is_atomic(SpecialPredType, ModuleInfo),
\+ type_has_user_defined_equality_pred(ModuleInfo, SpecialPredType, _)
@@ -1974,8 +1961,7 @@
SpecialId = unify,
in_mode(In),
Goal = unify(Arg1, var(Arg2), (In - In),
- simple_test(Arg1, Arg2),
- unify_context(explicit, []))
+ simple_test(Arg1, Arg2), unify_context(explicit, []))
;
SpecialId = compare,
SpecialPredArgs = [ComparisonResult, _, _],
@@ -1991,52 +1977,43 @@
;
NeedIntCast = yes,
goal_info_get_context(OrigGoalInfo, Context),
- generate_unsafe_type_cast(Context,
- CompareType, Arg1, CastArg1, CastGoal1,
- ProcInfo0, ProcInfo1),
- generate_unsafe_type_cast(Context,
- CompareType, Arg2, CastArg2, CastGoal2,
- ProcInfo1, ProcInfo),
- NewCallArgs = [ComparisonResult,
- CastArg1, CastArg2],
+ generate_unsafe_type_cast(Context, CompareType, Arg1, CastArg1,
+ CastGoal1, ProcInfo0, ProcInfo1),
+ generate_unsafe_type_cast(Context, CompareType, Arg2, CastArg2,
+ CastGoal2, ProcInfo1, ProcInfo),
+ NewCallArgs = [ComparisonResult, CastArg1, CastArg2],
Call = call(SpecialPredId, SpecialProcId, NewCallArgs,
not_builtin, MaybeContext, SymName),
- set.list_to_set([ComparisonResult,
- Arg1, Arg2], NonLocals),
+ set.list_to_set([ComparisonResult, Arg1, Arg2], NonLocals),
instmap_delta_from_assoc_list(
- [ComparisonResult - ground(shared,none)],
- InstMapDelta),
+ [ComparisonResult - ground(shared,none)], InstMapDelta),
Detism = det,
- goal_info_init(NonLocals, InstMapDelta,
- Detism, pure, Context, GoalInfo),
+ goal_info_init(NonLocals, InstMapDelta, Detism, pure, Context,
+ GoalInfo),
Goal = conj([CastGoal1, CastGoal2, Call - GoalInfo]),
!:Info = !.Info ^ proc_info := ProcInfo
)
)
;
- % Look for unification or comparison applied to a no-tag type
- % wrapping a builtin or atomic type.
- % This needs to be done to optimize all the map_lookups
- % with keys of type `term.var/1' in the compiler.
- % (:- type var(T) ---> var(int).)
- % This could possibly be better handled by just inlining the
- % unification code, but the compiler doesn't have the code for
- % the comparison or in-in unification procedures for imported
- % types, and unification and comparison may be implemented in C
- % code in the runtime system.
- %
+ % Look for unification or comparison applied to a no-tag type wrapping
+ % a builtin or atomic type. This needs to be done to optimize all
+ % the map_lookups with keys of type `term.var/1' in the compiler.
+ % (:- type var(T) ---> var(int).) This could possibly be better handled
+ % by just inlining the unification code, but the compiler doesn't have
+ % the code for the comparison or in-in unification procedures for
+ % imported types, and unification and comparison may be implemented
+ % in C code in the runtime system.
+
specializeable_special_call(SpecialId, CalledProc),
type_is_no_tag_type(ModuleInfo, SpecialPredType,
Constructor, WrappedType),
- \+ type_has_user_defined_equality_pred(ModuleInfo,
- SpecialPredType, _),
- \+ type_has_user_defined_equality_pred(ModuleInfo,
- WrappedType, _),
- %
+ \+ type_has_user_defined_equality_pred(ModuleInfo, SpecialPredType, _),
+ \+ type_has_user_defined_equality_pred(ModuleInfo, WrappedType, _),
+
% This could be done for non-atomic types, but it would be a bit
% more complicated because the type-info for the wrapped type
% would need to be extracted first.
- %
+
type_is_atomic(WrappedType, ModuleInfo)
->
(
@@ -2070,44 +2047,35 @@
SpecialPredArgs = [ComparisonResult, _, _],
set.insert(NonLocals0, ComparisonResult, NonLocals),
instmap_delta_from_assoc_list(
- [ComparisonResult - ground(shared, none)],
- InstMapDelta),
+ [ComparisonResult - ground(shared, none)], InstMapDelta),
Detism = det,
% Build a new call with the unwrapped arguments.
- find_builtin_type_with_equivalent_compare(
- ModuleInfo, WrappedType, CompareType,
- NeedIntCast),
- polymorphism.get_special_proc(CompareType,
- SpecialId, ModuleInfo, SymName,
- SpecialPredId, SpecialProcId),
+ find_builtin_type_with_equivalent_compare(ModuleInfo, WrappedType,
+ CompareType, NeedIntCast),
+ polymorphism.get_special_proc(CompareType, SpecialId, ModuleInfo,
+ SymName, SpecialPredId, SpecialProcId),
(
NeedIntCast = no,
- NewCallArgs = [ComparisonResult,
- UnwrappedArg1, UnwrappedArg2],
- SpecialGoal = call(SpecialPredId,
- SpecialProcId, NewCallArgs,
+ NewCallArgs = [ComparisonResult, UnwrappedArg1, UnwrappedArg2],
+ SpecialGoal = call(SpecialPredId, SpecialProcId, NewCallArgs,
not_builtin, MaybeContext, SymName),
- goal_info_init(NonLocals, InstMapDelta, Detism,
- pure, Context, GoalInfo),
+ goal_info_init(NonLocals, InstMapDelta, Detism, pure, Context,
+ GoalInfo),
Goal = conj([ExtractGoal1, ExtractGoal2,
SpecialGoal - GoalInfo]),
!:Info = !.Info ^ proc_info := ProcInfo2
;
NeedIntCast = yes,
- generate_unsafe_type_cast(Context,
- CompareType, UnwrappedArg1, CastArg1,
- CastGoal1, ProcInfo2, ProcInfo3),
- generate_unsafe_type_cast(Context,
- CompareType, UnwrappedArg2, CastArg2,
- CastGoal2, ProcInfo3, ProcInfo4),
+ generate_unsafe_type_cast(Context, CompareType,
+ UnwrappedArg1, CastArg1, CastGoal1, ProcInfo2, ProcInfo3),
+ generate_unsafe_type_cast(Context, CompareType,
+ UnwrappedArg2, CastArg2, CastGoal2, ProcInfo3, ProcInfo4),
NewCallArgs = [ComparisonResult, CastArg1, CastArg2],
- SpecialGoal = call(SpecialPredId,
- SpecialProcId, NewCallArgs,
+ SpecialGoal = call(SpecialPredId, SpecialProcId, NewCallArgs,
not_builtin, MaybeContext, SymName),
- goal_info_init(NonLocals, InstMapDelta, Detism,
- pure, Context, GoalInfo),
- Goal = conj([ExtractGoal1, CastGoal1,
- ExtractGoal2, CastGoal2,
+ goal_info_init(NonLocals, InstMapDelta, Detism, pure, Context,
+ GoalInfo),
+ Goal = conj([ExtractGoal1, CastGoal1, ExtractGoal2, CastGoal2,
SpecialGoal - GoalInfo]),
!:Info = !.Info ^ proc_info := ProcInfo4
)
@@ -2117,17 +2085,17 @@
% the type-specific unify or compare predicate if we are
% generating such predicates.
HaveSpecialPreds = yes,
- find_special_proc(SpecialPredType, SpecialId,
- SymName, SpecialPredId, SpecialProcId, !Info),
+ find_special_proc(SpecialPredType, SpecialId, SymName, SpecialPredId,
+ SpecialProcId, !Info),
( type_is_higher_order(SpecialPredType) ->
- % builtin_*_pred are special cases which
- % doesn't need the type-info arguments.
+ % Builtin_*_pred are special cases which don't need the type-info
+ % arguments.
CallArgs = SpecialPredArgs
;
list.append(TypeInfoArgs, SpecialPredArgs, CallArgs)
),
- Goal = call(SpecialPredId, SpecialProcId, CallArgs,
- not_builtin, MaybeContext, SymName)
+ Goal = call(SpecialPredId, SpecialProcId, CallArgs, not_builtin,
+ MaybeContext, SymName)
).
:- pred find_special_proc((type)::in, special_pred_id::in, sym_name::out,
@@ -2137,8 +2105,8 @@
find_special_proc(Type, SpecialId, SymName, PredId, ProcId, !Info) :-
ModuleInfo0 = !.Info ^ global_info ^ module_info,
(
- polymorphism.get_special_proc(Type, SpecialId,
- ModuleInfo0, SymName0, PredId0, ProcId0)
+ polymorphism.get_special_proc(Type, SpecialId, ModuleInfo0, SymName0,
+ PredId0, ProcId0)
->
SymName = SymName0,
PredId = PredId0,
@@ -2148,29 +2116,28 @@
special_pred_is_generated_lazily(ModuleInfo, TypeCtor),
(
SpecialId = compare,
- unify_proc.add_lazily_generated_compare_pred_decl(
- TypeCtor, PredId, ModuleInfo0, ModuleInfo),
+ unify_proc.add_lazily_generated_compare_pred_decl(TypeCtor,
+ PredId, ModuleInfo0, ModuleInfo),
ProcId = hlds_pred.initial_proc_id
;
SpecialId = index,
- % This shouldn't happen. The index predicate should
- % only be called from the compare predicate. If it
- % is called, it shouldn't be generated lazily.
+ % This shouldn't happen. The index predicate should only be called
+ % from the compare predicate. If it is called, it shouldn't be
+ % generated lazily.
fail
;
SpecialId = unify,
- %
- % XXX We should only add the declaration, not the body, for
- % the unify pred, but that complicates things if mode
- % analysis is rerun after higher_order.m and requests more
- % unification procedures. In particular, it's difficult to
- % run polymorphism on the new clauses if the predicate's
- % arguments have already had type-infos added. This case
- % shouldn't come up unless an optimization does reordering
- % which requires rescheduling a conjunction.
- %
- unify_proc.add_lazily_generated_unify_pred(TypeCtor,
- PredId, ModuleInfo0, ModuleInfo),
+
+ % XXX We should only add the declaration, not the body, for the
+ % unify pred, but that complicates things if mode analysis is rerun
+ % after higher_order.m and requests more unification procedures.
+ % In particular, it's difficult to run polymorphism on the new
+ % clauses if the predicate's arguments have already had type-infos
+ % added. This case shouldn't come up unless an optimization does
+ % reordering which requires rescheduling a conjunction.
+
+ unify_proc.add_lazily_generated_unify_pred(TypeCtor, PredId,
+ ModuleInfo0, ModuleInfo),
hlds_pred.in_in_unification_proc_id(ProcId)
),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
@@ -2291,13 +2258,12 @@
% new predicates that are required.
%
- % Filter out requests for higher-order specialization for preds
- % which are too large. Maybe we could allow programmers to declare
- % which predicates they want specialized, as with inlining?
- % Don't create specialized versions of specialized versions, since
- % for some fairly contrived examples involving recursively building
- % up lambda expressions this can create ridiculous numbers of
- % versions.
+ % Filter out requests for higher-order specialization for preds which are
+ % too large. Maybe we could allow programmers to declare which predicates
+ % they want specialized, as with inlining? Don't create specialized
+ % versions of specialized versions, since for some fairly contrived
+ % examples involving recursively building up lambda expressions
+ % this can create ridiculous numbers of versions.
%
:- pred filter_requests(list(request)::out, list(request)::out,
higher_order_global_info::in, higher_order_global_info::out,
@@ -2351,19 +2317,16 @@
higher_order_args_size(HOArgs) > Info ^ ho_params ^ arg_limit
->
% If the arguments are too large, we can end up producing a
- % specialized version with massive numbers of arguments,
- % because all of the curried arguments are passed as
- % separate arguments.
+ % specialized version with massive numbers of arguments, because
+ % all of the curried arguments are passed as separate arguments.
% Without this extras/xml/xml.parse.chars.m takes forever to
% compile.
maybe_write_string(VeryVerbose,
"% not specializing (args too large).\n", !IO)
;
- %
- % To ensure termination of the specialization process, the
- % depth of the higher-order arguments must strictly decrease
- % compared to parents with the same original pred_proc_id.
- %
+ % To ensure termination of the specialization process, the depth
+ % of the higher-order arguments must strictly decrease compared
+ % to parents with the same original pred_proc_id.
VersionInfoMap = Info ^ version_info,
(
map.search(VersionInfoMap, CalledPredProcId, CalledVersionInfo)
@@ -2405,19 +2368,17 @@
set.insert(!.PredsToFix, CallingPredProcId, !:PredsToFix),
( map.search(!.Info ^ new_preds, CalledPredProcId, SpecVersions0) ->
(
- % Check that we aren't redoing the same pred
- % SpecVersions0 are pred_proc_ids of the specialized
- % versions of the current pred.
- \+ (
+ % Check that we aren't redoing the same pred.
+ % SpecVersions0 are pred_proc_ids of the specialized versions
+ % of the current pred.
set.member(Version, SpecVersions0),
version_matches(!.Info ^ ho_params, !.Info ^ module_info,
Request, Version, _)
- )
->
+ true
+ ;
create_new_pred(Request, NewPred, !Info, !IO),
list.cons(NewPred, !NewPredList)
- ;
- true
)
;
create_new_pred(Request, NewPred, !Info, !IO),
@@ -2472,23 +2433,21 @@
(
IsUserTypeSpec = yes,
- % If this is a user-guided type specialisation, the new name
- % comes from the name and mode number of the requesting
- % predicate. The mode number is included because we want to
- % avoid the creation of more than one predicate with the same
- % name if more than one mode of a predicate is specialized.
- % Since the names of e.g. deep profiling proc_static structures
- % are derived from the names of predicates, duplicate predicate
- % names lead to duplicate global variable names and hence to
+ % If this is a user-guided type specialisation, the new name comes from
+ % the name and mode number of the requesting predicate. The mode number
+ % is included because we want to avoid the creation of more than one
+ % predicate with the same name if more than one mode of a predicate
+ % is specialized. Since the names of e.g. deep profiling proc_static
+ % structures are derived from the names of predicates, duplicate
+ % predicate names lead to duplicate global variable names and hence to
% link errors.
predicate_name(ModuleInfo0, CallerPredId, PredName0),
proc_id_to_int(CallerProcId, CallerProcInt),
- % The higher_order_arg_order_version part is to avoid
- % segmentation faults or other errors when the order
- % or number of extra arguments changes.
- % If the user does not recompile all affected code,
- % the program will not link.
+ % The higher_order_arg_order_version part is to avoid segmentation
+ % faults or other errors when the order or number of extra arguments
+ % changes. If the user does not recompile all affected code, the
+ % program will not link.
PredName = string.append_list(
[PredName0, "_", int_to_string(CallerProcInt), "_",
int_to_string(higher_order_arg_order_version)]),
@@ -2531,8 +2490,8 @@
map.init(EmptyConstraintMap),
rtti_varmaps_init(EmptyRttiVarMaps),
- % This isn't looked at after here, and just clutters up
- % hlds dumps if it's filled in.
+ % This isn't looked at after here, and just clutters up HLDS dumps
+ % if it's filled in.
set_clause_list([], ClausesRep),
ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes,
EmptyTVarNameMap, EmptyVarTypes, [], ClausesRep,
@@ -2618,7 +2577,7 @@
module_info_pred_info(ModuleInfo, PredId, PredInfo),
Name = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
- % adjust message for type_infos
+ % Adjust message for type_infos.
DeclaredArgNo = ArgNo - NumToDrop,
io.write_string("HeadVar__", !IO),
io.write_int(DeclaredArgNo, !IO),
@@ -2671,10 +2630,8 @@
fixup_specialized_versions(NewPredList, !Info) :-
NewPredProcIds = list.map(get_np_version_ppid, NewPredList),
- %
% Reprocess the goals to find any new specializations made
% possible by the specializations performed in this pass.
- %
MustRecompute = yes,
list.foldl(fixup_pred(MustRecompute), NewPredProcIds, !Info).
@@ -2711,9 +2668,8 @@
module_info_pred_info(ModuleInfo, CallerPredId, CallerPredInfo),
pred_info_typevarset(CallerPredInfo, CallerTypeVarSet),
pred_info_get_univ_quant_tvars(CallerPredInfo, CallerHeadParams),
- %
+
% Specialize the types of the called procedure as for inlining.
- %
proc_info_vartypes(!.NewProcInfo, VarTypes0),
tvarset_merge_renaming(CallerTypeVarSet, TypeVarSet0, TypeVarSet,
TypeRenaming),
@@ -2724,7 +2680,6 @@
% The real set of existentially quantified variables may be
% smaller, but this is OK.
- %
apply_variable_renaming_to_tvar_list(TypeRenaming, ExistQVars0,
ExistQVars1),
@@ -2742,8 +2697,7 @@
OriginalArgTypes),
proc_info_set_vartypes(VarTypes2, !NewProcInfo),
- % XXX kind inference:
- % we assume vars have kind `star'.
+ % XXX kind inference: we assume vars have kind `star'.
prog_type.var_list_to_type_list(map.init, ExtraTypeInfoTVars0,
ExtraTypeInfoTVarTypes0),
(
@@ -2755,8 +2709,8 @@
ExtraTypeInfoTVarTypes = ExtraTypeInfoTVarTypes0,
ExtraTypeInfoTVars = ExtraTypeInfoTVars0
;
- % If there are existentially quantified variables in the
- % callee we may need to bind type variables in the caller.
+ % If there are existentially quantified variables in the callee
+ % we may need to bind type variables in the caller.
list.map(substitute_higher_order_arg(TypeSubn), HOArgs0, HOArgs),
apply_rec_subst_to_type_list(TypeSubn, ExtraTypeInfoTVarTypes0,
@@ -2766,9 +2720,9 @@
% wouldn't be necessary to add them.
(
prog_type.type_list_to_var_list(ExtraTypeInfoTVarTypes,
- ExtraTypeInfoTVars1)
+ ExtraTypeInfoTVarsPrim)
->
- ExtraTypeInfoTVars = ExtraTypeInfoTVars1
+ ExtraTypeInfoTVars = ExtraTypeInfoTVarsPrim
;
unexpected(this_file, "create_new_proc: type var got bound")
)
@@ -2779,10 +2733,9 @@
ExtraTypeInfoTVarTypes, ExtraTypeInfoTypes),
proc_info_create_vars_from_types(ExtraTypeInfoTypes, ExtraTypeInfoVars,
!NewProcInfo),
- %
+
% Add any extra type-infos or typeclass-infos we've added
% to the typeinfo_varmap and typeclass_info_varmap.
- %
proc_info_rtti_varmaps(!.NewProcInfo, RttiVarMaps0),
% The variable renaming doesn't rename variables in the callee.
@@ -2821,9 +2774,7 @@
% The new entries come from HOArgs, which have already had TypeSubn
% applied, but not TypeRenaming. Perhaps this is enough?
- %
% Record extra information about this version.
- %
VersionInfoMap0 = !.Info ^ version_info,
ArgsDepth = higher_order_args_depth(HOArgs),
@@ -2846,9 +2797,8 @@
map.det_insert(VersionInfoMap0, NewPredProcId, VersionInfo,
VersionInfoMap),
!:Info = !.Info ^ version_info := VersionInfoMap,
- %
+
% Fix up the argument vars, types and modes.
- %
in_mode(InMode),
list.length(ExtraTypeInfoVars, NumTypeInfos),
list.duplicate(NumTypeInfos, InMode, ExtraTypeInfoModes),
@@ -2874,15 +2824,14 @@
ModifiedOriginalArgTypes], ArgTypes),
pred_info_set_arg_types(TypeVarSet, ExistQVars, ArgTypes, !NewPredInfo),
pred_info_set_typevarset(TypeVarSet, !NewPredInfo),
- %
- % The types of the headvars in the vartypes map in the proc_info may
- % be more specific than the argument types returned by
- % pred_info_argtypes if the procedure body binds some existentially
- % quantified type variables. The types of the extra arguments added
- % by construct_higher_order_terms use the substitution computed
- % based on the result pred_info_arg_types. We may need to apply a
- % substitution to the types of the new variables in the vartypes in
- % the proc_info.
+
+ % The types of the headvars in the vartypes map in the proc_info may be
+ % more specific than the argument types returned by pred_info_argtypes
+ % if the procedure body binds some existentially quantified type variables.
+ % The types of the extra arguments added by construct_higher_order_terms
+ % use the substitution computed based on the result pred_info_arg_types.
+ % We may need to apply a substitution to the types of the new variables
+ % in the vartypes in the proc_info.
%
% XXX We should apply this substitution to the variable types in any
% callers of this predicate, which may introduce other opportunities
@@ -2909,11 +2858,8 @@
"type_list_subsumes failed")
)
),
- %
- % Find the new class context by searching the argument types
- % for typeclass_infos (the corresponding constraint is encoded
- % in the type of a typeclass_info).
- %
+
+ % Find the new class context.
proc_info_headvars(!.NewProcInfo, ArgVars),
proc_info_rtti_varmaps(!.NewProcInfo, NewRttiVarMaps),
list.map(rtti_varmaps_var_info(NewRttiVarMaps), ArgVars, ArgVarInfos),
@@ -2961,9 +2907,8 @@
construct_higher_order_terms(ModuleInfo, HeadVars0, NewHeadVars, ArgModes0,
NewArgModes, [HOArg | HOArgs], !ProcInfo, !Renaming,
!PredVars, ConstGoals) :-
- HOArg = higher_order_arg(ConsId, Index, NumArgs,
- CurriedArgs, CurriedArgTypes, CurriedArgRttiInfo,
- CurriedHOArgs, IsConst),
+ HOArg = higher_order_arg(ConsId, Index, NumArgs, CurriedArgs,
+ CurriedArgTypes, CurriedArgRttiInfo, CurriedHOArgs, IsConst),
list.index1_det(HeadVars0, Index, LVar),
( ConsId = pred_const(ShroudedPredProcId, _) ->
@@ -3019,27 +2964,22 @@
VarPair = Var1 - Var2,
svmap.set(Var1, Var2, !Map)
), CurriedRenaming, !Renaming),
- %
+
% Recursively construct the curried higher-order arguments.
- %
construct_higher_order_terms(ModuleInfo, CurriedHeadVars1,
ExtraCurriedHeadVars, CurriedArgModes1, ExtraCurriedArgModes,
CurriedHOArgs, !ProcInfo, !Renaming, !PredVars,
CurriedConstGoals),
- %
+
% Construct the rest of the higher-order arguments.
- %
construct_higher_order_terms(ModuleInfo, HeadVars0, NewHeadVars1,
ArgModes0, NewArgModes1, HOArgs, !ProcInfo,
!Renaming, !PredVars, ConstGoals1),
(
IsConst = yes,
- %
% Build the constant inside the specialized version, so that
- % other constants which include it will be recognized as
- % constant.
- %
+ % other constants which include it will be recognized as constant.
modes_to_uni_modes(ModuleInfo, CurriedArgModes1,
CurriedArgModes1, UniModes),
set.list_to_set(CurriedHeadVars1, ConstNonLocals),
@@ -3059,9 +2999,8 @@
IsConst = no,
ConstGoals0 = CurriedConstGoals
),
- %
+
% Fix up the argument lists.
- %
remove_const_higher_order_args(1, CurriedHeadVars1, CurriedHOArgs,
CurriedHeadVars),
remove_const_higher_order_args(1, CurriedArgModes1, CurriedHOArgs,
@@ -3216,9 +3155,9 @@
list.reverse(Univ0, Univ),
list.reverse(Exist0, Exist),
Constraints = constraints(Univ, Exist).
-find_class_context(_, [], [_|_], _, _, _) :-
+find_class_context(_, [], [_ | _], _, _, _) :-
unexpected(this_file, "mismatched list length in find_class_context/6.").
-find_class_context(_, [_|_], [], _, _, _) :-
+find_class_context(_, [_ | _], [], _, _, _) :-
unexpected(this_file, "mismatched list length in find_class_context/6.").
find_class_context(ModuleInfo, [VarInfo | VarInfos], [Mode | Modes],
!.Univ, !.Exist, Constraints) :-
Index: mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.171
diff -u -b -r1.171 mode_util.m
--- mode_util.m 12 Sep 2005 05:24:17 -0000 1.171
+++ mode_util.m 19 Sep 2005 14:59:42 -0000
@@ -1229,8 +1229,7 @@
mode_list_get_initial_insts(ModuleInfo, ArgModes1, InitialInsts),
% Compute the inst_var substitution from the initial insts
- % of the called procedure and the insts of the argument
- % variables.
+ % of the called procedure and the insts of the argument variables.
map__init(InstVarSub0),
update_module_info(compute_inst_var_sub(Args, VarTypes, InstMap,
InitialInsts, InstVarSub0), InstVarSub, !RI),
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list