[m-rev.] diff: four space intermod
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Aug 22 13:47:34 AEST 2005
compiler/intermod.m:
Convert this module to four space indentation, and fix some departures
from our coding standard.
Zoltan.
Index: intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.173
diff -u -b -r1.173 intermod.m
--- intermod.m 14 Aug 2005 03:20:39 -0000 1.173
+++ intermod.m 21 Aug 2005 01:42:57 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2005 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.
@@ -47,16 +49,24 @@
:- import_module bool.
:- import_module io.
+ % Open the file "<module-name>.opt.tmp", and write out the declarations
+ % and clauses for intermodule optimization. Note that update_interface
+ % and touch_interface_datestamp are called from mercury_compile.m since
+ % they must be called after unused_args.m appends its information
+ % to the .opt.tmp file.
+ %
:- pred intermod__write_optfile(module_info::in, module_info::out,
io::di, io::uo) is det.
% Add the items from the .opt files of imported modules to
% the items for this module.
+ %
:- pred intermod__grab_optfiles(module_imports::in, module_imports::out,
bool::out, io::di, io::uo) is det.
% Make sure that local preds which have been exported in the .opt
% file get an exported(_) label.
+ %
:- pred intermod__adjust_pred_import_status(module_info::in, module_info::out,
io::di, io::uo) is det.
@@ -65,21 +75,21 @@
; trans_opt.
% intermod__update_error_status(OptFileType, FileName, Error, Messages,
- % Status0, Status)
+ % !Status)
%
% Work out whether any fatal errors have occurred while reading
% `.opt' files, updating Status0 if there were fatal errors.
%
% A missing `.opt' file is only a fatal error if
- % `--warn-missing-opt-files --halt-at-warn' was passed
- % the compiler.
+ % `--warn-missing-opt-files --halt-at-warn' was passed the compiler.
%
% Syntax errors in `.opt' files are always fatal.
%
% This is also used by trans_opt.m for reading `.trans_opt' files.
+ %
:- pred intermod__update_error_status(opt_file_type::in, string::in,
- module_error::in, message_list::in, bool::in, bool::out,
- io::di, io::uo) is det.
+ module_error::in, message_list::in, bool::in, bool::out, io::di, io::uo)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -126,13 +136,6 @@
%-----------------------------------------------------------------------------%
- % Open the file "<module-name>.opt.tmp", and write out the
- % declarations and clauses for intermodule optimization.
- % Note that update_interface and touch_interface_datestamp
- % are called from mercury_compile.m since they must be called
- % after unused_args.m appends its information to the .opt.tmp
- % file.
-
intermod__write_optfile(!ModuleInfo, !IO) :-
% We don't want to output line numbers in the .opt files,
% since that causes spurious changes to the .opt files
@@ -155,52 +158,48 @@
module_info_assertion_table(!.ModuleInfo, AssertionTable),
assertion_table_pred_ids(AssertionTable, AssertPredIds),
list__append(AssertPredIds, RealPredIds, PredIds),
- init_intermod_info(!.ModuleInfo, IntermodInfo0),
- globals__io_lookup_int_option(
- intermod_inline_simple_threshold, Threshold, !IO),
- globals__io_lookup_bool_option(deforestation, Deforestation,
- !IO),
+ globals__io_lookup_int_option(intermod_inline_simple_threshold,
+ Threshold, !IO),
+ globals__io_lookup_bool_option(deforestation, Deforestation, !IO),
globals__io_lookup_int_option(higher_order_size_limit,
HigherOrderSizeLimit, !IO),
+ globals__io_lookup_bool_option(intermod_unused_args, UnusedArgs, !IO),
+ some [!IntermodInfo] (
+ init_intermod_info(!.ModuleInfo, !:IntermodInfo),
intermod__gather_preds(PredIds, yes, Threshold,
- HigherOrderSizeLimit, Deforestation,
- IntermodInfo0, IntermodInfo1),
- intermod__gather_instances(IntermodInfo1,
- IntermodInfo2),
- intermod__gather_types(IntermodInfo2,
- IntermodInfo),
- intermod__write_intermod_info(IntermodInfo, !IO),
- intermod_info_get_module_info(!:ModuleInfo, IntermodInfo, _),
+ HigherOrderSizeLimit, Deforestation, !IntermodInfo),
+ intermod__gather_instances(!IntermodInfo),
+ intermod__gather_types(!IntermodInfo),
+ intermod__write_intermod_info(!.IntermodInfo, !IO),
+ intermod_info_get_module_info(!.IntermodInfo, !:ModuleInfo),
io__set_output_stream(OutputStream, _, !IO),
io__close_output(FileStream, !IO),
- globals__io_lookup_bool_option(intermod_unused_args,
- UnusedArgs, !IO),
- ( UnusedArgs = yes ->
- do_adjust_pred_import_status(IntermodInfo,
- !ModuleInfo)
+ (
+ UnusedArgs = yes,
+ do_adjust_pred_import_status(!.IntermodInfo, !ModuleInfo)
;
- true
+ UnusedArgs = no
+ )
)
),
% restore the option setting that we overrode above
globals__io_set_option(line_numbers, bool(LineNumbers), !IO).
%-----------------------------------------------------------------------------%
-
- % Predicates to gather stuff to output to .opt file.
+%
+% Predicates to gather stuff to output to .opt file.
:- pred intermod__gather_preds(list(pred_id)::in, bool::in, int::in,
int::in, bool::in, intermod_info::in, intermod_info::out) is det.
-intermod__gather_preds(AllPredIds, CollectTypes,
- InlineThreshold, HigherOrderSizeLimit, Deforestation, !Info) :-
- % first gather exported preds
+intermod__gather_preds(AllPredIds, CollectTypes, InlineThreshold,
+ HigherOrderSizeLimit, Deforestation, !Info) :-
+ % First gather exported preds.
ProcessLocalPreds = no,
- intermod__gather_pred_list(AllPredIds, ProcessLocalPreds,
- CollectTypes, InlineThreshold, HigherOrderSizeLimit,
- Deforestation, !Info),
+ intermod__gather_pred_list(AllPredIds, ProcessLocalPreds, CollectTypes,
+ InlineThreshold, HigherOrderSizeLimit, Deforestation, !Info),
- % then gather preds used by exported preds (recursively)
+ % Then gather preds used by exported preds (recursively).
set__init(ExtraExportedPreds0),
intermod__gather_preds_2(ExtraExportedPreds0, CollectTypes,
InlineThreshold, HigherOrderSizeLimit, Deforestation, !Info).
@@ -210,30 +209,28 @@
intermod__gather_preds_2(ExtraExportedPreds0, CollectTypes,
InlineThreshold, HigherOrderSizeLimit, Deforestation, !Info) :-
- intermod_info_get_pred_decls(ExtraExportedPreds, !Info),
+ intermod_info_get_pred_decls(!.Info, ExtraExportedPreds),
NewlyExportedPreds = set__to_sorted_list(
ExtraExportedPreds `set__difference` ExtraExportedPreds0),
- ( NewlyExportedPreds = [] ->
- true
+ (
+ NewlyExportedPreds = []
;
+ NewlyExportedPreds = [_ | _],
ProcessLocalPreds = yes,
- intermod__gather_pred_list(NewlyExportedPreds,
- ProcessLocalPreds, CollectTypes,
- InlineThreshold, HigherOrderSizeLimit, Deforestation,
+ intermod__gather_pred_list(NewlyExportedPreds, ProcessLocalPreds,
+ CollectTypes, InlineThreshold, HigherOrderSizeLimit, Deforestation,
!Info),
intermod__gather_preds_2(ExtraExportedPreds, CollectTypes,
- InlineThreshold, HigherOrderSizeLimit, Deforestation,
- !Info)
+ InlineThreshold, HigherOrderSizeLimit, Deforestation, !Info)
).
:- pred intermod__gather_pred_list(list(pred_id)::in, bool::in, bool::in,
- int::in, int::in, bool::in, intermod_info::in, intermod_info::out)
- is det.
+ int::in, int::in, bool::in, intermod_info::in, intermod_info::out) is det.
intermod__gather_pred_list([], _, _, _, _, _, !Info).
intermod__gather_pred_list([PredId | PredIds], ProcessLocalPreds, CollectTypes,
InlineThreshold, HigherOrderSizeLimit, Deforestation, !Info) :-
- intermod_info_get_module_info(ModuleInfo0, !Info),
+ intermod_info_get_module_info(!.Info, ModuleInfo0),
module_info_preds(ModuleInfo0, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
module_info_type_spec_info(ModuleInfo0, TypeSpecInfo),
@@ -247,9 +244,9 @@
%
clauses_info_explicit_vartypes(ClausesInfo0, ExplicitVarTypes),
map__is_empty(ExplicitVarTypes),
- intermod__should_be_processed(ProcessLocalPreds, PredId,
- PredInfo0, TypeSpecForcePreds, InlineThreshold,
- HigherOrderSizeLimit, Deforestation, ModuleInfo0)
+ intermod__should_be_processed(ProcessLocalPreds, PredId, PredInfo0,
+ TypeSpecForcePreds, InlineThreshold, HigherOrderSizeLimit,
+ Deforestation, ModuleInfo0)
->
SavedInfo = !.Info,
% Write a declaration to the `.opt' file for
@@ -263,8 +260,7 @@
intermod_info_set_var_types(VarTypes, !Info),
intermod_info_set_tvarset(TVarSet, !Info),
get_clause_list(ClausesRep0, Clauses0),
- intermod__traverse_clauses(Clauses0, Clauses, DoWrite,
- !Info),
+ intermod__traverse_clauses(Clauses0, Clauses, DoWrite, !Info),
set_clause_list(Clauses, ClausesRep)
;
DoWrite0 = no,
@@ -275,13 +271,10 @@
DoWrite = yes,
clauses_info_set_clauses_rep(ClausesRep,
ClausesInfo0, ClausesInfo),
- pred_info_set_clauses_info(ClausesInfo,
- PredInfo0, PredInfo),
- map__det_update(PredTable0, PredId,
- PredInfo, PredTable),
- module_info_set_preds(PredTable,
- ModuleInfo0, ModuleInfo),
- intermod_info_get_preds(Preds0, !Info),
+ pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo),
+ map__det_update(PredTable0, PredId, PredInfo, PredTable),
+ module_info_set_preds(PredTable, ModuleInfo0, ModuleInfo),
+ intermod_info_get_preds(!.Info, Preds0),
( pred_info_pragma_goal_type(PredInfo) ->
% The header code must be written since
% it could be used by the pragma_foreign_code.
@@ -294,8 +287,7 @@
intermod_info_set_module_info(ModuleInfo, !Info)
;
DoWrite = no,
- % Remove any items added for the clauses
- % for this predicate.
+ % Remove any items added for the clauses for this predicate.
!:Info = SavedInfo
)
;
@@ -330,14 +322,12 @@
% At this point, the goal size includes some dummy unifications
% HeadVar1 = X, HeadVar2 = Y, etc. which will be optimized away
- % later. To counter for this, we add the arity to the
- % size thresholds.
+ % later. To counter for this, we add the arity to the size thresholds.
Arity = pred_info_orig_arity(PredInfo),
- % Predicates with `class_method' markers contain
- % class_method_call goals which can't be written
- % to `.opt' files (they can't be read back in).
- % They will be recreated in the importing module.
+ % Predicates with `class_method' markers contain class_method_call
+ % goals which can't be written to `.opt' files (they can't be read
+ % back in). They will be recreated in the importing module.
pred_info_get_markers(PredInfo, Markers),
\+ check_marker(Markers, class_method),
\+ check_marker(Markers, class_instance_method),
@@ -345,8 +335,8 @@
% Don't write stub clauses to `.opt' files.
\+ check_marker(Markers, stub),
- % Don't export builtins since they will be
- % recreated in the importing module anyway.
+ % Don't export builtins since they will be recreated in the
+ % importing module anyway.
\+ is_unify_or_compare_pred(PredInfo),
\+ pred_info_is_builtin(PredInfo),
@@ -362,8 +352,7 @@
proc_info_eval_method(ProcInfo, eval_normal),
(
- inlining__is_simple_clause_list(Clauses,
- InlineThreshold + Arity),
+ inlining__is_simple_clause_list(Clauses, InlineThreshold + Arity),
pred_info_get_markers(PredInfo, Markers),
\+ check_marker(Markers, no_inline)
;
@@ -374,11 +363,9 @@
GoalSize =< HigherOrderSizeLimit + Arity
;
Deforestation = yes,
- % Double the inline-threshold since
- % goals we want to deforest will have at
- % least two disjuncts. This allows one
- % simple goal in each disjunct. The
- % disjunction adds one to the goal size,
+ % Double the inline-threshold since goals we want to deforest
+ % will have at least two disjuncts. This allows one simple goal
+ % in each disjunct. The disjunction adds one to the goal size,
% hence the `+1'.
DeforestThreshold = InlineThreshold * 2 + 1,
inlining__is_simple_clause_list(Clauses,
@@ -386,13 +373,14 @@
clause_list_is_deforestable(PredId, Clauses)
)
;
- % promises that are in the interface should always get
+ % Promises that are in the interface should always get
% included in the .opt file.
pred_info_get_goal_type(PredInfo, promise(_))
).
% If the clauses contains foreign code which requires an external
% definition, there is not much point in exporting it.
+ %
:- pred clauses_contain_noninlinable_foreign_code(compilation_target::in,
list(clause)::in) is semidet.
@@ -428,24 +416,24 @@
proc_info_headvars(ProcInfo, HeadVars),
proc_info_argmodes(ProcInfo, ArgModes),
proc_info_vartypes(ProcInfo, VarTypes),
- check_for_ho_input_args(ModuleInfo, HeadVars, ArgModes, VarTypes).
+ check_for_ho_input_args(ModuleInfo, VarTypes, HeadVars, ArgModes).
-:- pred check_for_ho_input_args(module_info::in, list(prog_var)::in,
- list(mode)::in, map(prog_var, type)::in) is semidet.
+:- pred check_for_ho_input_args(module_info::in, vartypes::in,
+ list(prog_var)::in, list(mode)::in) is semidet.
-check_for_ho_input_args(ModuleInfo, [HeadVar | HeadVars],
- [ArgMode | ArgModes], VarTypes) :-
+check_for_ho_input_args(ModuleInfo, VarTypes,
+ [HeadVar | HeadVars], [ArgMode | ArgModes]) :-
(
mode_is_input(ModuleInfo, ArgMode),
map__lookup(VarTypes, HeadVar, Type),
classify_type(ModuleInfo, Type) = higher_order_type
;
- check_for_ho_input_args(ModuleInfo, HeadVars,
- ArgModes, VarTypes)
+ check_for_ho_input_args(ModuleInfo, VarTypes, HeadVars, ArgModes)
).
% Rough guess: a goal is deforestable if it contains a single
% top-level branched goal and is recursive.
+ %
:- pred clause_list_is_deforestable(pred_id::in, list(clause)::in) is semidet.
clause_list_is_deforestable(PredId, Clauses) :-
@@ -486,6 +474,7 @@
% Go over the goal of an exported proc looking for proc decls, types,
% insts and modes that we need to write to the optfile.
+ %
:- pred intermod__traverse_goal(hlds_goal::in, hlds_goal::out, bool::out,
intermod_info::in, intermod_info::out) is det.
@@ -500,9 +489,7 @@
intermod__traverse_list_of_goals(Goals0, Goals, DoWrite, !Info).
intermod__traverse_goal(Goal, Goal, DoWrite, !Info) :-
Goal = call(PredId, _, _, _, _, _) - _,
- %
% Ensure that the called predicate will be exported.
- %
intermod__add_proc(PredId, DoWrite, !Info).
intermod__traverse_goal(Goal @ generic_call(CallType, _, _, _) - Info,
Goal - Info, DoWrite, !Info) :-
@@ -535,22 +522,21 @@
intermod__traverse_goal(Goal @ foreign_proc(_, _, _, _, _, _) - Info,
Goal - Info, yes, !Info).
intermod__traverse_goal(shorthand(_) - _, _, _, !Info) :-
- % these should have been expanded out by now
+ % These should have been expanded out by now.
error("intermod__traverse_goal: unexpected shorthand").
:- pred intermod__traverse_list_of_goals(hlds_goals::in, hlds_goals::out,
bool::out, intermod_info::in, intermod_info::out) is det.
intermod__traverse_list_of_goals([], [], yes, !Info).
-intermod__traverse_list_of_goals([Goal0 | Goals0], [Goal | Goals], DoWrite,
+intermod__traverse_list_of_goals([Goal0 | Goals0], [Goal | Goals], !:DoWrite,
!Info) :-
- intermod__traverse_goal(Goal0, Goal, DoWrite1, !Info),
+ intermod__traverse_goal(Goal0, Goal, !:DoWrite, !Info),
(
- DoWrite1 = yes,
- intermod__traverse_list_of_goals(Goals0, Goals, DoWrite, !Info)
+ !.DoWrite = yes,
+ intermod__traverse_list_of_goals(Goals0, Goals, !:DoWrite, !Info)
;
- DoWrite1 = no,
- DoWrite = no,
+ !.DoWrite = no,
Goals = Goals0
).
@@ -559,14 +545,13 @@
intermod__traverse_cases([], [], yes, !Info).
intermod__traverse_cases([case(F, Goal0) | Cases0],
- [case(F, Goal) | Cases], DoWrite, !Info) :-
- intermod__traverse_goal(Goal0, Goal, DoWrite1, !Info),
+ [case(F, Goal) | Cases], !:DoWrite, !Info) :-
+ intermod__traverse_goal(Goal0, Goal, !:DoWrite, !Info),
(
- DoWrite1 = yes,
- intermod__traverse_cases(Cases0, Cases, DoWrite, !Info)
+ !.DoWrite = yes,
+ intermod__traverse_cases(Cases0, Cases, !:DoWrite, !Info)
;
- DoWrite1 = no,
- DoWrite = no,
+ !.DoWrite = no,
Cases = Cases0
).
@@ -588,9 +573,9 @@
intermod__add_proc(PredId, DoWrite, !Info) :-
( PredId = invalid_pred_id ->
- % This will happen for type class instance methods
- % defined using the clause syntax. Currently we
- % can't handle intermodule-optimization of those.
+ % This will happen for type class instance methods defined using
+ % the clause syntax. Currently we can't handle intermodule
+ % optimization of those.
DoWrite = no
;
intermod__add_proc_2(PredId, DoWrite, !Info)
@@ -600,29 +585,27 @@
intermod_info::in, intermod_info::out) is det.
intermod__add_proc_2(PredId, DoWrite, !Info) :-
- intermod_info_get_module_info(ModuleInfo, !Info),
+ intermod_info_get_module_info(!.Info, ModuleInfo),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_import_status(PredInfo, Status),
ProcIds = pred_info_procids(PredInfo),
pred_info_get_markers(PredInfo, Markers),
(
%
- % Calling compiler-generated procedures is fine;
- % we don't need to output declarations for them to
- % the `.opt' file, since they will be recreated every
- % time anyway.
+ % Calling compiler-generated procedures is fine; we don't need
+ % to output declarations for them to the `.opt' file, since they
+ % will be recreated every time anyway.
%
is_unify_or_compare_pred(PredInfo)
->
DoWrite = yes
;
%
- % Don't write the caller to the `.opt' file if it calls
- % a pred without mode or determinism decls, because we'd
- % need to include the mode decls for the callee in the `.opt'
- % file and (since writing the `.opt' file happens before mode
- % inference) we can't do that because we don't know what
- % the modes are.
+ % Don't write the caller to the `.opt' file if it calls a pred
+ % without mode or determinism decls, because we'd need to include
+ % the mode decls for the callee in the `.opt' file and (since
+ % writing the `.opt' file happens before mode inference) we can't
+ % do that because we don't know what the modes are.
%
% XXX This prevents intermodule optimizations in such cases,
% which is a pity.
@@ -638,10 +621,9 @@
->
DoWrite = no
;
- % Goals which call impure predicates cannot be written
- % due to limitations in mode analysis. The problem is that
- % only head unifications are allowed to be reordered with
- % impure goals.
+ % Goals which call impure predicates cannot be written due to
+ % limitations in mode analysis. The problem is that only head
+ % unifications are allowed to be reordered with impure goals.
%
% e.g
% p(A::in, B::in, C::out) :- impure foo(A, B, C).
@@ -650,12 +632,11 @@
% A = HeadVar1, B = HeadVar2, C = HeadVar3,
% impure foo(A, B, C).
%
- % In the clauses written to `.opt' files, the head
- % unifications are already expanded, and are expanded
- % again when the `.opt' file is read in. The `C = HeadVar3'
- % unification cannot be reordered with the impure goal,
- % resulting in a mode error. Fixing this in mode analysis
- % would be tricky.
+ % In the clauses written to `.opt' files, the head unifications
+ % are already expanded, and are expanded again when the `.opt' file
+ % is read in. The `C = HeadVar3' unification cannot be reordered
+ % with the impure goal, resulting in a mode error. Fixing this
+ % in mode analysis would be tricky.
%
% See tests/valid/impure_intermod.m.
pred_info_get_purity(PredInfo, impure)
@@ -663,22 +644,23 @@
DoWrite = no
;
%
- % If a pred whose code we're going to put in the .opt file
- % calls a predicate which is exported, then we don't
- % need to do anything special.
+ % If a pred whose code we're going to put in the .opt file calls
+ % a predicate which is exported, then we don't need to do anything
+ % special.
%
- ( Status = exported
- ; Status = external(ExternalStatus),
+ (
+ Status = exported
+ ;
+ Status = external(ExternalStatus),
status_is_exported(ExternalStatus, yes)
)
->
DoWrite = yes
;
%
- % Declarations for class methods will be recreated
- % from the class declaration in the `.opt' file.
- % Declarations for local classes are always written
- % to the `.opt' file.
+ % Declarations for class methods will be recreated from the class
+ % declaration in the `.opt' file. Declarations for local classes
+ % are always written to the `.opt' file.
%
pred_info_get_markers(PredInfo, Markers),
check_marker(Markers, class_method)
@@ -686,15 +668,14 @@
DoWrite = yes
;
%
- % If a pred whose code we're going to put in the `.opt' file
- % calls a predicate which is local to that module, then
- % we need to put the declaration for the called predicate
- % in the `.opt' file.
+ % If a pred whose code we're going to put in the `.opt' file calls
+ % a predicate which is local to that module, then we need to put
+ % the declaration for the called predicate in the `.opt' file.
%
import_status_to_write(Status)
->
DoWrite = yes,
- intermod_info_get_pred_decls(PredDecls0, !Info),
+ intermod_info_get_pred_decls(!.Info, PredDecls0),
set__insert(PredDecls0, PredId, PredDecls),
intermod_info_set_pred_decls(PredDecls, !Info)
;
@@ -703,11 +684,11 @@
)
->
%
- % imported pred - add import for module
+ % Imported pred - add import for module.
%
DoWrite = yes,
PredModule = pred_info_module(PredInfo),
- intermod_info_get_modules(Modules0, !Info),
+ intermod_info_get_modules(!.Info, Modules0),
set__insert(Modules0, PredModule, Modules),
intermod_info_set_modules(Modules, !Info)
;
@@ -715,13 +696,14 @@
).
% Resolve overloading and module qualify everything in a unify_rhs.
+ % Fully module-qualify the right-hand-side of a unification.
+ % For function calls and higher-order terms, call intermod__add_proc
+ % so that the predicate or function will be exported if necessary.
+ %
:- pred intermod__module_qualify_unify_rhs(prog_var::in, unify_rhs::in,
unify_rhs::out, bool::out, intermod_info::in,
intermod_info::out) is det.
- % Fully module-qualify the right-hand-side of a unification.
- % For function calls and higher-order terms, call intermod__add_proc
- % so that the predicate or function will be exported if necessary.
intermod__module_qualify_unify_rhs(_LHS, RHS @ var(_Var), RHS, yes, !Info).
intermod__module_qualify_unify_rhs(_LHS,
lambda_goal(A,B,C,D,E,F,G,H,Goal0),
@@ -758,7 +740,7 @@
is det.
intermod__gather_instances(!Info) :-
- intermod_info_get_module_info(ModuleInfo, !Info),
+ intermod_info_get_module_info(!.Info, ModuleInfo),
module_info_instances(ModuleInfo, Instances),
map__foldl(intermod__gather_instances_2(ModuleInfo), Instances, !Info).
@@ -787,7 +769,8 @@
SaveInfo = !.Info,
(
Interface0 = concrete(Methods0),
- ( MaybePredProcIds = yes(ClassProcs) ->
+ (
+ MaybePredProcIds = yes(ClassProcs),
GetPredId =
(pred(Proc::in, PredId::out) is det :-
Proc = hlds_class_proc(PredId, _)
@@ -795,19 +778,18 @@
list__map(GetPredId, ClassProcs, ClassPreds0),
% The interface is sorted on pred_id.
- list__remove_adjacent_dups(ClassPreds0,
- ClassPreds),
- assoc_list__from_corresponding_lists(
- ClassPreds, Methods0, MethodAL)
+ list__remove_adjacent_dups(ClassPreds0, ClassPreds),
+ assoc_list__from_corresponding_lists(ClassPreds, Methods0,
+ MethodAL)
;
+ MaybePredProcIds = no,
error("intermod__gather_instances_3: " ++
"method pred_proc_ids not filled in")
),
- list__map_foldl(
- intermod__qualify_instance_method(ModuleInfo),
+ list__map_foldl(intermod__qualify_instance_method(ModuleInfo),
MethodAL, Methods, [], PredIds),
- list__map_foldl(intermod__add_proc, PredIds,
- DoWriteMethodsList, !Info),
+ list__map_foldl(intermod__add_proc, PredIds, DoWriteMethodsList,
+ !Info),
bool__and_list(DoWriteMethodsList, DoWriteMethods),
(
DoWriteMethods = yes,
@@ -816,15 +798,14 @@
DoWriteMethods = no,
%
- % Write an abstract instance declaration
- % if any of the methods cannot be written
- % to the `.opt' file for any reason.
+ % Write an abstract instance declaration if any of the methods
+ % cannot be written to the `.opt' file for any reason.
%
Interface = abstract,
%
- % Don't write declarations for any of the
- % methods if one can't be written.
+ % Don't write declarations for any of the methods if one
+ % can't be written.
%
!:Info = SaveInfo
)
@@ -843,12 +824,11 @@
status_is_exported(Status, no)
)
->
- InstanceDefnToWrite = hlds_instance_defn(A, Status,
- C, D, E, Interface, MaybePredProcIds, H, I),
- intermod_info_get_instances(Instances0, !Info),
+ InstanceDefnToWrite = hlds_instance_defn(A, Status, C, D, E,
+ Interface, MaybePredProcIds, H, I),
+ intermod_info_get_instances(!.Info, Instances0),
intermod_info_set_instances(
- [ClassId - InstanceDefnToWrite | Instances0],
- !Info)
+ [ClassId - InstanceDefnToWrite | Instances0], !Info)
;
true
)
@@ -858,15 +838,15 @@
% Resolve overloading of instance methods before writing them
% to the `.opt' file.
+ %
:- pred intermod__qualify_instance_method(module_info::in,
pair(pred_id, instance_method)::in, instance_method::out,
list(pred_id)::in, list(pred_id)::out) is det.
intermod__qualify_instance_method(ModuleInfo,
- MethodCallPredId - InstanceMethod0,
- InstanceMethod, PredIds0, PredIds) :-
- module_info_pred_info(ModuleInfo, MethodCallPredId,
- MethodCallPredInfo),
+ MethodCallPredId - InstanceMethod0, InstanceMethod,
+ PredIds0, PredIds) :-
+ module_info_pred_info(ModuleInfo, MethodCallPredId, MethodCallPredInfo),
pred_info_arg_types(MethodCallPredInfo, MethodCallTVarSet, _,
MethodCallArgTypes),
InstanceMethod0 = instance_method(PredOrFunc, MethodName,
@@ -875,24 +855,24 @@
InstanceMethodDefn0 = name(InstanceMethodName0),
PredOrFunc = function,
(
- find_func_matching_instance_method(ModuleInfo,
- InstanceMethodName0, MethodArity,
- MethodCallTVarSet, MethodCallArgTypes,
+ find_func_matching_instance_method(ModuleInfo, InstanceMethodName0,
+ MethodArity, MethodCallTVarSet, MethodCallArgTypes,
MaybePredId, InstanceMethodName)
->
- ( MaybePredId = yes(PredId) ->
+ (
+ MaybePredId = yes(PredId),
PredIds = [PredId | PredIds0]
;
+ MaybePredId = no,
PredIds = PredIds0
),
InstanceMethodDefn = name(InstanceMethodName)
;
- % This will force intermod__add_proc to
- % return DoWrite = no
+ % This will force intermod__add_proc to return DoWrite = no.
PredId = invalid_pred_id,
PredIds = [PredId | PredIds0],
- % We can just leave the method definition unchanged
+ % We can just leave the method definition unchanged.
InstanceMethodDefn = InstanceMethodDefn0
)
;
@@ -907,26 +887,23 @@
;
InstanceMethodDefn0 = clauses(_ItemList),
%
- % XXX for methods defined using this syntax
- % it is a little tricky to write out the .opt files,
- % so for now I've just disabled intermodule optimization
- % for type class instance declarations using the new
- % syntax.
+ % XXX for methods defined using this syntax it is a little tricky
+ % to write out the .opt files, so for now I've just disabled
+ % intermodule optimization for type class instance declarations
+ % using the new syntax.
%
- % This will force intermod__add_proc to return DoWrite = no
+ % This will force intermod__add_proc to return DoWrite = no.
PredId = invalid_pred_id,
PredIds = [PredId | PredIds0],
- % We can just leave the method definition unchanged
+ % We can just leave the method definition unchanged.
InstanceMethodDefn = InstanceMethodDefn0
),
InstanceMethod = instance_method(PredOrFunc, MethodName,
InstanceMethodDefn, MethodArity, MethodContext).
- %
- % A `func(x/n) is y' method implementation can match an ordinary
- % function, a field access function or a constructor.
- % For now, if there are multiple possible matches, we don't write
- % the instance method.
+ % A `func(x/n) is y' method implementation can match an ordinary function,
+ % a field access function or a constructor. For now, if there are multiple
+ % possible matches, we don't write the instance method.
%
:- pred find_func_matching_instance_method(module_info::in, sym_name::in,
arity::in, tvarset::in, list(type)::in, maybe(pred_id)::out,
@@ -944,8 +921,7 @@
->
TypeCtors0 = list__map(
(func(FieldDefn) = TypeCtor :-
- FieldDefn = hlds_ctor_field_defn(_, _,
- TypeCtor, _, _)
+ FieldDefn = hlds_ctor_field_defn(_, _, TypeCtor, _, _)
), FieldDefns)
;
TypeCtors0 = []
@@ -981,8 +957,7 @@
MaybePredId = no,
( TheTypeCtor = qualified(TypeModule, _) - _ ->
unqualify_name(InstanceMethodName0, UnqualMethodName),
- InstanceMethodName =
- qualified(TypeModule, UnqualMethodName)
+ InstanceMethodName = qualified(TypeModule, UnqualMethodName)
;
error("unqualified type_ctor in " ++
"hlds_cons_defn or hlds_ctor_field_defn")
@@ -994,7 +969,7 @@
:- pred intermod__gather_types(intermod_info::in, intermod_info::out) is det.
intermod__gather_types(!Info) :-
- intermod_info_get_module_info(ModuleInfo, !Info),
+ intermod_info_get_module_info(!.Info, ModuleInfo),
module_info_types(ModuleInfo, Types),
map__foldl(intermod__gather_types_2, Types, !Info).
@@ -1002,36 +977,32 @@
intermod_info::in, intermod_info::out) is det.
intermod__gather_types_2(TypeCtor, TypeDefn0, !Info) :-
- intermod_info_get_module_info(ModuleInfo, !Info),
+ intermod_info_get_module_info(!.Info, ModuleInfo),
module_info_name(ModuleInfo, ModuleName),
- (
- intermod__should_write_type(ModuleName, TypeCtor, TypeDefn0)
- ->
+ ( intermod__should_write_type(ModuleName, TypeCtor, TypeDefn0) ->
hlds_data__get_type_defn_body(TypeDefn0, TypeBody0),
(
- TypeBody0 = du_type(Ctors, Tags, Enum,
- MaybeUserEqComp0, ReservedTag, MaybeForeign0)
+ TypeBody0 = du_type(Ctors, Tags, Enum, MaybeUserEqComp0,
+ ReservedTag, MaybeForeign0)
->
module_info_globals(ModuleInfo, Globals),
globals__get_target(Globals, Target),
%
- % Note that we don't resolve overloading for the
- % definitions which won't be used on this back-end,
- % because their unification and comparison predicates
- % have not been typechecked. They are only written to
- % the `.opt' it can be handy when building against a
- % workspace for the other definitions to be present
- % (e.g. when testing compiling a module to IL when
- % the workspace was compiled to C).
+ % Note that we don't resolve overloading for the definitions
+ % which won't be used on this back-end, because their unification
+ % and comparison predicates have not been typechecked. They are
+ % only written to the `.opt' it can be handy when building
+ % against a workspace for the other definitions to be present
+ % (e.g. when testing compiling a module to IL when the workspace
+ % was compiled to C).
%
(
MaybeForeign0 = yes(ForeignTypeBody0),
- have_foreign_type_for_backend(Target,
- ForeignTypeBody0, yes)
+ have_foreign_type_for_backend(Target, ForeignTypeBody0, yes)
->
- % The header code must be written since
- % it could be used by the foreign type.
+ % The header code must be written since it could be used
+ % by the foreign type.
intermod_info_set_write_header(!Info),
intermod__resolve_foreign_type_body_overloading(
ModuleInfo, TypeCtor, ForeignTypeBody0,
@@ -1039,32 +1010,27 @@
MaybeForeign = yes(ForeignTypeBody),
MaybeUserEqComp = MaybeUserEqComp0
;
- intermod__resolve_unify_compare_overloading(
- ModuleInfo, TypeCtor,
- MaybeUserEqComp0, MaybeUserEqComp,
- !Info),
+ intermod__resolve_unify_compare_overloading(ModuleInfo,
+ TypeCtor, MaybeUserEqComp0, MaybeUserEqComp, !Info),
MaybeForeign = MaybeForeign0
),
- TypeBody = du_type(Ctors, Tags, Enum,
- MaybeUserEqComp, ReservedTag, MaybeForeign),
- hlds_data__set_type_defn_body(TypeBody,
- TypeDefn0, TypeDefn)
+ TypeBody = du_type(Ctors, Tags, Enum, MaybeUserEqComp,
+ ReservedTag, MaybeForeign),
+ hlds_data__set_type_defn_body(TypeBody, TypeDefn0, TypeDefn)
;
TypeBody0 = foreign_type(ForeignTypeBody0)
->
- % The header code must be written since
- % it could be used by the foreign type.
+ % The header code must be written since it could be used
+ % by the foreign type.
intermod_info_set_write_header(!Info),
- intermod__resolve_foreign_type_body_overloading(
- ModuleInfo, TypeCtor,
- ForeignTypeBody0, ForeignTypeBody, !Info),
+ intermod__resolve_foreign_type_body_overloading(ModuleInfo,
+ TypeCtor, ForeignTypeBody0, ForeignTypeBody, !Info),
TypeBody = foreign_type(ForeignTypeBody),
- hlds_data__set_type_defn_body(TypeBody,
- TypeDefn0, TypeDefn)
+ hlds_data__set_type_defn_body(TypeBody, TypeDefn0, TypeDefn)
;
TypeDefn = TypeDefn0
),
- intermod_info_get_types(Types0, !Info),
+ intermod_info_get_types(!.Info, Types0),
intermod_info_set_types([TypeCtor - TypeDefn | Types0], !Info)
;
true
@@ -1081,14 +1047,12 @@
globals__get_target(Globals, Target),
%
- % Note that we don't resolve overloading for the foreign
- % definitions which won't be used on this back-end, because
- % their unification and comparison predicates have not been
- % typechecked.
- % They are only written to the `.opt' it can be handy when
- % building against a workspace for the other definitions to
- % be present (e.g. when testing compiling a module to IL when
- % the workspace was compiled to C).
+ % Note that we don't resolve overloading for the foreign definitions
+ % which won't be used on this back-end, because their unification and
+ % comparison predicates have not been typechecked. They are only written
+ % to the `.opt' it can be handy when building against a workspace
+ % for the other definitions to be present (e.g. when testing compiling
+ % a module to IL when the workspace was compiled to C).
%
( ( Target = c ; Target = asm ) ->
intermod__resolve_foreign_type_body_overloading_2(ModuleInfo,
@@ -1116,10 +1080,8 @@
intermod__resolve_foreign_type_body_overloading_2(_, _, no, no, !Info).
intermod__resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
- yes(foreign_type_lang_data(Body, MaybeUserEqComp0,
- Assertions)),
- yes(foreign_type_lang_data(Body, MaybeUserEqComp,
- Assertions)),
+ yes(foreign_type_lang_data(Body, MaybeUserEqComp0, Assertions)),
+ yes(foreign_type_lang_data(Body, MaybeUserEqComp, Assertions)),
!Info) :-
intermod__resolve_unify_compare_overloading(ModuleInfo, TypeCtor,
MaybeUserEqComp0, MaybeUserEqComp, !Info).
@@ -1131,12 +1093,10 @@
intermod__resolve_unify_compare_overloading(_, _, no, no, !Info).
intermod__resolve_unify_compare_overloading(_, _,
yes(abstract_noncanonical_type(IsSolverType)),
- yes(abstract_noncanonical_type(IsSolverType)),
- !Info).
+ yes(abstract_noncanonical_type(IsSolverType)), !Info).
intermod__resolve_unify_compare_overloading(ModuleInfo, TypeCtor,
yes(unify_compare(MaybeUserEq0, MaybeUserCompare0)),
- yes(unify_compare(MaybeUserEq, MaybeUserCompare)),
- !Info) :-
+ yes(unify_compare(MaybeUserEq, MaybeUserCompare)), !Info) :-
intermod__resolve_user_special_pred_overloading(ModuleInfo,
unify, TypeCtor, MaybeUserEq0, MaybeUserEq, !Info),
intermod__resolve_user_special_pred_overloading(ModuleInfo,
@@ -1171,23 +1131,20 @@
%-----------------------------------------------------------------------------%
% Output module imports, types, modes, insts and predicates
-
+ %
:- pred intermod__write_intermod_info(intermod_info::in,
io::di, io::uo) is det.
-intermod__write_intermod_info(IntermodInfo0, !IO) :-
- intermod_info_get_module_info(ModuleInfo,
- IntermodInfo0, IntermodInfo1),
+intermod__write_intermod_info(IntermodInfo, !IO) :-
+ intermod_info_get_module_info(IntermodInfo, ModuleInfo),
module_info_name(ModuleInfo, ModuleName),
io__write_string(":- module ", !IO),
mercury_output_bracketed_sym_name(ModuleName, !IO),
io__write_string(".\n", !IO),
- intermod_info_get_preds(Preds, IntermodInfo1, IntermodInfo2),
- intermod_info_get_pred_decls(PredDecls,
- IntermodInfo2, IntermodInfo3),
- intermod_info_get_instances(Instances,
- IntermodInfo3, IntermodInfo),
+ intermod_info_get_preds(IntermodInfo, Preds),
+ intermod_info_get_pred_decls(IntermodInfo, PredDecls),
+ intermod_info_get_instances(IntermodInfo, Instances),
(
%
% If none of these item types need writing, nothing
@@ -1210,8 +1167,8 @@
intermod__write_intermod_info_2(IntermodInfo, !IO)
).
-:- pred intermod__write_intermod_info_2(intermod_info::in,
- io::di, io::uo) is det.
+:- pred intermod__write_intermod_info_2(intermod_info::in, io::di, io::uo)
+ is det.
intermod__write_intermod_info_2(IntermodInfo, !IO) :-
IntermodInfo = info(_, Preds0, PredDecls0, Instances, Types,
@@ -1223,8 +1180,8 @@
set__to_sorted_list(Modules0, Modules),
(
Modules = [_ | _],
- % XXX this could be reduced to the set that is
- % actually needed by the items being written.
+ % XXX this could be reduced to the set that is actually needed
+ % by the items being written.
io__write_string(":- use_module ", !IO),
intermod__write_modules(Modules, !IO)
;
@@ -1242,16 +1199,14 @@
globals__io_set_option(dump_hlds_options, string(""), !IO),
(
WriteHeader = yes,
- module_info_get_foreign_import_module(ModuleInfo,
- RevForeignImports),
+ module_info_get_foreign_import_module(ModuleInfo, RevForeignImports),
ForeignImports = list__reverse(RevForeignImports),
list__foldl(
(pred(ForeignImport::in, IO0::di, IO::uo) is det :-
- ForeignImport = foreign_import_module(Lang,
- Import, _),
- mercury_output_pragma_foreign_import_module(
- Lang, Import, IO0, IO)
+ ForeignImport = foreign_import_module(Lang, Import, _),
+ mercury_output_pragma_foreign_import_module(Lang, Import,
+ IO0, IO)
), ForeignImports, !IO)
;
WriteHeader = no
@@ -1306,25 +1261,22 @@
Body = solver_type(SolverTypeDetails, MaybeUserEqComp),
TypeBody = solver_type(SolverTypeDetails, MaybeUserEqComp)
),
- mercury_output_item(
- type_defn(VarSet, Name, Args, TypeBody, true),
- Context, !IO),
+ mercury_output_item(type_defn(VarSet, Name, Args, TypeBody, true), Context,
+ !IO),
(
( Body = foreign_type(ForeignTypeBody)
; Body ^ du_type_is_foreign_type = yes(ForeignTypeBody)
),
- ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC,
- MaybeJava)
+ ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava)
->
(
MaybeIL = yes(DataIL),
- DataIL = foreign_type_lang_data(ILForeignType,
- ILMaybeUserEqComp, AssertionsIL),
+ DataIL = foreign_type_lang_data(ILForeignType, ILMaybeUserEqComp,
+ AssertionsIL),
mercury_output_item(
type_defn(VarSet, Name, Args,
foreign_type(il(ILForeignType),
- ILMaybeUserEqComp,
- AssertionsIL),
+ ILMaybeUserEqComp, AssertionsIL),
true),
Context, !IO)
;
@@ -1337,8 +1289,7 @@
mercury_output_item(
type_defn(VarSet, Name, Args,
foreign_type(c(CForeignType),
- CMaybeUserEqComp,
- AssertionsC),
+ CMaybeUserEqComp, AssertionsC),
true),
Context, !IO)
;
@@ -1351,8 +1302,7 @@
mercury_output_item(
type_defn(VarSet, Name, Args,
foreign_type(java(JavaForeignType),
- JavaMaybeUserEqComp,
- AssertionsJava),
+ JavaMaybeUserEqComp, AssertionsJava),
true),
Context, !IO)
;
@@ -1365,8 +1315,7 @@
ReservedTag = Body ^ du_type_reserved_tag,
ReservedTag = yes
->
- mercury_output_item(pragma(reserve_tag(Name, Arity)),
- Context, !IO)
+ mercury_output_item(pragma(reserve_tag(Name, Arity)), Context, !IO)
;
true
).
@@ -1411,8 +1360,7 @@
intermod__write_inst(ModuleName, InstId, InstDefn, !IO) :-
InstId = SymName - _Arity,
- InstDefn = hlds_inst_defn(Varset, Args, Body,
- Context, ImportStatus),
+ InstDefn = hlds_inst_defn(Varset, Args, Body, Context, ImportStatus),
(
SymName = qualified(ModuleName, _),
import_status_to_write(ImportStatus)
@@ -1424,8 +1372,7 @@
Body = abstract_inst,
InstBody = abstract_inst
),
- mercury_output_item(
- inst_defn(Varset, SymName, Args, InstBody, true),
+ mercury_output_item(inst_defn(Varset, SymName, Args, InstBody, true),
Context, !IO)
;
true
@@ -1443,17 +1390,15 @@
intermod__write_class(ModuleName, ClassId, ClassDefn, !IO) :-
ClassDefn = hlds_class_defn(ImportStatus, Constraints, HLDSFunDeps,
- _Ancestors, TVars, Interface, _HLDSClassInterface,
- TVarSet, Context),
+ _Ancestors, TVars, Interface, _HLDSClassInterface, TVarSet, Context),
ClassId = class_id(QualifiedClassName, _),
(
QualifiedClassName = qualified(ModuleName, _),
import_status_to_write(ImportStatus)
->
- FunDeps = list.map(unmake_hlds_class_fundep(TVars),
- HLDSFunDeps),
- Item = typeclass(Constraints, FunDeps, QualifiedClassName,
- TVars, Interface, TVarSet),
+ FunDeps = list.map(unmake_hlds_class_fundep(TVars), HLDSFunDeps),
+ Item = typeclass(Constraints, FunDeps, QualifiedClassName, TVars,
+ Interface, TVarSet),
mercury_output_item(Item, Context, !IO)
;
true
@@ -1485,15 +1430,15 @@
io::di, io::uo) is det.
intermod__write_instance(ClassId - InstanceDefn, !IO) :-
- InstanceDefn = hlds_instance_defn(ModuleName, _, Context,
- Constraints, Types, Body, _, TVarSet, _),
+ InstanceDefn = hlds_instance_defn(ModuleName, _, Context, Constraints,
+ Types, Body, _, TVarSet, _),
ClassId = class_id(ClassName, _),
- Item = instance(Constraints, ClassName, Types, Body, TVarSet,
- ModuleName),
+ Item = instance(Constraints, ClassName, Types, Body, TVarSet, ModuleName),
mercury_output_item(Item, Context, !IO).
% We need to write all the declarations for local predicates so
% the procedure labels for the C code are calculated correctly.
+ %
:- pred intermod__write_pred_decls(module_info::in, list(pred_id)::in,
io::di, io::uo) is det.
@@ -1510,11 +1455,10 @@
pred_info_get_goal_type(PredInfo, GoalType),
(
GoalType = pragmas,
- % For foreign code goals we can't append variable numbers
- % to type variables in the predicate declaration
- % because the foreign code may contain references to
- % variables such as `TypeInfo_for_T' which will break
- % if `T' is written as `T_1' in the pred declaration.
+ % For foreign code goals we can't append variable numbers to type
+ % variables in the predicate declaration because the foreign code
+ % may contain references to variables such as `TypeInfo_for_T'
+ % which will break if `T' is written as `T_1' in the pred declaration.
AppendVarNums = no
;
GoalType = clauses_and_pragmas,
@@ -1533,22 +1477,20 @@
),
(
PredOrFunc = predicate,
- mercury_output_pred_type(TVarSet, ExistQVars,
- qualified(Module, Name), ArgTypes, no, Purity,
- ClassContext, Context, AppendVarNums, !IO)
+ mercury_output_pred_type(TVarSet, ExistQVars, qualified(Module, Name),
+ ArgTypes, no, Purity, ClassContext, Context, AppendVarNums, !IO)
;
PredOrFunc = function,
pred_args_to_func_args(ArgTypes, FuncArgTypes, FuncRetType),
- mercury_output_func_type(TVarSet, ExistQVars,
- qualified(Module, Name), FuncArgTypes,
- FuncRetType, no, Purity, ClassContext, Context,
+ mercury_output_func_type(TVarSet, ExistQVars, qualified(Module, Name),
+ FuncArgTypes, FuncRetType, no, Purity, ClassContext, Context,
AppendVarNums, !IO)
),
pred_info_procedures(PredInfo, Procs),
ProcIds = pred_info_procids(PredInfo),
- % Make sure the mode declarations go out in the same
- % order they came in, so that the all the modes get the
- % same proc_id in the importing modules.
+ % Make sure the mode declarations go out in the same order
+ % they came in, so that the all the modes get the same proc_id
+ % in the importing modules.
CompareProcId =
(pred(ProcId1::in, ProcId2::in, Result::out) is det :-
proc_id_to_int(ProcId1, ProcInt1),
@@ -1579,8 +1521,7 @@
ArgModes = ArgModes0,
Detism = Detism0
;
- error("intermod__write_pred_modes: " ++
- "attempt to write undeclared mode")
+ error("intermod__write_pred_modes: attempt to write undeclared mode")
),
proc_info_context(ProcInfo, Context),
varset__init(Varset),
@@ -1588,8 +1529,7 @@
PredOrFunc = function,
pred_args_to_func_args(ArgModes, FuncArgModes, FuncRetMode),
mercury_output_func_mode_decl(Varset, SymName,
- FuncArgModes, FuncRetMode,
- yes(Detism), Context, !IO)
+ FuncArgModes, FuncRetMode, yes(Detism), Context, !IO)
;
PredOrFunc = predicate,
mercury_output_pred_mode_decl(Varset, SymName, ArgModes,
@@ -1619,11 +1559,9 @@
( pred_info_get_goal_type(PredInfo, promise(PromiseType)) ->
( Clauses = [Clause] ->
hlds_out__write_promise(PromiseType, 0, ModuleInfo,
- PredId, VarSet, no, HeadVars,
- PredOrFunc, Clause, no, !IO)
+ PredId, VarSet, no, HeadVars, PredOrFunc, Clause, no, !IO)
;
- error("intermod__write_preds: " ++
- "assertion not a single clause.")
+ error("intermod__write_preds: assertion not a single clause.")
)
;
list__foldl(intermod__write_clause(ModuleInfo, PredId, VarSet,
@@ -1638,8 +1576,7 @@
intermod__write_clause(ModuleInfo, PredId, VarSet, HeadVars,
PredOrFunc, _SymName, Clause0, !IO) :-
Clause0 = clause(_, _, mercury, _),
- strip_headvar_unifications(HeadVars, Clause0,
- ClauseHeadVars, Clause),
+ strip_headvar_unifications(HeadVars, Clause0, ClauseHeadVars, Clause),
% Variable numbers need to be appended for the case
% where the added arguments for a DCG pred expression
% are named the same as variables in the enclosing clause.
@@ -1647,8 +1584,8 @@
UseDeclaredModes = yes,
MaybeVarTypes = no,
hlds_out__write_clause(1, ModuleInfo, PredId, VarSet, AppendVarNums,
- ClauseHeadVars, PredOrFunc, Clause, UseDeclaredModes,
- MaybeVarTypes, !IO).
+ ClauseHeadVars, PredOrFunc, Clause, UseDeclaredModes, MaybeVarTypes,
+ !IO).
intermod__write_clause(ModuleInfo, PredId, VarSet, _HeadVars,
PredOrFunc, SymName, Clause, !IO) :-
@@ -1665,13 +1602,11 @@
ForeignCodeGoal = foreign_proc(Attributes,
_, _, Args, _, PragmaCode) - _
;
- Goal = foreign_proc(Attributes,
- _, _, Args, _, PragmaCode) - _
+ Goal = foreign_proc(Attributes, _, _, Args, _, PragmaCode) - _
)
->
list__foldl(intermod__write_foreign_clause(Procs, PredOrFunc,
- PragmaCode, Attributes, Args, VarSet, SymName),
- ProcIds, !IO)
+ PragmaCode, Attributes, Args, VarSet, SymName), ProcIds, !IO)
;
error("foreign_proc expected within this goal")
).
@@ -1708,6 +1643,7 @@
% unifications added when the clauses are read in again from
% the `.opt' file. Clauses containing impure goals are not
% written to the `.opt' file for this reason.
+ %
:- pred strip_headvar_unifications(list(prog_var)::in,
clause::in, list(prog_term)::out, clause::out) is det.
@@ -1722,10 +1658,7 @@
->
list__map(
(pred(HeadVar0::in, HeadTerm::out) is det :-
- (
- map__search(HeadVarMap, HeadVar0,
- HeadTerm0)
- ->
+ ( map__search(HeadVarMap, HeadVar0, HeadTerm0) ->
HeadTerm = HeadTerm0
;
HeadTerm = term__variable(HeadVar0)
@@ -1758,21 +1691,17 @@
term__context_init(Context),
(
ConsId = int_const(Int),
- RHSTerm = term__functor(term__integer(Int),
- [], Context)
+ RHSTerm = term__functor(term__integer(Int), [], Context)
;
ConsId = float_const(Float),
- RHSTerm = term__functor(term__float(Float),
- [], Context)
+ RHSTerm = term__functor(term__float(Float), [], Context)
;
ConsId = string_const(String),
- RHSTerm = term__functor(term__string(String),
- [], Context)
+ RHSTerm = term__functor(term__string(String), [], Context)
;
ConsId = cons(SymName, _),
term__var_list_to_term_list(Args, ArgTerms),
- construct_qualified_term(SymName, ArgTerms,
- RHSTerm)
+ construct_qualified_term(SymName, ArgTerms, RHSTerm)
)
)
->
@@ -1807,8 +1736,7 @@
(
ShouldOutput = yes,
hlds_out__marker_name(Marker, Name),
- mercury_output_pragma_decl(SymName, Arity, PredOrFunc, Name,
- no, !IO)
+ mercury_output_pragma_decl(SymName, Arity, PredOrFunc, Name, no, !IO)
;
ShouldOutput = no
),
@@ -1818,15 +1746,14 @@
io::di, io::uo) is det.
intermod__write_type_spec_pragmas(ModuleInfo, PredId, !IO) :-
- module_info_type_spec_info(ModuleInfo,
- type_spec_info(_, _, _, PragmaMap)),
+ module_info_type_spec_info(ModuleInfo, type_spec_info(_, _, _, PragmaMap)),
( multi_map__search(PragmaMap, PredId, TypeSpecPragmas) ->
list__foldl(
( pred(Pragma::in, IO0::di, IO::uo) is det :-
( Pragma = type_spec(_, _, _, _, _, _, _, _) ->
AppendVarnums = yes,
- mercury_output_pragma_type_spec(Pragma,
- AppendVarnums, IO0, IO)
+ mercury_output_pragma_type_spec(Pragma, AppendVarnums,
+ IO0, IO)
;
error("write_type_spec_pragmas")
)
@@ -1837,6 +1764,7 @@
% Is a pragma declaration required in the `.opt' file for
% a predicate with the given marker.
+ %
:- pred intermod__should_output_marker(marker::in, bool::out) is det.
intermod__should_output_marker(stub, no).
@@ -1913,22 +1841,29 @@
---> info(
im_modules :: set(module_name),
% modules to import
+
im_preds :: set(pred_id),
% preds to output clauses for
+
im_pred_decls :: set(pred_id),
% preds to output decls for
+
im_instances :: assoc_list(class_id,
hlds_instance_defn),
% instances declarations to write
+
im_types :: assoc_list(type_ctor,
hlds_type_defn),
% type declarations to write
+
im_module_info :: module_info,
+
im_write_foreign_header :: bool,
% do the c_header_codes for the module
% need writing, yes if there are
% pragma_foreign_code procs being
% exported.
+
im_var_types :: vartypes,
im_tvarset :: tvarset
% Vartypes and tvarset for the
@@ -1948,27 +1883,21 @@
IntermodInfo = info(Modules, Procs, ProcDecls, Instances, Types,
ModuleInfo, no, VarTypes, TVarSet).
-:- pred intermod_info_get_modules(set(module_name)::out,
- intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_preds(set(pred_id)::out,
- intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_pred_decls(set(pred_id)::out,
- intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_instances(
- assoc_list(class_id, hlds_instance_defn)::out,
- intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_types(assoc_list(type_ctor, hlds_type_defn)::out,
- intermod_info::in, intermod_info::out) is det.
-%:- pred intermod_info_get_insts(set(inst_id)::out,
-% intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_module_info(module_info::out,
- intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_write_foreign_header(bool::out,
- intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_var_types(vartypes::out,
- intermod_info::in, intermod_info::out) is det.
-:- pred intermod_info_get_tvarset(tvarset::out,
- intermod_info::in, intermod_info::out) is det.
+:- pred intermod_info_get_modules(intermod_info::in, set(module_name)::out)
+ is det.
+:- pred intermod_info_get_preds(intermod_info::in, set(pred_id)::out) is det.
+:- pred intermod_info_get_pred_decls(intermod_info::in, set(pred_id)::out)
+ is det.
+:- pred intermod_info_get_instances(intermod_info::in,
+ assoc_list(class_id, hlds_instance_defn)::out) is det.
+:- pred intermod_info_get_types(intermod_info::in,
+ assoc_list(type_ctor, hlds_type_defn)::out) is det.
+:- pred intermod_info_get_module_info(intermod_info::in, module_info::out)
+ is det.
+:- pred intermod_info_get_write_foreign_header(intermod_info::in, bool::out)
+ is det.
+:- pred intermod_info_get_var_types(intermod_info::in, vartypes::out) is det.
+:- pred intermod_info_get_tvarset(intermod_info::in, tvarset::out) is det.
:- pred intermod_info_set_modules(set(module_name)::in,
intermod_info::in, intermod_info::out) is det.
@@ -1992,16 +1921,15 @@
:- pred intermod_info_set_tvarset(tvarset::in,
intermod_info::in, intermod_info::out) is det.
-intermod_info_get_modules(Info ^ im_modules, Info, Info).
-intermod_info_get_preds(Info ^ im_preds, Info, Info).
-intermod_info_get_pred_decls(Info ^ im_pred_decls, Info, Info).
-intermod_info_get_instances(Info ^ im_instances, Info, Info).
-intermod_info_get_types(Info ^ im_types, Info, Info).
-intermod_info_get_module_info(Info ^ im_module_info, Info, Info).
-intermod_info_get_write_foreign_header(Info ^ im_write_foreign_header,
- Info, Info).
-intermod_info_get_var_types(Info ^ im_var_types, Info, Info).
-intermod_info_get_tvarset(Info ^ im_tvarset, Info, Info).
+intermod_info_get_modules(Info, Info ^ im_modules).
+intermod_info_get_preds(Info, Info ^ im_preds).
+intermod_info_get_pred_decls(Info, Info ^ im_pred_decls).
+intermod_info_get_instances(Info, Info ^ im_instances).
+intermod_info_get_types(Info, Info ^ im_types).
+intermod_info_get_module_info(Info, Info ^ im_module_info).
+intermod_info_get_write_foreign_header(Info, Info ^ im_write_foreign_header).
+intermod_info_get_var_types(Info, Info ^ im_var_types).
+intermod_info_get_tvarset(Info, Info ^ im_tvarset).
intermod_info_set_modules(Modules, Info, Info ^ im_modules := Modules).
intermod_info_set_preds(Procs, Info, Info ^ im_preds := Procs).
@@ -2020,37 +1948,39 @@
% Make sure the labels of local preds needed by predicates in
% the .opt file are exported, and inhibit dead proc elimination
% on those preds.
-intermod__adjust_pred_import_status(Module0, Module, IO0, IO) :-
- globals__io_lookup_bool_option(very_verbose, VVerbose, IO0, IO1),
- maybe_write_string(VVerbose,
- "% Adjusting import status of predicates in the `.opt' file...",
- IO1, IO2),
-
- init_intermod_info(Module0, Info0),
- module_info_predids(Module0, PredIds),
- module_info_globals(Module0, Globals),
+ %
+intermod__adjust_pred_import_status(!Module, !IO) :-
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ maybe_write_string(VeryVerbose,
+ "% Adjusting import status of predicates in the `.opt' file...", !IO),
+
+ module_info_predids(!.Module, PredIds),
+ module_info_globals(!.Module, Globals),
globals__lookup_int_option(Globals, intermod_inline_simple_threshold,
Threshold),
globals__lookup_bool_option(Globals, deforestation, Deforestation),
globals__lookup_int_option(Globals, higher_order_size_limit,
HigherOrderSizeLimit),
+ some [!Info] (
+ init_intermod_info(!.Module, !:Info),
intermod__gather_preds(PredIds, yes, Threshold, HigherOrderSizeLimit,
- Deforestation, Info0, Info1),
- intermod__gather_instances(Info1, Info2),
- intermod__gather_types(Info2, Info),
- do_adjust_pred_import_status(Info, Module0, Module),
- maybe_write_string(VVerbose, " done\n", IO2, IO).
+ Deforestation, !Info),
+ intermod__gather_instances(!Info),
+ intermod__gather_types(!Info),
+ do_adjust_pred_import_status(!.Info, !Module)
+ ),
+ maybe_write_string(VeryVerbose, " done\n", !IO).
:- pred do_adjust_pred_import_status(intermod_info::in,
module_info::in, module_info::out) is det.
-do_adjust_pred_import_status(Info, ModuleInfo0, ModuleInfo) :-
- intermod_info_get_pred_decls(PredDecls0, Info, _),
+do_adjust_pred_import_status(Info, !ModuleInfo) :-
+ intermod_info_get_pred_decls(Info, PredDecls0),
set__to_sorted_list(PredDecls0, PredDecls),
- set_list_of_preds_exported(PredDecls, ModuleInfo0, ModuleInfo1),
- adjust_type_status(ModuleInfo1, ModuleInfo2),
- adjust_class_status(ModuleInfo2, ModuleInfo3),
- adjust_instance_status(ModuleInfo3, ModuleInfo).
+ set_list_of_preds_exported(PredDecls, !ModuleInfo),
+ adjust_type_status(!ModuleInfo),
+ adjust_class_status(!ModuleInfo),
+ adjust_instance_status(!ModuleInfo).
:- pred adjust_type_status(module_info::in, module_info::out) is det.
@@ -2099,12 +2029,9 @@
module_info::in, module_info::out) is det.
adjust_class_status_2(ClassId - ClassDefn0, ClassId - ClassDefn, !ModuleInfo) :-
- (
- import_status_to_write(ClassDefn0 ^ class_status)
- ->
+ ( import_status_to_write(ClassDefn0 ^ class_status) ->
ClassDefn = ClassDefn0 ^ class_status := exported,
- class_procs_to_pred_ids(ClassDefn ^ class_hlds_interface,
- PredIds),
+ class_procs_to_pred_ids(ClassDefn ^ class_hlds_interface, PredIds),
set_list_of_preds_exported(PredIds, !ModuleInfo)
;
ClassDefn = ClassDefn0
@@ -2136,34 +2063,31 @@
module_info::in, module_info::out) is det.
adjust_instance_status_2(ClassId - InstanceList0, ClassId - InstanceList,
- ModuleInfo0, ModuleInfo) :-
+ !ModuleInfo) :-
list__map_foldl(adjust_instance_status_3, InstanceList0, InstanceList,
- ModuleInfo0, ModuleInfo).
+ !ModuleInfo).
:- pred adjust_instance_status_3(hlds_instance_defn::in,
hlds_instance_defn::out, module_info::in, module_info::out) is det.
-adjust_instance_status_3(Instance0, Instance, ModuleInfo0, ModuleInfo) :-
+adjust_instance_status_3(Instance0, Instance, !ModuleInfo) :-
Instance0 = hlds_instance_defn(InstanceModule, Status0, Context,
Constraints, Types, Body, HLDSClassInterface,
TVarSet, ConstraintProofs),
- (
- import_status_to_write(Status0)
- ->
+ ( import_status_to_write(Status0) ->
Instance = hlds_instance_defn(InstanceModule, exported,
Context, Constraints, Types, Body, HLDSClassInterface,
TVarSet, ConstraintProofs),
- ( HLDSClassInterface = yes(ClassInterface) ->
+ (
+ HLDSClassInterface = yes(ClassInterface),
class_procs_to_pred_ids(ClassInterface, PredIds),
- set_list_of_preds_exported(PredIds,
- ModuleInfo0, ModuleInfo)
+ set_list_of_preds_exported(PredIds, !ModuleInfo)
;
% This can happen if an instance has multiple
% declarations, one of which is abstract.
- ModuleInfo = ModuleInfo0
+ HLDSClassInterface = no
)
;
- ModuleInfo = ModuleInfo0,
Instance = Instance0
).
@@ -2204,8 +2128,8 @@
),
set_list_of_preds_exported_2(PredIds, !Preds).
- % Should a declaration with the given status be written
- % to the `.opt' file.
+ % Should a declaration with the given status be written to the `.opt' file.
+ %
:- pred import_status_to_write(import_status::in) is semidet.
import_status_to_write(Status) :-
@@ -2233,41 +2157,33 @@
%-----------------------------------------------------------------------------%
% Read in and process the optimization interfaces.
-
-intermod__grab_optfiles(!Module, FoundError, !IO) :-
-
%
+intermod__grab_optfiles(!Module, FoundError, !IO) :-
% Read in the .opt files for imported and ancestor modules.
- %
ModuleName = !.Module ^ module_name,
Ancestors0 = !.Module ^ parent_deps,
InterfaceDeps0 = !.Module ^ int_deps,
ImplementationDeps0 = !.Module ^ impl_deps,
OptFiles = list__sort_and_remove_dups(list__condense(
[Ancestors0, InterfaceDeps0, ImplementationDeps0])),
- globals__io_lookup_bool_option(read_opt_files_transitively,
- Transitive, !IO),
+ globals__io_lookup_bool_option(read_opt_files_transitively, Transitive,
+ !IO),
ModulesProcessed = set__insert(set__sorted_list_to_set(OptFiles),
ModuleName),
read_optimization_interfaces(Transitive, ModuleName, OptFiles,
ModulesProcessed, [], OptItems, no, OptError, !IO),
- %
- % Append the items to the current item list, using
- % a `opt_imported' psuedo-declaration to let
- % make_hlds know the opt_imported stuff is coming.
- %
+ % Append the items to the current item list, using a `opt_imported'
+ % psuedo-declaration to let make_hlds know the opt_imported stuff
+ % is coming.
module_imports_get_items(!.Module, Items0),
Items1 = Items0 ++ [make_pseudo_decl(opt_imported) | OptItems],
module_imports_set_items(Items1, !Module),
- %
- % Get the :- pragma unused_args(...) declarations created
- % when writing the .opt file for the current module. These
- % are needed because we can probably remove more arguments
- % with intermod_unused_args, but the interface for other
- % modules must remain the same.
- %
+ % Get the :- pragma unused_args(...) declarations created when writing
+ % the .opt file for the current module. These are needed because we can
+ % probably remove more arguments with intermod_unused_args, but the
+ % interface for other modules must remain the same.
globals__io_lookup_bool_option(intermod_unused_args, UnusedArgs, !IO),
(
UnusedArgs = yes,
@@ -2287,12 +2203,9 @@
UAError = no
),
- %
% Read .int0 files required by the `.opt' files.
- %
Int0Files = list__delete_all(
- list__condense(list__map(get_ancestors, OptFiles)),
- ModuleName),
+ list__condense(list__map(get_ancestors, OptFiles)), ModuleName),
process_module_private_interfaces(ReadModules, Int0Files,
make_pseudo_decl(opt_imported),
make_pseudo_decl(opt_imported),
@@ -2311,22 +2224,17 @@
NewImplicitImportDeps0, NewImplicitUseDeps0,
AncestorImports1, AncestorImports2])),
- %
% Read in the .int, and .int2 files needed by the .opt files.
- %
map__init(ReadModules),
process_module_long_interfaces(ReadModules, must_be_qualified, NewDeps,
- ".int",
- make_pseudo_decl(opt_imported), make_pseudo_decl(opt_imported),
+ ".int", make_pseudo_decl(opt_imported), make_pseudo_decl(opt_imported),
[], NewIndirectDeps, [], NewImplIndirectDeps, !Module, !IO),
process_module_short_interfaces_and_impls_transitively(
ReadModules, NewIndirectDeps ++ NewImplIndirectDeps, ".int2",
make_pseudo_decl(opt_imported), make_pseudo_decl(opt_imported),
!Module, !IO),
- %
- % Figure out whether anything went wrong
- %
+ % Figure out whether anything went wrong.
module_imports_get_error(!.Module, FoundError0),
(
( FoundError0 \= no_module_errors
@@ -2346,14 +2254,13 @@
read_optimization_interfaces(_, _, [], _, !Items, !Error, !IO).
read_optimization_interfaces(Transitive, ModuleName,
- [ModuleToRead | ModulesToRead], ModulesProcessed0,
- !Items, !Error, !IO) :-
+ [ModuleToRead | ModulesToRead], ModulesProcessed0, !Items, !Error,
+ !IO) :-
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
maybe_write_string(VeryVerbose,
"% Reading optimization interface for module", !IO),
maybe_write_string(VeryVerbose, " `", !IO),
- mdbcomp__prim_data__sym_name_to_string(ModuleToRead,
- ModuleToReadString),
+ mdbcomp__prim_data__sym_name_to_string(ModuleToRead, ModuleToReadString),
maybe_write_string(VeryVerbose, ModuleToReadString, !IO),
maybe_write_string(VeryVerbose, "'...\n", !IO),
maybe_flush_output(VeryVerbose, !IO),
@@ -2370,9 +2277,8 @@
get_dependencies(OptItems, NewImportDeps0, NewUseDeps0),
get_implicit_dependencies(OptItems, Globals,
NewImplicitImportDeps0, NewImplicitUseDeps0),
- NewDeps0 = list__condense([NewImportDeps0,
- NewUseDeps0, NewImplicitImportDeps0,
- NewImplicitUseDeps0]),
+ NewDeps0 = list__condense([NewImportDeps0, NewUseDeps0,
+ NewImplicitImportDeps0, NewImplicitUseDeps0]),
set__list_to_set(NewDeps0, NewDepsSet0),
set__difference(NewDepsSet0, ModulesProcessed0, NewDepsSet),
set__union(ModulesProcessed0, NewDepsSet, ModulesProcessed),
@@ -2382,8 +2288,7 @@
NewDeps = []
),
read_optimization_interfaces(Transitive, ModuleName,
- NewDeps ++ ModulesToRead, ModulesProcessed,
- !Items, !Error, !IO).
+ NewDeps ++ ModulesToRead, ModulesProcessed, !Items, !Error, !IO).
update_error_status(FileType, FileName, ModuleError, Messages,
!Error, !IO) :-
@@ -2408,8 +2313,7 @@
io__write_string("Warning: cannot open `", !IO),
io__write_string(FileName, !IO),
io__write_string("'.\n", !IO),
- globals__io_lookup_bool_option(halt_at_warn,
- HaltAtWarn, !IO),
+ globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn, !IO),
(
HaltAtWarn = yes,
!:Error = yes
--------------------------------------------------------------------------
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