[m-rev.] for post-commit review: last call modulo constructor for hlc.gc
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Oct 17 17:42:22 AEST 2005
For review by anyone.
Zoltan.
Implement --optimize-constructor-last-call for hlc grades.
compiler/lco.m:
Include the types of pointed-to fields in the types of the address-of
variables generated by the transformation, since the HLC backend needs
it.
library/private_builtin.m:
Add a new type, store_at_ref_type, for use by the new version of the
transformation in lco.m.
compiler/ml_call_gen.m:
Handle the form of builtin used by store_at_ref.
compiler/ml_unify_gen.m:
Handle construction unifications that take the addresses of some
fields.
compiler/ml_closure_gen.m:
Conform to the change in ml_unify_gen.m.
compiler/handle_options.m:
Do not disable --optimize-constructor-last-call in hlc grades.
compiler/add_pred.m:
When creating the implementation of the store_at_ref builtin,
don't make the body of the predicate be an invocation of the builtin
itself, since the generated HLC code is not type-correct C. Instead,
make it "true". Since the predicate itself (as distinct from the
builtin operation) is never used, this is OK.
Minor cleanups.
compiler/mlds_to_c.m:
Make the generated C code somewhat easier to read.
Convert to four-space indentation.
compiler/options.m:
Add an option, opt_level_number, which records the selected
optimization level numerically. The idea is that optimizations such
as --optimize-constructor-last-call, which produce speedups only
at some but not all optimization levels, can be enabled only when
they help. This capability is not yet used; that will require further
experimentation.
Convert to four-space indentation.
compiler/mlds.m:
Translate store_at_ref Mercury types into a pointer MLDS type.
Minor cleanups.
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
Minor cleanups.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pred.m,v
retrieving revision 1.6
diff -u -b -r1.6 add_pred.m
--- compiler/add_pred.m 30 Sep 2005 08:08:15 -0000 1.6
+++ compiler/add_pred.m 14 Oct 2005 15:40:05 -0000
@@ -214,16 +214,12 @@
%
% foo(H1, H2) :- foo(H1, H2).
%
- % This does not generate an infinite loop!
- % Instead, the compiler will generate the usual builtin inline code
- % for foo/2 in the body. The reason for generating this
- % forwarding code stub is so that things work correctly if
- % you take the address of the predicate.
+ % This does not generate an infinite loop! Instead, the compiler will
+ % generate the usual builtin inline code for foo/2 in the body. The reason
+ % for generating this forwarding code stub is so that things work correctly
+ % if you take the address of the predicate.
%
add_builtin(PredId, Types, !PredInfo) :-
- %
- % lookup some useful info: Module, Name, Context, HeadVars
- %
Module = pred_info_module(!.PredInfo),
Name = pred_info_name(!.PredInfo),
pred_info_context(!.PredInfo, Context),
@@ -231,28 +227,30 @@
clauses_info_varset(ClausesInfo0, VarSet),
clauses_info_headvars(ClausesInfo0, HeadVars),
- %
- % construct the pseudo-recursive call to Module:Name(HeadVars)
- %
+ % Construct the pseudo-recursive call to Module.Name(HeadVars).
SymName = qualified(Module, Name),
- ModeId = invalid_proc_id, % mode checking will figure it out
+ % Mode checking will figure it the mode.
+ ModeId = invalid_proc_id,
MaybeUnifyContext = no,
- Call = call(PredId, ModeId, HeadVars, inline_builtin, MaybeUnifyContext,
- SymName),
+ (
+ Module = mercury_private_builtin_module,
+ Name = "store_at_ref"
+ ->
+ GoalExpr = conj([])
+ ;
+ GoalExpr = call(PredId, ModeId, HeadVars, inline_builtin,
+ MaybeUnifyContext, SymName)
+ ),
- %
- % construct a clause containing that pseudo-recursive call
- %
+ % Construct a clause containing that pseudo-recursive call.
goal_info_init(Context, GoalInfo0),
set__list_to_set(HeadVars, NonLocals),
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
- Goal = Call - GoalInfo,
+ Goal = GoalExpr - GoalInfo,
Clause = clause([], Goal, mercury, Context),
- %
- % put the clause we just built into the pred_info,
- % annotateed with the appropriate types
- %
+ % Put the clause we just built into the pred_info,
+ % annotateed with the appropriate types.
map__from_corresponding_lists(HeadVars, Types, VarTypes),
map__init(TVarNameMap),
rtti_varmaps_init(RttiVarMaps),
@@ -262,14 +260,11 @@
HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses),
pred_info_set_clauses_info(ClausesInfo, !PredInfo),
- %
- % It's pointless but harmless to inline these clauses.
- % The main purpose of the `no_inline' marker is to stop
- % constraint propagation creating real infinite loops in
- % the generated code when processing calls to these
- % predicates. The code generator will still generate
- % inline code for calls to these predicates.
- %
+ % It's pointless but harmless to inline these clauses. The main purpose
+ % of the `no_inline' marker is to stop constraint propagation creating
+ % real infinite loops in the generated code when processing calls to these
+ % predicates. The code generator will still generate inline code for calls
+ % to these predicates.
pred_info_get_markers(!.PredInfo, Markers0),
add_marker(user_marked_no_inline, Markers0, Markers),
pred_info_set_markers(Markers, !PredInfo).
@@ -436,7 +431,7 @@
predicate_table_insert(PredInfo, may_be_unqualified, MQInfo, PredId,
!PredicateTable)
;
- error("preds_add_implicit")
+ unexpected(this_file, "preds_add_implicit")
).
%-----------------------------------------------------------------------------%
@@ -496,5 +491,11 @@
words("should have been qualified by prog_io.m.")],
write_error_pieces(Context, 0, Pieces, !IO),
io__set_exit_status(1, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "add_pred.m".
%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.237
diff -u -b -r1.237 handle_options.m
--- compiler/handle_options.m 13 Sep 2005 08:25:29 -0000 1.237
+++ compiler/handle_options.m 14 Oct 2005 08:43:06 -0000
@@ -1573,14 +1573,16 @@
BackendForeignLanguages = ["c"]
;
Target = il,
- BackendForeignLanguages = ["il", "csharp", "mc++"]
+ BackendForeignLanguages = ["il", "csharp", "mc++"],
+ set_option(optimize_constructor_last_call, bool(no), !Globals)
;
Target = asm,
% XXX This is wrong! It should be asm.
BackendForeignLanguages = ["c"]
;
Target = java,
- BackendForeignLanguages = ["java"]
+ BackendForeignLanguages = ["java"],
+ set_option(optimize_constructor_last_call, bool(no), !Globals)
),
% only set the backend foreign languages if they are unset
@@ -1633,9 +1635,6 @@
globals__set_option(can_compare_constants_as_ints, bool(no),
!Globals)
),
-
- option_implies(highlevel_code, optimize_constructor_last_call,
- bool(no), !Globals),
(
HighLevel = no,
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.25
diff -u -b -r1.25 lco.m
--- compiler/lco.m 13 Sep 2005 04:56:05 -0000 1.25
+++ compiler/lco.m 14 Oct 2005 12:52:19 -0000
@@ -47,7 +47,7 @@
% app'(T, B, AddrHT)
% )
%
-% app'(list(T)::in, list(T)::in, c_pointer::in)
+% app'(list(T)::in, list(T)::in, store_by_ref_type(T)::in)
% app'(A, B, AddrC) :-
% (
% A == [],
@@ -75,7 +75,8 @@
% predicate, but it has a further transformation performed on it. This further
% transformation
%
-% 3 replaces the output arguments with input arguments of type c_pointer, and
+% 3 replaces the output arguments with input arguments of type
+% store_by_ref_type(T), where T is type of the field pointed to, and
%
% 4 follows each primitive goal that binds one of the output arguments
% with a store to the memory location indicated by the corresponding pointer.
@@ -635,10 +636,18 @@
varset__lookup_name(VarSet0, Var, "SCCcallarg", Name),
AddrName = "Addr" ++ Name,
varset__new_named_var(VarSet0, AddrName, AddrVar, VarSet),
- map__det_insert(VarTypes0, AddrVar, c_pointer_type, VarTypes),
+ map__lookup(VarTypes0, Var, FieldType),
+ map__det_insert(VarTypes0, AddrVar, make_ref_type(FieldType), VarTypes),
!:Info = !.Info ^ var_set := VarSet,
!:Info = !.Info ^ var_types := VarTypes.
+:- func make_ref_type(type) = (type).
+
+make_ref_type(FieldType) = PtrType :-
+ RefTypeName = qualified(mercury_private_builtin_module,
+ "store_by_ref_type"),
+ PtrType = defined(RefTypeName, [FieldType], star).
+
%-----------------------------------------------------------------------------%
:- pred ensure_variant_exists(pred_id::in, proc_id::in, list(int)::in,
@@ -761,8 +770,8 @@
:- pred transform_variant_proc(module_info::in, list(int)::in,
proc_info::in, proc_info::out) is det.
-transform_variant_proc(ModuleInfo, AddrOutArgPosns,
- ProcInfo, !:VariantProcInfo) :-
+transform_variant_proc(ModuleInfo, AddrOutArgPosns, ProcInfo,
+ !:VariantProcInfo) :-
!:VariantProcInfo = ProcInfo,
proc_info_varset(ProcInfo, VarSet0),
proc_info_vartypes(ProcInfo, VarTypes0),
@@ -812,7 +821,8 @@
varset__lookup_name(!.VarSet, HeadVar0, Name),
AddrName = "AddrOf" ++ Name,
svvarset__new_named_var(AddrName, AddrVar, !VarSet),
- svmap__det_insert(AddrVar, c_pointer_type, !VarTypes),
+ map__lookup(!.VarTypes, HeadVar0, OldType),
+ svmap__det_insert(AddrVar, make_ref_type(OldType), !VarTypes),
HeadVar = AddrVar,
Mode = in_mode,
make_addr_vars(HeadVars0, Modes0, HeadVars, Modes,
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.56
diff -u -b -r1.56 ml_call_gen.m
--- compiler/ml_call_gen.m 5 Oct 2005 06:33:44 -0000 1.56
+++ compiler/ml_call_gen.m 14 Oct 2005 08:41:27 -0000
@@ -911,16 +911,14 @@
Statements = [Statement]
)
;
- SimpleCode = ref_assign(_, _),
- % This should arise in only one case, where we are compiling
- % the code of store_at_ref in private_builtin. In MLDS grades,
- % we don't use that primitive, and therefore what code we generate
- % for it shouldn't matter.
- %
- % XXX If and when we extend the MLDS code generator to handle
- % --optimize-constructor-last-call, we will of course have to
- % emit proper code here.
- Statements = []
+ SimpleCode = ref_assign(AddrLval, ValueLval),
+ ( ValueLval = var(_ValueVarName, ValueType) ->
+ Statement = ml_gen_assign(mem_ref(lval(AddrLval), ValueType),
+ lval(ValueLval), Context),
+ Statements = [Statement]
+ ;
+ unexpected(this_file, "malformed ref_assign")
+ )
;
SimpleCode = test(_),
unexpected(this_file, "malformed det builtin predicate")
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.35
diff -u -b -r1.35 ml_closure_gen.m
--- compiler/ml_closure_gen.m 5 Oct 2005 06:33:44 -0000 1.35
+++ compiler/ml_closure_gen.m 14 Oct 2005 08:41:27 -0000
@@ -171,7 +171,7 @@
% Generate a `new_object' statement (or static constant) for the closure.
ml_gen_new_object(MaybeConsId, PrimaryTag, MaybeSecondaryTag,
MaybeConsName, Var, ExtraArgRvals, ExtraArgTypes, ArgVars,
- ArgModes, HowToConstruct, Context, Decls0, Statements, !Info),
+ ArgModes, [], HowToConstruct, Context, Decls0, Statements, !Info),
Decls1 = ClosureLayoutDecls ++ Decls0,
% We sometimes generates two definitions of the same RTTI constant
% in ml_gen_closure_layout (e.g. two definitions of the same
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.160
diff -u -b -r1.160 ml_code_gen.m
--- compiler/ml_code_gen.m 5 Oct 2005 06:33:44 -0000 1.160
+++ compiler/ml_code_gen.m 14 Oct 2005 13:17:17 -0000
@@ -1097,8 +1097,7 @@
mlds__entity_defn::out, mlds__defns::out) is det.
ml_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcDefnBody, ExtraDefns) :-
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, ProcInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
pred_info_import_status(PredInfo, ImportStatus),
pred_info_arg_types(PredInfo, ArgTypes),
proc_info_interface_code_model(ProcInfo, CodeModel),
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.97
diff -u -b -r1.97 ml_code_util.m
--- compiler/ml_code_util.m 14 Oct 2005 01:42:46 -0000 1.97
+++ compiler/ml_code_util.m 14 Oct 2005 14:46:55 -0000
@@ -158,12 +158,12 @@
%
:- func ml_gen_proc_params(module_info, pred_id, proc_id) = mlds__func_params.
- % As above, but from the rtti_proc_id rather than from the module_info,
- % pred_id, and proc_id.
- %
:- pred ml_gen_proc_params(pred_id::in, proc_id::in, mlds__func_params::out,
ml_gen_info::in, ml_gen_info::out) is det.
+ % As above, but from the rtti_proc_id rather than from the module_info,
+ % pred_id, and proc_id.
+ %
:- func ml_gen_proc_params_from_rtti(module_info, rtti_proc_label) =
mlds__func_params.
@@ -1000,8 +1000,7 @@
%
ml_gen_proc_params(ModuleInfo, PredId, ProcId) = FuncParams :-
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, ProcInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
proc_info_varset(ProcInfo, VarSet),
proc_info_headvars(ProcInfo, HeadVars),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
@@ -1014,8 +1013,7 @@
ml_gen_proc_params(PredId, ProcId, FuncParams, !Info) :-
ModuleInfo = !.Info ^ module_info,
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, ProcInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
proc_info_varset(ProcInfo, VarSet),
proc_info_headvars(ProcInfo, HeadVars),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
@@ -1077,8 +1075,8 @@
code_model::in, mlds__func_params::out,
maybe(ml_gen_info)::in, maybe(ml_gen_info)::out) is det.
-ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
- PredOrFunc, CodeModel, FuncParams, !MaybeInfo) :-
+ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, PredOrFunc,
+ CodeModel, FuncParams, !MaybeInfo) :-
module_info_get_globals(ModuleInfo, Globals),
CopyOut = get_copy_out_option(Globals, CodeModel),
ml_gen_arg_decls(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
@@ -1213,10 +1211,10 @@
ml_gen_arg_decl(ModuleInfo, Var, Type, ArgMode, FuncArg, !MaybeInfo) :-
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
- ( ArgMode \= top_in ->
- MLDS_ArgType = mlds__ptr_type(MLDS_Type)
- ;
+ ( ArgMode = top_in ->
MLDS_ArgType = MLDS_Type
+ ;
+ MLDS_ArgType = mlds__ptr_type(MLDS_Type)
),
Name = data(var(Var)),
(
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.88
diff -u -b -r1.88 ml_unify_gen.m
--- compiler/ml_unify_gen.m 14 Oct 2005 01:42:46 -0000 1.88
+++ compiler/ml_unify_gen.m 17 Oct 2005 07:34:25 -0000
@@ -70,8 +70,8 @@
mlds__rval.
% ml_gen_new_object(MaybeConsId, Tag, HasSecTag, MaybeCtorName, Var,
- % ExtraRvals, ExtraTypes, ArgVars, ArgModes, HowToConstruct,
- % Context, Decls, Statements):
+ % ExtraRvals, ExtraTypes, ArgVars, ArgModes, TakeAddr, HowToConstruct,
+ % Context, Decls, Statements, !Info):
%
% Generate a `new_object' statement, or a static constant, depending on the
% value of the how_to_construct argument. The `ExtraRvals' and `ExtraTypes'
@@ -80,7 +80,7 @@
%
:- pred ml_gen_new_object(maybe(cons_id)::in, mlds__tag::in, bool::in,
maybe(ctor_name)::in, prog_var::in, list(mlds__rval)::in,
- list(mlds__type)::in, prog_vars::in, list(uni_mode)::in,
+ list(mlds__type)::in, prog_vars::in, list(uni_mode)::in, list(int)::in,
how_to_construct::in, prog_context::in, mlds__defns::out,
mlds__statements::out, ml_gen_info::in, ml_gen_info::out) is det.
@@ -174,16 +174,21 @@
_CellIsUnique, SubInfo),
require(unify(CodeModel, model_det), "ml_code_gen: construct not det"),
(
- SubInfo = no_construct_sub_info
+ SubInfo = no_construct_sub_info,
+ TakeAddr = []
;
SubInfo = construct_sub_info(MaybeTakeAddr, MaybeSizeProfInfo),
- require(unify(MaybeTakeAddr, no),
- "ml_code_gen: take field addresses not yet supported"),
+ (
+ MaybeTakeAddr = no,
+ TakeAddr = []
+ ;
+ MaybeTakeAddr = yes(TakeAddr)
+ ),
require(unify(MaybeSizeProfInfo, no),
"ml_code_gen: term size profiling not yet supported")
),
- ml_gen_construct(Var, ConsId, Args, ArgModes, HowToConstruct, Context,
- Decls, Statements, !Info).
+ ml_gen_construct(Var, ConsId, Args, ArgModes, TakeAddr, HowToConstruct,
+ Context, Decls, Statements, !Info).
ml_gen_unification(Unification, CodeModel, Context, Decls, Statements,
!Info) :-
@@ -231,39 +236,36 @@
% the code here, and any changes may need to be done in both places.
%
:- pred ml_gen_construct(prog_var::in, cons_id::in, prog_vars::in,
- list(uni_mode)::in, how_to_construct::in, prog_context::in,
+ list(uni_mode)::in, list(int)::in, how_to_construct::in, prog_context::in,
mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_construct(Var, ConsId, Args, ArgModes, HowToConstruct, Context,
- Decls, Statements, !Info) :-
+ml_gen_construct(Var, ConsId, Args, ArgModes, TakeAddr, HowToConstruct,
+ Context, Decls, Statements, !Info) :-
% Figure out how this cons_id is represented.
ml_variable_type(!.Info, Var, Type),
ml_cons_id_to_tag(!.Info, ConsId, Type, Tag),
-
- ml_gen_construct_2(Tag, Type, Var, ConsId, Args, ArgModes,
+ ml_gen_construct_2(Tag, Type, Var, ConsId, Args, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info).
:- pred ml_gen_construct_2(cons_tag::in, prog_type::in, prog_var::in,
- cons_id::in, prog_vars::in, list(uni_mode)::in, how_to_construct::in,
- prog_context::in, mlds__defns::out, mlds__statements::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+ cons_id::in, prog_vars::in, list(uni_mode)::in, list(int)::in,
+ how_to_construct::in, prog_context::in, mlds__defns::out,
+ mlds__statements::out, ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_construct_2(Tag, Type, Var, ConsId, Args, ArgModes, HowToConstruct,
- Context, Decls, Statements, !Info) :-
+ml_gen_construct_2(Tag, Type, Var, ConsId, Args, ArgModes, TakeAddr,
+ HowToConstruct, Context, Decls, Statements, !Info) :-
(
% Types for which some other constructor has a reserved_address
% -- that only makes a difference when deconstructing, so here we
% ignore that, and just recurse on the representation for this
% constructor.
- Tag = shared_with_reserved_addresses(_, ThisTag)
- ->
+ Tag = shared_with_reserved_addresses(_, ThisTag),
ml_gen_construct_2(ThisTag, Type, Var, ConsId, Args, ArgModes,
- HowToConstruct, Context, Decls, Statements, !Info)
+ TakeAddr, HowToConstruct, Context, Decls, Statements, !Info)
;
- Tag = no_tag
- ->
+ Tag = no_tag,
(
Args = [Arg],
ArgModes = [ArgMode]
@@ -276,25 +278,34 @@
VarType, Context, [], Statements, !Info),
Decls = []
;
- error("ml_code_gen: no_tag: arity != 1")
+ unexpected(this_file, "ml_code_gen: no_tag: arity != 1")
)
;
% Lambda expressions.
- Tag = pred_closure_tag(PredId, ProcId, EvalMethod)
- ->
- ml_gen_closure(PredId, ProcId, EvalMethod, Var, Args,
- ArgModes, HowToConstruct, Context,
- Decls, Statements, !Info)
+ Tag = pred_closure_tag(PredId, ProcId, EvalMethod),
+ ml_gen_closure(PredId, ProcId, EvalMethod, Var, Args, ArgModes,
+ HowToConstruct, Context, Decls, Statements, !Info)
;
% Ordinary compound terms.
( Tag = single_functor
; Tag = unshared_tag(_TagVal)
; Tag = shared_remote_tag(_PrimaryTag, _SecondaryTag)
- )
- ->
- ml_gen_compound(Tag, ConsId, Var, Args, ArgModes,
+ ),
+ ml_gen_compound(Tag, ConsId, Var, Args, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info)
;
+ ( Tag = int_constant(_)
+ ; Tag = float_constant(_)
+ ; Tag = string_constant(_)
+ ; Tag = reserved_address(_)
+ ; Tag = shared_local_tag(_, _)
+ ; Tag = type_ctor_info_constant(_, _, _)
+ ; Tag = base_typeclass_info_constant(_, _, _)
+ ; Tag = deep_profiling_proc_layout_tag(_, _)
+ ; Tag = tabling_pointer_constant(_, _)
+ ; Tag = table_io_decl_tag(_, _)
+ ),
+ (
% Constants.
Args = []
->
@@ -304,7 +315,8 @@
Decls = [],
Statements = [Statement]
;
- unexpected(this_file, "ml_gen_construct: unknown compound term")
+ unexpected(this_file, "ml_gen_construct: bad constant term")
+ )
).
% ml_gen_static_const_arg is similar to ml_gen_construct with
@@ -528,12 +540,12 @@
% Generate code to construct a new object.
%
:- pred ml_gen_compound(cons_tag::in, cons_id::in, prog_var::in, prog_vars::in,
- list(uni_mode)::in, how_to_construct::in, prog_context::in,
+ list(uni_mode)::in, list(int)::in, how_to_construct::in, prog_context::in,
mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_compound(Tag, ConsId, Var, ArgVars, ArgModes, HowToConstruct, Context,
- Decls, Statements, !Info) :-
+ml_gen_compound(Tag, ConsId, Var, ArgVars, ArgModes, TakeAddr, HowToConstruct,
+ Context, Decls, Statements, !Info) :-
% Get the primary and secondary tags.
( get_primary_tag(Tag) = yes(PrimaryTag0) ->
PrimaryTag = PrimaryTag0
@@ -581,7 +593,7 @@
ExtraArgTypes = []
),
ml_gen_new_object(yes(ConsId), PrimaryTag, HasSecTag, MaybeCtorName,
- Var, ExtraRvals, ExtraArgTypes, ArgVars, ArgModes,
+ Var, ExtraRvals, ExtraArgTypes, ArgVars, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info).
% ml_gen_new_object: Generate a `new_object' statement, or a static
@@ -590,7 +602,7 @@
% to insert at the start of the argument list.
%
ml_gen_new_object(MaybeConsId, Tag, HasSecTag, MaybeCtorName, Var,
- ExtraRvals, ExtraTypes, ArgVars, ArgModes, HowToConstruct,
+ ExtraRvals, ExtraTypes, ArgVars, ArgModes, TakeAddr, HowToConstruct,
Context, Decls, Statements, !Info) :-
% Determine the variable's type and lval, the tag to use, and the types
% of the argument vars.
@@ -613,8 +625,10 @@
ml_gen_info_get_module_info(!.Info, ModuleInfo),
get_maybe_cons_id_arg_types(MaybeConsId, ArgTypes, Type,
ModuleInfo, ConsArgTypes),
- ml_gen_cons_args(ArgLvals, ArgTypes, ConsArgTypes, ArgModes,
- ModuleInfo, ArgRvals0, MLDS_ArgTypes0, !Info),
+ FirstOffset = length(ExtraRvals),
+ ml_gen_cons_args(ArgVars, ArgLvals, ArgTypes, ConsArgTypes, ArgModes,
+ FirstOffset, 1, TakeAddr, ModuleInfo, ArgRvals0, MLDS_ArgTypes0,
+ TakeAddrInfos, !Info),
% Insert the extra rvals at the start.
list__append(ExtraRvals, ArgRvals0, ArgRvals),
@@ -631,10 +645,16 @@
yes(SizeInWordsRval), MaybeCtorName, ArgRvals, MLDS_ArgTypes),
Stmt = atomic(MakeNewObject),
Statement = mlds__statement(Stmt, mlds__make_context(Context)),
- Statements = [Statement],
+
+ ml_gen_field_take_address_assigns(TakeAddrInfos, VarLval, MLDS_Type,
+ MaybeTag, Context, !.Info, FieldAssigns),
+ Statements = [Statement | FieldAssigns],
Decls = []
;
HowToConstruct = construct_statically(StaticArgs),
+ require(unify(TakeAddr, []),
+ "ml_gen_new_object: cannot take address of static object's field"),
+
% Find out the types of the constructor arguments.
ml_gen_info_get_module_info(!.Info, ModuleInfo),
get_maybe_cons_id_arg_types(MaybeConsId, ArgTypes, Type,
@@ -757,6 +777,28 @@
Statements = [Statement | Statements0]
).
+:- pred ml_gen_field_take_address_assigns(list(take_addr_info)::in,
+ mlds__lval::in, mlds__type::in, maybe(mlds__tag)::in, prog_context::in,
+ ml_gen_info::in, list(mlds__statement)::out) is det.
+
+ml_gen_field_take_address_assigns([], _, _, _, _, _, []).
+ml_gen_field_take_address_assigns([TakeAddrInfo | TakeAddrInfos],
+ CellLval, CellType, MaybeTag, Context, Info, [Assign | Assigns]) :-
+ TakeAddrInfo = take_addr_info(AddrVar, Offset, ConsArgType, FieldType),
+ % I am not sure that the types specified here are always the right ones,
+ % particularly in cases where the field whose address we are taking has
+ % a non-du type such as int or float. However, I can't think of a test case
+ % in which a predicate fills in a field of such a type after a *recursive*
+ % call, since recursive calls tend to generate values of recursive (i.e.
+ % discriminated union) types. -zs
+ SourceRval = mem_addr(field(MaybeTag, lval(CellLval),
+ offset(const(int_const(Offset))), FieldType, CellType)),
+ ml_gen_var(Info, AddrVar, AddrLval),
+ CastSourceRval = unop(cast(ptr_type(ConsArgType)), SourceRval),
+ Assign = ml_gen_assign(AddrLval, CastSourceRval, Context),
+ ml_gen_field_take_address_assigns(TakeAddrInfos, CellLval, CellType,
+ MaybeTag, Context, Info, Assigns).
+
% Return the MLDS type suitable for constructing a constant static
% ground term with the specified cons_id.
%
@@ -921,9 +963,8 @@
% type_infos and type_class_infos for existentially quantified
% types. We can get these from the ArgTypes.
- NumExtraArgs = list__length(ArgTypes) -
- list__length(ConsArgTypes0),
- ExtraArgTypes = list__take_upto(NumExtraArgs, ArgTypes),
+ NumExtraArgs = list.length(ArgTypes) - list.length(ConsArgTypes0),
+ ExtraArgTypes = list.take_upto(NumExtraArgs, ArgTypes),
ConsArgTypes = ExtraArgTypes ++ ConsArgTypes0
;
% If we didn't find a constructor definition, maybe that is because
@@ -1119,32 +1160,53 @@
),
QualifiedConsId = qual(ModuleName, module_qual, ConsId).
+:- type take_addr_info
+ ---> take_addr_info(
+ prog_var, % The variable we record the address in.
+ int, % The offset of the field
+ mlds__type, % The type of the field variable.
+ mlds__type % The type of the field, possibly
+ % after boxing.
+ ).
+
% Create a list of rvals for the arguments for a construction unification.
% For each argument which is input to the construction unification,
% we produce the corresponding lval, boxed or unboxed if needed,
% but if the argument is free, we produce a null value.
%
-:- pred ml_gen_cons_args(list(mlds__lval)::in, list(prog_type)::in,
- list(prog_type)::in, list(uni_mode)::in, module_info::in,
- list(mlds__rval)::out, list(mlds__type)::out,
+:- pred ml_gen_cons_args(list(prog_var)::in, list(mlds__lval)::in,
+ list(prog_type)::in, list(prog_type)::in, list(uni_mode)::in,
+ int::in, int::in, list(int)::in, module_info::in, list(mlds__rval)::out,
+ list(mlds__type)::out, list(take_addr_info)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_cons_args(Lvals, ArgTypes, ConsArgTypes, UniModes, ModuleInfo,
- Rvals, MLDS_Types, !Info) :-
+ml_gen_cons_args(Vars, Lvals, ArgTypes, ConsArgTypes, UniModes, FirstOffset,
+ FirstArgNum, TakeAddr, ModuleInfo, Rvals, MLDS_Types, TakeAddrInfos,
+ !Info) :-
(
- Lvals = [],
- ArgTypes = [],
- ConsArgTypes = [],
- UniModes = []
- ->
- Rvals = [],
- MLDS_Types = []
+ ml_gen_cons_args_2(Vars, Lvals, ArgTypes, ConsArgTypes, UniModes,
+ FirstOffset, FirstArgNum, TakeAddr, ModuleInfo, RvalsPrime,
+ MLDS_TypesPrime, TakeAddrInfosPrime, !Info)
+ ->
+ Rvals = RvalsPrime,
+ MLDS_Types = MLDS_TypesPrime,
+ TakeAddrInfos = TakeAddrInfosPrime
;
- Lvals = [Lval | LvalsTail],
- ArgTypes = [ArgType | ArgTypesTail],
- ConsArgTypes = [ConsArgType | ConsArgTypesTail],
- UniModes = [UniMode | UniModesTail]
- ->
+ unexpected(this_file, "ml_gen_cons_args: length mismatch")
+ ).
+
+:- pred ml_gen_cons_args_2(list(prog_var)::in, list(mlds__lval)::in,
+ list(prog_type)::in, list(prog_type)::in, list(uni_mode)::in,
+ int::in, int::in, list(int)::in, module_info::in, list(mlds__rval)::out,
+ list(mlds__type)::out, list(take_addr_info)::out,
+ ml_gen_info::in, ml_gen_info::out) is semidet.
+
+ml_gen_cons_args_2([], [], [], [], [], _FirstOffset, _FirstArgNum, _TakeAddr,
+ _ModuleInfo, [], [], [], !Info).
+ml_gen_cons_args_2([Var | Vars], [Lval | Lvals], [ArgType | ArgTypes],
+ [ConsArgType | ConsArgTypes], [UniMode | UniModes], FirstOffset,
+ CurArgNum, !.TakeAddr, ModuleInfo, [Rval | Rvals],
+ [MLDS_Type | MLDS_Types], TakeAddrInfos, !Info) :-
% Figure out the type of the field. Note that for the MLDS->C and
% MLDS->asm back-ends, we need to box floating point fields.
module_info_get_globals(ModuleInfo, Globals),
@@ -1154,28 +1216,33 @@
% Compute the value of the field.
UniMode = ((_LI - RI) -> (_LF - RF)),
- (
- ( is_dummy_argument_type(ModuleInfo, ArgType)
- ; is_dummy_argument_type(ModuleInfo, ConsArgType)
- )
- ->
- Rval = const(null(MLDS_Type))
- ;
- mode_to_arg_mode(ModuleInfo, (RI -> RF), ArgType, top_in)
+ ( !.TakeAddr = [CurArgNum | !:TakeAddr] ->
+ Rval = const(null(MLDS_Type)),
+ ml_gen_cons_args_2(Vars, Lvals, ArgTypes, ConsArgTypes, UniModes,
+ FirstOffset, CurArgNum + 1, !.TakeAddr, ModuleInfo, Rvals,
+ MLDS_Types, TakeAddrInfosTail, !Info),
+ % Whereas CurArgNum starts numbering the arguments from 1, offsets
+ % into fields start from zero. However, if FirstOffset > 0, then the
+ % cell contains FirstOffset other things (e.g. a secondary tag) before
+ % the first argument.
+ Offset = CurArgNum - 1 + FirstOffset,
+ OrigMLDS_Type = mercury_type_to_mlds_type(ModuleInfo, ConsArgType),
+ TakeAddrInfo = take_addr_info(Var, Offset, OrigMLDS_Type, MLDS_Type),
+ TakeAddrInfos = [TakeAddrInfo | TakeAddrInfosTail]
+ ;
+ (
+ mode_to_arg_mode(ModuleInfo, (RI -> RF), ArgType, top_in),
+ not is_dummy_argument_type(ModuleInfo, ArgType),
+ not is_dummy_argument_type(ModuleInfo, ConsArgType)
->
ml_gen_box_or_unbox_rval(ArgType, BoxedArgType, lval(Lval), Rval,
!Info)
;
Rval = const(null(MLDS_Type))
),
-
- % Process the remaining arguments.
- ml_gen_cons_args(LvalsTail, ArgTypesTail, ConsArgTypesTail,
- UniModesTail, ModuleInfo, Rvals1, MLDS_Types1, !Info),
- Rvals = [Rval | Rvals1],
- MLDS_Types = [MLDS_Type | MLDS_Types1]
- ;
- unexpected(this_file, "ml_gen_cons_args: length mismatch")
+ ml_gen_cons_args_2(Vars, Lvals, ArgTypes, ConsArgTypes, UniModes,
+ FirstOffset, CurArgNum + 1, !.TakeAddr, ModuleInfo, Rvals,
+ MLDS_Types, TakeAddrInfos, !Info)
).
%-----------------------------------------------------------------------------%
@@ -1198,7 +1265,6 @@
ml_gen_det_deconstruct(Var, ConsId, Args, Modes, Context, Decls, Statements,
!Info) :-
-
Decls = [],
ml_variable_type(!.Info, Var, Type),
ml_cons_id_to_tag(!.Info, ConsId, Type, Tag),
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.124
diff -u -b -r1.124 mlds.m
--- compiler/mlds.m 12 Oct 2005 01:27:51 -0000 1.124
+++ compiler/mlds.m 14 Oct 2005 12:39:16 -0000
@@ -1457,7 +1457,7 @@
field_addr :: mlds__rval,
field_field_id :: field_id,
field_type :: mlds__type,
- field_ptr_typ :: mlds__type
+ field_ptr_type :: mlds__type
)
% Values somewhere in memory.
@@ -1465,7 +1465,7 @@
; mem_ref(
% The rval should have originally come from a mem_addr rval.
- % The type is the type of the value being dereferenced
+ % The type is the type of the value being dereferenced.
mlds__rval,
mlds__type
@@ -1712,14 +1712,13 @@
%-----------------------------------------------------------------------------%
-% There is some special-case handling for arrays and foreign_types here.
-% But apart from that,
-% currently we return mlds__types that are just the same as Mercury types,
-% except that we also store the type category, so that we
-% can tell if the type is an enumeration or not, without
+% There is some special-case handling for arrays, foreign types and some
+% other types here, but apart from that, currently we return mlds__types
+% that are just the same as Mercury types, except that we also store the type
+% category, so that we can tell if the type is an enumeration or not, without
% needing to refer to the HLDS type_table.
-% XXX It might be a better idea to get rid of the mercury_type/2
-% MLDS type and instead fully convert all Mercury types to MLDS types.
+% XXX It might be a better idea to get rid of the mercury_type/2 MLDS type
+% and instead fully convert all Mercury types to MLDS types.
mercury_type_to_mlds_type(ModuleInfo, Type) = MLDSType :-
(
@@ -1728,6 +1727,13 @@
->
MLDSElemType = mercury_type_to_mlds_type(ModuleInfo, ElemType),
MLDSType = mlds__mercury_array_type(MLDSElemType)
+ ;
+ type_to_ctor_and_args(Type, TypeCtor, [RefType]),
+ TypeCtor = qualified(mercury_private_builtin_module,
+ "store_by_ref_type") - 1
+ ->
+ MLDSRefType = mercury_type_to_mlds_type(ModuleInfo, RefType),
+ MLDSType = mlds__ptr_type(MLDSRefType)
;
type_to_ctor_and_args(Type, TypeCtor, _),
module_info_get_type_table(ModuleInfo, Types),
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.175
diff -u -b -r1.175 mlds_to_c.m
--- compiler/mlds_to_c.m 5 Oct 2005 06:33:46 -0000 1.175
+++ compiler/mlds_to_c.m 14 Oct 2005 09:21:40 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1999-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.
@@ -31,32 +33,37 @@
:- import_module std_util.
% output_mlds(MLDS, MaybeRLFile, Suffix):
- % Output C code the the appropriate C file and
- % C declarations to the appropriate header file.
- % The file names are determined by the module name,
- % with the specified Suffix appended at the end.
- % (The suffix is used for debugging dumps. For normal
- % output, the suffix should be the empty string.)
+ %
+ % Output C code the the appropriate C file and C declarations to the
+ % appropriate header file. The file names are determined by the module
+ % name, with the specified Suffix appended at the end. (The suffix is used
+ % for debugging dumps. For normal output, the suffix should be the empty
+ % string.)
+ %
:- pred mlds_to_c__output_mlds(mlds::in, maybe(rl_file)::in, string::in,
io::di, io::uo) is det.
% output_header_file(MLDS, Suffix):
- % Output C declarations for the procedures (etc.) in the
- % specified MLDS module to the appropriate .mih header file.
- % See output_mlds for the meaning of Suffix.
+ %
+ % Output C declarations for the procedures (etc.) in the specified MLDS
+ % module to the appropriate .mih header file. See output_mlds for the
+ % meaning of Suffix.
+ %
:- pred mlds_to_c__output_header_file(mlds::in, string::in,
io::di, io::uo) is det.
% output_c_file(MLDS, MaybeRLFile, Suffix):
- % Output C code for the specified MLDS module to the
- % appropriate C file.
+ %
+ % Output C code for the specified MLDS module to the appropriate C file.
% See output_mlds for the meaning of Suffix.
+ %
:- pred mlds_to_c__output_c_file(mlds::in, maybe(rl_file)::in, string::in,
io::di, io::uo) is det.
- % output an MLDS context in C #line format.
- % this is useful for other foreign language interfaces such as
+ % Output an MLDS context in C #line format.
+ % This is useful for other foreign language interfaces such as
% managed extensions for C++.
+ %
:- pred mlds_to_c__output_context(mlds__context::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -77,11 +84,12 @@
:- import_module libs__options.
:- import_module mdbcomp__prim_data.
:- import_module ml_backend__ml_code_util.
- % for ml_gen_public_field_decl_flags, which is
- % used by the code that handles derived classes
+ % for ml_gen_public_field_decl_flags,
+ % which is used by the code that
+ % handles derived classes
:- import_module ml_backend__ml_type_gen. % for ml_gen_type_name
:- import_module ml_backend__ml_util.
-:- import_module ml_backend__rtti_to_mlds. % for mlds_rtti_type_name.
+:- import_module ml_backend__rtti_to_mlds.% for mlds_rtti_type_name.
:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_data.
@@ -108,13 +116,12 @@
%-----------------------------------------------------------------------------%
mlds_to_c__output_mlds(MLDS, MaybeRLFile, Suffix, !IO) :-
- % We output the source file before outputting the header,
- % since the Mmake dependencies say the header file depends
- % on the source file, and so if we wrote them out in the
- % other order this might lead to unnecessary recompilation
- % next time Mmake is run.
+ % We output the source file before outputting the header, since the Mmake
+ % dependencies say the header file depends on the source file, and so if
+ % we wrote them out in the other order, this might lead to unnecessary
+ % recompilation next time Mmake is run.
%
- % XXX at some point we should also handle output of any non-C
+ % XXX At some point we should also handle output of any non-C
% foreign code (Ada, Fortran, etc.) to appropriate files.
%
output_c_file(MLDS, MaybeRLFile, Suffix, !IO),
@@ -122,27 +129,24 @@
mlds_to_c__output_c_file(MLDS, MaybeRLFile, Suffix, !IO) :-
ModuleName = mlds__get_module_name(MLDS),
- module_name_to_file_name(ModuleName, ".c" ++ Suffix, yes, SourceFile,
- !IO),
+ module_name_to_file_name(ModuleName, ".c" ++ Suffix, yes, SourceFile, !IO),
Indent = 0,
- output_to_file(SourceFile,
- mlds_output_src_file(Indent, MLDS, MaybeRLFile), !IO).
+ output_to_file(SourceFile, mlds_output_src_file(Indent, MLDS, MaybeRLFile),
+ !IO).
- %
- % Generate the header file
+ % Generate the header file.
%
mlds_to_c__output_header_file(MLDS, Suffix, !IO) :-
- %
- % We write the header file out to <module>.mih.tmp and then
- % call `update_interface' to move the <module>.mih.tmp file to
- % <module>.mih; this avoids updating the timestamp on the `.mih'
- % file if it hasn't changed.
- %
+ % We write the header file out to <module>.mih.tmp and then call
+ % `update_interface' to move the <module>.mih.tmp file to <module>.mih;
+ % this avoids updating the timestamp on the `.mih' file if it hasn't
+ % changed.
+
ModuleName = mlds__get_module_name(MLDS),
- module_name_to_file_name(ModuleName, ".mih" ++ Suffix ++ ".tmp",
- yes, TmpHeaderFile, !IO),
- module_name_to_file_name(ModuleName, ".mih" ++ Suffix,
- yes, HeaderFile, !IO),
+ module_name_to_file_name(ModuleName, ".mih" ++ Suffix ++ ".tmp", yes,
+ TmpHeaderFile, !IO),
+ module_name_to_file_name(ModuleName, ".mih" ++ Suffix, yes,
+ HeaderFile, !IO),
Indent = 0,
output_to_file(TmpHeaderFile, mlds_output_hdr_file(Indent, MLDS), !IO),
update_interface(HeaderFile, !IO).
@@ -156,25 +160,25 @@
io__nl(!IO),
mlds_output_hdr_imports(Indent, Imports, !IO),
io__nl(!IO),
+
% Get the foreign code for C
ForeignCode = mlds_get_c_foreign_code(AllForeignCode),
mlds_output_c_hdr_decls(MLDS_ModuleName, Indent, ForeignCode, !IO),
io__nl(!IO),
+
+ % The header file must contain _definitions_ of all public types, but only
+ % _declarations_ of all public variables, constants, and functions.
%
- % The header file must contain _definitions_ of all public types,
- % but only _declarations_ of all public variables, constants,
- % and functions.
- %
- % Note that we don't forward-declare the types here; the
- % forward declarations that we need for types used in function
- % prototypes are generated by mlds_output_type_forward_decls.
- % See the comment in mlds_output_decl.
- %
+ % Note that we don't forward-declare the types here; the forward
+ % declarations that we need for types used in function prototypes
+ % are generated by mlds_output_type_forward_decls. See the comment
+ % in mlds_output_decl.
+
list__filter(defn_is_public, Defns, PublicDefns),
list__filter(defn_is_type, PublicDefns, PublicTypeDefns,
PublicNonTypeDefns),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- mlds_output_defns(Indent, MLDS_ModuleName, PublicTypeDefns, !IO),
+ mlds_output_defns(Indent, yes, MLDS_ModuleName, PublicTypeDefns, !IO),
io__nl(!IO),
mlds_output_decls(Indent, MLDS_ModuleName, PublicNonTypeDefns, !IO),
io__nl(!IO),
@@ -185,9 +189,8 @@
:- pred mlds_output_hdr_imports(indent::in, mlds__imports::in,
io::di, io::uo) is det.
-% XXX currently we assume all imports are source imports,
-% i.e. that the header file does not depend on any types
-% defined in other header files.
+% XXX currently we assume all imports are source imports, i.e. that the header
+% file does not depend on any types defined in other header files.
mlds_output_hdr_imports(_Indent, _Imports, !IO).
:- pred mlds_output_src_imports(indent::in, mlds__imports::in,
@@ -196,13 +199,13 @@
mlds_output_src_imports(Indent, Imports, !IO) :-
globals__io_get_target(Target, !IO),
( Target = asm ->
- % For --target asm, we don't create the header files
- % for modules that don't contain C code, so we'd better
- % not include them, since they might not exist.
- % XXX This is a hack; it may lead to warnings or errors
- % when compiling the generated code, since the functions
- % that we call (e.g. for `pragma export') may not have
- % been declared.
+ % For --target asm, we don't create the header files for modules that
+ % don't contain C code, so we'd better not include them, since they
+ % might not exist.
+
+ % XXX This is a hack; it may lead to warnings or errors when compiling
+ % the generated code, since the functions that we call (e.g. for
+ % `pragma export') may not have been declared.
true
;
list__foldl(mlds_output_src_import(Indent), Imports, !IO)
@@ -219,11 +222,9 @@
; ImportType = compiler_visible_interface, HeaderExt = ".mih"
),
- % Strip off the "mercury" qualifier for standard
- % library modules.
+ % Strip off the "mercury" qualifier for standard library modules.
(
- ModuleName0 = qualified(unqualified("mercury"),
- ModuleName1),
+ ModuleName0 = qualified(unqualified("mercury"), ModuleName1),
mercury_std_library_module(ModuleName1)
->
ModuleName = unqualified(ModuleName1)
@@ -232,25 +233,21 @@
)
;
Import = foreign_import(ForeignImport),
- % This case shouldn't happen when compiling to C,
- % but we need to handle it for MLDS dumps when
- % compiling to IL.
+ % This case shouldn't happen when compiling to C, but we need to handle
+ % it for MLDS dumps when compiling to IL.
ForeignImport = il_assembly_name(ImportName),
ModuleName = mlds_module_name_to_sym_name(ImportName),
HeaderExt = ".dll"
),
- module_name_to_search_file_name(ModuleName, HeaderExt, HeaderFile,
- !IO),
+ module_name_to_search_file_name(ModuleName, HeaderExt, HeaderFile, !IO),
io__write_strings(["#include """, HeaderFile, """\n"], !IO).
+ % Generate the `.c' file.
%
- % Generate the `.c' file
- %
- % (Calling it the "source" file is a bit of a misnomer,
- % since in our case it is actually the target file,
- % but there's no obvious alternative term to use which
- % also has a clear and concise abbreviation, so never mind...)
+ % (Calling it the "source" file is a bit of a misnomer, since in our case
+ % it is actually the target file, but there's no obvious alternative term
+ % to use which also has a clear and concise abbreviation, so never mind...)
%
:- pred mlds_output_src_file(indent::in, mlds::in, maybe(rl_file)::in,
io::di, io::uo) is det.
@@ -258,38 +255,34 @@
mlds_output_src_file(Indent, MLDS, MaybeRLFile, !IO) :-
MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns,
InitPreds, FinalPreds),
- %
- % Get the foreign code for C.
- %
- ForeignCode = mlds_get_c_foreign_code(AllForeignCode),
- mlds_output_src_start(Indent, ModuleName, ForeignCode, InitPreds,
- FinalPreds, !IO),
+ ForeignCode = mlds_get_c_foreign_code(AllForeignCode),
+ mlds_output_src_start(Indent, ModuleName, ForeignCode,
+ InitPreds, FinalPreds, !IO),
io__nl(!IO),
mlds_output_src_imports(Indent, Imports, !IO),
io__nl(!IO),
mlds_output_c_decls(Indent, ForeignCode, !IO),
io__nl(!IO),
- %
- % The public types have already been defined in the
- % header file, and the public vars, consts, and functions
- % have already been declared in the header file.
- % In the source file, we need to have
+
+ % The public types have already been defined in the header file, and the
+ % public vars, consts, and functions have already been declared in the
+ % header file. In the source file, we need to have
% #1. definitions of the private types,
% #2. forward-declarations of the private non-types
% #3. definitions of all the non-types
% #4. initialization functions
% in that order.
- % #2 is needed to allow #3 to contain forward references,
- % which can arise for e.g. mutually recursive procedures.
- % #1 is needed since #2 may refer to the types.
- %
- % Note that we don't forward-declare the types here; the
- % forward declarations that we need for types used in function
- % prototypes are generated by mlds_output_type_forward_decls.
- % See the comment in mlds_output_decl.
- %
+ % #2 is needed to allow #3 to contain forward references, which can arise
+ % for e.g. mutually recursive procedures. #1 is needed since #2 may refer
+ % to the types.
+ %
+ % Note that we don't forward-declare the types here; the forward
+ % declarations that we need for types used in function prototypes
+ % are generated by mlds_output_type_forward_decls. See the comment in
+ % mlds_output_decl.
+
list__filter(defn_is_public, Defns, _PublicDefns, PrivateDefns),
list__filter(defn_is_type, PrivateDefns, PrivateTypeDefns,
PrivateNonTypeDefns),
@@ -298,17 +291,17 @@
list__filter(defn_is_type_ctor_info, NonTypeDefns,
TypeCtorInfoDefns),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- mlds_output_defns(Indent, MLDS_ModuleName, PrivateTypeDefns, !IO),
+ mlds_output_defns(Indent, yes, MLDS_ModuleName, PrivateTypeDefns, !IO),
io__nl(!IO),
mlds_output_decls(Indent, MLDS_ModuleName, PrivateNonTypeDefns, !IO),
io__nl(!IO),
mlds_output_c_defns(MLDS_ModuleName, Indent, ForeignCode, !IO),
io__nl(!IO),
- mlds_output_defns(Indent, MLDS_ModuleName, NonTypeDefns, !IO),
+ mlds_output_defns(Indent, yes, MLDS_ModuleName, NonTypeDefns, !IO),
io__nl(!IO),
- mlds_output_init_fn_defns(MLDS_ModuleName, FuncDefns,
- TypeCtorInfoDefns, !IO),
+ mlds_output_init_fn_defns(MLDS_ModuleName, FuncDefns, TypeCtorInfoDefns,
+ !IO),
io__nl(!IO),
c_util__output_rl_file(ModuleName, MaybeRLFile, !IO),
io__nl(!IO),
@@ -338,11 +331,11 @@
io__write_string(MangledModuleName, !IO),
io__nl(!IO),
io__nl(!IO),
- %
- % If we're outputting C (rather than C++), then add a
- % conditional `extern "C"' wrapper around the header file,
- % so that the header file can be #included by C++ programs.
- %
+
+ % If we're outputting C (rather than C++), then add a conditional
+ % `extern "C"' wrapper around the header file, so that the header file
+ % can be #included by C++ programs.
+
globals__io_get_target(Target, !IO),
( Target = c ->
mlds_indent(Indent, !IO),
@@ -362,8 +355,8 @@
mlds__foreign_code::in, list(string)::in, list(string)::in,
io::di, io::uo) is det.
-mlds_output_src_start(Indent, ModuleName, ForeignCode, InitPreds,
- FinalPreds, !IO) :-
+mlds_output_src_start(Indent, ModuleName, ForeignCode, InitPreds, FinalPreds,
+ !IO) :-
mlds_output_auto_gen_comment(ModuleName, !IO),
mlds_indent(Indent, !IO),
io__write_string("/* :- module ", !IO),
@@ -373,24 +366,19 @@
io__write_string("/* :- implementation. */\n", !IO),
mlds_output_src_bootstrap_defines(!IO),
io__nl(!IO),
- mlds_output_init_and_final_comments(ModuleName,
- InitPreds, FinalPreds, !IO),
+ mlds_output_init_and_final_comments(ModuleName, InitPreds, FinalPreds,
+ !IO),
mlds_output_src_import(Indent,
- mercury_import(
- compiler_visible_interface,
+ mercury_import(compiler_visible_interface,
mercury_module_name_to_mlds(ModuleName)), !IO),
- %
- % If there are `:- pragma export' declarations,
- % #include the `.mh' file.
- %
+ % If there are `:- pragma export' declarations, #include the `.mh' file.
( ForeignCode = mlds__foreign_code(_, _, _, []) ->
true
;
mlds_output_src_import(Indent,
- mercury_import(
- user_visible_interface,
+ mercury_import(user_visible_interface,
mercury_module_name_to_mlds(ModuleName)), !IO)
),
io__nl(!IO).
@@ -403,10 +391,12 @@
mlds_output_init_and_final_comments(ModuleName,
UserInitPredCNames, UserFinalPredCNames, !IO) :-
- ( UserInitPredCNames = [], UserFinalPredCNames = [] ->
-
- % There's no point writing out anything if this
- % module doesn't have any module init or final preds.
+ (
+ UserInitPredCNames = [],
+ UserFinalPredCNames = []
+ ->
+ % There's no point writing out anything if this module doesn't have
+ % any module init or final preds.
true
;
io.write_string("/*\n", !IO),
@@ -448,7 +438,7 @@
mlds_output_hdr_end(Indent, ModuleName, !IO) :-
globals__io_get_target(Target, !IO),
( Target = c ->
- % terminate the `extern "C"' wrapper
+ % Terminate the `extern "C"' wrapper.
mlds_indent(Indent, !IO),
io__write_string("#ifdef __cplusplus\n", !IO),
mlds_indent(Indent, !IO),
@@ -478,9 +468,8 @@
prog_out__write_sym_name(ModuleName, !IO),
io__write_string(". */\n", !IO).
- %
- % Output a C comment saying that the file was automatically
- % generated (and giving details such as the compiler version).
+ % Output a C comment saying that the file was automatically generated
+ % (and giving details such as the compiler version).
%
:- pred mlds_output_auto_gen_comment(module_name::in, io::di, io::uo) is det.
@@ -490,11 +479,9 @@
output_c_file_intro_and_grade(SourceFileName, Version, !IO),
io__nl(!IO).
- %
- % Output a reference to the mangled grade name for the grade
- % that the C file gets compiled with. This ensures that
- % we don't try to link objects files compiled in different
- % grades.
+ % Output a reference to the mangled grade name for the grade that the C
+ % file gets compiled with. This ensures that we don't try to link objects
+ % files compiled in different grades.
%
:- pred mlds_output_grade_var(io::di, io::uo) is det.
@@ -506,26 +493,25 @@
"static const void *const MR_grade = &MR_GRADE_VAR;\n",
!IO).
+ % Get the foreign code for C.
+ %
:- func mlds_get_c_foreign_code(map(foreign_language, mlds__foreign_code))
= mlds__foreign_code.
- % Get the foreign code for C
mlds_get_c_foreign_code(AllForeignCode) = ForeignCode :-
( map__search(AllForeignCode, c, ForeignCode0) ->
ForeignCode = ForeignCode0
;
- % this can occur when compiling to a non-C target
- % using "--mlds-dump all"
+ % This can occur when compiling to a non-C target using
+ % "--mlds-dump all".
ForeignCode = foreign_code([], [], [], [])
).
%-----------------------------------------------------------------------------%
- %
% Maybe output the function `mercury__<modulename>__init()'.
- % The body of the function consists of calls
- % MR_init_entry(<function>) for each function defined in the
- % module.
+ % The body of the function consists of calls MR_init_entry(<function>)
+ % for each function defined in the module.
%
:- pred mlds_output_init_fn_decls(mlds_module_name::in, io::di, io::uo) is det.
@@ -546,10 +532,9 @@
globals__io_get_globals(Globals, !IO),
(
need_to_init_entries(Globals),
- FuncDefns \= []
+ FuncDefns = [_ | _]
->
- io__write_strings(
- ["\tstatic MR_bool initialised = MR_FALSE;\n",
+ io__write_strings(["\tstatic MR_bool initialised = MR_FALSE;\n",
"\tif (initialised) return;\n",
"\tinitialised = MR_TRUE;\n\n"], !IO),
mlds_output_calls_to_init_entry(ModuleName, FuncDefns, !IO)
@@ -561,16 +546,13 @@
output_init_fn_name(ModuleName, "_type_tables", !IO),
io__write_string("\n{\n", !IO),
(
- TypeCtorInfoDefns \= []
- ->
- io__write_strings(
- ["\tstatic MR_bool initialised = MR_FALSE;\n",
+ TypeCtorInfoDefns = [_ | _],
+ io__write_strings(["\tstatic MR_bool initialised = MR_FALSE;\n",
"\tif (initialised) return;\n",
"\tinitialised = MR_TRUE;\n\n"], !IO),
- mlds_output_calls_to_register_tci(ModuleName,
- TypeCtorInfoDefns, !IO)
+ mlds_output_calls_to_register_tci(ModuleName, TypeCtorInfoDefns, !IO)
;
- true
+ TypeCtorInfoDefns = []
),
io__write_string("}\n\n", !IO),
@@ -584,16 +566,14 @@
io::di, io::uo) is det.
output_init_fn_name(ModuleName, Suffix, !IO) :-
- % Here we ensure that we only get one "mercury__" at the
- % start of the function name.
- mdbcomp__prim_data__sym_name_to_string(
- mlds_module_name_to_sym_name(ModuleName), "__",
+ % Here we ensure that we only get one "mercury__" at the start
+ % of the function name.
+ sym_name_to_string(mlds_module_name_to_sym_name(ModuleName), "__",
ModuleNameString0),
( string__prefix(ModuleNameString0, "mercury__") ->
ModuleNameString = ModuleNameString0
;
- string__append("mercury__", ModuleNameString0,
- ModuleNameString)
+ ModuleNameString = "mercury__" ++ ModuleNameString0
),
io__write_string("void ", !IO),
io__write_string(ModuleNameString, !IO),
@@ -604,10 +584,10 @@
:- pred need_to_init_entries(globals::in) is semidet.
need_to_init_entries(Globals) :-
- % We only need to output calls to MR_init_entry() if profiling is
- % enabled. (It would be OK to output the calls regardless, since
- % they will macro-expand to nothing if profiling is not enabled,
- % but for readability of the generated code we prefer not to.)
+ % We only need to output calls to MR_init_entry() if profiling is enabled.
+ % (It would be OK to output the calls regardless, since they will
+ % macro-expand to nothing if profiling is not enabled, but for readability
+ % of the generated code we prefer not to.)
( Option = profile_calls
; Option = profile_time
; Option = profile_memory
@@ -623,8 +603,8 @@
mlds_output_calls_to_init_entry(ModuleName, [FuncDefn | FuncDefns], !IO) :-
FuncDefn = mlds__defn(EntityName, _, _, _),
io__write_string("\tMR_init_entry(", !IO),
- mlds_output_fully_qualified_name(
- qual(ModuleName, module_qual, EntityName), !IO),
+ mlds_output_fully_qualified_name(qual(ModuleName, module_qual, EntityName),
+ !IO),
io__write_string(");\n", !IO),
mlds_output_calls_to_init_entry(ModuleName, FuncDefns, !IO).
@@ -639,8 +619,8 @@
[TypeCtorInfoDefn | TypeCtorInfoDefns], !IO) :-
TypeCtorInfoDefn = mlds__defn(EntityName, _, _, _),
io__write_string("\tMR_register_type_ctor_info(&", !IO),
- mlds_output_fully_qualified_name(
- qual(ModuleName, module_qual, EntityName), !IO),
+ mlds_output_fully_qualified_name(qual(ModuleName, module_qual, EntityName),
+ !IO),
io__write_string(");\n", !IO),
mlds_output_calls_to_register_tci(ModuleName, TypeCtorInfoDefns, !IO).
@@ -662,11 +642,10 @@
SymName = mlds_module_name_to_sym_name(ModuleName)
),
DeclGuard = decl_guard(SymName),
- io__write_strings(["#ifndef ", DeclGuard,
- "\n#define ", DeclGuard, "\n"], !IO),
- io__write_list(HeaderCode, "\n",
- mlds_output_c_hdr_decl(Indent, yes(foreign_decl_is_exported)),
+ io__write_strings(["#ifndef ", DeclGuard, "\n#define ", DeclGuard, "\n"],
!IO),
+ io__write_list(HeaderCode, "\n",
+ mlds_output_c_hdr_decl(Indent, yes(foreign_decl_is_exported)), !IO),
io__write_string("\n#endif\n", !IO).
:- pred mlds_output_c_hdr_decl(indent::in, maybe(foreign_decl_is_local)::in,
@@ -684,8 +663,7 @@
IsLocal = DesiredIsLocal
)
->
- mlds_to_c__output_context(mlds__make_context(Context),
- !IO),
+ mlds_to_c__output_context(mlds__make_context(Context), !IO),
io__write_string(Code, !IO)
;
true
@@ -702,8 +680,7 @@
_RevBodyCode, _ExportDefns),
HeaderCode = list__reverse(RevHeaderCode),
io__write_list(HeaderCode, "\n",
- mlds_output_c_hdr_decl(Indent, yes(foreign_decl_is_local)),
- !IO).
+ mlds_output_c_hdr_decl(Indent, yes(foreign_decl_is_local)), !IO).
:- pred mlds_output_c_defns(mlds_module_name::in, indent::in,
mlds__foreign_code::in, io::di, io::uo) is det.
@@ -753,22 +730,20 @@
mlds_output_pragma_export_defn(ModuleName, Indent, PragmaExport, !IO) :-
PragmaExport = ml_pragma_export(_C_name, MLDS_Name, MLDS_Signature,
Context),
- mlds_output_pragma_export_func_name(ModuleName, Indent, PragmaExport,
- !IO),
+ mlds_output_pragma_export_func_name(ModuleName, Indent, PragmaExport, !IO),
io__write_string("\n", !IO),
mlds_indent(Context, Indent, !IO),
io__write_string("{\n", !IO),
mlds_indent(Context, Indent, !IO),
- mlds_output_pragma_export_defn_body(ModuleName, MLDS_Name,
- MLDS_Signature, !IO),
+ mlds_output_pragma_export_defn_body(ModuleName, MLDS_Name, MLDS_Signature,
+ !IO),
io__write_string("}\n", !IO).
:- pred mlds_output_pragma_export_func_name(mlds_module_name::in, indent::in,
mlds__pragma_export::in, io::di, io::uo) is det.
-mlds_output_pragma_export_func_name(ModuleName, Indent,
- ml_pragma_export(C_name, _MLDS_Name, Signature, Context),
- !IO) :-
+mlds_output_pragma_export_func_name(ModuleName, Indent, Export, !IO) :-
+ Export = ml_pragma_export(C_name, _MLDS_Name, Signature, Context),
Name = qual(ModuleName, module_qual, export(C_name)),
mlds_indent(Context, Indent, !IO),
% For functions exported using `pragma export',
@@ -785,7 +760,9 @@
mlds_output_pragma_export_type(prefix, Type, !IO),
mlds_output_pragma_export_type(suffix, Type, !IO).
-:- type locn ---> prefix ; suffix.
+:- type locn
+ ---> prefix
+ ; suffix.
:- pred mlds_output_pragma_export_type(locn::in, mlds__type::in,
io::di, io::uo) is det.
@@ -808,14 +785,15 @@
mlds_output_pragma_export_type(prefix, mlds__native_char_type, !IO) :-
io__write_string("MR_Char", !IO).
mlds_output_pragma_export_type(prefix, mlds__foreign_type(ForeignType), !IO) :-
- ( ForeignType = c(c(Name)),
+ (
+ ForeignType = c(c(Name)),
io__write_string(Name, !IO)
- ; ForeignType = il(_),
- unexpected(this_file,
- "mlds_output_type_prefix: il foreign_type")
- ; ForeignType = java(_),
- unexpected(this_file,
- "mlds_output_type_prefix: java foreign_type")
+ ;
+ ForeignType = il(_),
+ unexpected(this_file, "mlds_output_type_prefix: il foreign_type")
+ ;
+ ForeignType = java(_),
+ unexpected(this_file, "mlds_output_type_prefix: java foreign_type")
).
mlds_output_pragma_export_type(prefix, mlds__class_type(_, _, _), !IO) :-
io__write_string("MR_Word", !IO).
@@ -839,7 +817,6 @@
mlds_output_pragma_export_type(prefix, mlds__unknown_type, !IO) :-
unexpected(this_file, "mlds_output_pragma_export_type: unknown_type").
- %
% Output the definition body for a pragma export
%
:- pred mlds_output_pragma_export_defn_body(mlds_module_name::in,
@@ -850,7 +827,7 @@
Signature = mlds__func_params(Parameters, RetTypes),
% Declare local variables corresponding to any foreign_type
- % parameters
+ % parameters.
IsCForeignType = (pred(Arg::in) is semidet :-
Arg = mlds__argument(_Name, Type, _GCTraceCode),
Type = mlds__foreign_type(c(_))),
@@ -892,8 +869,7 @@
% is being exported
( RetTypes = [] ->
io__write_string("\t", !IO),
- mlds_output_pragma_export_call(ModuleName, FuncName,
- Parameters, !IO)
+ mlds_output_pragma_export_call(ModuleName, FuncName, Parameters, !IO)
; RetTypes = [RetType2] ->
( RetType2 = mlds__foreign_type(c(_)) ->
io__write_string("\tboxed_ret_value = ", !IO)
@@ -902,15 +878,13 @@
mlds_output_pragma_export_type(RetType2, !IO),
io__write_string(")", !IO)
),
- mlds_output_pragma_export_call(ModuleName, FuncName,
- Parameters, !IO)
+ mlds_output_pragma_export_call(ModuleName, FuncName, Parameters, !IO)
;
% This is just for MLDS dumps when compiling to non-C targets.
% So we don't need to worry about boxing/unboxing foreign types
% here.
io__write_string("\treturn (", !IO),
- mlds_output_return_list(RetTypes,
- mlds_output_pragma_export_type, !IO),
+ mlds_output_return_list(RetTypes, mlds_output_pragma_export_type, !IO),
io__write_string(") ", !IO)
),
@@ -923,11 +897,9 @@
% return value, if needed.
( RetTypes = [RetType3] ->
( RetType3 = mlds__foreign_type(c(_)) ->
- io__write_string("\tMR_MAYBE_UNBOX_FOREIGN_TYPE(",
- !IO),
+ io__write_string("\tMR_MAYBE_UNBOX_FOREIGN_TYPE(", !IO),
mlds_output_pragma_export_type(RetType3, !IO),
- io__write_string(", boxed_ret_value, ret_value);\n",
- !IO)
+ io__write_string(", boxed_ret_value, ret_value);\n", !IO)
;
true
),
@@ -972,8 +944,7 @@
mlds_output_pragma_export_input_defns(ModuleName, Arg, !IO) :-
Arg = mlds__argument(Name, Type, _GC_TraceCode),
io__write_string("\t", !IO),
- mlds_output_data_decl_ho(mlds_output_type_prefix,
- mlds_output_type_suffix,
+ mlds_output_data_decl_ho(mlds_output_type_prefix, mlds_output_type_suffix,
qual(ModuleName, module_qual, boxed_name(Name)), Type, !IO),
io__write_string(";\n", !IO).
@@ -983,10 +954,8 @@
mlds_output_pragma_export_output_defns(ModuleName, Arg, !IO) :-
Arg = mlds__argument(Name, Type, _GC_TraceCode),
io__write_string("\t", !IO),
- mlds_output_data_decl_ho(mlds_output_type_prefix,
- mlds_output_type_suffix,
- qual(ModuleName, module_qual, boxed_name(Name)),
- pointed_to_type(Type),
+ mlds_output_data_decl_ho(mlds_output_type_prefix, mlds_output_type_suffix,
+ qual(ModuleName, module_qual, boxed_name(Name)), pointed_to_type(Type),
!IO),
io__write_string(";\n", !IO).
@@ -1015,11 +984,10 @@
mlds_output_pragma_export_call(ModuleName, FuncName, Parameters, !IO) :-
mlds_output_fully_qualified_name(FuncName, !IO),
io__write_string("(", !IO),
- io__write_list(Parameters, ", ",
- mlds_output_pragma_export_arg(ModuleName), !IO),
+ io__write_list(Parameters, ", ", mlds_output_pragma_export_arg(ModuleName),
+ !IO),
io__write_string(");\n", !IO).
- %
% Output a fully qualified name preceded by a cast.
%
:- pred mlds_output_pragma_export_arg(mlds_module_name::in, mlds__argument::in,
@@ -1028,8 +996,7 @@
mlds_output_pragma_export_arg(ModuleName, Arg, !IO) :-
Arg = mlds__argument(Name, Type, _GC_TraceCode),
( Type = mlds__foreign_type(c(_)) ->
- % This is a foreign_type input. Pass in the already-boxed
- % value.
+ % This is a foreign_type input. Pass in the already-boxed value.
BoxedName = boxed_name(Name),
mlds_output_fully_qualified_name(
qual(ModuleName, module_qual, BoxedName), !IO)
@@ -1044,11 +1011,10 @@
% Otherwise, no boxing or unboxing is needed.
% Just cast the argument to the right type.
mlds_output_cast(Type, !IO),
- mlds_output_fully_qualified_name(
- qual(ModuleName, module_qual, Name), !IO)
+ mlds_output_fully_qualified_name(qual(ModuleName, module_qual, Name),
+ !IO)
).
- %
% Generates the signature for det functions in the forward mode.
%
:- func det_func_signature(mlds__func_params) = mlds__func_params.
@@ -1083,22 +1049,22 @@
mlds_output_decls(Indent, ModuleName, Defns, !IO) :-
list__foldl(mlds_output_decl(Indent, ModuleName), Defns, !IO).
-:- pred mlds_output_defns(indent::in, mlds_module_name::in, mlds__defns::in,
- io::di, io::uo) is det.
+:- pred mlds_output_defns(indent::in, bool::in, mlds_module_name::in,
+ mlds__defns::in, io::di, io::uo) is det.
-mlds_output_defns(Indent, ModuleName, Defns, !IO) :-
- OutputDefn = mlds_output_defn(Indent, ModuleName),
+mlds_output_defns(Indent, Separate, ModuleName, Defns, !IO) :-
+ OutputDefn = mlds_output_defn(Indent, Separate, ModuleName),
globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels, !IO),
- ( GCC_LocalLabels = yes ->
- %
- % GNU C __label__ declarations must precede
- % ordinary variable declarations.
- %
- list__filter(defn_is_commit_type_var, Defns, LabelDecls,
- OtherDefns),
+ (
+ GCC_LocalLabels = yes,
+ % GNU C __label__ declarations must precede ordinary variable
+ % declarations.
+
+ list__filter(defn_is_commit_type_var, Defns, LabelDecls, OtherDefns),
list__foldl(OutputDefn, LabelDecls, !IO),
list__foldl(OutputDefn, OtherDefns, !IO)
;
+ GCC_LocalLabels = no,
list__foldl(OutputDefn, Defns, !IO)
).
@@ -1108,38 +1074,30 @@
mlds_output_decl(Indent, ModuleName, Defn, !IO) :-
Defn = mlds__defn(Name, Context, Flags, DefnBody),
(
- %
- % ANSI C does not permit forward declarations
- % of enumeration types. So we just skip those.
- % Currently they're not needed since we don't
+ % ANSI C does not permit forward declarations of enumeration types.
+ % So we just skip those. Currently they're not needed since we don't
% actually use the enum types.
- %
+
DefnBody = mlds__class(ClassDefn),
- ClassDefn^kind = mlds__enum
+ ClassDefn ^ kind = mlds__enum
->
true
;
- %
- % If we're using --high-level-data, then
- % for function declarations, we need to ensure
- % that we forward-declare any types used in
- % the function parameters. This is because
- % otherwise, for any struct names whose first
- % occurence is in the function parameters,
- % the scope of such struct names is just that
- % function declaration, which is never right.
- %
- % We generate such forward declarations here,
- % rather than generating type declarations in a
- % header file and #including that header file,
- % because doing the latter would significantly
- % complicate the dependencies (to avoid cyclic
- % #includes, you'd need to generate the type
- % declarations in a different header file than
- % the function declarations).
- %
- globals__io_lookup_bool_option(highlevel_data, HighLevelData,
- !IO),
+ % If we're using --high-level-data, then for function declarations,
+ % we need to ensure that we forward-declare any types used in the
+ % function parameters. This is because otherwise, for any struct names
+ % whose first occurence is in the function parameters, the scope of
+ % such struct names is just that function declaration, which is never
+ % right.
+ %
+ % We generate such forward declarations here, rather than generating
+ % type declarations in a header file and #including that header file,
+ % because doing the latter would significantly complicate the
+ % dependencies (to avoid cyclic #includes, you'd need to generate
+ % the type declarations in a different header file than the function
+ % declarations).
+
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData, !IO),
(
HighLevelData = yes,
DefnBody = mlds__function(_, Params, _, _)
@@ -1150,31 +1108,28 @@
;
true
),
- %
+
% Now output the declaration for this mlds__defn.
- %
mlds_indent(Context, Indent, !IO),
- mlds_output_decl_flags(Flags, forward_decl, Name, DefnBody,
- !IO),
- mlds_output_decl_body(Indent,
- qual(ModuleName, module_qual, Name), Context,
- DefnBody, !IO)
+ mlds_output_decl_flags(Flags, forward_decl, Name, DefnBody, !IO),
+ mlds_output_decl_body(Indent, qual(ModuleName, module_qual, Name),
+ Context, DefnBody, !IO)
).
:- pred mlds_output_type_forward_decls(indent::in, list(mlds__type)::in,
io::di, io::uo) is det.
mlds_output_type_forward_decls(Indent, ParamTypes, !IO) :-
- %
% Output forward declarations for all struct types
% that are contained in the parameter types.
- %
+
aggregate(mlds_type_list_contains_type(ParamTypes),
mlds_output_type_forward_decl(Indent), !IO).
% mlds_type_list_contains_type(Types, SubType):
- % True iff the type SubType occurs (directly or indirectly)
- % in the specified list of Types.
+ %
+ % True iff the type SubType occurs (directly or indirectly) in the
+ % specified list of Types.
%
:- pred mlds_type_list_contains_type(list(mlds__type)::in, mlds__type::out)
is nondet.
@@ -1184,6 +1139,7 @@
mlds_type_contains_type(Type, SubType).
% mlds_type_contains_type(Type, SubType):
+ %
% True iff the type Type contains the type SubType.
%
:- pred mlds_type_contains_type(mlds__type::in, mlds__type::out) is multi.
@@ -1209,11 +1165,9 @@
ClassType = Type
;
Type = mercury_type(MercuryType, user_ctor_type, _),
- type_to_ctor_and_args(MercuryType, TypeCtor,
- _ArgsTypes),
+ type_to_ctor_and_args(MercuryType, TypeCtor, _ArgsTypes),
ml_gen_type_name(TypeCtor, ClassName, ClassArity),
- ClassType = mlds__class_type(ClassName, ClassArity,
- mlds__class)
+ ClassType = mlds__class_type(ClassName, ClassArity, mlds__class)
)
->
mlds_indent(Indent, !IO),
@@ -1223,13 +1177,15 @@
true
).
-:- pred mlds_output_defn(indent::in, mlds_module_name::in, mlds__defn::in,
- io::di, io::uo) is det.
+:- pred mlds_output_defn(indent::in, bool::in, mlds_module_name::in,
+ mlds__defn::in, io::di, io::uo) is det.
-mlds_output_defn(Indent, ModuleName, Defn, !IO) :-
+mlds_output_defn(Indent, Separate, ModuleName, Defn, !IO) :-
Defn = mlds__defn(Name, Context, Flags, DefnBody),
( DefnBody \= mlds__data(_, _, _) ->
io__nl(!IO)
+ ; Separate = yes ->
+ io__nl(!IO)
;
true
),
@@ -1244,13 +1200,12 @@
mlds_output_decl_body(Indent, Name, Context, DefnBody, !IO) :-
(
DefnBody = mlds__data(Type, Initializer, _GC_TraceCode),
- mlds_output_data_decl(Name, Type,
- initializer_array_size(Initializer), !IO)
+ mlds_output_data_decl(Name, Type, initializer_array_size(Initializer),
+ !IO)
;
DefnBody = mlds__function(MaybePredProcId, Signature,
_MaybeBody, _Attrs),
- mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id,
- !IO),
+ mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id, !IO),
mlds_output_func_decl(Indent, Name, Context, Signature, !IO)
;
DefnBody = mlds__class(ClassDefn),
@@ -1263,18 +1218,15 @@
mlds_output_defn_body(Indent, Name, Context, DefnBody, !IO) :-
(
- DefnBody = mlds__data(Type, Initializer,
- Maybe_GC_TraceCode),
+ DefnBody = mlds__data(Type, Initializer, Maybe_GC_TraceCode),
mlds_output_data_defn(Name, Type, Initializer, !IO),
- mlds_output_maybe_gc_trace_code(Indent, Name,
- Maybe_GC_TraceCode, "", !IO)
+ mlds_output_maybe_gc_trace_code(Indent, Name, Maybe_GC_TraceCode, "",
+ !IO)
;
DefnBody = mlds__function(MaybePredProcId, Signature,
MaybeBody, _Attributes),
- mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id,
- !IO),
- mlds_output_func(Indent, Name, Context, Signature, MaybeBody,
- !IO)
+ mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id, !IO),
+ mlds_output_func(Indent, Name, Context, Signature, MaybeBody, !IO)
;
DefnBody = mlds__class(ClassDefn),
mlds_output_class(Indent, Name, Context, ClassDefn, !IO)
@@ -1284,17 +1236,16 @@
mlds__qualified_entity_name::in, maybe(mlds__statement)::in,
string::in, io::di, io::uo) is det.
-mlds_output_maybe_gc_trace_code(Indent, Name, Maybe_GC_TraceCode,
- MaybeNewLine, !IO) :-
+mlds_output_maybe_gc_trace_code(Indent, Name, Maybe_GC_TraceCode, MaybeNewLine,
+ !IO) :-
(
Maybe_GC_TraceCode = no
;
Maybe_GC_TraceCode = yes(GC_TraceCode),
io__write_string(MaybeNewLine, !IO),
io__write_string("#if 0 /* GC trace code */\n", !IO),
- % XXX this value for FuncInfo is bogus
- % However, this output is only for debugging anyway,
- % so it doesn't really matter.
+ % XXX This value for FuncInfo is bogus. However, this output is only
+ % for debugging anyway, so it doesn't really matter.
FuncInfo = func_info(Name, mlds__func_signature([], [])),
mlds_output_statement(Indent, FuncInfo, GC_TraceCode, !IO),
io__write_string("#endif\n", !IO)
@@ -1323,14 +1274,12 @@
mlds__context::in, mlds__class_defn::in, io::di, io::uo) is det.
mlds_output_class(Indent, Name, Context, ClassDefn, !IO) :-
- %
- % To avoid name clashes, we need to qualify the names of
- % the member constants with the class name.
- % (In particular, this is needed for enumeration constants
- % and for the nested classes that we generate for constructors
- % of discriminated union types.)
- % Here we compute the appropriate qualifier.
- %
+ % To avoid name clashes, we need to qualify the names of the member
+ % constants with the class name. (In particular, this is needed for
+ % enumeration constants and for the nested classes that we generate for
+ % constructors of discriminated union types.) Here we compute the
+ % appropriate qualifier.
+
Name = qual(ModuleName, QualKind, UnqualName),
( UnqualName = type(ClassName, ClassArity) ->
globals__io_get_globals(Globals, !IO),
@@ -1340,13 +1289,12 @@
error("mlds_output_enum_constants")
),
- %
% Hoist out static members, since plain old C doesn't support
% static members in structs (except for enumeration constants).
%
% XXX this should be conditional: only when compiling to C,
% not when compiling to C++
- %
+
ClassDefn = class_defn(Kind, _Imports, BaseClasses, _Implements,
Ctors, Members),
@@ -1356,48 +1304,45 @@
StaticMembers = [],
StructMembers = AllMembers
;
- list__filter(is_static_member, AllMembers, StaticMembers,
- NonStaticMembers),
+ list__filter(is_static_member, AllMembers,
+ StaticMembers, NonStaticMembers),
StructMembers = NonStaticMembers
),
- %
% Convert the base classes into member variables,
% since plain old C doesn't support base classes.
%
% XXX this should be conditional: only when compiling to C,
% not when compiling to C++
- %
+
list__map_foldl(mlds_make_base_class(Context), BaseClasses, BaseDefns,
1, _),
list__append(BaseDefns, StructMembers, BasesAndMembers),
- %
% Output the class declaration and the class members.
% We treat enumerations specially.
%
- % Note that standard ANSI/ISO C does not allow empty structs.
- % We could handle empty structs here, by adding a dummy member,
- % but that would waste a lot of space, and would also
- % cause incompatibilities between the data layout for
- % --high-level-data and --no-high-level-data. So instead,
- % we make it is the responsibility of the MLDS code generator
+ % Note that standard ANSI/ISO C does not allow empty structs. We could
+ % handle empty structs here, by adding a dummy member, but that would
+ % waste a lot of space, and would also cause incompatibilities between
+ % the data layout for --high-level-data and --no-high-level-data.
+ % So instead, we make it is the responsibility of the MLDS code generator
% to not generate any. (E.g. ml_type_gen.m checks whether
- % `target_uses_empty_base_classes' before generating empty
- % structs.) Hence we don't need to check for empty structs here.
- %
+ % `target_uses_empty_base_classes' before generating empty structs.)
+ % Hence we don't need to check for empty structs here.
+
mlds_output_class_decl(Indent, Name, ClassDefn, !IO),
io__write_string(" {\n", !IO),
( Kind = mlds__enum ->
mlds_output_enum_constants(Indent + 1, ClassModuleName,
BasesAndMembers, !IO)
;
- mlds_output_defns(Indent + 1, ClassModuleName,
+ mlds_output_defns(Indent + 1, no, ClassModuleName,
BasesAndMembers, !IO)
),
mlds_indent(Context, Indent, !IO),
io__write_string("};\n", !IO),
- mlds_output_defns(Indent, ClassModuleName, StaticMembers, !IO).
+ mlds_output_defns(Indent, yes, ClassModuleName, StaticMembers, !IO).
:- pred is_static_member(mlds__defn::in) is semidet.
@@ -1414,8 +1359,7 @@
mlds__defn::out, int::in, int::out) is det.
mlds_make_base_class(Context, ClassId, MLDS_Defn, BaseNum0, BaseNum) :-
- BaseName = mlds__var_name(string__format("base_%d", [i(BaseNum0)]),
- no),
+ BaseName = mlds__var_name(string__format("base_%d", [i(BaseNum0)]), no),
Type = ClassId,
% We only need GC tracing code for top-level variables,
% not for base classes.
@@ -1432,10 +1376,8 @@
mlds__defns::in, io::di, io::uo) is det.
mlds_output_enum_constants(Indent, EnumModuleName, Members, !IO) :-
- %
% Select the enumeration constants from the list of members
% for this enumeration type, and output them.
- %
EnumConsts = list__filter(is_enum_const, Members),
io__write_list(EnumConsts, ",\n",
mlds_output_enum_constant(Indent, EnumModuleName), !IO),
@@ -1457,9 +1399,7 @@
mlds_output_enum_constant(Indent, EnumModuleName, Defn, !IO) :-
Defn = mlds__defn(Name, Context, _Flags, DefnBody),
- (
- DefnBody = data(Type, Initializer, _GC_TraceCode)
- ->
+ ( DefnBody = data(Type, Initializer, _GC_TraceCode) ->
mlds_indent(Context, Indent, !IO),
mlds_output_fully_qualified_name(
qual(EnumModuleName, type_qual, Name), !IO),
@@ -1478,8 +1418,7 @@
mlds_output_data_decl(Name, Type, InitializerSize, !IO) :-
mlds_output_data_decl_ho(mlds_output_type_prefix,
- mlds_output_data_decl_2(InitializerSize),
- Name, Type, !IO).
+ mlds_output_data_decl_2(InitializerSize), Name, Type, !IO).
:- pred mlds_output_data_decl_2(initializer_array_size::in, mlds__type::in,
io::di, io::uo) is det.
@@ -1510,10 +1449,11 @@
pred(T, io, io)::in(pred(in, di, uo) is det), io::di, io::uo) is det.
mlds_output_maybe(MaybeValue, OutputAction, !IO) :-
- ( MaybeValue = yes(Value) ->
+ (
+ MaybeValue = yes(Value),
OutputAction(Value, !IO)
;
- true
+ MaybeValue = no
).
:- pred mlds_output_initializer(mlds__type::in, mlds__initializer::in,
@@ -1522,7 +1462,7 @@
mlds_output_initializer(_Type, Initializer, !IO) :-
( mlds_needs_initialization(Initializer) = yes ->
io__write_string(" = ", !IO),
- mlds_output_initializer_body(Initializer, !IO)
+ mlds_output_initializer_body(0, Initializer, !IO)
;
true
).
@@ -1535,38 +1475,41 @@
mlds_needs_initialization(init_struct(_Type, [_|_])) = yes.
mlds_needs_initialization(init_array(_)) = yes.
-:- pred mlds_output_initializer_body(mlds__initializer::in,
+:- pred mlds_output_initializer_body(int::in, mlds__initializer::in,
io::di, io::uo) is det.
-mlds_output_initializer_body(no_initializer, !IO).
-mlds_output_initializer_body(init_obj(Rval), !IO) :-
+mlds_output_initializer_body(_, no_initializer, !IO).
+mlds_output_initializer_body(Indent, init_obj(Rval), !IO) :-
+ mlds_indent(Indent, !IO),
mlds_output_rval(Rval, !IO).
-mlds_output_initializer_body(init_struct(_Type, FieldInits), !IO) :-
- % Note that standard ANSI/ISO C does not allow empty structs.
- % But it is the responsibility of the MLDS code generator
- % to not generate any. So we don't need to handle empty
- % initializers specially here.
- io__write_string("{\n\t\t", !IO),
- io__write_list(FieldInits, ",\n\t\t", mlds_output_initializer_body,
+mlds_output_initializer_body(Indent, init_struct(_Type, FieldInits), !IO) :-
+ % Note that standard ANSI/ISO C does not allow empty structs. But it is
+ % the responsibility of the MLDS code generator to not generate any.
+ % So we don't need to handle empty initializers specially here.
+ mlds_indent(Indent, !IO),
+ io__write_string("{\n", !IO),
+ io__write_list(FieldInits, ",\n", mlds_output_initializer_body(Indent + 1),
!IO),
io__write_string("}", !IO).
-mlds_output_initializer_body(init_array(ElementInits), !IO) :-
- io__write_string("{\n\t\t", !IO),
+mlds_output_initializer_body(Indent, init_array(ElementInits), !IO) :-
% Standard ANSI/ISO C does not allow empty arrays. But the MLDS does.
- % To keep the C compiler happy, we therefore convert zero-element
- % MLDS arrays into one-element C arrays. (The extra element is
- % a minor waste of space, but it will otherwise be ignored.)
- % So if the initializer list here is empty, we need to output
- % a single initializer. We can initialize the extra element
- % with any value; we use "0", since that is a valid initializer
- % for any type.
- ( ElementInits = [] ->
+ % To keep the C compiler happy, we therefore convert zero-element MLDS
+ % arrays into one-element C arrays. (The extra element is a minor waste
+ % of space, but it will otherwise be ignored.) So if the initializer list
+ % here is empty, we need to output a single initializer. We can initialize
+ % the extra element with any value; we use "0", since that is a valid
+ % initializer for any type.
+ io__write_string("{\n", !IO),
+ (
+ ElementInits = [],
+ mlds_indent(Indent, !IO),
io__write_string("0", !IO)
;
- io__write_list(ElementInits,
- ",\n\t\t", mlds_output_initializer_body, !IO)
+ ElementInits = [_ | _],
+ io__write_list(ElementInits, ",\n",
+ mlds_output_initializer_body(Indent + 1), !IO)
),
- io__write_string("}", !IO).
+ io__write_string(" }", !IO).
%-----------------------------------------------------------------------------%
%
@@ -1577,7 +1520,8 @@
mlds_output_pred_proc_id(proc(PredId, ProcId), !IO) :-
globals__io_lookup_bool_option(auto_comments, AddComments, !IO),
- ( AddComments = yes ->
+ (
+ AddComments = yes,
io__write_string("/* pred_id: ", !IO),
pred_id_to_int(PredId, PredIdNum),
io__write_int(PredIdNum, !IO),
@@ -1586,7 +1530,7 @@
io__write_int(ProcIdNum, !IO),
io__write_string(" */\n", !IO)
;
- true
+ AddComments = no
).
:- pred mlds_output_func(indent::in, qualified_entity_name::in,
@@ -1605,8 +1549,7 @@
mlds_indent(Context, Indent, !IO),
io__write_string("{\n", !IO),
- mlds_maybe_output_time_profile_instr(Context, Indent + 1, Name,
- !IO),
+ mlds_maybe_output_time_profile_instr(Context, Indent + 1, Name, !IO),
Signature = mlds__get_func_signature(Params),
FuncInfo = func_info(Name, Signature),
@@ -1630,18 +1573,19 @@
output_type::in(output_type), output_type::in(output_type),
io::di, io::uo) is det.
-mlds_output_func_decl_ho(Indent, QualifiedName, Context,
- CallingConvention, Signature, OutputPrefix, OutputSuffix,
- !IO) :-
+mlds_output_func_decl_ho(Indent, QualifiedName, Context, CallingConvention,
+ Signature, OutputPrefix, OutputSuffix, !IO) :-
Signature = mlds__func_params(Parameters, RetTypes),
- ( RetTypes = [] ->
+ (
+ RetTypes = [],
io__write_string("void", !IO)
- ; RetTypes = [RetType] ->
+ ;
+ RetTypes = [RetType],
OutputPrefix(RetType, !IO)
;
+ RetTypes = [_, _ | _],
mlds_output_return_list(RetTypes,
- mlds_output_prefix_suffix(OutputPrefix, OutputSuffix),
- !IO)
+ mlds_output_prefix_suffix(OutputPrefix, OutputSuffix), !IO)
),
io__write_char(' ', !IO),
io__write_string(CallingConvention, !IO),
@@ -1669,9 +1613,11 @@
mlds_output_params(OutputPrefix, OutputSuffix, Indent, ModuleName,
Context, Parameters, !IO) :-
io__write_char('(', !IO),
- ( Parameters = [] ->
+ (
+ Parameters = [],
io__write_string("void", !IO)
;
+ Parameters = [_ | _],
io__nl(!IO),
io__write_list(Parameters, ",\n",
mlds_output_param(OutputPrefix, OutputSuffix,
@@ -1688,8 +1634,7 @@
Arg = mlds__argument(Name, Type, Maybe_GC_TraceCode),
QualName = qual(ModuleName, module_qual, Name),
mlds_indent(Context, Indent, !IO),
- mlds_output_data_decl_ho(OutputPrefix, OutputSuffix, QualName, Type,
- !IO),
+ mlds_output_data_decl_ho(OutputPrefix, OutputSuffix, QualName, Type, !IO),
mlds_output_maybe_gc_trace_code(Indent, QualName, Maybe_GC_TraceCode,
"\n", !IO).
@@ -1697,16 +1642,19 @@
mlds_output_func_type_prefix(Params, !IO) :-
Params = mlds__func_params(_Parameters, RetTypes),
- ( RetTypes = [] ->
+ (
+ RetTypes = [],
io__write_string("void", !IO)
- ; RetTypes = [RetType] ->
+ ;
+ RetTypes = [RetType],
mlds_output_type(RetType, !IO)
;
+ RetTypes = [_, _ | _],
mlds_output_return_list(RetTypes, mlds_output_type, !IO)
),
- % Note that mlds__func_type actually corresponds to a
- % function _pointer_ type in C. This is necessary because
- % function types in C are not first class.
+ % Note that mlds__func_type actually corresponds to a function _pointer_
+ % type in C. This is necessary because function types in C are not first
+ % class.
io__write_string(" MR_CALL (*", !IO).
:- pred mlds_output_func_type_suffix(func_params::in, io::di, io::uo) is det.
@@ -1720,9 +1668,11 @@
mlds_output_param_types(Parameters, !IO) :-
io__write_char('(', !IO),
- ( Parameters = [] ->
+ (
+ Parameters = [],
io__write_string("void", !IO)
;
+ Parameters = [_ | _],
io__write_list(Parameters, ", ", mlds_output_param_type, !IO)
),
io__write_char(')', !IO).
@@ -1744,12 +1694,9 @@
QualifiedName = qual(_ModuleName, _QualKind, Name),
(
(
- %
- % don't module-qualify main/2
- %
+ % Don't module-qualify main/2.
Name = function(PredLabel, _, _, _),
- PredLabel = pred(predicate, no, "main", 2,
- model_det, no)
+ PredLabel = pred(predicate, no, "main", 2, model_det, no)
;
Name = data(rtti(RttiId)),
module_qualify_name_of_rtti_id(RttiId) = no
@@ -1760,8 +1707,7 @@
->
mlds_output_name(Name, !IO)
;
- mlds_output_fully_qualified(QualifiedName, mlds_output_name,
- !IO)
+ mlds_output_fully_qualified(QualifiedName, mlds_output_name, !IO)
).
:- pred mlds_output_fully_qualified_proc_label(mlds__qualified_proc_label::in,
@@ -1769,17 +1715,14 @@
mlds_output_fully_qualified_proc_label(QualifiedName, !IO) :-
(
- %
- % don't module-qualify main/2
- %
+ % Don't module-qualify main/2.
QualifiedName = qual(_ModuleName, _QualKind, Name),
Name = PredLabel - _ProcId,
PredLabel = pred(predicate, no, "main", 2, model_det, no)
->
mlds_output_proc_label(Name, !IO)
;
- mlds_output_fully_qualified(QualifiedName,
- mlds_output_proc_label, !IO)
+ mlds_output_fully_qualified(QualifiedName, mlds_output_proc_label, !IO)
).
:- pred mlds_output_fully_qualified(mlds__fully_qualified_name(T)::in,
@@ -1802,9 +1745,8 @@
:- pred mlds_output_name(mlds__entity_name::in, io::di, io::uo) is det.
-% XXX we should avoid appending the arity, modenum, and seqnum
-% if they are not needed.
-
+ % XXX We should avoid appending the arity, modenum, and seqnum
+ % if they are not needed.
mlds_output_name(type(Name, Arity), !IO) :-
MangledName = name_mangle(Name),
io__format("%s_%d", [s(MangledName), i(Arity)], !IO).
@@ -1814,10 +1756,11 @@
mlds_output_pred_label(PredLabel, !IO),
proc_id_to_int(ProcId, ModeNum),
io__format("_%d", [i(ModeNum)], !IO),
- ( MaybeSeqNum = yes(SeqNum) ->
+ (
+ MaybeSeqNum = yes(SeqNum),
io__format("_%d", [i(SeqNum)], !IO)
;
- true
+ MaybeSeqNum = no
).
mlds_output_name(export(Name), !IO) :-
io__write_string(Name, !IO).
@@ -1831,11 +1774,12 @@
),
MangledName = name_mangle(Name),
io__format("%s_%d_%s", [s(MangledName), i(Arity), s(Suffix)], !IO),
- ( MaybeDefiningModule = yes(DefiningModule) ->
+ (
+ MaybeDefiningModule = yes(DefiningModule),
io__write_string("_in__", !IO),
mlds_output_module_name(DefiningModule, !IO)
;
- true
+ MaybeDefiningModule = no
).
mlds_output_pred_label(special_pred(PredName, MaybeTypeModule,
TypeName, TypeArity), !IO) :-
@@ -1843,11 +1787,12 @@
MangledTypeName = name_mangle(TypeName),
io__write_string(MangledPredName, !IO),
io__write_string("__", !IO),
- ( MaybeTypeModule = yes(TypeModule) ->
+ (
+ MaybeTypeModule = yes(TypeModule),
mlds_output_module_name(TypeModule, !IO),
io__write_string("__", !IO)
;
- true
+ MaybeTypeModule = no
),
io__write_string(MangledTypeName, !IO),
io__write_string("_", !IO),
@@ -1878,18 +1823,15 @@
% Code to output types
%
-%
-% Because of the joys of C syntax, the code for outputting
-% types needs to be split into two parts; first the prefix,
-% i.e. the part of the type name that goes before the variable
-% name in a variable declaration, and then the suffix, i.e.
-% the part which goes after the variable name, e.g. the "[]"
-% for array types.
-%
-
:- pred mlds_output_type(mlds__type::in, io::di, io::uo) is det.
mlds_output_type(Type, !IO) :-
+ % Because of the joys of C syntax, the code for outputting types
+ % needs to be split into two parts; first the prefix, i.e. the part
+ % of the type name that goes before the variable name in a variable
+ % declaration, and then the suffix, i.e. the part which goes after
+ % the variable name, e.g. the "[]" for array types.
+
mlds_output_type_prefix(Type, !IO),
mlds_output_type_suffix(Type, !IO).
@@ -1899,11 +1841,13 @@
mlds_output_mercury_type_prefix(Type, TypeCategory, !IO).
mlds_output_type_prefix(mercury_array_type(_ElemType), !IO) :-
globals__io_lookup_bool_option(highlevel_data, HighLevelData, !IO),
- ( HighLevelData = yes ->
+ (
+ HighLevelData = yes,
mlds_output_mercury_user_type_name(
qualified(unqualified("array"), "array") - 1,
user_ctor_type, !IO)
;
+ HighLevelData = no,
io__write_string("MR_ArrayPtr", !IO)
).
mlds_output_type_prefix(mlds__native_int_type, !IO) :-
@@ -1915,43 +1859,36 @@
mlds_output_type_prefix(mlds__native_char_type, !IO) :-
io__write_string("char", !IO).
mlds_output_type_prefix(mlds__foreign_type(_ForeignType), !IO) :-
- % for binary compatibility with the --target asm back-end,
+ % For binary compatibility with the --target asm back-end,
% we need to output these as a generic type, rather than making
% use of the C type name
io__write_string("MR_Box", !IO).
mlds_output_type_prefix(mlds__class_type(Name, Arity, ClassKind), !IO) :-
( ClassKind = mlds__enum ->
- %
- % We can't just use the enumeration type,
- % since the enumeration type's definition
- % is not guaranteed to be in scope at this point.
- % (Fixing that would be somewhat complicated; it would
- % require writing enum definitions to a separate header file.)
- % Also the enumeration might not be word-sized,
- % which would cause problems for e.g. `std_util:arg/2'.
- % So we just use `MR_Integer', and output the
+ % We can't just use the enumeration type, since the enumeration type's
+ % definition is not guaranteed to be in scope at this point. (Fixing
+ % that would be somewhat complicated; it would require writing enum
+ % definitions to a separate header file.) Also the enumeration might
+ % not be word-sized, which would cause problems for e.g.
+ % `std_util.arg/2'. So we just use `MR_Integer', and output the
% actual enumeration type as a comment.
- %
+
io__write_string("MR_Integer /* actually `enum ", !IO),
- mlds_output_fully_qualified(Name, mlds_output_mangled_name,
- !IO),
+ mlds_output_fully_qualified(Name, mlds_output_mangled_name, !IO),
io__format("_%d_e", [i(Arity)], !IO),
io__write_string("' */", !IO)
;
% For struct types it's OK to output an incomplete type,
- % since don't use these types directly, we only
- % use pointers to them.
+ % since don't use these types directly, we only use pointers to them.
io__write_string("struct ", !IO),
- mlds_output_fully_qualified(Name, mlds_output_mangled_name,
- !IO),
+ mlds_output_fully_qualified(Name, mlds_output_mangled_name, !IO),
io__format("_%d_s", [i(Arity)], !IO)
).
mlds_output_type_prefix(mlds__ptr_type(Type), !IO) :-
mlds_output_type(Type, !IO),
io__write_string(" *", !IO).
mlds_output_type_prefix(mlds__array_type(Type), !IO) :-
- % Here we just output the element type.
- % The "[]" goes in the type suffix.
+ % Here we just output the element type. The "[]" goes in the type suffix.
mlds_output_type(Type, !IO).
mlds_output_type_prefix(mlds__func_type(FuncParams), !IO) :-
mlds_output_func_type_prefix(FuncParams, !IO).
@@ -1964,23 +1901,29 @@
mlds_output_type_prefix(mlds__pseudo_type_info_type, !IO) :-
io__write_string("MR_PseudoTypeInfo", !IO).
mlds_output_type_prefix(mlds__cont_type(ArgTypes), !IO) :-
- ( ArgTypes = [] ->
- globals__io_lookup_bool_option(gcc_nested_functions,
- GCC_NestedFuncs, !IO),
- ( GCC_NestedFuncs = yes ->
+ (
+ ArgTypes = [],
+ globals__io_lookup_bool_option(gcc_nested_functions, GCC_NestedFuncs,
+ !IO),
+ (
+ GCC_NestedFuncs = yes,
io__write_string("MR_NestedCont", !IO)
;
+ GCC_NestedFuncs = no,
io__write_string("MR_Cont", !IO)
)
;
+ ArgTypes = [_ | _],
% This case only happens for --nondet-copy-out
io__write_string("void MR_CALL (*", !IO)
).
mlds_output_type_prefix(mlds__commit_type, !IO) :-
globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels, !IO),
- ( GCC_LocalLabels = yes ->
+ (
+ GCC_LocalLabels = yes,
io__write_string("__label__", !IO)
;
+ GCC_LocalLabels = no,
io__write_string("jmp_buf", !IO)
).
mlds_output_type_prefix(mlds__rtti_type(RttiIdMaybeElement), !IO) :-
@@ -2036,11 +1979,12 @@
io__write_string("MR_Tuple", !IO)
;
TypeCategory = higher_order_type,
- globals__io_lookup_bool_option(highlevel_data, HighLevelData,
- !IO),
- ( HighLevelData = yes ->
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData, !IO),
+ (
+ HighLevelData = yes,
io__write_string("MR_ClosurePtr", !IO)
;
+ HighLevelData = no,
io__write_string("MR_Word", !IO)
)
;
@@ -2059,16 +2003,16 @@
mlds_output_mercury_user_type_prefix(Type, TypeCategory, !IO) :-
globals__io_lookup_bool_option(highlevel_data, HighLevelData, !IO),
- ( HighLevelData = yes ->
+ (
+ HighLevelData = yes,
( type_to_ctor_and_args(Type, TypeCtor, _ArgsTypes) ->
- mlds_output_mercury_user_type_name(TypeCtor,
- TypeCategory, !IO)
+ mlds_output_mercury_user_type_name(TypeCtor, TypeCategory, !IO)
;
error("mlds_output_mercury_user_type_prefix")
)
;
- % for the --no-high-level-data case,
- % we just treat everything as `MR_Word'
+ HighLevelData = no,
+ % In this case, we just treat everything as `MR_Word'.
io__write_string("MR_Word", !IO)
).
@@ -2092,8 +2036,8 @@
:- type initializer_array_size
---> array_size(int)
- ; no_size. % either the size is unknown,
- % or the data is not an array
+ ; no_size. % Either the size is unknown,
+ % or the data is not an array.
:- func initializer_array_size(mlds__initializer) = initializer_array_size.
@@ -2124,19 +2068,21 @@
mlds_output_type_suffix(mlds__type_info_type, _, !IO).
mlds_output_type_suffix(mlds__pseudo_type_info_type, _, !IO).
mlds_output_type_suffix(mlds__cont_type(ArgTypes), _, !IO) :-
- ( ArgTypes = [] ->
- true
+ (
+ ArgTypes = []
;
- % This case only happens for --nondet-copy-out
+ ArgTypes = [_ | _],
+ % This case only happens for --nondet-copy-out.
io__write_string(")(", !IO),
io__write_list(ArgTypes, ", ", mlds_output_type, !IO),
% add the type for the environment parameter, if needed
- globals__io_lookup_bool_option(gcc_nested_functions,
- GCC_NestedFuncs, !IO),
- ( GCC_NestedFuncs = no ->
+ globals__io_lookup_bool_option(gcc_nested_functions, GCC_NestedFuncs,
+ !IO),
+ (
+ GCC_NestedFuncs = no,
io__write_string(", void *", !IO)
;
- true
+ GCC_NestedFuncs = yes
),
io__write_string(")", !IO)
).
@@ -2156,10 +2102,9 @@
mlds_output_array_type_suffix(no_size, !IO) :-
io__write_string("[]", !IO).
mlds_output_array_type_suffix(array_size(Size0), !IO) :-
- % Standard ANSI/ISO C does not allow arrays of size 0.
- % But the MLDS does. To keep the C compiler happy,
- % we therefore convert zero-element MLDS arrays into
- % one-element C arrays.
+ % Standard ANSI/ISO C does not allow arrays of size 0. But the MLDS does.
+ % To keep the C compiler happy, we therefore convert zero-element MLDS
+ % arrays into one-element C arrays.
int__max(Size0, 1, Size),
io__format("[%d]", [i(Size)], !IO).
@@ -2176,14 +2121,12 @@
mlds__entity_name::in, mlds__entity_defn::in, io::di, io::uo) is det.
mlds_output_decl_flags(Flags, DeclOrDefn, Name, DefnBody, !IO) :-
- %
- % mlds_output_extern_or_static handles both the
- % `access' and the `per_instance' fields of the mlds__decl_flags.
- % We have to handle them together because C overloads `static'
- % to mean both `private' and `one_copy', rather than having
- % separate keywords for each. To make it clear which MLDS
- % construct each `static' keyword means, we precede the `static'
- % without (optionally-enabled) comments saying whether it is
+ % mlds_output_extern_or_static handles both the `access' and the
+ % `per_instance' fields of the mlds__decl_flags. We have to handle them
+ % together because C overloads `static' to mean both `private' and
+ % `one_copy', rather than having separate keywords for each. To make it
+ % clear which MLDS construct each `static' keyword means, we precede the
+ % `static' without (optionally-enabled) comments saying whether it is
% `private', `one_copy', or both.
%
mlds_output_access_comment(access(Flags), !IO),
@@ -2199,10 +2142,11 @@
mlds_output_access_comment(Access, !IO) :-
globals__io_lookup_bool_option(auto_comments, Comments, !IO),
- ( Comments = yes ->
+ (
+ Comments = yes,
mlds_output_access_comment_2(Access, !IO)
;
- true
+ Comments = no
).
:- pred mlds_output_access_comment_2(access::in, io::di, io::uo) is det.
@@ -2223,10 +2167,11 @@
mlds_output_per_instance_comment(PerInstance, !IO) :-
globals__io_lookup_bool_option(auto_comments, Comments, !IO),
- ( Comments = yes ->
+ (
+ Comments = yes,
mlds_output_per_instance_comment_2(PerInstance, !IO)
;
- true
+ Comments = no
).
:- pred mlds_output_per_instance_comment_2(per_instance::in, io::di, io::uo)
@@ -2243,8 +2188,11 @@
mlds_output_extern_or_static(Access, PerInstance, DeclOrDefn, Name, DefnBody,
!IO) :-
(
- ( Access = private
- ; Access = local, PerInstance = one_copy
+ (
+ Access = private
+ ;
+ Access = local,
+ PerInstance = one_copy
),
Name \= type(_, _),
% Don't output "static" for functions that don't have a body.
@@ -2258,8 +2206,8 @@
->
io__write_string("extern ", !IO)
;
- % forward declarations for GNU C nested functions need
- % to be prefixed with "auto"
+ % Forward declarations for GNU C nested functions need to be prefixed
+ % with "auto".
DeclOrDefn = forward_decl,
Name = function(_, _, _, _),
Access = local
@@ -2318,40 +2266,34 @@
:- pred mlds_output_stmt(indent::in, func_info::in, mlds__stmt::in,
mlds__context::in, io::di, io::uo) is det.
- %
- % sequence
- %
mlds_output_stmt(Indent, FuncInfo, block(Defns, Statements), Context, !IO) :-
mlds_indent(Indent, !IO),
io__write_string("{\n", !IO),
- ( Defns \= [] ->
+ (
+ Defns = [_ | _],
FuncInfo = func_info(FuncName, _),
FuncName = qual(ModuleName, _, _),
- % output forward declarations for any nested functions
- % defined in this block, in case they are referenced before
- % they are defined
+ % Output forward declarations for any nested functions defined in
+ % this block, in case they are referenced before they are defined.
list__filter(defn_is_function, Defns, NestedFuncDefns),
- ( NestedFuncDefns \= [] ->
- mlds_output_decls(Indent + 1, ModuleName,
- NestedFuncDefns, !IO),
+ (
+ NestedFuncDefns = [_ | _],
+ mlds_output_decls(Indent + 1, ModuleName, NestedFuncDefns, !IO),
io__write_string("\n", !IO)
;
- true
+ NestedFuncDefns = []
),
- mlds_output_defns(Indent + 1, ModuleName, Defns, !IO),
+ mlds_output_defns(Indent + 1, no, ModuleName, Defns, !IO),
io__write_string("\n", !IO)
;
- true
+ Defns = []
),
mlds_output_statements(Indent + 1, FuncInfo, Statements, !IO),
mlds_indent(Context, Indent, !IO),
io__write_string("}\n", !IO).
- %
- % iteration
- %
mlds_output_stmt(Indent, FuncInfo, while(Cond, Statement, no), _, !IO) :-
mlds_indent(Indent, !IO),
io__write_string("while (", !IO),
@@ -2368,17 +2310,11 @@
mlds_output_rval(Cond, !IO),
io__write_string(");\n", !IO).
- %
- % selection (see also computed_goto)
- %
mlds_output_stmt(Indent, FuncInfo, if_then_else(Cond, Then0, MaybeElse),
Context, !IO) :-
- %
- % we need to take care to avoid problems caused by the
- % dangling else ambiguity
- %
+ % We need to take care to avoid problems caused by the dangling else
+ % ambiguity.
(
- %
% For examples of the form
%
% if (...)
@@ -2387,17 +2323,15 @@
% else
% ...
%
- % we need braces around the inner `if', otherwise
- % they wouldn't parse they way we want them to:
- % C would match the `else' with the inner `if'
- % rather than the outer `if'.
- %
+ % we need braces around the inner `if', otherwise they wouldn't parse
+ % they way we want them to: C would match the `else' with the inner
+ % `if' rather than the outer `if'.
+
MaybeElse = yes(_),
Then0 = statement(if_then_else(_, _, no), ThenContext)
->
Then = statement(block([], [Then0]), ThenContext)
;
- %
% For examples of the form
%
% if (...)
@@ -2406,10 +2340,10 @@
% else
% ...
%
- % we don't _need_ braces around the inner `if',
- % since C will match the else with the inner `if',
- % but we add braces anyway, to avoid a warning from gcc.
- %
+ % we don't _need_ braces around the inner `if', since C will match
+ % the else with the inner `if', but we add braces anyway, to avoid
+ % a warning from gcc.
+
MaybeElse = no,
Then0 = statement(if_then_else(_, _, yes(_)), ThenContext)
->
@@ -2423,12 +2357,13 @@
mlds_output_rval(Cond, !IO),
io__write_string(")\n", !IO),
mlds_output_statement(Indent + 1, FuncInfo, Then, !IO),
- ( MaybeElse = yes(Else) ->
+ (
+ MaybeElse = yes(Else),
mlds_indent(Context, Indent, !IO),
io__write_string("else\n", !IO),
mlds_output_statement(Indent + 1, FuncInfo, Else, !IO)
;
- true
+ MaybeElse = no
).
mlds_output_stmt(Indent, FuncInfo, switch(_Type, Val, _Range, Cases, Default),
Context, !IO) :-
@@ -2444,15 +2379,11 @@
mlds_indent(Context, Indent, !IO),
io__write_string("}\n", !IO).
- %
- % transfer of control
- %
mlds_output_stmt(Indent, _FuncInfo, label(LabelName), _, !IO) :-
- %
- % Note: MLDS allows labels at the end of blocks.
- % C doesn't. Hence we need to insert a semi-colon after the colon
- % to ensure that there is a statement to attach the label to.
- %
+ % Note: MLDS allows labels at the end of blocks. C doesn't. Hence we need
+ % to insert a semi-colon after the colon to ensure that there is a
+ % statement to attach the label to.
+
mlds_indent(Indent - 1, !IO),
mlds_output_label_name(LabelName, !IO),
io__write_string(":;\n", !IO).
@@ -2469,7 +2400,7 @@
io__write_string("continue;\n", !IO).
mlds_output_stmt(Indent, _FuncInfo, computed_goto(Expr, Labels), Context,
!IO) :-
- % XXX for GNU C, we could output potentially more efficient code
+ % XXX For GNU C, we could output potentially more efficient code
% by using an array of labels; this would tell the compiler that
% it didn't need to do any range check.
mlds_indent(Indent, !IO),
@@ -2483,45 +2414,36 @@
mlds_indent(Context, Indent, !IO),
io__write_string("}\n", !IO).
- %
- % function call/return
- %
mlds_output_stmt(Indent, CallerFuncInfo, Call, Context, !IO) :-
Call = call(Signature, FuncRval, MaybeObject, CallArgs,
Results, IsTailCall),
CallerFuncInfo = func_info(CallerName, CallerSignature),
- %
- % We need to enclose the generated code inside an extra pair
- % of curly braces, in case we generate more than one statement
- % (e.g. because we generate extra statements for profiling
- % or for tail call optimization) and the generated code is
- % e.g. inside an if-then-else.
- %
+ % We need to enclose the generated code inside an extra pair of curly
+ % braces, in case we generate more than one statement (e.g. because we
+ % generate extra statements for profiling or for tail call optimization)
+ % and the generated code is e.g. inside an if-then-else.
+
mlds_indent(Indent, !IO),
io__write_string("{\n", !IO),
- mlds_maybe_output_call_profile_instr(Context,
- Indent + 1, FuncRval, CallerName, !IO),
+ mlds_maybe_output_call_profile_instr(Context, Indent + 1, FuncRval,
+ CallerName, !IO),
- %
- % Optimize general tail calls.
- % We can't really do much here except to insert `return'
- % as an extra hint to the C compiler.
- % XXX these optimizations should be disable-able
- %
- % If Results = [], i.e. the function has `void' return type,
- % then this would result in code that is not legal ANSI C
- % (although it _is_ legal in GNU C and in C++),
- % so for that case, we put the return statement after
+ % Optimize general tail calls. We can't really do much here except to
+ % insert `return' as an extra hint to the C compiler.
+ % XXX These optimizations should be disable-able.
+ %
+ % If Results = [], i.e. the function has `void' return type, then this
+ % would result in code that is not legal ANSI C (although it _is_ legal
+ % in GNU C and in C++), so for that case, we put the return statement after
% the call -- see below.
%
- % Note that it's only safe to add such a return statement if
- % the calling procedure has the same return types as the callee,
- % or if the calling procedure has no return value.
- % (Calls where the types are different can be marked as tail calls
- % if they are known to never return.)
- %
+ % Note that it's only safe to add such a return statement if the calling
+ % procedure has the same return types as the callee, or if the calling
+ % procedure has no return value. (Calls where the types are different
+ % can be marked as tail calls if they are known to never return.)
+
mlds_indent(Context, Indent + 1, !IO),
Signature = mlds__func_signature(_, RetTypes),
CallerSignature = mlds__func_signature(_, CallerRetTypes),
@@ -2529,25 +2451,28 @@
( IsTailCall = tail_call
; IsTailCall = no_return_call
),
- Results \= [],
+ Results = [_ | _],
RetTypes = CallerRetTypes
->
io__write_string("return ", !IO)
;
true
),
- ( MaybeObject = yes(Object) ->
+ (
+ MaybeObject = yes(Object),
mlds_output_bracketed_rval(Object, !IO),
io__write_string(".", !IO) % XXX should this be "->"?
;
- true
+ MaybeObject = no
),
- ( Results = [] ->
- true
- ; Results = [Lval] ->
+ (
+ Results = []
+ ;
+ Results = [Lval],
mlds_output_lval(Lval, !IO),
io__write_string(" = ", !IO)
;
+ Results = [_, _ | _],
mlds_output_return_list(Results, mlds_output_lval, !IO),
io__write_string(" = ", !IO)
),
@@ -2565,8 +2490,8 @@
mlds_indent(Context, Indent + 1, !IO),
io__write_string("return;\n", !IO)
;
- mlds_maybe_output_time_profile_instr(Context, Indent + 1,
- CallerName, !IO)
+ mlds_maybe_output_time_profile_instr(Context, Indent + 1, CallerName,
+ !IO)
),
mlds_indent(Indent, !IO),
io__write_string("}\n", !IO).
@@ -2574,32 +2499,32 @@
mlds_output_stmt(Indent, _FuncInfo, return(Results), _, !IO) :-
mlds_indent(Indent, !IO),
io__write_string("return", !IO),
- ( Results = [] ->
- true
- ; Results = [Rval] ->
+ (
+ Results = []
+ ;
+ Results = [Rval],
io__write_char(' ', !IO),
mlds_output_rval(Rval, !IO)
;
+ Results = [_, _ | _],
mlds_output_return_list(Results, mlds_output_rval, !IO)
),
io__write_string(";\n", !IO).
- %
- % commits
- %
mlds_output_stmt(Indent, _FuncInfo, do_commit(Ref), _, !IO) :-
mlds_indent(Indent, !IO),
globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels, !IO),
- ( GCC_LocalLabels = yes ->
- % output "goto <Ref>"
+ (
+ GCC_LocalLabels = yes,
+ % Output "goto <Ref>".
io__write_string("goto ", !IO),
mlds_output_rval(Ref, !IO)
;
- % output "MR_builtin_longjmp(<Ref>, 1)".
- % This is a macro that expands to either the standard longjmp()
- % or the GNU C's __builtin_longjmp().
- % Note that the second argument to GNU C's
- % __builtin_longjmp() *must* be `1'.
+ GCC_LocalLabels = no,
+ % Output "MR_builtin_longjmp(<Ref>, 1)". This is a macro that expands
+ % to either the standard longjmp() or the GNU C's __builtin_longjmp().
+ % Note that the second argument to GNU C's __builtin_longjmp() *must*
+ % be `1'.
io__write_string("MR_builtin_longjmp(", !IO),
mlds_output_rval(Ref, !IO),
io__write_string(", 1)", !IO)
@@ -2620,9 +2545,8 @@
% <Ref>_done:
% ;
- % Note that <Ref> should be just variable name,
- % not a complicated expression. If not, the
- % C compiler will catch it.
+ % Note that <Ref> should be just variable name, not a complicated
+ % expression. If not, the C compiler will catch it.
mlds_output_statement(Indent, FuncInfo, Stmt0, !IO),
@@ -2651,30 +2575,23 @@
% else
% <Handler>
%
- % MR_builtin_setjmp() expands to either the
- % standard setjmp() or GNU C's __builtin_setjmp().
- %
- % Note that ISO C says that any non-volatile variables
- % that are local to the function containing the setjmp()
- % and which are modified between the setjmp() and the
- % longjmp() become indeterminate after the longjmp().
- % The MLDS code generator handles that by generating
- % each commit in its own nested function, with the
- % local variables remaining in the containing function.
- % This ensures that none of the variables which get
- % modified between the setjmp() and the longjmp() and
- % which get referenced after the longjmp() are local
- % variables in the function containing the setjmp(),
- % so we don't need to mark them as volatile.
- %
-
+ % MR_builtin_setjmp() expands to either the standard setjmp()
+ % or GNU C's __builtin_setjmp().
%
- % we need to take care to avoid problems caused by the
- % dangling else ambiguity
- %
- (
- Stmt0 = statement(if_then_else(_, _, no), Context)
- ->
+ % Note that ISO C says that any non-volatile variables that are local
+ % to the function containing the setjmp() and which are modified
+ % between the setjmp() and the longjmp() become indeterminate after
+ % the longjmp(). The MLDS code generator handles that by generating
+ % each commit in its own nested function, with the local variables
+ % remaining in the containing function. This ensures that none of the
+ % variables which get modified between the setjmp() and the longjmp()
+ % and which get referenced after the longjmp() are local variables
+ % in the function containing the setjmp(), so we don't need to mark
+ % them as volatile.
+
+ % We need to take care to avoid problems caused by the dangling else
+ % ambiguity.
+ ( Stmt0 = statement(if_then_else(_, _, no), Context) ->
Stmt = statement(block([], [Stmt0]), Context)
;
Stmt = Stmt0
@@ -2741,8 +2658,8 @@
:- pred mlds_output_switch_default(indent::in, func_info::in, mlds__context::in,
mlds__switch_default::in, io::di, io::uo) is det.
-mlds_output_switch_default(Indent, _FuncInfo, Context,
- default_is_unreachable, !IO) :-
+mlds_output_switch_default(Indent, _FuncInfo, Context, default_is_unreachable,
+ !IO) :-
mlds_indent(Context, Indent, !IO),
io__write_string("default: /*NOTREACHED*/ MR_assert(0);\n", !IO).
mlds_output_switch_default(_Indent, _FuncInfo, _Context, default_do_nothing,
@@ -2757,8 +2674,7 @@
%-----------------------------------------------------------------------------%
- %
- % If memory profiling is turned on output an instruction to
+ % If memory profiling is turned on, output an instruction to
% record the heap allocation.
%
:- pred mlds_maybe_output_heap_profile_instr(mlds__context::in,
@@ -2769,8 +2685,7 @@
MaybeCtorName, !IO) :-
globals__io_lookup_bool_option(profile_memory, ProfileMem, !IO),
(
- ProfileMem = yes
- ->
+ ProfileMem = yes,
mlds_indent(Context, Indent, !IO),
io__write_string("MR_record_allocation(", !IO),
io__write_int(list__length(Args), !IO),
@@ -2779,37 +2694,36 @@
io__write_string(", """, !IO),
mlds_output_fully_qualified_name(FuncName, !IO),
io__write_string(""", ", !IO),
- ( MaybeCtorName = yes(CtorId) ->
+ (
+ MaybeCtorName = yes(CtorId),
io__write_char('"', !IO),
CtorId = qual(_ModuleName, _QualKind, CtorDefn),
CtorDefn = ctor_id(CtorName, _CtorArity),
c_util__output_quoted_string(CtorName, !IO),
io__write_char('"', !IO)
;
- /*
- ** Just use an empty string. Note that we can't use
- ** a null pointer here, because MR_record_allocation()
- ** requires its string arguments to not be NULL.
- */
+ MaybeCtorName = no,
+ % Just use an empty string. Note that we can't use a null pointer
+ % here, because MR_record_allocation() requires its string
+ % arguments to not be NULL.
io__write_string("\"\"", !IO)
),
io__write_string(");\n", !IO)
;
- true
+ ProfileMem = no
).
- %
% If call profiling is turned on output an instruction to record
% an arc in the call profile between the callee and caller.
%
:- pred mlds_maybe_output_call_profile_instr(mlds__context::in, indent::in,
- mlds__rval::in, mlds__qualified_entity_name::in,
- io::di, io::uo) is det.
+ mlds__rval::in, mlds__qualified_entity_name::in, io::di, io::uo) is det.
mlds_maybe_output_call_profile_instr(Context, Indent,
CalleeFuncRval, CallerName, !IO) :-
globals__io_lookup_bool_option(profile_calls, ProfileCalls, !IO),
- ( ProfileCalls = yes ->
+ (
+ ProfileCalls = yes,
mlds_indent(Context, Indent, !IO),
io__write_string("MR_prof_call_profile(", !IO),
mlds_output_bracketed_rval(CalleeFuncRval, !IO),
@@ -2817,45 +2731,31 @@
mlds_output_fully_qualified_name(CallerName, !IO),
io__write_string(");\n", !IO)
;
- true
+ ProfileCalls = no
).
- %
- % If time profiling is turned on output an instruction which
- % informs the runtime which procedure we are currently located
- % in.
+ % If time profiling is turned on output an instruction which informs
+ % the runtime which procedure we are currently located in.
%
:- pred mlds_maybe_output_time_profile_instr(mlds__context::in,
- indent::in, mlds__qualified_entity_name::in,
- io::di, io::uo) is det.
+ indent::in, mlds__qualified_entity_name::in, io::di, io::uo) is det.
mlds_maybe_output_time_profile_instr(Context, Indent, Name, !IO) :-
globals__io_lookup_bool_option(profile_time, ProfileTime, !IO),
(
- ProfileTime = yes
- ->
+ ProfileTime = yes,
mlds_indent(Context, Indent, !IO),
io__write_string("MR_set_prof_current_proc(", !IO),
mlds_output_fully_qualified_name(Name, !IO),
io__write_string(");\n", !IO)
;
- true
+ ProfileTime = no
).
%-----------------------------------------------------------------------------%
- %
- % exception handling
- %
-
- /* XXX not yet implemented */
-
- %
- % atomic statements
- %
mlds_output_stmt(Indent, FuncInfo, atomic(AtomicStatement), Context, !IO) :-
- mlds_output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context,
- !IO).
+ mlds_output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context, !IO).
:- pred mlds_output_label_name(mlds__label::in, io::di, io::uo) is det.
@@ -2865,21 +2765,14 @@
:- pred mlds_output_atomic_stmt(indent::in, func_info::in,
mlds__atomic_statement::in, mlds__context::in, io::di, io::uo) is det.
- %
- % comments
- %
mlds_output_atomic_stmt(Indent, _FuncInfo, comment(Comment), _, !IO) :-
- % XXX we should escape any "*/"'s in the Comment.
- % we should also split the comment into lines and indent
- % each line appropriately.
+ % XXX We should escape any "*/"'s in the Comment. We should also split
+ % the comment into lines and indent each line appropriately.
mlds_indent(Indent, !IO),
io__write_string("/* ", !IO),
io__write_string(Comment, !IO),
io__write_string(" */\n", !IO).
- %
- % assignment
- %
mlds_output_atomic_stmt(Indent, _FuncInfo, assign(Lval, Rval), _, !IO) :-
mlds_indent(Indent, !IO),
mlds_output_lval(Lval, !IO),
@@ -2887,9 +2780,6 @@
mlds_output_rval(Rval, !IO),
io__write_string(";\n", !IO).
- %
- % heap management
- %
mlds_output_atomic_stmt(_Indent, _FuncInfo, delete_object(_Lval), _, !IO) :-
error("mlds_to_c.m: sorry, delete_object not implemented").
@@ -2921,19 +2811,18 @@
io__write_string(";\n", !IO)
),
- % for --gc accurate, we need to insert a call to GC_check()
- % before every allocation
+ % For --gc accurate, we need to insert a call to GC_check()
+ % before every allocation.
globals__io_get_gc_method(GC_Method, !IO),
( GC_Method = accurate ->
mlds_indent(Context, Indent + 1, !IO),
io__write_string("MR_GC_check();\n", !IO),
- % For types which hold RTTI that will be traversed
- % by the collector at GC-time, we need to allocate
- % an extra word at the start, to hold the forwarding
- % pointer. Normally we would just overwrite the
- % first word of the object in the "from" space,
- % but this can't be done for objects which will be
- % referenced during the garbage collection process.
+ % For types which hold RTTI that will be traversed by the collector
+ % at GC-time, we need to allocate an extra word at the start, to hold
+ % the forwarding pointer. Normally we would just overwrite the first
+ % word of the object in the "from" space, but this can't be done for
+ % objects which will be referenced during the garbage collection
+ % process.
( type_needs_forwarding_pointer_space(Type) = yes ->
mlds_indent(Context, Indent + 1, !IO),
io__write_string("/* reserve space for " ++
@@ -2954,7 +2843,8 @@
mlds_indent(Context, Indent + 1, !IO),
write_lval_or_string(Base, !IO),
io__write_string(" = ", !IO),
- ( MaybeTag = yes(Tag0) ->
+ (
+ MaybeTag = yes(Tag0),
Tag = Tag0,
mlds_output_cast(Type, !IO),
io__write_string("MR_mkword(", !IO),
@@ -2962,35 +2852,36 @@
io__write_string(", ", !IO),
EndMkword = ")"
;
+ MaybeTag = no,
Tag = 0,
- %
- % XXX we shouldn't need the cast here,
- % but currently the type that we include
- % in the call to MR_new_object() is not
- % always correct.
- %
+ % XXX We shouldn't need the cast here, but currently the type that we
+ % include in the call to MR_new_object() is not always correct.
mlds_output_cast(Type, !IO),
EndMkword = ""
),
io__write_string("MR_new_object(", !IO),
mlds_output_type(Type, !IO),
io__write_string(", ", !IO),
- ( MaybeSize = yes(Size) ->
+ (
+ MaybeSize = yes(Size),
io__write_string("(", !IO),
mlds_output_rval(Size, !IO),
io__write_string(" * sizeof(MR_Word))", !IO)
;
+ MaybeSize = no,
% XXX what should we do here?
io__write_int(-1, !IO)
),
io__write_string(", ", !IO),
- ( MaybeCtorName = yes(QualifiedCtorId) ->
+ (
+ MaybeCtorName = yes(QualifiedCtorId),
io__write_char('"', !IO),
QualifiedCtorId = qual(_ModuleName, _QualKind, CtorDefn),
CtorDefn = ctor_id(CtorName, _CtorArity),
c_util__output_quoted_string(CtorName, !IO),
io__write_char('"', !IO)
;
+ MaybeCtorName = no,
io__write_string("NULL", !IO)
),
io__write_string(")", !IO),
@@ -3006,8 +2897,8 @@
io__write_string(BaseVarName1, !IO),
io__write_string(";\n", !IO)
),
- mlds_output_init_args(Args, ArgTypes, Context, 0, Base, Tag,
- Indent + 1, !IO),
+ mlds_output_init_args(Args, ArgTypes, Context, 0, Base, Tag, Indent + 1,
+ !IO),
mlds_indent(Context, Indent, !IO),
io__write_string("}\n", !IO).
@@ -3027,29 +2918,20 @@
mlds_output_rval(Rval, !IO),
io__write_string(");\n", !IO).
- %
- % trail management
- %
mlds_output_atomic_stmt(_Indent, _FuncInfo, trail_op(_TrailOp), _, !IO) :-
error("mlds_to_c.m: sorry, trail_ops not implemented").
- %
- % foreign language interfacing
- %
mlds_output_atomic_stmt(_Indent, _FuncInfo,
inline_target_code(TargetLang, Components), Context, !IO) :-
( TargetLang = lang_C ->
- list__foldl(
- mlds_output_target_code_component(Context),
- Components, !IO)
+ list__foldl(mlds_output_target_code_component(Context), Components,
+ !IO)
;
- error("mlds_to_c.m: sorry, inline_target_code only works " ++
- "for lang_C")
+ error("mlds_to_c.m: sorry, inline_target_code only works for lang_C")
).
mlds_output_atomic_stmt(_Indent, _FuncInfo,
- outline_foreign_proc(_Lang, _Vs, _Lvals, _Code), _Context,
- !IO) :-
+ outline_foreign_proc(_Lang, _Vs, _Lvals, _Code), _Context, !IO) :-
error("mlds_to_c.m: outline_foreign_proc is not used in C backend").
:- pred mlds_output_target_code_component(mlds__context::in,
@@ -3068,9 +2950,11 @@
% (although some compilers, e.g. gcc 3.2, do allow it).
mlds_output_target_code_component(Context,
user_target_code(CodeString, MaybeUserContext, _Attrs), !IO) :-
- ( MaybeUserContext = yes(UserContext) ->
+ (
+ MaybeUserContext = yes(UserContext),
mlds_to_c__output_context(mlds__make_context(UserContext), !IO)
;
+ MaybeUserContext = no,
mlds_to_c__output_context(Context, !IO)
),
io__write_string(CodeString, !IO),
@@ -3110,13 +2994,12 @@
type_needs_forwarding_pointer_space(mlds__generic_type) = no.
type_needs_forwarding_pointer_space(mlds__generic_env_ptr_type) = no.
type_needs_forwarding_pointer_space(mlds__rtti_type(_)) = _ :-
- % these should all be statically allocated, not dynamically allocated,
- % so we should never get here
+ % These should all be statically allocated, not dynamically allocated,
+ % so we should never get here.
unexpected(this_file,
"type_needs_forwarding_pointer_space: rtti_type").
type_needs_forwarding_pointer_space(mlds__unknown_type) = _ :-
- unexpected(this_file,
- "type_needs_forwarding_pointer_space: unknown_type").
+ unexpected(this_file, "type_needs_forwarding_pointer_space: unknown_type").
:- type lval_or_string
---> lval(mlds__lval)
@@ -3133,17 +3016,14 @@
mlds_output_init_args([], [], _, _, _, _, _, !IO).
mlds_output_init_args([Arg | Args], [ArgType | ArgTypes], Context,
ArgNum, Base, Tag, Indent, !IO) :-
- %
- % The MR_hl_field() macro expects its argument to
- % have type MR_Box, so we need to box the arguments
- % if they aren't already boxed. Hence the use of
- % mlds_output_boxed_rval below.
- %
- % XXX For --high-level-data, we ought to generate
- % assignments to the fields (or perhaps a call to
- % a constructor function) rather than using the
+ % The MR_hl_field() macro expects its argument to have type MR_Box,
+ % so we need to box the arguments if they aren't already boxed.
+ % Hence the use of mlds_output_boxed_rval below.
+
+ % XXX For --high-level-data, we ought to generate assignments to the fields
+ % (or perhaps a call to a constructor function) rather than using the
% MR_hl_field() macro.
- %
+
mlds_indent(Context, Indent, !IO),
io__write_string("MR_hl_field(", !IO),
mlds_output_tag(Tag, !IO),
@@ -3188,11 +3068,13 @@
% must be something that maps to MR_Box.
error("unexpected field type")
),
- ( MaybeTag = yes(Tag) ->
+ (
+ MaybeTag = yes(Tag),
io__write_string("MR_hl_field(", !IO),
mlds_output_tag(Tag, !IO),
io__write_string(", ", !IO)
;
+ MaybeTag = no,
io__write_string("MR_hl_mask_field(", !IO),
io__write_string("(MR_Word) ", !IO)
),
@@ -3218,12 +3100,14 @@
)
;
mlds_output_cast(CtorType, !IO),
- ( MaybeTag = yes(Tag) ->
+ (
+ MaybeTag = yes(Tag),
io__write_string("MR_body(", !IO),
mlds_output_rval(PtrRval, !IO),
io__write_string(", ", !IO),
mlds_output_tag(Tag, !IO)
;
+ MaybeTag = no,
io__write_string("MR_strip_tag(", !IO),
mlds_output_rval(PtrRval, !IO)
),
@@ -3255,7 +3139,7 @@
mlds_output_bracketed_lval(Lval, !IO) :-
(
- % if it's just a variable name, then we don't need parentheses
+ % If it's just a variable name, then we don't need parentheses.
Lval = var(_, _)
->
mlds_output_lval(Lval, !IO)
@@ -3269,7 +3153,7 @@
mlds_output_bracketed_rval(Rval, !IO) :-
(
- % if it's just a variable name, then we don't need parentheses
+ % If it's just a variable name, then we don't need parentheses.
( Rval = lval(var(_,_))
; Rval = const(code_addr_const(_))
)
@@ -3283,18 +3167,16 @@
% mlds_output_return_list(List, OutputPred, IO0, IO) outputs a List
% of return types/values using OutputPred.
-
+ %
:- pred mlds_output_return_list(list(T)::in,
pred(T, io, io)::in(pred(in, di, uo) is det),
io::di, io::uo) is det.
mlds_output_return_list(List, OutputPred, !IO) :-
- % Even though C doesn't support multiple return types,
- % this case needs to be handled for e.g. MLDS dumps when
- % compiling to Java. We generate an "#error" directive
- % to make the error message clearer, but then we go ahead
- % and generate C-like psuedo-code for the purposes of MLDS
- % dumps.
+ % Even though C doesn't support multiple return types, this case needs
+ % to be handled for e.g. MLDS dumps when compiling to Java. We generate
+ % an "#error" directive to make the error message clearer, but then we go
+ % ahead and generate C-like psuedo-code for the purposes of MLDS dumps.
io__write_string("\n#error multiple return values\n", !IO),
io__write_string("\t{", !IO),
io__write_list(List, ", ", OutputPred, !IO),
@@ -3304,28 +3186,28 @@
mlds_output_rval(lval(Lval), !IO) :-
mlds_output_lval(Lval, !IO).
-/**** XXX do we need this?
-mlds_output_rval(lval(Lval), !IO) :-
- % if a field is used as an rval, then we need to use
- % the MR_hl_const_field() macro, not the MR_hl_field() macro,
- % to avoid warnings about discarding const,
- % and similarly for MR_mask_field.
- ( Lval = field(MaybeTag, Rval, FieldNum, _, _) ->
- ( MaybeTag = yes(Tag) ->
- io__write_string("MR_hl_const_field(", !IO),
- mlds_output_tag(Tag, !IO),
- io__write_string(", ", !IO)
- ;
- io__write_string("MR_hl_const_mask_field(", !IO)
- ),
- mlds_output_rval(Rval, !IO),
- io__write_string(", ", !IO),
- mlds_output_rval(FieldNum, !IO),
- io__write_string(")", !IO)
- ;
- mlds_output_lval(Lval, !IO)
- ).
-****/
+
+% XXX Do we need the commented out code below?
+% mlds_output_rval(lval(Lval), !IO) :-
+% % if a field is used as an rval, then we need to use
+% % the MR_hl_const_field() macro, not the MR_hl_field() macro,
+% % to avoid warnings about discarding const,
+% % and similarly for MR_mask_field.
+% ( Lval = field(MaybeTag, Rval, FieldNum, _, _) ->
+% ( MaybeTag = yes(Tag) ->
+% io__write_string("MR_hl_const_field(", !IO),
+% mlds_output_tag(Tag, !IO),
+% io__write_string(", ", !IO)
+% ;
+% io__write_string("MR_hl_const_mask_field(", !IO)
+% ),
+% mlds_output_rval(Rval, !IO),
+% io__write_string(", ", !IO),
+% mlds_output_rval(FieldNum, !IO),
+% io__write_string(")", !IO)
+% ;
+% mlds_output_lval(Lval, !IO)
+% ).
mlds_output_rval(mkword(Tag, Rval), !IO) :-
io__write_string("MR_mkword(", !IO),
@@ -3386,7 +3268,7 @@
; Type = mlds__mercury_type(_, variable_type, _)
)
->
- % It already has type MR_Box, so no cast is needed
+ % It already has type MR_Box, so no cast is needed.
mlds_output_rval(Exprn, !IO)
;
Exprn = unop(cast(OtherType), InnerExprn),
@@ -3394,9 +3276,9 @@
; is_an_address(InnerExprn)
)
->
- % avoid unnecessary double-casting -- strip away the inner cast
- % This is necessary for ANSI/ISO C conformance, to avoid
- % casts from pointers to integers in static initializers.
+ % Avoid unnecessary double-casting -- strip away the inner cast.
+ % This is necessary for ANSI/ISO C conformance, to avoid casts
+ % from pointers to integers in static initializers.
mlds_output_boxed_rval(Type, InnerExprn, !IO)
;
( Type = mlds__mercury_type(builtin(float), _, _)
@@ -3425,8 +3307,9 @@
io__write_string("))", !IO)
).
-% Succeed if the specified rval is an address
-% (possibly tagged and/or cast to a different type).
+ % Succeed if the specified rval is an address (possibly tagged and/or
+ % cast to a different type).
+ %
:- pred is_an_address(mlds__rval::in) is semidet.
is_an_address(mkword(_Tag, Expr)) :-
@@ -3480,9 +3363,8 @@
io__write_string(UnaryOpString, !IO),
io__write_string("(", !IO),
( UnaryOp = tag ->
- % The MR_tag macro requires its argument to be of type
- % `MR_Word'.
- % XXX should we put this cast inside the definition of MR_tag?
+ % The MR_tag macro requires its argument to be of type `MR_Word'.
+ % XXX Should we put this cast inside the definition of MR_tag?
io__write_string("(MR_Word) ", !IO)
;
true
@@ -3538,25 +3420,22 @@
mlds_output_bracketed_rval(Y, !IO),
io__write_string(")", !IO)
;
-/****
-XXX broken for C == minint
-(since `NewC is 0 - C' overflows)
- Op = (+),
- Y = const(int_const(C)),
- C < 0
- ->
- NewOp = (-),
- NewC is 0 - C,
- NewY = const(int_const(NewC)),
- io__write_string("(", !IO),
- mlds_output_rval(X, !IO),
- io__write_string(" ", !IO),
- mlds_output_binary_op(NewOp, !IO),
- io__write_string(" ", !IO),
- mlds_output_rval(NewY, !IO),
- io__write_string(")", !IO)
- ;
-******/
+% XXX Broken for C == minint, (since `NewC is 0 - C' overflows)
+% Op = (+),
+% Y = const(int_const(C)),
+% C < 0
+% ->
+% NewOp = (-),
+% NewC is 0 - C,
+% NewY = const(int_const(NewC)),
+% io__write_string("(", !IO),
+% mlds_output_rval(X, !IO),
+% io__write_string(" ", !IO),
+% mlds_output_binary_op(NewOp, !IO),
+% io__write_string(" ", !IO),
+% mlds_output_rval(NewY, !IO),
+% io__write_string(")", !IO)
+% ;
io__write_string("(", !IO),
mlds_output_rval(X, !IO),
io__write_string(" ", !IO),
@@ -3582,20 +3461,18 @@
mlds_output_rval_const(false, !IO) :-
io__write_string("MR_FALSE", !IO).
mlds_output_rval_const(int_const(N), !IO) :-
- % we need to cast to (MR_Integer) to ensure
- % things like 1 << 32 work when `Integer' is 64 bits
- % but `int' is 32 bits.
+ % We need to cast to (MR_Integer) to ensure things like 1 << 32 work
+ % when `Integer' is 64 bits but `int' is 32 bits.
io__write_string("(MR_Integer) ", !IO),
io__write_int(N, !IO).
mlds_output_rval_const(float_const(FloatVal), !IO) :-
- % the cast to (MR_Float) here lets the C compiler
- % do arithmetic in `float' rather than `double'
- % if `MR_Float' is `float' not `double'.
+ % The cast to (MR_Float) here lets the C compiler do arithmetic in `float'
+ % rather than `double' if `MR_Float' is `float' not `double'.
io__write_string("(MR_Float) ", !IO),
c_util__output_float_literal(FloatVal, !IO).
mlds_output_rval_const(string_const(String), !IO) :-
- % the cast avoids the following gcc warning
- % "assignment discards qualifiers from pointer target type"
+ % The cast avoids the following gcc warning
+ % "assignment discards qualifiers from pointer target type".
io__write_string("(MR_String) ", !IO),
io__write_string("""", !IO),
c_util__output_quoted_string(String, !IO),
@@ -3642,7 +3519,7 @@
mlds_output_data_addr(data_addr(ModuleName, DataName), !IO) :-
(
- % if its an array type, then we just use the name,
+ % If its an array type, then we just use the name,
% otherwise we must prefix the name with `&'.
DataName = rtti(RttiId),
rtti_id_has_array_type(RttiId) = yes
@@ -3664,8 +3541,7 @@
->
true
;
- mlds_output_module_name(
- mlds_module_name_to_sym_name(ModuleName), !IO),
+ mlds_output_module_name(mlds_module_name_to_sym_name(ModuleName), !IO),
io__write_string("__", !IO)
),
mlds_output_data_name(DataName, !IO).
@@ -3693,9 +3569,9 @@
mlds_to_c__output_context(Context, !IO),
mlds_indent(N, !IO).
-% A value of type `indent' records the number of levels
-% of indentation to indent the next piece of code.
-% Currently we output two spaces for each level of indentation.
+ % A value of type `indent' records the number of levels
+ % of indentation to indent the next piece of code.
+ % Currently we output two spaces for each level of indentation.
:- type indent == int.
:- pred mlds_indent(indent::in, io::di, io::uo) is det.
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.469
diff -u -b -r1.469 options.m
--- compiler/options.m 28 Sep 2005 08:28:09 -0000 1.469
+++ compiler/options.m 16 Oct 2005 02:47:03 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1994-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.
@@ -29,6 +31,7 @@
% special_handler(Option, ValueForThatOption, OptionTableIn,
% MaybeOptionTableOut):
+ %
% This predicate is invoked whenever getopt finds an option
% (long or short) designated as special, with special_data holding
% the argument of the option (if any). The predicate can change the
@@ -50,10 +53,12 @@
% Add a directory to search for Mercury libraries. This
% adds `--search-directory', `--c-include-directory',
% `--library-directory' and `--init-file-directory' options.
-:- func option_table_add_mercury_library_directory(option_table,
- string) = option_table.
+ %
+:- func option_table_add_mercury_library_directory(option_table, string)
+ = option_table.
% Quote an argument to a shell command.
+ %
:- func quote_arg(string) = string.
% NOTE: ALL OPTIONS SHOULD BE DOCUMENTED!
@@ -71,6 +76,7 @@
% here, or as commented-out code in the appropriate subroutine
% of options_help/2.
:- type option
+
% Warning options
---> inhibit_warnings
; inhibit_accumulator_warnings
@@ -100,6 +106,7 @@
; warn_dead_procs
; warn_table_with_inline
; warn_non_term_special_preds
+
% Verbosity options
; verbose
; very_verbose
@@ -128,6 +135,7 @@
; debug_stack_opt
; debug_make
; debug_closure
+
% Output options
; make_short_interface
; make_interface
@@ -147,14 +155,15 @@
; output_grade_string
; output_link_command
; output_shared_lib_link_command
+
% Auxiliary output options
; smart_recompilation
- % This option is used to control output
- % of version numbers in interface files.
- % It is implied by --smart-recompilation,
- % and cannot be set explicitly by the user.
; generate_item_version_numbers
+ % This option is used to control output of version numbers
+ % in interface files. It is implied by --smart-recompilation,
+ % and cannot be set explicitly by the user.
+
; generate_mmc_make_module_dependencies
; assume_gmake
; trace
@@ -167,13 +176,12 @@
; trace_table_io_all
; delay_death
; suppress_trace
-
- % Force no tracing, even in .debug grades.
- % This is used to turn off tracing in the
- % browser directory while still allowing
- % the browser library to be linked in with an
- % executable compiled in a .debug grade.
; force_disable_tracing
+ % Force no tracing, even in .debug grades. This is used to turn off
+ % tracing in the browser directory while still allowing the browser
+ % library to be linked in with an executable compiled in a .debug
+ % grade.
+
; stack_trace_higher_order
; tabling_via_extra_args
; allow_table_reset
@@ -198,6 +206,7 @@
; benchmark_modes_repeat
; sign_assembly
; separate_assemblies
+
% Language semantics options
; reorder_conj
; reorder_disj
@@ -210,6 +219,7 @@
; infer_all
; type_inference_iteration_limit
; mode_inference_iteration_limit
+
% Compilation Model options
; grade
@@ -224,9 +234,9 @@
% Compilation model options for optional features:
% (a) Debugging
- % For documentation of the exec_trace and decl_debug
- % options, see the documentation for MR_EXEC_TRACE
- % and MR_DECL_DEBUG in runtime/mercury_conf_param.h.
+ % For documentation of the exec_trace and decl_debug options, see the
+ % documentation for MR_EXEC_TRACE and MR_DECL_DEBUG in
+ % runtime/mercury_conf_param.h.
; exec_trace
; decl_debug
@@ -240,17 +250,16 @@
; profile_memory
; profile_deep
; use_activation_counts
- % use_activation_counts is used to determine
- % which mechanism for cycle detection should be
- % used for deep profiling. Actually, we only
- % want to use the `yes' value, but we keep
- % support for the `no' value for benchmarks
- % for the paper.
+ % Use_activation_counts is used to determine which mechanism for
+ % cycle detection should be used for deep profiling. Actually,
+ % we only want to use the `yes' value, but we keep support for
+ % the `no' value for benchmarks for the paper.
+
; use_zeroing_for_ho_cycles
; use_lots_of_ho_specialization
- % We should always handle tail recursion
- % specially in deep profiling; the option is
- % only for benchmarks for the paper.
+ % We should always handle tail recursion specially in deep
+ % profiling; the option is only for benchmarks for the paper.
+
; deep_profile_tail_recursion
; record_term_sizes_as_words
; record_term_sizes_as_cells
@@ -279,16 +288,13 @@
; num_reserved_objects
; bits_per_word
; bytes_per_word
- % The undocumented conf_low_tag_bits option
- % is used by the `mmc' script to pass the
- % default value for num_tag_bits
- % assuming --tags low.
- % The reason that `mmc' doesn't just
- % pass a default value for --num-tag-bits
- % is that we want to be able to give an
- % error message if the user specifies
- % `--tags high' and doesn't specify
- % `--num-tag-bits'.
+ % The undocumented conf_low_tag_bits option is used by the `mmc'
+ % script to pass the default value for num_tag_bits assuming
+ % --tags low. The reason that `mmc' doesn't just pass a default
+ % value for --num-tag-bits is that we want to be able to give an
+ % error message if the user specifies `--tags high' and doesn't
+ % specify `--num-tag-bits'.
+
; conf_low_tag_bits
; unboxed_float
; unboxed_enums
@@ -309,118 +315,106 @@
; nondet_copy_out
; put_commit_in_own_func
; put_nondet_env_on_heap
+
% IL back-end compilation model options
; verifiable_code
; il_refany_fields
; il_funcptr_types
- ; il_byref_tailcalls % Currently this is not really a
- % compilation model option,
- % i.e. it doesn't affect the ABI.
- % In future it might become one,
- % though -- we should return
- % multiple values in value types,
- % rather than using byrefs.
- % Also it's nicer to keep it with
- % the other IL back-end options here.
+ ; il_byref_tailcalls
+ % Currently this is not really a compilation model option, i.e.
+ % it doesn't affect the ABI. In future it might become one, though
+ % -- we should return multiple values in value types, rather than
+ % using byrefs. Also it's nicer to keep it with the other IL
+ % back-end options here.
+ % Options for internal use only (the values of these options are implied
+ % by the settings of other options)
- % Options for internal use only
- % (the values of these options are implied by the
- % settings of other options)
- % The foreign programming languages that this
- % backend can interface to.
; backend_foreign_languages
+ % The foreign programming languages that this backend can
+ % interface to.
+
; stack_trace
- % Stack layout information required to do
- % a stack trace.
+ % Stack layout information required to do a stack trace.
+
; basic_stack_layout
- % Stack layout information required to do
- % accurate GC.
+ % Stack layout information required to do accurate GC.
+
; agc_stack_layout
- % Stack layout information required to do
- % procedure identification.
+ % Stack layout information required to do procedure identification.
+
; procid_stack_layout
- % Stack layout information required to do
- % execution tracing.
+ % Stack layout information required to do execution tracing.
+
; trace_stack_layout
- % Use an alternate calculation of liveness
- % where the typeinfo for a type variable
- % must live at any point in the body of the
- % procedure at which a live variable's type
- % includes that type variable.
+
+ ; body_typeinfo_liveness
+ % Use an alternate calculation of liveness where the typeinfo
+ % for a type variable must live at any point in the body of the
+ % procedure at which a live variable's type includes that type
+ % variable.
%
- % Although this option governs whether the
- % body of a procedure uses this liveness
- % calculation, it is not the only consideration
- % we have to take into account when deciding on
- % the interface of any procedure whose address
- % may be taken. We must include typeinfos
- % describing the types of all arguments in the
- % interface of a procedure if either this
- % option is set *or* the procedure's address
- % may be taken, otherwise, the layout structure
- % we include in closures using that procedure
- % may not have all the information required
- % to reconstruct the types of all the values
- % inside the closure.
+ % Although this option governs whether the body of a procedure
+ % uses this liveness calculation, it is not the only consideration
+ % we have to take into account when deciding on the interface
+ % of any procedure whose address may be taken. We must include
+ % typeinfos describing the types of all arguments in the interface
+ % of a procedure if either this option is set *or* the procedure's
+ % address may be taken, otherwise, the layout structure we include
+ % in closures using that procedure may not have all the information
+ % required to reconstruct the types of all the values inside the
+ % closure.
%
- % The only place in the compiler that should
- % look at this option is the predicate
- % body_should_use_typeinfo_liveness in
- % hlds_pred.m; everything else, including
- % the predicates deciding interface typeinfo
- % liveness, should go through there.
- ; body_typeinfo_liveness
- % Should be set to yes if the target back end
- % guarantees that comparing two values for
- % equality, at least one of which is a
- % constant, can be done by casting them both
- % to integers and comparing the integers
- % for equality.
- ; can_compare_constants_as_ints
+ % The only place in the compiler that should look at this option
+ % is the predicate body_should_use_typeinfo_liveness in
+ % hlds_pred.m; everything else, including the predicates deciding
+ % interface typeinfo liveness, should go through there.
- % Options for internal use only
- % (setting these options to non-default values can result in
- % programs that do not link, or programs that dump core)
- % Generate unify and compare preds. For
- % measurement only. Code generated with
- % this set to `no' is unlikely to
- % actually work.
+ ; can_compare_constants_as_ints
+ % Should be set to yes if the target back end guarantees that
+ % comparing two values for equality, at least one of which is a
+ % constant, can be done by casting them both to integers and
+ % comparing the integers for equality.
+
+ % Options for internal use only (setting these options to non-default
+ % values can result in programs that do not link, or programs that dump
+ % core)
; special_preds
- % Generate type_ctor_info structures.
- % For measurement only -- if you turn this
- % off, then you're unlikely to be able
- % to link.
+ % Generate unify and compare preds. For measurement only.
+ % Code generated with this set to `no' is unlikely to actually
+ % work.
+
; type_ctor_info
- % Generate type_ctor_layout structures.
- % For measurement only -- if you turn this
- % off, then you're unlikely to be able
- % to link.
+ % Generate type_ctor_info structures. For measurement only --
+ % if you turn this off, then you're unlikely to be able to link.
+
; type_ctor_layout
- % Generate type_ctor_functors structures.
- % For measurement only -- if you turn this
- % off, then you're unlikely to be able
- % to link.
+ % Generate type_ctor_layout structures. For measurement only --
+ % if you turn this off, then you're unlikely to be able to link.
+
; type_ctor_functors
- % XXX temporary option: enables the generation
- % of new style static data structures for
- % runtime information about type classes.
- % These are not yet used. When we add code to
- % generate the matching dynamic data structures
- % and switch over to use them, we won't need
- % this option anymore.
+ % Generate type_ctor_functors structures. For measurement only --
+ % if you turn this off, then you're unlikely to be able to link.
+
; new_type_class_rtti
- % Generate line number information in the RTTI
- % when debugging is enabled. For measurement
- % only -- if you turn this off, then the
- % debugger may dereference garbage pointers.
+ % XXX temporary option: enables the generation of new style static
+ % data structures for runtime information about type classes.
+ % These are not yet used. When we add code to generate the matching
+ % dynamic data structures and switch over to use them, we won't
+ % need this option anymore.
+
; rtti_line_numbers
- % These four are used to analyze the
- % performance effects of minimal model tabling.
+ % Generate line number information in the RTTI when debugging is
+ % enabled. For measurement only -- if you turn this off, then the
+ % debugger may dereference garbage pointers.
+
; disable_minimal_model_stack_copy_pneg
; disable_minimal_model_stack_copy_cut
; use_minimal_model_stack_copy_pneg
; use_minimal_model_stack_copy_cut
+ % These four are used to analyze the performance effects
+ % of minimal model tabling.
+
% Code generation options
; low_level_debug
; trad_passes
@@ -439,13 +433,11 @@
; max_specialized_do_call_class_method
; compare_specialization
; fact_table_max_array_size
- % maximum number of elements in a single
- % fact table data array
+ % Maximum number of elements in a single fact table data array.
; fact_table_hash_percent_full
- % how full the fact table hash tables should
- % be allowed to get, given as an integer
- % percentage.
+ % How full the fact table hash tables should be allowed to get,
+ % given as an integer percentage.
; gcc_local_labels
; prefer_switch
@@ -453,7 +445,8 @@
% Optimization Options
; opt_level
- ; opt_space % default is to optimize time
+ ; opt_level_number
+ ; opt_space % Default is to optimize time.
; intermodule_optimization
; intermodule_analysis
; read_opt_files_transitively
@@ -462,6 +455,7 @@
; use_trans_opt_files
; transitive_optimization
; split_c_files
+
% - HLDS
; allow_inlining
; inlining
@@ -524,9 +518,8 @@
; termination_norm
; termination_error_limit
; termination_path_limit
- %
+
% Stuff for the new termination analyser.
- %
; termination2
; check_termination2
; verbose_check_termination2
@@ -542,6 +535,7 @@
; tuple_trace_counts_file
; tuple_costs_ratio
; tuple_min_args
+
% - HLDS->LLDS
; smart_indexing
; dense_switch_req_density
@@ -556,13 +550,15 @@
; middle_rec
; simple_neg
; allow_hijacks
+
% - MLDS
; optimize_tailcalls
; optimize_initializations
; eliminate_local_vars
+
% - LLDS
; common_data
- ; optimize % also used for MLDS->MLDS optimizations
+ ; optimize % Also used for MLDS->MLDS optimizations.
; optimize_peep
; optimize_jumps
; optimize_fulljumps
@@ -573,11 +569,11 @@
; optimize_labels
; optimize_dups
; optimize_proc_dups
-%%% unused: ; optimize_copyprop
; optimize_frames
; optimize_delay_slot
; optimize_reassign
; optimize_repeat
+
% - RL
; optimize_rl
; optimize_rl_cse
@@ -589,8 +585,10 @@
; emit_c_loops
; procs_per_c_function
; everything_in_one_c_function
+
% - IL
% (none yet)
+
% Target code compilation options
; target_debug
@@ -603,7 +601,7 @@
; ansi_c
; inline_alloc
- % auto-configured C compilation options.
+ % Auto-configured C compilation options.
; cflags_for_warnings
; cflags_for_optimization
; cflags_for_ansi
@@ -674,7 +672,7 @@
; runtime_flags
; extra_initialization_functions
- % auto-configured options.
+ % Auto-configured options.
; shared_library_extension
; library_extension
; executable_file_extension
@@ -745,28 +743,23 @@
; version
; fullarch
; compiler_sufficiently_recent
- % This option is used to test that the compiler
- % is sufficiently recent when no other test
- % can easily be constructed in configure.in.
+ % This option is used to test that the compiler is sufficiently
+ % recent when no other test can easily be constructed in
+ % configure.in.
+
; experiment.
- % This option is provided for use by
- % implementors who want to compare a new way
- % of doing something with the old way.
- % The idea is that the code that switches
- % between the two ways should consult this
- % option and make its decision accordingly.
+ % This option is provided for use by implementors who want to
+ % compare a new way of doing something with the old way. The idea
+ % is that the code that switches between the two ways should
+ % consult this option and make its decision accordingly.
%
- % The intention is that all use of this
- % option is within developer workspaces;
- % no code using this option should be
- % committed.
+ % The intention is that all use of this option is within developer
+ % workspaces; no code using this option should be committed.
%
- % Of course, a developer could always create
- % a purpose-specific option to control their
- % code, but adding an option requires
- % recompiling most of the modules in the
- % compiler. Having this option permanently here
- % should reduce the need for that.
+ % Of course, a developer could always create a purpose-specific
+ % option to control their code, but adding an option requires
+ % recompiling most of the modules in the compiler. Having this
+ % option permanently here should reduce the need for that.
:- implementation.
@@ -812,12 +805,12 @@
inhibit_accumulator_warnings - bool(no),
halt_at_warn - bool(no),
halt_at_syntax_errors - bool(no),
- %
+
% IMPORTANT NOTE:
- % if you add any new warning options, or if you change
- % the default for an existing warning option to `yes',
- % then you will need to modify the handling of inhibit_warnings
- %
+ % if you add any new warning options, or if you change the default
+ % for an existing warning option to `yes', then you will need to modify
+ % the handling of inhibit_warnings.
+
warn_singleton_vars - bool(yes),
warn_overlapping_scopes - bool(yes),
warn_det_decls_too_lax - bool(yes),
@@ -849,8 +842,7 @@
very_verbose - bool(no),
verbose_errors - bool(no),
verbose_recompilation - bool(no),
- find_all_recompilation_reasons -
- bool(no),
+ find_all_recompilation_reasons - bool(no),
verbose_make - bool(yes),
verbose_commands - bool(no),
output_compile_error_lines - int(15),
@@ -953,14 +945,10 @@
mode_inference_iteration_limit - int(30)
]).
option_defaults_2(compilation_model_option, [
- %
- % Compilation model options (ones that affect binary
- % compatibility).
- %
+ % Compilation model options (ones that affect binary compatibility).
grade - string_special,
- % the `mmc' script will pass the
- % default grade determined
- % at configuration time
+ % The `mmc' script will pass the default grade determined
+ % at configuration time.
% Target selection compilation model options
target - string("c"),
@@ -984,12 +972,9 @@
profile_memory - bool(no),
profile_deep - bool(no),
use_activation_counts - bool(no),
- use_zeroing_for_ho_cycles
- - bool(yes),
- use_lots_of_ho_specialization
- - bool(no),
- deep_profile_tail_recursion
- - bool(no),
+ use_zeroing_for_ho_cycles - bool(yes),
+ use_lots_of_ho_specialization - bool(no),
+ deep_profile_tail_recursion - bool(no),
record_term_sizes_as_words - bool(no),
record_term_sizes_as_cells - bool(no),
experimental_complexity - string(""),
@@ -1004,7 +989,7 @@
minimal_model_debug - bool(no),
type_layout - bool(yes),
aditi - bool(no),
- aditi_calls_mercury - bool(no),% XXX eventually yes
+ aditi_calls_mercury - bool(no), % XXX eventually yes
% Data representation compilation model options
reserve_tag - bool(no),
@@ -1023,13 +1008,13 @@
% A good default for the current
% generation of architectures.
conf_low_tag_bits - int(2),
- % the `mmc' script will override the
+ % The `mmc' script will override the
% above default with a value determined
- % at configuration time
+ % at configuration time.
sync_term_size - int(8),
% 8 is the size on linux (at the time
- % of writing) - will usually be over-
- % ridden by a value from configure.
+ % of writing) - will usually be
+ % overridden by a value from configure.
unboxed_float - bool(no),
unboxed_enums - bool(yes),
unboxed_no_tag_types - bool(yes),
@@ -1056,7 +1041,7 @@
]).
option_defaults_2(internal_use_option, [
% Options for internal use only
- backend_foreign_languages- accumulating([]),
+ backend_foreign_languages - accumulating([]),
% The backend_foreign_languages option
% depends on the target and is set in
% handle_options.
@@ -1087,16 +1072,16 @@
reclaim_heap_on_semidet_failure - bool(yes),
reclaim_heap_on_nondet_failure - bool(yes),
have_delay_slot - bool(no),
- % the `mmc' script may override the
+ % The `mmc' script may override the
% above default if configure says
- % the machine has branch delay slots
+ % the machine has branch delay slots.
num_real_r_regs - int(5),
num_real_f_regs - int(0),
num_real_r_temps - int(5),
num_real_f_temps - int(0),
- % the `mmc' script will override the
+ % The `mmc' script will override the
% above defaults with values determined
- % at configuration time
+ % at configuration time.
pic - bool(no),
max_jump_table_size - int(0),
% 0 indicates any size.
@@ -1128,6 +1113,7 @@
% Special optimization options.
% These ones are not affected by `-O<n>'.
opt_level - int_special,
+ opt_level_number - int(-2),
opt_space - special,
intermodule_optimization - bool(no),
intermodule_analysis - bool(no),
@@ -1163,8 +1149,8 @@
% IMPORTANT: the default here should be all optimizations OFF.
% Optimizations should be enabled by the appropriate
% optimization level in the opt_level table.
- %
-% HLDS
+
+ % HLDS
allow_inlining - bool(yes),
inlining - bool_special,
inline_simple - bool(no),
@@ -1172,15 +1158,19 @@
inline_single_use - bool(no),
inline_call_cost - int(0),
inline_compound_threshold - int(0),
- inline_simple_threshold - int(5), % has no effect until
- % --inline-simple is enabled
+ inline_simple_threshold - int(5),
+ % Has no effect until
+ % --inline-simple is enabled.
inline_vars_threshold - int(100),
- intermod_inline_simple_threshold - % has no effect until
- int(5), % --intermodule-optimization
+ intermod_inline_simple_threshold - int(5),
+ % Has no effect until
+ % --intermodule-optimization.
common_struct - bool(no),
common_goal - bool(yes),
- % common_goal is not really an optimization, since
- % it affects the semantics
+ % common_goal is not really an
+ % optimization, since it affects
+ % the semantics.
+
constraint_propagation - bool(no),
local_constraint_propagation - bool(no),
optimize_duplicate_calls - bool(no),
@@ -1211,7 +1201,7 @@
higher_order_size_limit - int(20),
higher_order_arg_limit - int(10),
unneeded_code - bool(no),
- unneeded_code_copy_limit- int(10),
+ unneeded_code_copy_limit - int(10),
type_specialization - bool(no),
user_guided_type_specialization - bool(no),
introduce_accumulators - bool(no),
@@ -1229,12 +1219,14 @@
tuple_costs_ratio - int(100),
tuple_min_args - int(4),
-% HLDS -> LLDS
+ % HLDS -> LLDS
smart_indexing - bool(no),
dense_switch_req_density - int(25),
- % Minimum density before using a dense switch
+ % Minimum density before using
+ % a dense switch.
lookup_switch_req_density - int(25),
- % Minimum density before using a lookup switch
+ % Minimum density before using
+ % a lookup switch.
dense_switch_size - int(4),
lookup_switch_size - int(4),
string_switch_size - int(8),
@@ -1245,11 +1237,13 @@
middle_rec - bool(no),
simple_neg - bool(no),
allow_hijacks - bool(yes),
-% MLDS
+
+ % MLDS
optimize_tailcalls - bool(no),
optimize_initializations - bool(no),
eliminate_local_vars - bool(no),
-% LLDS
+
+ % LLDS
common_data - bool(no),
optimize - bool(no),
optimize_peep - bool(no),
@@ -1262,18 +1256,18 @@
optimize_labels - bool(no),
optimize_dups - bool(no),
optimize_proc_dups - bool(no),
-%%% optimize_copyprop - bool(no),
optimize_frames - bool(no),
optimize_delay_slot - bool(no),
optimize_reassign - bool(no),
optimize_repeat - int(0),
-% LLDS -> C
+ % LLDS -> C
use_macro_for_redo_fail - bool(no),
emit_c_loops - bool(no),
procs_per_c_function - int(1),
everything_in_one_c_function - special,
-% RL
+
+ % RL
optimize_rl - bool(no),
optimize_rl_cse - bool(no),
optimize_rl_invariants - bool(no),
@@ -1284,25 +1278,25 @@
% Target code compilation options
target_debug - bool(no),
-% C
- % the `mmc' script will override the
- % following default with a value
- % determined at configuration time.
+ % C
cc - string("gcc"),
- % the `mmc' script will override the
- % following default with a value
- % determined at configuration time
+ % The `mmc' script will override the
+ % default with a value determined at
+ % configuration time.
c_include_directory - accumulating([]),
+ % The `mmc' script will override the
+ % default with a value determined at
+ % configuration time.
c_optimize - bool(no),
ansi_c - bool(yes),
inline_alloc - bool(no),
cflags - accumulating([]),
quoted_cflag - string_special,
- % the `mmc' script will override the
- % following defaults with values
- % determined at configuration time
cflags_for_warnings - string(""),
+ % The `mmc' script will override the
+ % default with values determined at
+ % configuration time.
cflags_for_optimization - string("-O"),
cflags_for_ansi - string(""),
cflags_for_regs - string(""),
@@ -1315,7 +1309,7 @@
pic_object_file_extension - string(".o"),
link_with_pic_object_file_extension - string(".o"),
-% Java
+ % Java
java_compiler - string("javac"),
java_interpreter - string("java"),
java_flags - accumulating([]),
@@ -1323,22 +1317,22 @@
java_classpath - accumulating([]),
java_object_file_extension - string(".class"),
-% IL
+ % IL
il_assembler - string("ilasm"),
ilasm_flags - accumulating([]),
quoted_ilasm_flag - string_special,
- % We default to the version of the library that came
- % with Beta2.
dotnet_library_version - string("1.0.3300.0"),
+ % We default to the version of the
+ % library that came with Beta2.
support_ms_clr - bool(yes),
support_rotor_clr - bool(no),
-% Managed C++
+ % Managed C++
mcpp_compiler - string("cl"),
mcpp_flags - accumulating([]),
quoted_mcpp_flag - string_special,
-% C#
+ % C#
csharp_compiler - string("csc"),
csharp_flags - accumulating([]),
quoted_csharp_flag - string_special
@@ -1346,9 +1340,9 @@
option_defaults_2(link_option, [
% Link Options
output_file_name - string(""),
- % if the output_file_name is an empty
+ % If the output_file_name is an empty
% string, we use the name of the first
- % module on the command line
+ % module on the command line.
ld_flags - accumulating([]),
quoted_ld_flag - string_special,
ld_libflags - accumulating([]),
@@ -1357,14 +1351,13 @@
runtime_link_library_directories - accumulating([]),
link_libraries - accumulating([]),
link_objects - accumulating([]),
- mercury_library_directory_special -
- string_special,
+ mercury_library_directory_special - string_special,
mercury_library_directories - accumulating([]),
mercury_library_special - string_special,
mercury_libraries - accumulating([]),
+ mercury_standard_library_directory - maybe_string(no),
% The Mercury.config file will set the
% default standard library directory.
- mercury_standard_library_directory - maybe_string(no),
mercury_standard_library_directory_special - maybe_string_special,
init_file_directories - accumulating([]),
init_files - accumulating([]),
@@ -1381,17 +1374,16 @@
runtime_flags - accumulating([]),
extra_initialization_functions - bool(no),
- % the `mmc' script will override the
- % following defaults with a value
- % determined at configuration time
shared_library_extension - string(".so"),
+ % The `mmc' script will override the
+ % default with a value determined at
+ % configuration time.
library_extension - string(".a"),
executable_file_extension - string(""),
link_executable_command - string("gcc"),
link_shared_lib_command - string("gcc -shared"),
create_archive_command - string("ar"),
- create_archive_command_output_flag -
- string(""),
+ create_archive_command_output_flag - string(""),
create_archive_command_flags - accumulating([]), % "cr"
ranlib_command - string(""),
mkinit_command - string("mkinit"),
@@ -1423,8 +1415,7 @@
linker_error_undefined_flag - string("-Wl,-no-undefined"),
shlib_linker_use_install_name - bool(no),
shlib_linker_install_name_flag - string("-install_name "),
- shlib_linker_install_name_path - string(
- "$(INSTALL_MERC_LIB_DIR)")
+ shlib_linker_install_name_path - string("$(INSTALL_MERC_LIB_DIR)")
]).
option_defaults_2(build_system_option, [
% Build System Options
@@ -1447,15 +1438,14 @@
flags_file - file_special,
options_files - accumulating(["Mercury.options"]),
- % yes("") means unset.
config_file - maybe_string(yes("")),
+ % yes("") means unset.
options_search_directories - accumulating(["."]),
use_subdirs - bool(no),
use_grade_subdirs - bool(no),
search_directories - accumulating(["."]),
intermod_directories - accumulating([]),
- use_search_directories_for_intermod
- - bool(yes)
+ use_search_directories_for_intermod - bool(yes)
]).
option_defaults_2(miscellaneous_option, [
% Miscellaneous Options
@@ -1464,8 +1454,7 @@
help - bool(no),
version - bool(no),
fullarch - string(""),
- compiler_sufficiently_recent
- - bool(no),
+ compiler_sufficiently_recent - bool(no),
experiment - string("")
]).
@@ -1581,10 +1570,8 @@
long_option("make-int", make_interface).
long_option("make-private-interface", make_private_interface).
long_option("make-priv-int", make_private_interface).
-long_option("make-optimization-interface",
- make_optimization_interface).
-long_option("make-optimisation-interface",
- make_optimization_interface).
+long_option("make-optimization-interface", make_optimization_interface).
+long_option("make-optimisation-interface", make_optimization_interface).
long_option("make-opt-int", make_optimization_interface).
long_option("make-transitive-optimization-interface",
make_transitive_opt_interface).
@@ -1602,8 +1589,7 @@
long_option("aditi-only", aditi_only).
long_option("output-grade-string", output_grade_string).
long_option("output-link-command", output_link_command).
-long_option("output-shared-lib-link-command",
- output_shared_lib_link_command).
+long_option("output-shared-lib-link-command", output_shared_lib_link_command).
% aux output options
long_option("smart-recompilation", smart_recompilation).
@@ -1663,14 +1649,12 @@
long_option("infer-modes", infer_modes).
long_option("infer-determinism", infer_det).
long_option("infer-det", infer_det).
-long_option("type-inference-iteration-limit",
- type_inference_iteration_limit).
-long_option("mode-inference-iteration-limit",
- mode_inference_iteration_limit).
+long_option("type-inference-iteration-limit", type_inference_iteration_limit).
+long_option("mode-inference-iteration-limit", mode_inference_iteration_limit).
% compilation model options
long_option("grade", grade).
- % target selection options
+% target selection options
long_option("target", target).
long_option("il", il).
long_option("il-only", il_only).
@@ -1681,8 +1665,8 @@
long_option("Java", java).
long_option("java-only", java_only).
long_option("Java-only", java_only).
- % Optional features compilation model options:
- % (a) debugging
+% Optional features compilation model options:
+% (a) debugging
long_option("debug", exec_trace).
long_option("decl-debug", decl_debug).
% (b) profiling
@@ -1704,7 +1688,7 @@
long_option("record-term-sizes-as-words", record_term_sizes_as_words).
long_option("record-term-sizes-as-cells", record_term_sizes_as_cells).
long_option("experimental-complexity", experimental_complexity).
- % (c) miscellaneous optional features
+% (c) miscellaneous optional features
long_option("gc", gc).
long_option("garbage-collection", gc).
long_option("parallel", parallel).
@@ -1714,7 +1698,7 @@
long_option("extend-stacks-when-needed", extend_stacks_when_needed).
long_option("aditi", aditi).
long_option("aditi-calls-mercury", aditi_calls_mercury).
- % Data representation options
+% Data representation options
long_option("reserve-tag", reserve_tag).
long_option("use-minimal-model-stack_copy", use_minimal_model_stack_copy).
long_option("use-minimal-model-own-stacks", use_minimal_model_own_stacks).
@@ -1733,11 +1717,11 @@
long_option("unboxed-no-tag-types", unboxed_no_tag_types).
long_option("highlevel-data", highlevel_data).
long_option("high-level-data", highlevel_data).
- % LLDS back-end compilation model options
+% LLDS back-end compilation model options
long_option("gcc-non-local-gotos", gcc_non_local_gotos).
long_option("gcc-global-registers", gcc_global_registers).
long_option("asm-labels", asm_labels).
- % MLDS back-end compilation model options
+% MLDS back-end compilation model options
long_option("highlevel-code", highlevel_code).
long_option("high-level-code", highlevel_code).
long_option("highlevel-C", highlevel_code).
@@ -1749,7 +1733,7 @@
long_option("nondet-copy-out", nondet_copy_out).
long_option("put-commit-in-own-func", put_commit_in_own_func).
long_option("put-nondet-env-on-heap", put_nondet_env_on_heap).
- % IL back-end compilation model options
+% IL back-end compilation model options
long_option("verifiable-code", verifiable_code).
long_option("verifiable", verifiable_code).
long_option("il-funcptr-types", il_funcptr_types).
@@ -1760,8 +1744,7 @@
long_option("IL-byref-tailcalls", il_byref_tailcalls).
% internal use options
-long_option("backend-foreign-languages",
- backend_foreign_languages).
+long_option("backend-foreign-languages", backend_foreign_languages).
long_option("agc-stack-layout", agc_stack_layout).
long_option("basic-stack-layout", basic_stack_layout).
long_option("procid-stack-layout", procid_stack_layout).
@@ -1858,17 +1841,20 @@
long_option("osv-loop", optimize_saved_vars_cell_loop).
long_option("osv-full-path", optimize_saved_vars_cell_full_path).
long_option("osv-on-stack", optimize_saved_vars_cell_on_stack).
-long_option("osv-cand-head", optimize_saved_vars_cell_candidate_headvars).
- % The next four options are used by tupling.m as well; changes to
- % them may require changes there as well.
+long_option("osv-cand-head",
+ optimize_saved_vars_cell_candidate_headvars).
+% The next four options are used by tupling.m as well; changes to them
+% may require changes there as well.
long_option("osv-cvstore-cost", optimize_saved_vars_cell_cv_store_cost).
long_option("osv-cvload-cost", optimize_saved_vars_cell_cv_load_cost).
long_option("osv-fvstore-cost", optimize_saved_vars_cell_fv_store_cost).
long_option("osv-fvload-cost", optimize_saved_vars_cell_fv_load_cost).
long_option("osv-op-ratio", optimize_saved_vars_cell_op_ratio).
long_option("osv-node-ratio", optimize_saved_vars_cell_node_ratio).
-long_option("osv-allpath-node-ratio", optimize_saved_vars_cell_all_path_node_ratio).
-long_option("osv-all-cand", optimize_saved_vars_cell_include_all_candidates).
+long_option("osv-allpath-node-ratio",
+ optimize_saved_vars_cell_all_path_node_ratio).
+long_option("osv-all-cand",
+ optimize_saved_vars_cell_include_all_candidates).
long_option("delay-construct", delay_construct).
long_option("delay-constructs", delay_construct).
long_option("prev-code", prev_code).
@@ -1890,17 +1876,20 @@
user_guided_type_specialization).
long_option("user-guided-type-specialisation",
user_guided_type_specialization).
- % This option is for use in configure.in to test for
- % some bug-fixes for type-specialization which are needed
- % to compile the library. It's not documented, and should
- % eventually be removed.
+% This option is for use in configure.in to test for some bug-fixes for
+% type-specialization which are needed to compile the library. It's not
+% documented, and should eventually be removed.
long_option("fixed-user-guided-type-specialization",
user_guided_type_specialization).
long_option("introduce-accumulators", introduce_accumulators).
-long_option("optimise-constructor-last-call-accumulator", optimize_constructor_last_call_accumulator).
-long_option("optimize-constructor-last-call-accumulator", optimize_constructor_last_call_accumulator).
-long_option("optimise-constructor-last-call", optimize_constructor_last_call).
-long_option("optimize-constructor-last-call", optimize_constructor_last_call).
+long_option("optimise-constructor-last-call-accumulator",
+ optimize_constructor_last_call_accumulator).
+long_option("optimize-constructor-last-call-accumulator",
+ optimize_constructor_last_call_accumulator).
+long_option("optimise-constructor-last-call",
+ optimize_constructor_last_call).
+long_option("optimize-constructor-last-call",
+ optimize_constructor_last_call).
long_option("optimize-dead-procs", optimize_dead_procs).
long_option("optimise-dead-procs", optimize_dead_procs).
long_option("deforestation", deforestation).
@@ -2039,10 +2028,9 @@
long_option("cc", cc).
long_option("c-optimise", c_optimize).
long_option("c-optimize", c_optimize).
- % XXX we should consider the relationship between c_debug and
- % target_debug more carefully. Perhaps target_debug could imply
- % C debug if the target is C. However for the moment they are
- % just synonyms.
+% XXX we should consider the relationship between c_debug and target_debug
+% more carefully. Perhaps target_debug could imply C debug if the target is C.
+% However for the moment they are just synonyms.
long_option("c-debug", target_debug).
long_option("c-include-directory", c_include_directory).
long_option("ansi-c", ansi_c).
@@ -2067,10 +2055,9 @@
long_option("java-interpreter", java_interpreter).
long_option("java-flags", java_flags).
long_option("java-flag", quoted_java_flag).
- % XXX we should consider the relationship between java_debug and
- % target_debug more carefully. Perhaps target_debug could imply
- % Java debug if the target is Java. However for the moment they are
- % just synonyms.
+% XXX we should consider the relationship between java_debug and target_debug
+% more carefully. Perhaps target_debug could imply Java debug if the target
+% is Java. However for the moment they are just synonyms.
long_option("java-debug", target_debug).
long_option("java-classpath", java_classpath).
long_option("java-object-file-extension", java_object_file_extension).
@@ -2210,8 +2197,7 @@
( convert_grade_option(Grade, OptionTable0, OptionTable) ->
Result = ok(OptionTable)
;
- string__append_list(["invalid grade `", Grade, "'"], Msg),
- Result = error(Msg)
+ Result = error("invalid grade `" ++ Grade ++ "'")
).
special_handler(il, none, OptionTable0, ok(OptionTable)) :-
map__set(OptionTable0, target, string("il"), OptionTable).
@@ -2252,12 +2238,10 @@
map__set(OptionTable2, inline_single_use, bool(Value), OptionTable3),
(
Value = yes,
- map__set(OptionTable3, inline_compound_threshold,
- int(10), OptionTable)
+ map__set(OptionTable3, inline_compound_threshold, int(10), OptionTable)
;
Value = no,
- map__set(OptionTable3, inline_compound_threshold,
- int(0), OptionTable)
+ map__set(OptionTable3, inline_compound_threshold, int(0), OptionTable)
).
special_handler(everything_in_one_c_function, none, OptionTable0,
ok(OptionTable)) :-
@@ -2275,8 +2259,8 @@
reorder_disj - bool(no),
fully_strict - bool(yes)
], OptionTable0, OptionTable).
-special_handler(inhibit_warnings, bool(Inhibit), OptionTable0, ok(OptionTable))
- :-
+special_handler(inhibit_warnings, bool(Inhibit), OptionTable0,
+ ok(OptionTable)) :-
bool__not(Inhibit, Enable),
override_options([
inhibit_accumulator_warnings - bool(Inhibit),
@@ -2318,7 +2302,8 @@
;
N = N0
),
- set_opt_level(N, OptionTable0, OptionTable).
+ map__set(OptionTable0, opt_level_number, int(N), OptionTable1),
+ set_opt_level(N, OptionTable1, OptionTable).
special_handler(optimize_saved_vars, bool(Optimize),
OptionTable0, ok(OptionTable)) :-
map__set(OptionTable0, optimize_saved_vars_const, bool(Optimize),
@@ -2341,10 +2326,8 @@
maybe_string(MaybeStdLibDir), OptionTable0, ok(OptionTable)) :-
OptionTable =
map__set(map__set(OptionTable0,
- mercury_standard_library_directory,
- maybe_string(MaybeStdLibDir)),
- mercury_configuration_directory,
- maybe_string(MaybeStdLibDir)).
+ mercury_standard_library_directory, maybe_string(MaybeStdLibDir)),
+ mercury_configuration_directory, maybe_string(MaybeStdLibDir)).
special_handler(mercury_configuration_directory_special,
string(ConfDir), OptionTable0, ok(OptionTable)) :-
OptionTable = map__set(OptionTable0, mercury_configuration_directory,
@@ -2376,17 +2359,16 @@
(OptionTable0 ^ elem(mercury_linkage) := string(Flag))
^ elem(linkage) := string(Flag))
;
- Result = error(
- "argument of `--linkage' should be either ""shared"" or ""static"".")
+ Result = error("argument of `--linkage' should be either " ++
+ """shared"" or ""static"".")
).
special_handler(mercury_linkage_special, string(Flag),
OptionTable0, Result) :-
( ( Flag = "shared" ; Flag = "static" ) ->
- Result = ok(
- OptionTable0 ^ elem(mercury_linkage) := string(Flag))
+ Result = ok(OptionTable0 ^ elem(mercury_linkage) := string(Flag))
;
- Result = error(
-"argument of `--mercury-linkage' should be either ""shared"" or ""static"".")
+ Result = error("argument of `--mercury-linkage' should be either " ++
+ """shared"" or ""static"".")
).
%-----------------------------------------------------------------------------%
@@ -2411,39 +2393,33 @@
getopt_io__lookup_accumulating_option(OptionTable0, Option)
++ [Value]).
-:- pred set_opt_level(int, option_table, option_table).
-:- mode set_opt_level(in, in, out) is det.
+:- pred set_opt_level(int::in, option_table::in, option_table::out) is det.
set_opt_level(N, OptionTable0, OptionTable) :-
- %
- % first reset all optimizations to their default
- % (the default should be all optimizations off)
- %
+ % First reset all optimizations to their default
+ % (the default should be all optimizations off).
option_defaults_2(optimization_option, OptimizationDefaults),
override_options(OptimizationDefaults, OptionTable0, OptionTable1),
- %
- % next enable the optimization levels from 0 up to N.
- %
+
+ % Next enable the optimization levels from 0 up to N.
enable_opt_levels(0, N, OptionTable1, OptionTable).
-:- pred enable_opt_levels(int, int, option_table, option_table).
-:- mode enable_opt_levels(in, in, in, out) is det.
+:- pred enable_opt_levels(int::in, int::in,
+ option_table::in, option_table::out) is det.
enable_opt_levels(N0, N, OptionTable0, OptionTable) :-
( N0 > N ->
OptionTable = OptionTable0
; opt_level(N0, OptionTable0, OptionSettingsList) ->
- override_options(OptionSettingsList, OptionTable0,
- OptionTable1),
+ override_options(OptionSettingsList, OptionTable0, OptionTable1),
N1 = N0 + 1,
enable_opt_levels(N1, N, OptionTable1, OptionTable)
;
error("Unknown optimization level")
).
-:- pred override_options(list(pair(option, option_data)),
- option_table, option_table).
-:- mode override_options(in, in, out) is det.
+:- pred override_options(list(pair(option, option_data))::in,
+ option_table::in, option_table::out) is det.
override_options([], OptionTable, OptionTable).
override_options([Option - Value | Settings], OptionTable0, OptionTable) :-
@@ -2521,11 +2497,9 @@
inline_single_use - bool(yes),
inline_compound_threshold - int(10),
common_struct - bool(yes),
- user_guided_type_specialization
- - bool(yes),
- % XXX While inst `array' is defined as `ground', we
- % can't optimize duplicate calls (we might combine
- % calls to `array.init').
+ user_guided_type_specialization - bool(yes),
+ % XXX While inst `array' is defined as `ground', we can't optimize
+ % duplicate calls (we might combine calls to `array.init').
% optimize_duplicate_calls - bool(yes),
simple_neg - bool(yes),
@@ -2540,7 +2514,6 @@
% payoff even if they increase compilation time quite a bit.
opt_level(3, _, [
-%%% optimize_copyprop - bool(yes),
optimize_saved_vars_const - bool(yes),
optimize_unused_args - bool(yes),
optimize_higher_order - bool(yes),
@@ -2549,7 +2522,7 @@
constant_propagation - bool(yes),
optimize_reassign - bool(yes),
% Disabled until a bug in extras/trailed_update/var.m is resolved.
- %introduce_accumulators - bool(yes),
+ % introduce_accumulators - bool(yes),
optimize_repeat - int(4)
]).
@@ -2584,14 +2557,13 @@
loop_invariants - bool(yes)
]).
-% Optimization level 6: apply optimizations which may have any
-% payoff even if they increase compilation time to completely
-% unreasonable levels.
-
-% Currently this sets `everything_in_one_c_function', which causes
-% the compiler to put everything in the one C function and treat
-% calls to predicates in the same module as local.
-% We also enable inlining of GC_malloc(), redo(), and fail().
+% Optimization level 6: apply optimizations which may have any payoff even if
+% they increase compilation time to completely unreasonable levels.
+
+% Currently this sets `everything_in_one_c_function', which causes the compiler
+% to put everything in the one C function and treat calls to predicates in the
+% same module as local. We also enable inlining of GC_malloc(), redo(), and
+% fail().
opt_level(6, _, [
procs_per_c_function - int(0), % everything in one C function
@@ -2613,6 +2585,8 @@
% Not useful?
%
% unneeded_code:
+% Because it can cause slowdowns at high optimization levels;
+% cause unknown
% type_specialization:
% optimize_rl_invariant:
% XXX why not?
@@ -2627,8 +2601,8 @@
%-----------------------------------------------------------------------------%
-:- pred handle_quoted_flag(option::in, string::in, option_table::in,
- option_table::out) is det.
+:- pred handle_quoted_flag(option::in, string::in,
+ option_table::in, option_table::out) is det.
handle_quoted_flag(Option, Flag, Table,
append_to_accumulating_option(Option - quote_arg(Flag), Table)).
@@ -2639,10 +2613,10 @@
( dir__use_windows_paths ->
ArgList = quote_arg_windows(string__to_char_list(Arg0)),
(
- ArgList = []
- ->
+ ArgList = [],
Arg = """"""
;
+ ArgList = [_ | _],
Arg = string__from_char_list(ArgList)
)
;
@@ -2674,10 +2648,9 @@
Chars1 = quote_arg_windows(Chars0),
( quote_char_windows(Char) ->
% We want whitespace characters within an argument to not be
- % treated as whitespace when splitting the command line
- % into words.
- % Newlines and tabs within a word don't really make
- % sense, so just convert them to spaces.
+ % treated as whitespace when splitting the command line into words.
+ % Newlines and tabs within a word don't really make sense, so just
+ % convert them to spaces.
QuoteChar = ( char__is_whitespace(Char) -> ' ' ; Char ),
Chars = [('\\'), QuoteChar | Chars1]
;
@@ -4522,11 +4495,11 @@
:- pred write_tabbed_lines(list(string)::in, io::di, io::uo) is det.
-write_tabbed_lines([]) --> [].
-write_tabbed_lines([Str|Strs]) -->
- io__write_char('\t'),
- io__write_string(Str),
- io__write_char('\n'),
- write_tabbed_lines(Strs).
+write_tabbed_lines([], !IO).
+write_tabbed_lines([Str | Strs], !IO) :-
+ io__write_char('\t', !IO),
+ io__write_string(Str, !IO),
+ io__write_char('\n', !IO),
+ write_tabbed_lines(Strs, !IO).
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.147
diff -u -b -r1.147 private_builtin.m
--- library/private_builtin.m 7 Oct 2005 05:08:17 -0000 1.147
+++ library/private_builtin.m 14 Oct 2005 09:49:20 -0000
@@ -1205,7 +1205,13 @@
% store_at_ref/2 is used internally by the compiler. Bad things
% will happen if this is used in programs.
%
-:- pred store_at_ref(c_pointer::in, T::in) is det.
+:- pred store_at_ref(store_at_ref_type(T)::in, T::in) is det.
+
+ % This type should be used only by the program transformation that
+ % introduces calls to store_at_ref. Any other use is will cause bad things
+ % to happen.
+:- type store_at_ref_type(T)
+ ---> store_at_ref_type(int).
% unused/0 should never be called.
% The compiler sometimes generates references to this procedure,
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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