[m-rev.] diff: MLDS codegen cleanups.
Zoltan Somogyi
zs at csse.unimelb.edu.au
Fri Jan 16 13:30:38 AEDT 2009
compiler/mercury_compile.m:
compiler/ml_call_gen.m:
compiler/ml_closure_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_simplify_switch.m:
compiler/ml_string_switch.m:
compiler/ml_switch_gen.m:
compiler/ml_tag_switch.m:
compiler/ml_tailcall.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/mlds.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/modules.m:
compiler/rtti_to_mlds.m:
compiler/switch_detection.m:
Misc cleanups of MLDS code generation.
Zoltan.
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/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.484
diff -u -r1.484 mercury_compile.m
--- compiler/mercury_compile.m 23 Dec 2008 01:37:36 -0000 1.484
+++ compiler/mercury_compile.m 14 Jan 2009 15:32:24 -0000
@@ -5060,7 +5060,7 @@
OptimizeInitializations),
globals.io_set_option(optimize_initializations, bool(no), !IO),
maybe_write_string(Verbose, "% Optimizing MLDS...\n", !IO),
- ml_optimize.optimize(!MLDS, !IO),
+ mlds_optimize(!MLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
globals.io_set_option(optimize_initializations,
@@ -5115,7 +5115,7 @@
(
Optimize = yes,
maybe_write_string(Verbose, "% Optimizing MLDS again...\n", !IO),
- ml_optimize.optimize(!MLDS, !IO),
+ mlds_optimize(!MLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO)
;
Optimize = no
@@ -5141,7 +5141,7 @@
RttiDefns = rtti_data_list_to_mlds(HLDS, RttiData),
!.MLDS = mlds(ModuleName, ForeignCode, Imports, Defns0, InitPreds,
FinalPreds, ExportedEnums),
- list.append(RttiDefns, Defns0, Defns),
+ Defns = RttiDefns ++ Defns0,
!:MLDS = mlds(ModuleName, ForeignCode, Imports, Defns, InitPreds,
FinalPreds, ExportedEnums).
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.82
diff -u -r1.82 ml_call_gen.m
--- compiler/ml_call_gen.m 11 Feb 2008 21:25:59 -0000 1.82
+++ compiler/ml_call_gen.m 14 Jan 2009 15:14:09 -0000
@@ -34,7 +34,7 @@
%
:- pred ml_gen_generic_call(generic_call::in, list(prog_var)::in,
list(mer_mode)::in, determinism::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% ml_gen_call(PredId, ProcId, ArgNames, ArgLvals, ArgTypes,
@@ -51,21 +51,21 @@
%
:- pred ml_gen_call(pred_id::in, proc_id::in, list(mlds_var_name)::in,
list(mlds_lval)::in, list(mer_type)::in, code_model::in,
- prog_context::in, bool::in, mlds_defns::out, statements::out,
+ prog_context::in, bool::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate MLDS code for a call to a builtin procedure.
%
:- pred ml_gen_builtin(pred_id::in, proc_id::in, list(prog_var)::in,
code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate MLDS code for a cast. The list of argument variables
% must have only two elements, the input and the output.
%
:- pred ml_gen_cast(prog_context::in, list(prog_var)::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate an rval containing the address of the specified procedure.
@@ -101,7 +101,8 @@
%
:- pred ml_gen_box_or_unbox_lval(mer_type::in, mer_type::in, box_policy::in,
mlds_lval::in, mlds_var_name::in, prog_context::in, bool::in, int::in,
- mlds_lval::out, mlds_defns::out, statements::out, statements::out,
+ mlds_lval::out, list(mlds_defn)::out,
+ list(statement)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate the appropriate MLDS type for a continuation function
@@ -170,7 +171,7 @@
:- pred ml_gen_main_generic_call(generic_call::in(main_generic_call),
list(prog_var)::in, list(mer_mode)::in, determinism::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_main_generic_call(GenericCall, ArgVars, ArgModes, Determinism, Context,
@@ -297,7 +298,7 @@
% Conjoin the code generated by the two closures that we computed
% above. `ml_combine_conj' will generate whatever kind of sequence
% is necessary for this code model.
- %
+
ml_combine_conj(CodeModel, Context, DoGenCall,
DoGenConvOutputAndSucceed, CallAndConvOutputDecls,
CallAndConvOutputStatements, !Info),
@@ -419,7 +420,7 @@
ml_combine_conj(CodeModel, Context, DoGenCall,
DoGenConvOutputAndSucceed, CallAndConvOutputDecls,
CallAndConvOutputStatements, !Info),
- Decls = list.append(ConvArgDecls, CallAndConvOutputDecls),
+ Decls = ConvArgDecls ++ CallAndConvOutputDecls,
Statements = CallAndConvOutputStatements
).
@@ -430,7 +431,7 @@
:- pred ml_gen_mlds_call(mlds_func_signature::in, maybe(mlds_rval)::in,
mlds_rval::in, list(mlds_rval)::in, list(mlds_lval)::in,
list(mlds_type)::in, determinism::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_mlds_call(Signature, ObjectRval, FuncRval, ArgRvals0, RetLvals0,
@@ -494,7 +495,7 @@
Statements = [Statement].
:- pred ml_gen_success_cont(list(mlds_type)::in, list(mlds_lval)::in,
- prog_context::in, success_cont::out, mlds_defns::out,
+ prog_context::in, success_cont::out, list(mlds_defn)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_success_cont(OutputArgTypes, OutputArgLvals, Context,
@@ -530,7 +531,7 @@
OutputArgTypes, Context, CopyDecls, CopyStatements),
ml_gen_call_current_success_cont(Context, CallCont, !Info),
CopyStatement = ml_gen_block(CopyDecls,
- list.append(CopyStatements, [CallCont]), Context),
+ CopyStatements ++ [CallCont], Context),
% pop nesting level
ml_gen_label_func(!.Info, ContFuncLabel, Params, Context,
CopyStatement, ContFuncDefn),
@@ -571,8 +572,8 @@
ml_gen_cont_params_2(Types, ArgNum + 1, Arguments).
:- pred ml_gen_copy_args_to_locals(ml_gen_info::in, list(mlds_lval)::in,
- list(mlds_type)::in, prog_context::in, mlds_defns::out,
- statements::out) is det.
+ list(mlds_type)::in, prog_context::in,
+ list(mlds_defn)::out, list(statement)::out) is det.
ml_gen_copy_args_to_locals(Info, ArgLvals, ArgTypes, Context,
CopyDecls, CopyStatements) :-
@@ -581,8 +582,8 @@
CopyStatements).
:- pred ml_gen_copy_args_to_locals_2(ml_gen_info::in, list(mlds_lval)::in,
- list(mlds_type)::in, int::in, prog_context::in, statements::out)
- is det.
+ list(mlds_type)::in, int::in, prog_context::in,
+ list(statement)::out) is det.
ml_gen_copy_args_to_locals_2(_Info, [], [], _, _, []).
ml_gen_copy_args_to_locals_2(Info, [LocalLval | LocalLvals], [Type | Types],
@@ -618,7 +619,7 @@
list(mer_type)::in, list(mer_type)::in, list(mer_mode)::in,
pred_or_func::in, code_model::in, prog_context::in, bool::in, int::in,
list(mlds_rval)::out, list(mlds_lval)::out, list(mlds_type)::out,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_arg_list(VarNames, VarLvals, CallerTypes, CalleeTypes, Modes,
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.57
diff -u -r1.57 ml_closure_gen.m
--- compiler/ml_closure_gen.m 5 Jan 2009 01:30:50 -0000 1.57
+++ compiler/ml_closure_gen.m 14 Jan 2009 15:14:47 -0000
@@ -37,8 +37,8 @@
%
:- pred ml_gen_closure(pred_id::in, proc_id::in, prog_var::in, prog_vars::in,
list(uni_mode)::in, how_to_construct::in, prog_context::in,
- mlds_defns::out, statements::out, ml_gen_info::in, ml_gen_info::out)
- is det.
+ list(mlds_defn)::out, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
% ml_gen_closure_wrapper(PredId, ProcId, Offset, NumClosureArgs,
% Context, WrapperFuncRval, WrapperFuncType):
@@ -183,7 +183,7 @@
% any changes here may need to be reflected there, and vice versa.
%
:- pred ml_gen_closure_layout(pred_id::in, proc_id::in, prog_context::in,
- mlds_rval::out, mlds_type::out, mlds_defns::out,
+ mlds_rval::out, mlds_type::out, list(mlds_defn)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_closure_layout(PredId, ProcId, Context,
@@ -225,7 +225,7 @@
ClosureLayoutType)).
:- pred ml_gen_closure_proc_id(module_info::in, prog_context::in,
- mlds_initializer::out, mlds_type::out, mlds_defns::out) is det.
+ mlds_initializer::out, mlds_type::out, list(mlds_defn)::out) is det.
ml_gen_closure_proc_id(_ModuleInfo, _Context, InitProcId, ProcIdType,
ClosureProcIdDefns) :-
@@ -250,7 +250,7 @@
:- pred ml_stack_layout_construct_closure_args(module_info::in,
list(closure_arg_info)::in, list(mlds_initializer)::out,
- list(mlds_type)::out, mlds_defns::out) is det.
+ list(mlds_type)::out, list(mlds_defn)::out) is det.
ml_stack_layout_construct_closure_args(ModuleInfo, ClosureArgs,
ClosureArgInits, ClosureArgTypes, Defns) :-
@@ -267,7 +267,7 @@
:- pred ml_stack_layout_construct_closure_arg_rval(module_info::in,
closure_arg_info::in, pair(mlds_initializer, mlds_type)::out,
- mlds_defns::in, mlds_defns::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_stack_layout_construct_closure_arg_rval(ModuleInfo, ClosureArg,
ArgInit - ArgType, !Defns) :-
@@ -288,26 +288,28 @@
ArgInit = init_obj(CastArgRval).
:- pred ml_gen_maybe_pseudo_type_info_defn(module_info::in,
- rtti_maybe_pseudo_type_info::in, mlds_defns::in, mlds_defns::out) is det.
+ rtti_maybe_pseudo_type_info::in, list(mlds_defn)::in, list(mlds_defn)::out)
+ is det.
ml_gen_maybe_pseudo_type_info_defn(ModuleInfo, MaybePTI, !Defns) :-
ml_gen_maybe_pseudo_type_info(ModuleInfo, MaybePTI, _Rval, _Type, !Defns).
:- pred ml_gen_pseudo_type_info_defn(module_info::in,
- rtti_pseudo_type_info::in, mlds_defns::in, mlds_defns::out) is det.
+ rtti_pseudo_type_info::in, list(mlds_defn)::in, list(mlds_defn)::out)
+ is det.
ml_gen_pseudo_type_info_defn(ModuleInfo, PTI, !Defns) :-
ml_gen_pseudo_type_info(ModuleInfo, PTI, _Rval, _Type, !Defns).
:- pred ml_gen_type_info_defn(module_info::in, rtti_type_info::in,
- mlds_defns::in, mlds_defns::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_type_info_defn(ModuleInfo, TI, !Defns) :-
ml_gen_type_info(ModuleInfo, TI, _Rval, _Type, !Defns).
:- pred ml_gen_maybe_pseudo_type_info(module_info::in,
rtti_maybe_pseudo_type_info::in, mlds_rval::out, mlds_type::out,
- mlds_defns::in, mlds_defns::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_maybe_pseudo_type_info(ModuleInfo, MaybePseudoTypeInfo, Rval, Type,
!Defns) :-
@@ -320,7 +322,8 @@
).
:- pred ml_gen_pseudo_type_info(module_info::in, rtti_pseudo_type_info::in,
- mlds_rval::out, mlds_type::out, mlds_defns::in, mlds_defns::out) is det.
+ mlds_rval::out, mlds_type::out, list(mlds_defn)::in, list(mlds_defn)::out)
+ is det.
ml_gen_pseudo_type_info(ModuleInfo, PseudoTypeInfo, Rval, Type, !Defns) :-
(
@@ -369,7 +372,8 @@
).
:- pred ml_gen_type_info(module_info::in, rtti_type_info::in,
- mlds_rval::out, mlds_type::out, mlds_defns::in, mlds_defns::out) is det.
+ mlds_rval::out, mlds_type::out, list(mlds_defn)::in, list(mlds_defn)::out)
+ is det.
ml_gen_type_info(ModuleInfo, TypeInfo, Rval, Type, !Defns) :-
(
@@ -428,7 +432,7 @@
:- pred ml_stack_layout_construct_tvar_vector(module_info::in,
mlds_var_name::in, prog_context::in, map(tvar, set(layout_locn))::in,
- mlds_rval::out, mlds_type::out, mlds_defns::out) is det.
+ mlds_rval::out, mlds_type::out, list(mlds_defn)::out) is det.
ml_stack_layout_construct_tvar_vector(ModuleInfo, TvarVectorName, Context,
TVarLocnMap, MLDS_Rval, ArrayType, Defns) :-
@@ -1096,7 +1100,7 @@
%
:- pred ml_gen_closure_wrapper_gc_decls(closure_kind::in, mlds_var_name::in,
mlds_type::in, pred_id::in, proc_id::in, prog_context::in,
- mlds_defns::out, ml_gen_info::in, ml_gen_info::out) is det.
+ list(mlds_defn)::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_closure_wrapper_gc_decls(ClosureKind, ClosureArgName, ClosureArgType,
PredId, ProcId, Context, GC_Decls, !Info) :-
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.213
diff -u -r1.213 ml_code_gen.m
--- compiler/ml_code_gen.m 5 Jan 2009 01:30:50 -0000 1.213
+++ compiler/ml_code_gen.m 14 Jan 2009 15:38:11 -0000
@@ -715,6 +715,7 @@
:- import_module parse_tree.prog_data.
:- import_module io.
+:- import_module list.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -735,7 +736,7 @@
% and the other containing the generated statements.
%
:- pred ml_gen_goal(code_model::in, hlds_goal::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% ml_gen_wrap_goal(OuterCodeModel, InnerCodeModel, Context,
@@ -748,13 +749,13 @@
% for OuterCodeModel.
%
:- pred ml_gen_wrap_goal(code_model::in, code_model::in, prog_context::in,
- statements::in, statements::out,
+ list(statement)::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate declarations for a list of local variables.
%
:- pred ml_gen_local_var_decls(prog_varset::in, vartypes::in,
- prog_context::in, prog_vars::in, mlds_defns::out,
+ prog_context::in, prog_vars::in, list(mlds_defn)::out,
ml_gen_info::in, ml_gen_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -787,7 +788,6 @@
:- import_module parse_tree.prog_type.
:- import_module bool.
-:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
@@ -921,7 +921,8 @@
unexpected(this_file, "foreign_type_required_imports: target erlang")
).
-:- pred ml_gen_defns(module_info::in, mlds_defns::out, io::di, io::uo) is det.
+:- pred ml_gen_defns(module_info::in, list(mlds_defn)::out, io::di, io::uo)
+ is det.
ml_gen_defns(ModuleInfo, Defns, !IO) :-
ml_gen_types(ModuleInfo, TypeDefns, !IO),
@@ -954,16 +955,16 @@
% Generate MLDS definitions for all the non-imported predicates
% (and functions) in the HLDS.
%
-:- pred ml_gen_preds(module_info::in, mlds_defns::out, io::di, io::uo) is det.
+:- pred ml_gen_preds(module_info::in, list(mlds_defn)::out, io::di, io::uo)
+ is det.
ml_gen_preds(ModuleInfo, PredDefns, !IO) :-
module_info_preds(ModuleInfo, PredTable),
map.keys(PredTable, PredIds),
- PredDefns0 = [],
- ml_gen_preds_2(ModuleInfo, PredIds, PredTable, PredDefns0, PredDefns, !IO).
+ ml_gen_preds_2(ModuleInfo, PredIds, PredTable, [], PredDefns, !IO).
:- pred ml_gen_preds_2(module_info::in, list(pred_id)::in, pred_table::in,
- mlds_defns::in, mlds_defns::out, io::di, io::uo) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out, io::di, io::uo) is det.
ml_gen_preds_2(ModuleInfo, PredIds0, PredTable, !Defns, !IO) :-
(
@@ -994,8 +995,8 @@
% of a given predicate (or function).
%
:- pred ml_gen_pred(module_info::in, pred_id::in, pred_info::in,
- import_status::in, mlds_defns::in, mlds_defns::out, io::di, io::uo)
- is det.
+ import_status::in, list(mlds_defn)::in, list(mlds_defn)::out,
+ io::di, io::uo) is det.
ml_gen_pred(ModuleInfo, PredId, PredInfo, ImportStatus, !Defns, !IO) :-
( ImportStatus = status_external(_) ->
@@ -1014,7 +1015,8 @@
).
:- pred ml_gen_procs(list(proc_id)::in, module_info::in, pred_id::in,
- pred_info::in, proc_table::in, mlds_defns::in, mlds_defns::out) is det.
+ pred_info::in, proc_table::in, list(mlds_defn)::in,
+ list(mlds_defn)::out) is det.
ml_gen_procs([], _, _, _, _, !Defns).
ml_gen_procs([ProcId | ProcIds], ModuleInfo, PredId, PredInfo, ProcTable,
@@ -1031,7 +1033,7 @@
% Generate MLDS code for the specified procedure.
%
:- pred ml_gen_proc(module_info::in, pred_id::in, proc_id::in, pred_info::in,
- proc_info::in, mlds_defns::in, mlds_defns::out) is det.
+ proc_info::in, list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_proc(ModuleInfo, PredId, ProcId, _PredInfo, ProcInfo, !Defns) :-
proc_info_get_context(ProcInfo, Context),
@@ -1040,14 +1042,14 @@
DeclFlags = ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId),
ml_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcDefnBody, ExtraDefns),
ProcDefn = mlds_defn(Name, MLDS_Context, DeclFlags, ProcDefnBody),
- !:Defns = list.append(ExtraDefns, [ProcDefn | !.Defns]).
+ !:Defns = ExtraDefns ++ [ProcDefn | !.Defns].
%-----------------------------------------------------------------------------%
%
% Code for handling tabling structures
%
-:- pred ml_gen_table_structs(module_info::in, mlds_defns::out) is det.
+:- pred ml_gen_table_structs(module_info::in, list(mlds_defn)::out) is det.
ml_gen_table_structs(ModuleInfo, Defns) :-
module_info_get_table_struct_map(ModuleInfo, TableStructMap),
@@ -1073,7 +1075,7 @@
:- pred ml_gen_add_table_var(module_info::in,
pair(pred_proc_id, table_struct_info)::in,
- mlds_defns::in, mlds_defns::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_add_table_var(ModuleInfo, PredProcId - TableStructInfo, !Defns) :-
module_info_get_name(ModuleInfo, ModuleName),
@@ -1103,9 +1105,10 @@
InputStepsInit = init_array(
list.map(init_step_desc(tabling_steps_desc(call_table)),
InputSteps)),
- InputStepsDefns = [tabling_name_and_init_to_defn(MLDS_ProcLabel,
+ InputStepsDefn = tabling_name_and_init_to_defn(MLDS_ProcLabel,
MLDS_Context, const, tabling_steps_desc(call_table),
- InputStepsInit)]
+ InputStepsInit),
+ InputStepsDefns = [InputStepsDefn]
),
init_stats(MLDS_ModuleName, MLDS_ProcLabel, MLDS_Context,
call_table, curr_table, InputSteps,
@@ -1128,9 +1131,10 @@
OutputStepsInit = init_array(
list.map(init_step_desc(tabling_steps_desc(answer_table)),
OutputSteps)),
- OutputStepsDefns = [tabling_name_and_init_to_defn(MLDS_ProcLabel,
+ OutputStepsDefn = tabling_name_and_init_to_defn(MLDS_ProcLabel,
MLDS_Context, const, tabling_steps_desc(answer_table),
- OutputStepsInit)]
+ OutputStepsInit),
+ OutputStepsDefns = [OutputStepsDefn]
),
init_stats(MLDS_ModuleName, MLDS_ProcLabel, MLDS_Context,
answer_table, curr_table, InputSteps,
@@ -1207,8 +1211,9 @@
StepDescs = [_ | _],
list.map(init_stats_step(StatsStepsId), StepDescs, StatsStepsInits),
StatsStepsArrayInit = init_array(StatsStepsInits),
- StatsStepDefns = [tabling_name_and_init_to_defn(MLDS_ProcLabel,
- MLDS_Context, modifiable, StatsStepsId, StatsStepsArrayInit)],
+ StatsStepDefn = tabling_name_and_init_to_defn(MLDS_ProcLabel,
+ MLDS_Context, modifiable, StatsStepsId, StatsStepsArrayInit),
+ StatsStepDefns = [StatsStepDefn],
StatsStepsArrayRefInit = gen_init_tabling_name(MLDS_ModuleName,
MLDS_ProcLabel, tabling_stat_steps(CallOrAnswer, CurrOrPrev))
),
@@ -1320,7 +1325,7 @@
% Generate an MLDS definition for the specified procedure.
%
:- pred ml_gen_proc_defn(module_info::in, pred_id::in, proc_id::in,
- mlds_entity_defn::out, mlds_defns::out) is det.
+ mlds_entity_defn::out, list(mlds_defn)::out) is det.
ml_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcDefnBody, ExtraDefns) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
@@ -1409,7 +1414,7 @@
CopiedOutputVars, Goal, Decls0, Statements, !Info),
ml_gen_proc_params(PredId, ProcId, MLDS_Params, !Info),
ml_gen_info_get_extra_defns(!.Info, ExtraDefns),
- Decls = list.append(MLDS_LocalVars, Decls0),
+ Decls = MLDS_LocalVars ++ Decls0,
Statement = ml_gen_block(Decls, Statements, Context),
FunctionBody = body_defined_here(Statement)
),
@@ -1497,7 +1502,7 @@
% local declarations for all the variables used in each sub-goal.
%
:- pred ml_gen_all_local_var_decls(hlds_goal::in, prog_varset::in,
- vartypes::in, list(prog_var)::in, mlds_defns::out,
+ vartypes::in, list(prog_var)::in, list(mlds_defn)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_all_local_var_decls(Goal, VarSet, VarTypes, HeadVars, MLDS_LocalVars,
@@ -1537,7 +1542,7 @@
%
:- pred ml_gen_proc_body(code_model::in, list(prog_var)::in,
list(mer_type)::in, list(arg_mode)::in, list(prog_var)::in,
- hlds_goal::in, mlds_defns::out, statements::out,
+ hlds_goal::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_proc_body(CodeModel, HeadVars, ArgTypes, ArgModes, CopiedOutputVars,
@@ -1594,7 +1599,7 @@
%
:- pred ml_gen_convert_headvars(list(prog_var)::in, list(mer_type)::in,
list(arg_mode)::in, list(prog_var)::in, prog_context::in,
- mlds_defns::out, statements::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_convert_headvars(Vars, HeadTypes, ArgModes, CopiedOutputVars, Context,
@@ -1821,7 +1826,7 @@
% Generate code for a commit.
%
:- pred ml_gen_commit(hlds_goal::in, code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_commit(Goal, CodeModel, Context, Decls, Statements, !Info) :-
@@ -1905,8 +1910,9 @@
SetSuccessTrue),
TryCommitStmt = ml_stmt_try_commit(CommitRefLval,
ml_gen_block([], [GoalStatement, SetSuccessFalse], Context),
- ml_gen_block([], list.append(CopyLocalsToOutputArgs,
- [SetSuccessTrue]), Context)),
+ ml_gen_block([], CopyLocalsToOutputArgs ++ [SetSuccessTrue],
+ Context)
+ ),
TryCommitStatement = statement(TryCommitStmt, MLDS_Context),
CommitFuncLocalDecls = [CommitRefDecl, SuccessFunc | GoalStaticDecls],
maybe_put_commit_in_own_func(CommitFuncLocalDecls,
@@ -2024,8 +2030,8 @@
% But that would impose distributed fat and would make interoperability
% difficult.]
%
-:- pred maybe_put_commit_in_own_func(mlds_defns::in, statements::in,
- prog_context::in, mlds_defns::out, statements::out,
+:- pred maybe_put_commit_in_own_func(list(mlds_defn)::in, list(statement)::in,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
maybe_put_commit_in_own_func(CommitFuncLocalDecls, TryCommitStatements,
@@ -2079,7 +2085,7 @@
% we'll copy the local variables into the output arguments.
%
:- pred ml_gen_maybe_make_locals_for_output_args(hlds_goal_info::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
map(prog_var, mlds_lval)::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -2104,7 +2110,7 @@
).
:- pred ml_gen_make_locals_for_output_args(list(prog_var)::in,
- prog_context::in, mlds_defns::out, statements::out,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_make_locals_for_output_args([], _, [], [], !Info).
@@ -2168,7 +2174,7 @@
% Generate MLDS code for the different kinds of HLDS goals.
%
:- pred ml_gen_goal_expr(hlds_goal_expr::in, code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_goal_expr(GoalExpr, CodeModel, Context, Decls, Statements, !Info) :-
@@ -2284,7 +2290,7 @@
prog_context::in, string::in, maybe(prog_context)::in, string::in,
maybe(prog_context)::in, string::in, maybe(prog_context)::in,
string::in, maybe(prog_context)::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% For model_non pragma c_code,
@@ -2468,16 +2474,13 @@
Ending_C_Code_Stmt = inline_target_code(ml_target_c, Ending_C_Code),
Ending_C_Code_Statement = statement(
ml_stmt_atomic(Ending_C_Code_Stmt), mlds_make_context(Context)),
- Statements = list.condense([
- [Starting_C_Code_Statement],
- ConvStatements,
- [CallCont,
- Ending_C_Code_Statement]
- ]),
+ Statements =
+ [Starting_C_Code_Statement | ConvStatements] ++
+ [CallCont, Ending_C_Code_Statement],
Decls = ConvDecls.
:- pred ml_gen_trace_runtime_cond(trace_expr(trace_runtime)::in,
- term.context::in, mlds_defns::out, statements::out,
+ term.context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_trace_runtime_cond(TraceRuntimeCond, Context, Decls, Statements,
@@ -2521,7 +2524,7 @@
:- pred ml_gen_ordinary_pragma_foreign_proc(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in, string::in,
- prog_context::in, mlds_defns::out, statements::out,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes, PredId, ProcId,
@@ -2590,7 +2593,7 @@
:- pred ml_gen_ordinary_pragma_java_proc(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in, string::in,
- prog_context::in, mlds_defns::out, statements::out,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_ordinary_pragma_java_proc(_CodeModel, Attributes, _PredId, _ProcId,
@@ -2622,11 +2625,7 @@
Java_Code_Statement = statement(
ml_stmt_atomic(Java_Code_Stmt),
mlds_make_context(Context)),
- Statements = list.condense([
- [Java_Code_Statement],
- AssignOutputsList,
- ConvStatements
- ]),
+ Statements = [Java_Code_Statement | AssignOutputsList] ++ ConvStatements,
Decls = ConvDecls.
:- type ordinary_pragma_kind
@@ -2641,12 +2640,11 @@
:- pred ml_gen_ordinary_pragma_managed_proc(ordinary_pragma_kind::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in, string::in,
- prog_context::in, mlds_defns::out, statements::out,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_ordinary_pragma_managed_proc(OrdinaryKind, Attributes, _PredId, _ProcId,
Args, ExtraArgs, ForeignCode, Context, Decls, Statements, !Info) :-
-
ml_gen_outline_args(Args, OutlineArgs, !Info),
expect(unify(ExtraArgs, []), this_file,
"ml_gen_ordinary_pragma_managed_proc: extra args"),
@@ -2689,10 +2687,8 @@
"kind_failure not yet implemented")
),
- Statements = [
- statement(ml_stmt_atomic(OutlineStmt), MLDSContext) |
- SuccessIndicatorStatements
- ],
+ OutlineStatement = statement(ml_stmt_atomic(OutlineStmt), MLDSContext),
+ Statements = [OutlineStatement | SuccessIndicatorStatements],
Decls = SuccessVarLocals.
:- pred ml_gen_outline_args(list(foreign_arg)::in, list(outline_arg)::out,
@@ -2734,12 +2730,11 @@
:- pred ml_gen_ordinary_pragma_il_proc(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in, string::in,
- prog_context::in, mlds_defns::out, statements::out,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_ordinary_pragma_il_proc(_CodeModel, Attributes, PredId, ProcId,
Args, ExtraArgs, ForeignCode, Context, Decls, Statements, !Info) :-
-
expect(unify(ExtraArgs, []), this_file,
"ml_gen_ordinary_pragma_managed_proc: extra args"),
@@ -2797,9 +2792,11 @@
]),
ILCodeFragment = statement(ml_stmt_atomic(OutlineStmt), MLDSContext),
- Statements = [statement(ml_stmt_block(VarLocals,
- [ILCodeFragment] ++ ByRefAssignStatements ++ CopiedOutputStatements),
- mlds_make_context(Context))],
+ BlockStatements = [ILCodeFragment | ByRefAssignStatements] ++
+ CopiedOutputStatements,
+ BlockStatement = statement(ml_stmt_block(VarLocals, BlockStatements),
+ mlds_make_context(Context)),
+ Statements = [BlockStatement],
Decls = [].
:- pred build_arg_map(list(foreign_arg)::in, map(prog_var, foreign_arg)::in,
@@ -2955,7 +2952,7 @@
:- pred ml_gen_ordinary_pragma_c_proc(ordinary_pragma_kind::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in, string::in,
- prog_context::in, mlds_defns::out, statements::out,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_ordinary_pragma_c_proc(OrdinaryKind, Attributes, PredId, _ProcId,
@@ -3057,11 +3054,8 @@
ml_stmt_atomic(Starting_C_Code_Stmt), mlds_make_context(Context)),
Ending_C_Code_Statement = statement(ml_stmt_atomic(Ending_C_Code_Stmt),
mlds_make_context(Context)),
- Statements = list.condense([
- [Starting_C_Code_Statement],
- ConvStatements,
- [Ending_C_Code_Statement]
- ]),
+ Statements = [Starting_C_Code_Statement | ConvStatements] ++
+ [Ending_C_Code_Statement],
Decls = ConvDecls.
% Generate code fragments to obtain and release the global lock
@@ -3307,8 +3301,8 @@
).
:- pred ml_gen_pragma_java_output_arg_list(foreign_language::in,
- list(foreign_arg)::in, prog_context::in, statements::out,
- mlds_defns::out, statements::out,
+ list(foreign_arg)::in, prog_context::in, list(statement)::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_pragma_java_output_arg_list(_, [], _, [], [], [], !Info).
@@ -3326,8 +3320,8 @@
% value of an output arg for a `pragma foreign_proc' declaration.
%
:- pred ml_gen_pragma_java_output_arg(foreign_language::in,
- foreign_arg::in, prog_context::in, statements::out,
- mlds_defns::out, statements::out,
+ foreign_arg::in, prog_context::in, list(statement)::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_pragma_java_output_arg(_Lang, ForeignArg, Context, AssignOutput,
@@ -3377,8 +3371,9 @@
:- pred ml_gen_pragma_c_output_arg_list(foreign_language::in,
list(foreign_arg)::in, prog_context::in,
- list(target_code_component)::out, mlds_defns::out,
- statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+ list(target_code_component)::out,
+ list(mlds_defn)::out, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_pragma_c_output_arg_list(_, [], _, [], [], [], !Info).
ml_gen_pragma_c_output_arg_list(Lang, [ForeignArg | ForeignArgs], Context,
@@ -3396,7 +3391,7 @@
%
:- pred ml_gen_pragma_c_output_arg(foreign_language::in, foreign_arg::in,
prog_context::in, list(target_code_component)::out,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_pragma_c_output_arg(Lang, Arg, Context, AssignOutput, ConvDecls,
@@ -3421,8 +3416,9 @@
:- pred ml_gen_pragma_c_gen_output_arg(foreign_language::in, prog_var::in,
string::in, mer_type::in, box_policy::in, prog_context::in,
- list(target_code_component)::out, mlds_defns::out,
- statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+ list(target_code_component)::out,
+ list(mlds_defn)::out, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_pragma_c_gen_output_arg(Lang, Var, ArgName, OrigType, BoxPolicy,
Context, AssignOutput, ConvDecls, ConvOutputStatements, !Info) :-
@@ -3509,7 +3505,7 @@
%
:- pred ml_gen_ite(code_model::in, hlds_goal::in, hlds_goal::in, hlds_goal::in,
- prog_context::in, mlds_defns::out, statements::out,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_ite(CodeModel, Cond, Then, Else, Context, Decls, Statements, !Info) :-
@@ -3627,7 +3623,7 @@
%
:- pred ml_gen_negation(hlds_goal::in, code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_negation(Cond, CodeModel, Context, Decls, Statements, !Info) :-
@@ -3658,7 +3654,7 @@
ml_gen_set_success(!.Info, const(mlconst_false), Context,
SetSuccessFalse),
Decls = CondDecls,
- Statements = list.append(CondStatements, [SetSuccessFalse])
+ Statements = CondStatements ++ [SetSuccessFalse]
;
% model_semi negation, model_semi goal:
% <succeeded = not(Goal)>
@@ -3672,7 +3668,7 @@
ml_gen_set_success(!.Info, unop(std_unop(logical_not), Succeeded),
Context, InvertSuccess),
Decls = CondDecls,
- Statements = list.append(CondStatements, [InvertSuccess])
+ Statements = CondStatements ++ [InvertSuccess]
;
CodeModel = model_semi, CondCodeModel = model_non,
unexpected(this_file, "ml_gen_negation: nondet cond")
@@ -3687,26 +3683,32 @@
%
:- pred ml_gen_conj(hlds_goals::in, code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_conj([], CodeModel, Context, [], Statements, !Info) :-
- ml_gen_success(CodeModel, Context, Statements, !Info).
-ml_gen_conj([SingleGoal], CodeModel, _Context, Decls, Statements, !Info) :-
- ml_gen_goal(CodeModel, SingleGoal, Decls, Statements, !Info).
-ml_gen_conj([First | Rest], CodeModel, Context, Decls, Statements, !Info) :-
- Rest = [_ | _],
- First = hlds_goal(_, FirstGoalInfo),
- FirstDeterminism = goal_info_get_determinism(FirstGoalInfo),
- ( determinism_components(FirstDeterminism, _, at_most_zero) ->
- % the `Rest' code is unreachable
- ml_gen_goal(CodeModel, First, Decls, Statements, !Info)
- ;
- determinism_to_code_model(FirstDeterminism, FirstCodeModel),
- DoGenFirst = ml_gen_goal(FirstCodeModel, First),
- DoGenRest = ml_gen_conj(Rest, CodeModel, Context),
- ml_combine_conj(FirstCodeModel, Context, DoGenFirst, DoGenRest,
- Decls, Statements, !Info)
+ml_gen_conj(Conjuncts, CodeModel, Context, Decls, Statements, !Info) :-
+ (
+ Conjuncts = [],
+ ml_gen_success(CodeModel, Context, Statements, !Info),
+ Decls = []
+ ;
+ Conjuncts = [SingleGoal],
+ ml_gen_goal(CodeModel, SingleGoal, Decls, Statements, !Info)
+ ;
+ Conjuncts = [First | Rest],
+ Rest = [_ | _],
+ First = hlds_goal(_, FirstGoalInfo),
+ FirstDeterminism = goal_info_get_determinism(FirstGoalInfo),
+ ( determinism_components(FirstDeterminism, _, at_most_zero) ->
+ % the `Rest' code is unreachable
+ ml_gen_goal(CodeModel, First, Decls, Statements, !Info)
+ ;
+ determinism_to_code_model(FirstDeterminism, FirstCodeModel),
+ DoGenFirst = ml_gen_goal(FirstCodeModel, First),
+ DoGenRest = ml_gen_conj(Rest, CodeModel, Context),
+ ml_combine_conj(FirstCodeModel, Context, DoGenFirst, DoGenRest,
+ Decls, Statements, !Info)
+ )
).
%-----------------------------------------------------------------------------%
@@ -3715,93 +3717,102 @@
%
:- pred ml_gen_disj(hlds_goals::in, code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_disj([], CodeModel, Context, [], Statements, !Info) :-
- % Handle empty disjunctions (a.ka. `fail').
- ml_gen_failure(CodeModel, Context, Statements, !Info).
-
-ml_gen_disj([SingleGoal], CodeModel, Context, [], [Statement], !Info) :-
- % Handle singleton disjunctions.
- % (The HLDS should not contain singleton disjunctions, but this code
- % is needed to handle recursive calls to ml_gen_disj).
- % Note that each arm of the model_non disjunction is placed into a block.
- % This avoids a problem where ml_join_decls can create block nesting
- % proportional to the size of the disjunction. The nesting can hit fixed
- % limit problems in some C compilers.
- ml_gen_goal(CodeModel, SingleGoal, Goal_Decls, Goal_Statements, !Info),
- Statement = ml_gen_block(Goal_Decls, Goal_Statements, Context).
-
-ml_gen_disj([First | Rest], CodeModel, Context, Decls, Statements, !Info) :-
- Rest = [_ | _],
+ml_gen_disj(Goals, CodeModel, Context, Decls, Statements, !Info) :-
(
- CodeModel = model_non,
- % model_non disj:
- %
- % <(Goal ; Goals) && SUCCEED()>
- % ===>
- % <Goal && SUCCEED()>
- % <Goals && SUCCEED()>
-
- ml_gen_goal(model_non, First, FirstDecls, FirstStatements, !Info),
- ml_gen_disj(Rest, model_non, Context, RestDecls, RestStatements,
- !Info),
- (
- RestDecls = [],
- FirstBlock = ml_gen_block(FirstDecls, FirstStatements, Context),
- Decls = [],
- Statements = [FirstBlock | RestStatements]
- ;
- RestDecls = [_ | _],
- unexpected(this_file, "ml_gen_disj: RestDecls not empty.")
- )
-
+ Goals = [],
+ % Handle empty disjunctions (a.ka. `fail').
+ ml_gen_failure(CodeModel, Context, Statements, !Info),
+ Decls = []
+ ;
+ Goals = [SingleGoal],
+ % Handle singleton disjunctions.
+ % (The HLDS should not contain singleton disjunctions, but this code
+ % is needed to handle recursive calls to ml_gen_disj).
+ % Note that each arm of the model_non disjunction is placed into
+ % a block. This avoids a problem where ml_join_decls can create block
+ % nesting proportional to the size of the disjunction. The nesting
+ % can hit fixed limit problems in some C compilers.
+ ml_gen_goal(CodeModel, SingleGoal, Goal_Decls, Goal_Statements, !Info),
+ Statement = ml_gen_block(Goal_Decls, Goal_Statements, Context),
+ Statements = [Statement],
+ Decls = []
;
- ( CodeModel = model_det
- ; CodeModel = model_semi
- ),
- % model_det/model_semi disj:
- %
- % model_det goal:
- % <Goal ; Goals>
- % ===>
- % <Goal>
- % /* <Goals> will never be reached */
- %
- % model_semi goal:
- % <Goal ; Goals>
- % ===>
- % {
- % MR_bool succeeded;
- %
- % <succeeded = Goal>;
- % if (!succeeded) {
- % <Goals>;
- % }
- % }
-
- First = hlds_goal(_, FirstGoalInfo),
- FirstCodeModel = goal_info_get_code_model(FirstGoalInfo),
+ Goals = [First | Rest],
+ Rest = [_ | _],
(
- FirstCodeModel = model_det,
- ml_gen_goal(model_det, First, Decls, Statements, !Info)
+ CodeModel = model_non,
+ % model_non disj:
+ %
+ % <(Goal ; Goals) && SUCCEED()>
+ % ===>
+ % <Goal && SUCCEED()>
+ % <Goals && SUCCEED()>
+
+ ml_gen_goal(model_non, First, FirstDecls, FirstStatements, !Info),
+ ml_gen_disj(Rest, model_non, Context, RestDecls, RestStatements,
+ !Info),
+ (
+ RestDecls = [],
+ FirstBlock = ml_gen_block(FirstDecls, FirstStatements,
+ Context),
+ Decls = [],
+ Statements = [FirstBlock | RestStatements]
+ ;
+ RestDecls = [_ | _],
+ unexpected(this_file, "ml_gen_disj: RestDecls not empty.")
+ )
;
- FirstCodeModel = model_semi,
- ml_gen_goal(model_semi, First, FirstDecls, FirstStatements, !Info),
- ml_gen_test_success(!.Info, Succeeded),
- ml_gen_disj(Rest, CodeModel, Context,
- RestDecls, RestStatements, !Info),
- RestStatement = ml_gen_block(RestDecls, RestStatements, Context),
- IfStmt = ml_stmt_if_then_else(
- unop(std_unop(logical_not), Succeeded), RestStatement, no),
- IfStatement = statement(IfStmt, mlds_make_context(Context)),
- Decls = FirstDecls,
- Statements = FirstStatements ++ [IfStatement]
- ;
- FirstCodeModel = model_non,
- % simplify.m should get wrap commits around these.
- unexpected(this_file, "model_non disj in model_det disjunction")
+ ( CodeModel = model_det
+ ; CodeModel = model_semi
+ ),
+ % model_det/model_semi disj:
+ %
+ % model_det goal:
+ % <Goal ; Goals>
+ % ===>
+ % <Goal>
+ % /* <Goals> will never be reached */
+ %
+ % model_semi goal:
+ % <Goal ; Goals>
+ % ===>
+ % {
+ % MR_bool succeeded;
+ %
+ % <succeeded = Goal>;
+ % if (!succeeded) {
+ % <Goals>;
+ % }
+ % }
+
+ First = hlds_goal(_, FirstGoalInfo),
+ FirstCodeModel = goal_info_get_code_model(FirstGoalInfo),
+ (
+ FirstCodeModel = model_det,
+ ml_gen_goal(model_det, First, Decls, Statements, !Info)
+ ;
+ FirstCodeModel = model_semi,
+ ml_gen_goal(model_semi, First, FirstDecls, FirstStatements,
+ !Info),
+ ml_gen_test_success(!.Info, Succeeded),
+ ml_gen_disj(Rest, CodeModel, Context,
+ RestDecls, RestStatements, !Info),
+ RestStatement = ml_gen_block(RestDecls, RestStatements,
+ Context),
+ IfStmt = ml_stmt_if_then_else(
+ unop(std_unop(logical_not), Succeeded), RestStatement, no),
+ IfStatement = statement(IfStmt, mlds_make_context(Context)),
+ Decls = FirstDecls,
+ Statements = FirstStatements ++ [IfStatement]
+ ;
+ FirstCodeModel = model_non,
+ % simplify.m should get wrap commits around these.
+ unexpected(this_file,
+ "model_non disj in model_det disjunction")
+ )
)
).
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.135
diff -u -r1.135 ml_code_util.m
--- compiler/ml_code_util.m 5 Jan 2009 01:30:50 -0000 1.135
+++ compiler/ml_code_util.m 14 Jan 2009 15:39:21 -0000
@@ -46,14 +46,16 @@
% and returning the given lvals, if needed.
%
:- pred ml_append_return_statement(ml_gen_info::in, code_model::in,
- list(mlds_lval)::in, prog_context::in, statements::in,
- statements::out) is det.
+ list(mlds_lval)::in, prog_context::in, list(statement)::in,
+ list(statement)::out) is det.
% Generate a block statement, i.e. `{ <Decls>; <Statements>; }'.
% But if the block consists only of a single statement with no
% declarations, then just return that statement.
%
-:- func ml_gen_block(mlds_defns, statements, prog_context)
+:- func ml_gen_block(list(mlds_defn), list(statement), prog_context)
+ = statement.
+:- func ml_gen_block_mlds(list(mlds_defn), list(statement), mlds_context)
= statement.
% Join two statement lists and their corresponding declaration lists
@@ -65,11 +67,12 @@
% in common, then we put each statement list and its declarations into
% a block, so that the declarations remain local to each statement list.
%
-:- pred ml_join_decls(mlds_defns::in, statements::in,
- mlds_defns::in, statements::in, prog_context::in,
- mlds_defns::out, statements::out) is det.
+:- pred ml_join_decls(list(mlds_defn)::in, list(statement)::in,
+ list(mlds_defn)::in, list(statement)::in, prog_context::in,
+ list(mlds_defn)::out, list(statement)::out) is det.
-:- type gen_pred == pred(mlds_defns, statements, ml_gen_info, ml_gen_info).
+:- type gen_pred == pred(list(mlds_defn), list(statement),
+ ml_gen_info, ml_gen_info).
:- inst gen_pred == (pred(out, out, in, out) is det).
% Given closures to generate code for two conjuncts, generate code
@@ -77,7 +80,7 @@
%
:- pred ml_combine_conj(code_model::in, prog_context::in,
gen_pred::in(gen_pred), gen_pred::in(gen_pred),
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Given a function label and the statement which will comprise
@@ -349,12 +352,12 @@
% Generate code to succeed in the given code_model.
%
-:- pred ml_gen_success(code_model::in, prog_context::in, statements::out,
+:- pred ml_gen_success(code_model::in, prog_context::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate code to fail in the given code_model.
%
-:- pred ml_gen_failure(code_model::in, prog_context::in, statements::out,
+:- pred ml_gen_failure(code_model::in, prog_context::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate the declaration for the built-in `succeeded' flag.
@@ -721,7 +724,8 @@
% Get the list of extra definitions.
%
-:- pred ml_gen_info_get_extra_defns(ml_gen_info::in, mlds_defns::out) is det.
+:- pred ml_gen_info_get_extra_defns(ml_gen_info::in, list(mlds_defn)::out)
+ is det.
% Add the given string as the name of an environment variable used by
% the function being generated.
@@ -801,17 +805,28 @@
CodeModel = model_non
).
-ml_gen_block(VarDecls, Statements, Context) =
+ml_gen_block(VarDecls, Statements, Context) = Block :-
(
VarDecls = [],
Statements = [SingleStatement]
->
- SingleStatement
+ Block = SingleStatement
;
- statement(ml_stmt_block(VarDecls, Statements),
+ Block = statement(ml_stmt_block(VarDecls, Statements),
mlds_make_context(Context))
).
+ml_gen_block_mlds(VarDecls, Statements, Context) = Block :-
+ (
+ VarDecls = [],
+ Statements = [SingleStatement]
+ ->
+ Block = SingleStatement
+ ;
+ Block = statement(ml_stmt_block(VarDecls, Statements),
+ Context)
+ ).
+
ml_join_decls(FirstDecls, FirstStatements, RestDecls, RestStatements, Context,
Decls, Statements) :-
(
@@ -1975,32 +1990,47 @@
%
:- func ml_type_might_contain_pointers_for_gc(mlds_type) = bool.
-ml_type_might_contain_pointers_for_gc(mercury_type(_Type, TypeCategory, _)) =
- ml_type_category_might_contain_pointers(TypeCategory).
-ml_type_might_contain_pointers_for_gc(mlds_mercury_array_type(_)) = yes.
-ml_type_might_contain_pointers_for_gc(mlds_native_int_type) = no.
-ml_type_might_contain_pointers_for_gc(mlds_native_float_type) = no.
-ml_type_might_contain_pointers_for_gc(mlds_native_bool_type) = no.
-ml_type_might_contain_pointers_for_gc(mlds_native_char_type) = no.
-ml_type_might_contain_pointers_for_gc(mlds_foreign_type(_)) = no.
- % We assume that foreign types are not allowed to contain pointers
- % to the Mercury heap. XXX is this requirement too strict?
-ml_type_might_contain_pointers_for_gc(mlds_class_type(_, _, Category)) =
- (if Category = mlds_enum then no else yes).
-ml_type_might_contain_pointers_for_gc(mlds_ptr_type(_)) = yes.
-ml_type_might_contain_pointers_for_gc(mlds_array_type(_)) = yes.
-ml_type_might_contain_pointers_for_gc(mlds_func_type(_)) = no.
-ml_type_might_contain_pointers_for_gc(mlds_generic_type) = yes.
-ml_type_might_contain_pointers_for_gc(mlds_generic_env_ptr_type) = yes.
-ml_type_might_contain_pointers_for_gc(mlds_type_info_type) = yes.
-ml_type_might_contain_pointers_for_gc(mlds_pseudo_type_info_type) = yes.
-ml_type_might_contain_pointers_for_gc(mlds_cont_type(_)) = no.
-ml_type_might_contain_pointers_for_gc(mlds_commit_type) = no.
-ml_type_might_contain_pointers_for_gc(mlds_rtti_type(_)) = yes.
- % Values of mlds_tabling_type types may contain pointers, but they won't
- % exist if we are using accurate GC.
-ml_type_might_contain_pointers_for_gc(mlds_tabling_type(_)) = no.
-ml_type_might_contain_pointers_for_gc(mlds_unknown_type) = yes.
+ml_type_might_contain_pointers_for_gc(Type) = MightContainPointers :-
+ (
+ Type = mercury_type(_Type, TypeCategory, _),
+ MightContainPointers =
+ ml_type_category_might_contain_pointers(TypeCategory)
+ ;
+ Type = mlds_class_type(_, _, Category),
+ ( Category = mlds_enum ->
+ MightContainPointers = no
+ ;
+ MightContainPointers = yes
+ )
+ ;
+ ( Type = mlds_mercury_array_type(_)
+ ; Type = mlds_ptr_type(_)
+ ; Type = mlds_array_type(_)
+ ; Type = mlds_generic_type
+ ; Type = mlds_generic_env_ptr_type
+ ; Type = mlds_type_info_type
+ ; Type = mlds_pseudo_type_info_type
+ ; Type = mlds_rtti_type(_)
+ ; Type = mlds_unknown_type
+ ),
+ MightContainPointers = yes
+ ;
+ ( Type = mlds_native_int_type
+ ; Type = mlds_native_float_type
+ ; Type = mlds_native_bool_type
+ ; Type = mlds_native_char_type
+ ; Type = mlds_foreign_type(_)
+ % We assume that foreign types are not allowed to contain pointers
+ % to the Mercury heap. XXX is this requirement too strict?
+ ; Type = mlds_func_type(_)
+ ; Type = mlds_cont_type(_)
+ ; Type = mlds_commit_type
+ ; Type = mlds_tabling_type(_)
+ % Values of mlds_tabling_type types may contain pointers, but
+ % they won't exist if we are using accurate GC.
+ ),
+ MightContainPointers = no
+ ).
:- func ml_type_category_might_contain_pointers(type_ctor_category) = bool.
@@ -2115,7 +2145,7 @@
% Combine the MLDS code fragments together.
GC_TraceCode = ml_gen_block(MLDS_NewobjLocals ++ MLDS_NonLocalVarDecls,
- [MLDS_TypeInfoStatement] ++ [MLDS_TraceStatement], Context).
+ [MLDS_TypeInfoStatement, MLDS_TraceStatement], Context).
% ml_gen_trace_var(VarName, DeclType, TypeInfo, Context, Code):
% Generate a call to `private_builtin.gc_trace'
@@ -2196,7 +2226,7 @@
fnoi_context :: mlds_context,
% The local variable declarations accumulated so far.
- fnoi_locals :: mlds_defns,
+ fnoi_locals :: list(mlds_defn),
% A counter used to allocate variable names.
fnoi_next_id :: counter
@@ -2208,7 +2238,7 @@
% allocation.
%
:- pred fixup_newobj(statement::in, mlds_module_name::in,
- statement::out, mlds_defns::out) is det.
+ statement::out, list(mlds_defn)::out) is det.
fixup_newobj(Statement0, ModuleName, Statement, Defns) :-
Statement0 = statement(Stmt0, Context),
@@ -2333,8 +2363,10 @@
Context = !.Fixup ^ fnoi_context,
VarDecl = ml_gen_mlds_var_decl_init(var(VarName), VarType, Initializer,
GCStatement, Context),
- !:Fixup = !.Fixup ^ fnoi_next_id := NextId,
- !:Fixup= !.Fixup ^ fnoi_locals := !.Fixup ^ fnoi_locals ++ [VarDecl],
+ !Fixup ^ fnoi_next_id := NextId,
+ % XXX We should keep a more structured representation of the local
+ % variables, such as a map from variable names.
+ !Fixup ^ fnoi_locals := !.Fixup ^ fnoi_locals ++ [VarDecl],
% Generate code to initialize the variable.
%
@@ -2419,6 +2451,7 @@
mgi_cond_var :: counter,
mgi_conv_var :: counter,
mgi_const_num :: counter,
+
mgi_const_var_name_map :: map(prog_var, mlds_var_name),
% A partial mapping from vars to lvals, used to override
@@ -2430,7 +2463,7 @@
% current procedure.
mgi_var_lvals :: map(prog_var, mlds_lval),
- mgi_extra_defns :: mlds_defns,
+ mgi_extra_defns :: list(mlds_defn),
mgi_env_var_names :: set(string)
).
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.99
diff -u -r1.99 ml_elim_nested.m
--- compiler/ml_elim_nested.m 5 Jan 2009 01:30:50 -0000 1.99
+++ compiler/ml_elim_nested.m 14 Jan 2009 13:46:29 -0000
@@ -687,7 +687,7 @@
%
:- pred ml_maybe_copy_args(mlds_arguments::in, statement::in,
elim_info::in, mlds_type::in, mlds_type::in, mlds_context::in,
- mlds_defns::out, statements::out) is det.
+ list(mlds_defn)::out, list(statement)::out) is det.
ml_maybe_copy_args([], _, _, _, _, _, [], []).
ml_maybe_copy_args([Arg|Args], FuncBody, ElimInfo, ClassType, EnvPtrTypeName,
@@ -883,10 +883,11 @@
EnvDecls = [EnvVarDecl, EnvPtrVarDecl],
InitEnv = NewObj ++ [InitEnv0] ++ LinkStackChain.
-:- pred ml_chain_stack_frames(mlds_defns::in, statements::in,
+:- pred ml_chain_stack_frames(list(mlds_defn)::in, list(statement)::in,
mlds_type::in, mlds_context::in, mlds_entity_name::in,
- mlds_module_name::in, globals::in, mlds_defns::out, mlds_initializer::out,
- statements::out, mlds_defns::out) is det.
+ mlds_module_name::in, globals::in,
+ list(mlds_defn)::out, mlds_initializer::out,
+ list(statement)::out, list(mlds_defn)::out) is det.
ml_chain_stack_frames(Fields0, GCTraceStatements, EnvTypeName, Context,
FuncName, ModuleName, Globals, Fields,
@@ -1038,7 +1039,7 @@
Virtuality, Finality, Constness, Abstractness).
:- pred extract_gc_statements(mlds_defn::in, mlds_defn::out,
- statements::out, statements::out) is det.
+ list(statement)::out, list(statement)::out) is det.
extract_gc_statements(mlds_defn(Name, Context, Flags, Body0),
mlds_defn(Name, Context, Flags, Body), GCInitStmts, GCTraceStmts) :-
@@ -1223,7 +1224,7 @@
% But if the block consists only of a single statement with no
% declarations, then just return that statement.
%
-:- func make_block_stmt(mlds_defns, statements, mlds_context)
+:- func make_block_stmt(list(mlds_defn), list(statement), mlds_context)
= statement.
make_block_stmt(VarDecls, Statements, Context) =
@@ -1367,7 +1368,7 @@
!Info) :-
flatten_statement(Statement0, Statement, !Info).
-:- pred flatten_statements(statements::in, statements::out,
+:- pred flatten_statements(list(statement)::in, list(statement)::out,
elim_info::in, elim_info::out) is det.
flatten_statements(!Statements, !Info) :-
@@ -1530,8 +1531,8 @@
% Return the remaining (non-hoisted) definitions,
% the list of assignment statements, and the updated elim_info.
-:- pred flatten_nested_defns(mlds_defns::in, statements::in,
- mlds_defns::out, statements::out,
+:- pred flatten_nested_defns(list(mlds_defn)::in, list(statement)::in,
+ list(mlds_defn)::out, list(statement)::out,
elim_info::in, elim_info::out) is det.
flatten_nested_defns([], _, [], [], !Info).
@@ -1544,8 +1545,9 @@
Defns = Defns1 ++ Defns2,
InitStatements = InitStatements1 ++ InitStatements2.
-:- pred flatten_nested_defn(mlds_defn::in, mlds_defns::in,
- statements::in, mlds_defns::out, statements::out,
+:- pred flatten_nested_defn(mlds_defn::in,
+ list(mlds_defn)::in, list(statement)::in,
+ list(mlds_defn)::out, list(statement)::out,
elim_info::in, elim_info::out) is det.
flatten_nested_defn(Defn0, FollowingDefns, FollowingStatements,
@@ -1660,7 +1662,7 @@
% top level (if it's a static const).
%
:- pred ml_should_add_local_data(elim_info::in, mlds_data_name::in,
- mlds_gc_statement::in, mlds_defns::in, statements::in)
+ mlds_gc_statement::in, list(mlds_defn)::in, list(statement)::in)
is semidet.
ml_should_add_local_data(Info, DataName, GCStatement,
@@ -1693,7 +1695,7 @@
% fields here?
%
:- pred ml_need_to_hoist(mlds_module_name::in, mlds_data_name::in,
- mlds_defns::in, statements::in) is semidet.
+ list(mlds_defn)::in, list(statement)::in) is semidet.
ml_need_to_hoist(ModuleName, DataName,
FollowingDefns, FollowingStatements) :-
@@ -1950,7 +1952,7 @@
Locals = elim_info_get_local_data(!.Info),
fixup_gc_statements_defns(Locals, !Info).
-:- pred fixup_gc_statements_defns(mlds_defns::in,
+:- pred fixup_gc_statements_defns(list(mlds_defn)::in,
elim_info::in, elim_info::out) is det.
fixup_gc_statements_defns([], !Info).
@@ -2113,7 +2115,7 @@
% Nondeterministically return all the definitions contained
% in the specified construct.
-:- pred defns_contains_defn(mlds_defns::in, mlds_defn::out) is nondet.
+:- pred defns_contains_defn(list(mlds_defn)::in, mlds_defn::out) is nondet.
defns_contains_defn(Defns, Name) :-
list.member(Defn, Defns),
@@ -2139,7 +2141,7 @@
; defns_contains_defn(CtorDefns, Name)
).
-:- pred statements_contains_defn(statements::in, mlds_defn::out) is nondet.
+:- pred statements_contains_defn(list(statement)::in, mlds_defn::out) is nondet.
statements_contains_defn(Statements, Defn) :-
list.member(Statement, Statements),
@@ -2232,8 +2234,8 @@
add_unchain_stack_to_maybe_statement(yes(Statement0), yes(Statement), !Info) :-
add_unchain_stack_to_statement(Statement0, Statement, !Info).
-:- pred add_unchain_stack_to_statements(statements::in,
- statements::out,
+:- pred add_unchain_stack_to_statements(
+ list(statement)::in, list(statement)::out,
elim_info::in, elim_info::out) is det.
add_unchain_stack_to_statements(!Statements, !Info) :-
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.55
diff -u -r1.55 ml_optimize.m
--- compiler/ml_optimize.m 8 Sep 2008 03:39:03 -0000 1.55
+++ compiler/ml_optimize.m 14 Jan 2009 15:44:33 -0000
@@ -38,7 +38,7 @@
:- import_module io.
-:- pred optimize(mlds::in, mlds::out, io::di, io::uo) is det.
+:- pred mlds_optimize(mlds::in, mlds::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -64,36 +64,38 @@
:- type opt_info
---> opt_info(
- globals :: globals,
- module_name :: mlds_module_name,
- entity_name :: mlds_entity_name,
- func_params :: mlds_func_params,
- context :: mlds_context
+ oi_globals :: globals,
+ oi_module_name :: mlds_module_name,
+ oi_entity_name :: mlds_entity_name,
+ oi_func_params :: mlds_func_params,
+ oi_context :: mlds_context
).
-optimize(MLDS0, MLDS, !IO) :-
+mlds_optimize(!MLDS, !IO) :-
globals.io_get_globals(Globals, !IO),
- Defns = optimize_in_defns(MLDS0 ^ defns, Globals,
- mercury_module_name_to_mlds(MLDS0 ^ name)),
- MLDS = MLDS0 ^ defns := Defns.
+ Defns0 = !.MLDS ^ mlds_defns,
+ ModuleName = mercury_module_name_to_mlds(!.MLDS ^ mlds_name),
+ optimize_in_defns(Globals, ModuleName, Defns0, Defns),
+ !MLDS ^ mlds_defns := Defns.
-:- func optimize_in_defns(mlds_defns, globals, mlds_module_name)
- = mlds_defns.
+:- pred optimize_in_defns(globals::in, mlds_module_name::in,
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
-optimize_in_defns(Defns, Globals, ModuleName) =
- list.map(optimize_in_defn(ModuleName, Globals), Defns).
+optimize_in_defns(Globals, ModuleName, !Defns) :-
+ list.map(optimize_in_defn(ModuleName, Globals), !Defns).
-:- func optimize_in_defn(mlds_module_name, globals, mlds_defn) = mlds_defn.
+:- pred optimize_in_defn(mlds_module_name::in, globals::in,
+ mlds_defn::in, mlds_defn::out) is det.
-optimize_in_defn(ModuleName, Globals, Defn0) = Defn :-
+optimize_in_defn(ModuleName, Globals, Defn0, Defn) :-
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
(
DefnBody0 = mlds_function(PredProcId, Params, FuncBody0, Attributes,
EnvVarNames),
OptInfo = opt_info(Globals, ModuleName, Name, Params, Context),
- FuncBody1 = optimize_func(OptInfo, FuncBody0),
- FuncBody = optimize_in_function_body(OptInfo, FuncBody1),
+ optimize_func(OptInfo, FuncBody0, FuncBody1),
+ optimize_in_function_body(OptInfo, FuncBody1, FuncBody),
DefnBody = mlds_function(PredProcId, Params, FuncBody, Attributes,
EnvVarNames),
@@ -105,45 +107,60 @@
DefnBody0 = mlds_class(ClassDefn0),
ClassDefn0 = mlds_class_defn(Kind, Imports, BaseClasses, Implements,
CtorDefns0, MemberDefns0),
- MemberDefns = optimize_in_defns(MemberDefns0, Globals, ModuleName),
- CtorDefns = optimize_in_defns(CtorDefns0, Globals, ModuleName),
+ optimize_in_defns(Globals, ModuleName, MemberDefns0, MemberDefns),
+ optimize_in_defns(Globals, ModuleName, CtorDefns0, CtorDefns),
ClassDefn = mlds_class_defn(Kind, Imports, BaseClasses, Implements,
CtorDefns, MemberDefns),
DefnBody = mlds_class(ClassDefn),
Defn = mlds_defn(Name, Context, Flags, DefnBody)
).
-:- func optimize_in_function_body(opt_info, mlds_function_body)
- = mlds_function_body.
+:- pred optimize_in_function_body(opt_info::in,
+ mlds_function_body::in, mlds_function_body::out) is det.
-optimize_in_function_body(_, body_external) = body_external.
-optimize_in_function_body(OptInfo, body_defined_here(Statement0)) =
- body_defined_here(Statement) :-
- Statement = optimize_in_statement(OptInfo, Statement0).
+optimize_in_function_body(OptInfo, !Body) :-
+ (
+ !.Body = body_external
+ ;
+ !.Body = body_defined_here(Statement0),
+ optimize_in_statement(OptInfo, Statement0, Statement),
+ !:Body = body_defined_here(Statement)
+ ).
-:- func optimize_in_maybe_statement(opt_info, maybe(statement))
- = maybe(statement).
+:- pred optimize_in_maybe_statement(opt_info::in,
+ maybe(statement)::in, maybe(statement)::out) is det.
-optimize_in_maybe_statement(_, no) = no.
-optimize_in_maybe_statement(OptInfo, yes(Statement0)) = yes(Statement) :-
- Statement = optimize_in_statement(OptInfo, Statement0).
+optimize_in_maybe_statement(OptInfo, !MaybeStatement) :-
+ (
+ !.MaybeStatement = no
+ ;
+ !.MaybeStatement = yes(Statement0),
+ optimize_in_statement(OptInfo, Statement0, Statement),
+ !:MaybeStatement = yes(Statement)
+ ).
-:- func optimize_in_statements(opt_info, list(statement)) = list(statement).
+:- pred optimize_in_statements(opt_info::in,
+ list(statement)::in, list(statement)::out) is det.
-optimize_in_statements(OptInfo, Statements) =
- list.map(optimize_in_statement(OptInfo), Statements).
+optimize_in_statements(OptInfo, !Statements) :-
+ list.map(optimize_in_statement(OptInfo), !Statements).
-:- func optimize_in_statement(opt_info, statement) = statement.
+:- pred optimize_in_statement(opt_info::in,
+ statement::in, statement::out) is det.
-optimize_in_statement(OptInfo, statement(Stmt, Context)) =
- statement(optimize_in_stmt(OptInfo ^ context := Context, Stmt), Context).
+optimize_in_statement(!.OptInfo, !Statement) :-
+ !.Statement = statement(Stmt0, Context),
+ !OptInfo ^ oi_context := Context,
+ optimize_in_stmt(!.OptInfo, Stmt0, Stmt),
+ !:Statement = statement(Stmt, Context).
-:- func optimize_in_stmt(opt_info, mlds_stmt) = mlds_stmt.
+:- pred optimize_in_stmt(opt_info::in,
+ mlds_stmt::in, mlds_stmt::out) is det.
-optimize_in_stmt(OptInfo, Stmt0) = Stmt :-
+optimize_in_stmt(OptInfo, Stmt0, Stmt) :-
(
Stmt0 = ml_stmt_call(_, _, _, _, _, _),
- Stmt = optimize_in_call_stmt(OptInfo, Stmt0)
+ optimize_in_call_stmt(OptInfo, Stmt0, Stmt)
;
Stmt0 = ml_stmt_block(Defns0, Statements0),
maybe_convert_assignments_into_initializers(OptInfo,
@@ -151,26 +168,26 @@
maybe_eliminate_locals(OptInfo, Defns1, Defns,
Statements1, Statements2),
maybe_flatten_block(Statements2, Statements3),
- Statements = optimize_in_statements(OptInfo, Statements3),
+ optimize_in_statements(OptInfo, Statements3, Statements),
Stmt = ml_stmt_block(Defns, Statements)
;
Stmt0 = ml_stmt_while(Rval, Statement0, Once),
- Statement = optimize_in_statement(OptInfo, Statement0),
+ optimize_in_statement(OptInfo, Statement0, Statement),
Stmt = ml_stmt_while(Rval, Statement, Once)
;
- Stmt0 = ml_stmt_if_then_else(Rval, Then, MaybeElse),
- Stmt = ml_stmt_if_then_else(Rval,
- optimize_in_statement(OptInfo, Then),
- map_maybe(optimize_in_statement(OptInfo), MaybeElse))
+ Stmt0 = ml_stmt_if_then_else(Rval, Then0, MaybeElse0),
+ optimize_in_statement(OptInfo, Then0, Then),
+ optimize_in_maybe_statement(OptInfo, MaybeElse0, MaybeElse),
+ Stmt = ml_stmt_if_then_else(Rval, Then, MaybeElse)
;
Stmt0 = ml_stmt_switch(Type, Rval, Range, Cases0, Default0),
- Stmt = ml_stmt_switch(Type, Rval, Range,
- list.map(optimize_in_case(OptInfo), Cases0),
- optimize_in_default(OptInfo, Default0))
+ list.map(optimize_in_case(OptInfo), Cases0, Cases),
+ optimize_in_default(OptInfo, Default0, Default),
+ Stmt = ml_stmt_switch(Type, Rval, Range, Cases, Default)
;
Stmt0 = ml_stmt_try_commit(Ref, TryGoal0, HandlerGoal0),
- TryGoal = optimize_in_statement(OptInfo, TryGoal0),
- HandlerGoal = optimize_in_statement(OptInfo, HandlerGoal0),
+ optimize_in_statement(OptInfo, TryGoal0, TryGoal),
+ optimize_in_statement(OptInfo, HandlerGoal0, HandlerGoal),
Stmt = ml_stmt_try_commit(Ref, TryGoal, HandlerGoal)
;
( Stmt0 = ml_stmt_do_commit(_)
@@ -183,71 +200,76 @@
Stmt = Stmt0
).
-:- func optimize_in_case(opt_info, mlds_switch_case) = mlds_switch_case.
+:- pred optimize_in_case(opt_info::in,
+ mlds_switch_case::in, mlds_switch_case::out) is det.
-optimize_in_case(OptInfo, Case0) = Case :-
+optimize_in_case(OptInfo, Case0, Case) :-
Case0 = mlds_switch_case(Conds, Statement0),
- Statement = optimize_in_statement(OptInfo, Statement0),
+ optimize_in_statement(OptInfo, Statement0, Statement),
Case = mlds_switch_case(Conds, Statement).
-:- func optimize_in_default(opt_info, mlds_switch_default) =
- mlds_switch_default.
+:- pred optimize_in_default(opt_info::in,
+ mlds_switch_default::in, mlds_switch_default::out) is det.
-optimize_in_default(_OptInfo, default_is_unreachable) = default_is_unreachable.
-optimize_in_default(_OptInfo, default_do_nothing) = default_do_nothing.
-optimize_in_default(OptInfo, default_case(Statement0)) =
- default_case(Statement) :-
- Statement = optimize_in_statement(OptInfo, Statement0).
+optimize_in_default(OptInfo, Default0, Default) :-
+ (
+ Default0 = default_is_unreachable,
+ Default = default_is_unreachable
+ ;
+ Default0 = default_do_nothing,
+ Default = default_do_nothing
+ ;
+ Default0 = default_case(Statement0),
+ optimize_in_statement(OptInfo, Statement0, Statement),
+ Default = default_case(Statement)
+ ).
%-----------------------------------------------------------------------------%
:- inst mlcall
---> ml_stmt_call(ground, ground, ground, ground, ground, ground).
-:- func optimize_in_call_stmt(opt_info::in, mlds_stmt::in(mlcall))
- = (mlds_stmt::out) is det.
+:- pred optimize_in_call_stmt(opt_info::in,
+ mlds_stmt::in(mlcall), mlds_stmt::out) is det.
-optimize_in_call_stmt(OptInfo, Stmt0) = Stmt :-
+optimize_in_call_stmt(OptInfo, Stmt0, Stmt) :-
Stmt0 = ml_stmt_call(_Signature, FuncRval, _MaybeObject, CallArgs,
_Results, _IsTailCall),
% If we have a self-tailcall, assign to the arguments and
% then goto the top of the tailcall loop.
+ Globals = OptInfo ^ oi_globals,
+ globals.lookup_bool_option(Globals, optimize_tailcalls, OptTailCalls),
(
- globals.lookup_bool_option(OptInfo ^ globals, optimize_tailcalls, yes),
- can_optimize_tailcall(
- qual(OptInfo ^ module_name, module_qual, OptInfo ^ entity_name),
- Stmt0)
+ OptTailCalls = yes,
+ ModuleName = OptInfo ^ oi_module_name,
+ EntityName = OptInfo ^ oi_entity_name,
+ can_optimize_tailcall(qual(ModuleName, module_qual, EntityName), Stmt0)
->
+ Context = OptInfo ^ oi_context,
CommentStatement = statement(
ml_stmt_atomic(comment("direct tailcall eliminated")),
- OptInfo ^ context),
- GotoStatement = statement(
- ml_stmt_goto(tailcall_loop_top(OptInfo ^ globals)),
- OptInfo ^ context),
- OptInfo ^ func_params = mlds_func_params(FuncArgs, _RetTypes),
+ Context),
+ GotoStatement = statement(ml_stmt_goto(tailcall_loop_top(Globals)),
+ Context),
+ OptInfo ^ oi_func_params = mlds_func_params(FuncArgs, _RetTypes),
generate_assign_args(OptInfo, FuncArgs, CallArgs,
AssignStatements, AssignDefns),
AssignVarsStatement = statement(ml_stmt_block(AssignDefns,
- AssignStatements), OptInfo ^ context),
+ AssignStatements), Context),
- CallReplaceStatements = [
- CommentStatement,
- AssignVarsStatement,
- GotoStatement
- ],
+ CallReplaceStatements = [CommentStatement, AssignVarsStatement,
+ GotoStatement],
Stmt = ml_stmt_block([], CallReplaceStatements)
;
- % Convert calls to `mark_hp' and `restore_hp' to the
- % corresponding MLDS instructions. This ensures that
- % they get generated as inline code. (Without this
- % they won't, since HLDS inlining doesn't get run again
- % after the add_heap_ops pass that adds these calls.)
- % This approach is better than running HLDS inlining
- % again, both because it cheaper in compilation time
- % and because inlining the C code doesn't help with
- % the --target asm back-end, whereas generating the
- % appropriate MLDS instructions does.
- %
+ % Convert calls to `mark_hp' and `restore_hp' to the corresponding
+ % MLDS instructions. This ensures that they get generated as
+ % inline code. (Without this they won't, since HLDS inlining doesn't
+ % get run again after the add_heap_ops pass that adds these calls.)
+ % This approach is better than running HLDS inlining again,
+ % both because it cheaper in compilation time and because inlining
+ % the C code doesn't help with the --target asm back-end, whereas
+ % generating the appropriate MLDS instructions does.
+
FuncRval = const(mlconst_code_addr(
code_addr_proc(qual(ModName, module_qual, ProcLabel),
_FuncSignature))),
@@ -276,17 +298,17 @@
%
:- func tailcall_loop_top(globals) = mlds_goto_target.
-tailcall_loop_top(Globals) =
+tailcall_loop_top(Globals) = Target :-
( target_supports_break_and_continue(Globals) ->
% The function body has been wrapped inside
% `while (true) { ... break; }', and so to branch to the top of the
% function, we just do a `continue' which will continue the next
% iteration of the loop.
- continue
+ Target = continue
;
% A label has been inserted at the start of the function, and so to
% branch to the top of the function, we just branch to that label.
- label(tailcall_loop_label_name)
+ Target = label(tailcall_loop_label_name)
).
% The label name we use for the top of the loop introduced by
@@ -316,7 +338,8 @@
% Extract the variable name.
Name = entity_data(var(VarName))
->
- QualVarName = qual(OptInfo ^ module_name, module_qual, VarName),
+ ModuleName = OptInfo ^ oi_module_name,
+ QualVarName = qual(ModuleName, module_qual, VarName),
(
% Don't bother assigning a variable to itself.
ArgRval = lval(var(QualVarName, _VarType))
@@ -345,21 +368,22 @@
VarName = mlds_var_name(VarNameStr, MaybeNum),
TempName = mlds_var_name(VarNameStr ++ "__tmp_copy", MaybeNum),
- QualTempName = qual(OptInfo ^ module_name, module_qual, TempName),
+ QualTempName = qual(ModuleName, module_qual, TempName),
Initializer = no_initializer,
% We don't need to trace the temporary variables for GC, since they
% are not live across a call or a heap allocation.
GCStatement = gc_no_stmt,
+ Context = OptInfo ^ oi_context,
TempDefn = ml_gen_mlds_var_decl_init(var(TempName), Type,
- Initializer, GCStatement, OptInfo ^ context),
+ Initializer, GCStatement, Context),
TempInitStatement = statement(
ml_stmt_atomic(assign(var(QualTempName, Type), ArgRval)),
- OptInfo ^ context),
+ Context),
AssignStatement = statement(
ml_stmt_atomic(assign(
var(QualVarName, Type),
lval(var(QualTempName, Type)))),
- OptInfo ^ context),
+ Context),
generate_assign_args(OptInfo, Args, ArgRvals,
Statements0, TempDefns0),
Statements = [TempInitStatement | Statements0] ++
@@ -373,25 +397,35 @@
%----------------------------------------------------------------------------
-:- func optimize_func(opt_info, mlds_function_body) = mlds_function_body.
+:- pred optimize_func(opt_info::in,
+ mlds_function_body::in, mlds_function_body::out) is det.
-optimize_func(_, body_external) = body_external.
-optimize_func(OptInfo, body_defined_here(Statement)) =
- body_defined_here(optimize_func_stmt(OptInfo, Statement)).
+optimize_func(OptInfo, Body0, Body) :-
+ (
+ Body0 = body_external,
+ Body = body_external
+ ;
+ Body0 = body_defined_here(Statement0),
+ optimize_func_stmt(OptInfo, Statement0, Statement),
+ Body = body_defined_here(Statement)
+ ).
-:- func optimize_func_stmt(opt_info, statement) = statement.
+:- pred optimize_func_stmt(opt_info::in,
+ statement::in, statement::out) is det.
-optimize_func_stmt(OptInfo, statement(Stmt0, Context)) =
- statement(Stmt, Context) :-
+optimize_func_stmt(OptInfo, Statement0, Statement) :-
+ Statement0 = statement(Stmt0, Context),
% Tailcall optimization -- if we do a self tailcall, we can turn it
% into a loop.
+ Globals = OptInfo ^ oi_globals,
(
- globals.lookup_bool_option(OptInfo ^ globals, optimize_tailcalls, yes),
+ globals.lookup_bool_option(Globals, optimize_tailcalls, yes),
stmt_contains_statement(Stmt0, Call),
Call = statement(CallStmt, _),
- can_optimize_tailcall(
- qual(OptInfo ^ module_name, module_qual, OptInfo ^ entity_name),
+ ModuleName = OptInfo ^ oi_module_name,
+ EntityName = OptInfo ^ oi_entity_name,
+ can_optimize_tailcall(qual(ModuleName, module_qual, EntityName),
CallStmt)
->
Comment = ml_stmt_atomic(comment("tailcall optimized into a loop")),
@@ -400,7 +434,7 @@
% or using a label and goto. We prefer to use the former, if possible,
% since it is a higher-level construct that may help the back-end
% compiler's optimizer.
- ( target_supports_break_and_continue(OptInfo ^ globals) ->
+ ( target_supports_break_and_continue(Globals) ->
% Wrap a while loop around the function body:
% while (true) {
% /* tailcall optimized into a loop */
@@ -432,7 +466,8 @@
)
;
Stmt = Stmt0
- ).
+ ),
+ Statement = statement(Stmt, Context).
:- pred target_supports_break_and_continue(globals::in) is semidet.
@@ -460,18 +495,18 @@
% a compiler limit in the Microsoft C compiler (version 13.10.3077) for
% too deeply nested blocks.
%
-:- pred maybe_flatten_block(statements::in, statements::out) is det.
+:- pred maybe_flatten_block(list(statement)::in, list(statement)::out) is det.
maybe_flatten_block(!Stmts) :-
!:Stmts = list.condense(list.map(flatten_block, !.Stmts)).
-:- func flatten_block(statement) = statements.
+:- func flatten_block(statement) = list(statement).
-flatten_block(Statement) =
+flatten_block(Statement) = Statements :-
( Statement = statement(ml_stmt_block([], BlockStatements), _) ->
- BlockStatements
+ Statements = BlockStatements
;
- [Statement]
+ Statements = [Statement]
).
%-----------------------------------------------------------------------------%
@@ -560,23 +595,21 @@
% ...
:- pred maybe_convert_assignments_into_initializers(opt_info::in,
- mlds_defns::in, mlds_defns::out,
- statements::in, statements::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out,
+ list(statement)::in, list(statement)::out) is det.
maybe_convert_assignments_into_initializers(OptInfo, !Defns, !Statements) :-
- (
- % Check if --optimize-initializations is enabled
- globals.lookup_bool_option(OptInfo ^ globals,
- optimize_initializations, yes)
- ->
+ Globals = OptInfo ^ oi_globals,
+ % Check if --optimize-initializations is enabled.
+ ( globals.lookup_bool_option(Globals, optimize_initializations, yes) ->
convert_assignments_into_initializers(OptInfo, !Defns, !Statements)
;
true
).
:- pred convert_assignments_into_initializers(opt_info::in,
- mlds_defns::in, mlds_defns::out,
- statements::in, statements::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out,
+ list(statement)::in, list(statement)::out) is det.
convert_assignments_into_initializers(OptInfo, !Defns, !Statements) :-
(
@@ -587,7 +620,7 @@
LHS = var(ThisVar, _ThisType),
ThisVar = qual(Qualifier, QualKind, VarName),
ThisData = qual(Qualifier, QualKind, var(VarName)),
- Qualifier = OptInfo ^ module_name,
+ Qualifier = OptInfo ^ oi_module_name,
list.takewhile(isnt(var_defn(VarName)), !.Defns,
_PrecedingDefns, [_VarDefn | FollowingDefns]),
@@ -609,7 +642,7 @@
->
% Replace the assignment statement with an initializer
% on the variable declaration.
- set_initializer(!.Defns, VarName, RHS, !:Defns),
+ set_initializer(VarName, RHS, !Defns),
% Now try to apply the same optimization again.
convert_assignments_into_initializers(OptInfo, !Defns, !Statements)
@@ -623,17 +656,17 @@
var_defn(VarName, Defn) :-
Defn = mlds_defn(entity_data(var(VarName)), _, _, _).
- % set_initializer(Defns0, VarName, Rval, Defns):
+ % set_initializer(VarName, Rval, Defns0, Defns):
%
% Finds the first definition of the specified variable in Defns0,
% and replaces the initializer of that definition with init_obj(Rval).
%
-:- pred set_initializer(mlds_defns::in, mlds_var_name::in, mlds_rval::in,
- mlds_defns::out) is det.
+:- pred set_initializer(mlds_var_name::in, mlds_rval::in,
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
-set_initializer([], _, _, _) :-
+set_initializer(_, _, [], _) :-
unexpected(this_file, "set_initializer: var not found!").
-set_initializer([Defn0 | Defns0], VarName, Rval, [Defn | Defns]) :-
+set_initializer(VarName, Rval, [Defn0 | Defns0], [Defn | Defns]) :-
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
(
Name = entity_data(var(VarName)),
@@ -644,7 +677,7 @@
Defns = Defns0
;
Defn = Defn0,
- set_initializer(Defns0, VarName, Rval, Defns)
+ set_initializer(VarName, Rval, Defns0, Defns)
).
%-----------------------------------------------------------------------------%
@@ -657,11 +690,12 @@
% would be to do one pass to figure out which variables could be eliminated,
% and then do another pass to actually eliminate them.
-:- pred maybe_eliminate_locals(opt_info::in, mlds_defns::in, mlds_defns::out,
- statements::in, statements::out) is det.
+:- pred maybe_eliminate_locals(opt_info::in,
+ list(mlds_defn)::in, list(mlds_defn)::out,
+ list(statement)::in, list(statement)::out) is det.
maybe_eliminate_locals(OptInfo, !Defns, !Statements) :-
- globals.lookup_bool_option(OptInfo ^ globals, eliminate_local_vars,
+ globals.lookup_bool_option(OptInfo ^ oi_globals, eliminate_local_vars,
EliminateLocalVars),
(
EliminateLocalVars = yes,
@@ -670,10 +704,11 @@
EliminateLocalVars = no
).
-:- pred eliminate_locals(opt_info::in, mlds_defns::in, mlds_defns::out,
- statements::in, statements::out) is det.
+:- pred eliminate_locals(opt_info::in,
+ list(mlds_defn)::in, list(mlds_defn)::out,
+ list(statement)::in, list(statement)::out) is det.
-eliminate_locals(_OptInfo, [], [], Statements, Statements).
+eliminate_locals(_OptInfo, [], [], !Statements).
eliminate_locals(OptInfo, [Defn0 | Defns0], Defns, !Statements) :-
( try_to_eliminate_defn(OptInfo, Defn0, Defns0, Defns1, !Statements) ->
eliminate_locals(OptInfo, Defns1, Defns, !Statements)
@@ -712,8 +747,9 @@
% or if any of the statements or definitions take the address
% of the variable, or assign to it.
%
-:- pred try_to_eliminate_defn(opt_info::in, mlds_defn::in, mlds_defns::in,
- mlds_defns::out, statements::in, statements::out) is semidet.
+:- pred try_to_eliminate_defn(opt_info::in, mlds_defn::in,
+ list(mlds_defn)::in, list(mlds_defn)::out,
+ list(statement)::in, list(statement)::out) is semidet.
try_to_eliminate_defn(OptInfo, Defn0, Defns0, Defns, !Statements) :-
Defn0 = mlds_defn(Name, _Context, Flags, DefnBody),
@@ -724,7 +760,7 @@
DefnBody = mlds_data(_Type, Initializer, _GCStatement),
% ... with a known initial value.
- QualVarName = qual(OptInfo ^ module_name, module_qual, VarName),
+ QualVarName = qual(OptInfo ^ oi_module_name, module_qual, VarName),
(
Initializer = init_obj(Rval)
;
@@ -747,8 +783,9 @@
(
rval_cannot_throw(Rval)
;
- globals.lookup_bool_option(OptInfo ^ globals, reorder_conj, yes),
- globals.lookup_bool_option(OptInfo ^ globals, reorder_disj, yes)
+ Globals = OptInfo ^ oi_globals,
+ globals.lookup_bool_option(Globals, reorder_conj, yes),
+ globals.lookup_bool_option(Globals, reorder_disj, yes)
),
% Replace uses of this variable with the variable's value,
@@ -810,7 +847,7 @@
% value can't be determined.
%
:- pred find_initial_val_in_statements(mlds_var::in, mlds_rval::out,
- statements::in, statements::out) is semidet.
+ list(statement)::in, list(statement)::out) is semidet.
find_initial_val_in_statements(VarName, Rval, [Statement0 | Statements0],
Statements) :-
@@ -868,7 +905,8 @@
% transformation should not be performed.
%
:- pred eliminate_var(mlds_var::in, mlds_rval::in,
- mlds_defns::in, mlds_defns::out, statements::in, statements::out,
+ list(mlds_defn)::in, list(mlds_defn)::out,
+ list(statement)::in, list(statement)::out,
int::out, bool::out) is det.
eliminate_var(QualVarName, VarRval, !Defns, !Statements, Count, Invalidated) :-
@@ -886,15 +924,15 @@
% ^replace_count field for each occurrence as an rvalue, and setting
% ^invalidated to yes if the variable occurs as an lvalue.
-:- pred eliminate_var_in_block(mlds_defns::in, mlds_defns::out,
- statements::in, statements::out,
+:- pred eliminate_var_in_block(list(mlds_defn)::in, list(mlds_defn)::out,
+ list(statement)::in, list(statement)::out,
var_elim_info::in, var_elim_info::out) is det.
eliminate_var_in_block(!Defns, !Statements, !VarElimInfo) :-
eliminate_var_in_defns(!Defns, !VarElimInfo),
eliminate_var_in_statements(!Statements, !VarElimInfo).
-:- pred eliminate_var_in_defns(mlds_defns::in, mlds_defns::out,
+:- pred eliminate_var_in_defns(list(mlds_defn)::in, list(mlds_defn)::out,
var_elim_info::in, var_elim_info::out) is det.
eliminate_var_in_defns(!Defns, !VarElimInfo) :-
@@ -1039,7 +1077,7 @@
).
:- pred eliminate_var_in_statements(
- statements::in, statements::out,
+ list(statement)::in, list(statement)::out,
var_elim_info::in, var_elim_info::out) is det.
eliminate_var_in_statements(!Statements, !VarElimInfo) :-
Index: compiler/ml_simplify_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_simplify_switch.m,v
retrieving revision 1.26
diff -u -r1.26 ml_simplify_switch.m
--- compiler/ml_simplify_switch.m 11 Feb 2008 21:26:02 -0000 1.26
+++ compiler/ml_simplify_switch.m 14 Jan 2009 14:32:46 -0000
@@ -45,6 +45,7 @@
:- import_module parse_tree.prog_type.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module map.
@@ -272,7 +273,7 @@
:- pred generate_dense_switch(list(mlds_switch_case)::in,
mlds_switch_default::in, int::in, int::in, bool::in,
mlds_type::in, mlds_rval::in, mlds_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
generate_dense_switch(Cases, Default, FirstVal, LastVal, NeedRangeCheck,
@@ -328,18 +329,19 @@
MLDS_Context),
DoSwitch = statement(ml_stmt_if_then_else(InRange, SwitchBody, Else),
MLDS_Context),
- Statements = [StartComment, DoSwitch] ++
- [EndLabelStatement, EndComment]
+ Statements = [StartComment, DoSwitch, EndLabelStatement, EndComment]
;
NeedRangeCheck = no,
- Statements = [StartComment, DoJump | CasesCode] ++
- DefaultStatements ++ [EndLabelStatement, EndComment]
+ Statements =
+ [StartComment, DoJump | CasesCode] ++
+ DefaultStatements ++
+ [EndLabelStatement, EndComment]
),
Decls = CasesDecls.
:- pred generate_cases(list(mlds_switch_case)::in, mlds_label::in,
case_labels_map::in, case_labels_map::out,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
generate_cases([], _EndLabel, !CaseLabelsMap, [], [], !Info).
@@ -358,7 +360,7 @@
%
:- pred generate_case(mlds_switch_case::in, mlds_label::in,
case_labels_map::in, case_labels_map::out,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
generate_case(Case, EndLabel, CaseLabelsMap0, CaseLabelsMap,
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.37
diff -u -r1.37 ml_string_switch.m
--- compiler/ml_string_switch.m 5 Jan 2009 01:30:50 -0000 1.37
+++ compiler/ml_string_switch.m 14 Jan 2009 14:47:29 -0000
@@ -30,8 +30,8 @@
:- pred ml_generate_string_switch(list(tagged_case)::in, prog_var::in,
code_model::in, can_fail::in, prog_context::in,
- mlds_defns::out, statements::out, ml_gen_info::in, ml_gen_info::out)
- is det.
+ list(mlds_defn)::out, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -121,9 +121,8 @@
( CodeModel = model_semi
; CodeModel = model_non
),
- FailComment =
- statement(ml_stmt_atomic(comment("no match, so fail")),
- MLDS_Context),
+ FailComment = statement(ml_stmt_atomic(comment("no match, so fail")),
+ MLDS_Context),
ml_gen_failure(CodeModel, Context, FailStatements, !Info)
),
@@ -226,7 +225,9 @@
% Collect all the generated variable/constant declarations
% and code fragments together.
Decls = [NextSlotsDefn, StringTableDefn, SlotVarDefn, StringVarDefn],
- Statements = HashLookupStatements ++ [FailComment | FailStatements] ++
+ Statements =
+ HashLookupStatements ++
+ [FailComment | FailStatements] ++
[EndLabelStatement, EndComment].
%-----------------------------------------------------------------------------%
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.37
diff -u -r1.37 ml_switch_gen.m
--- compiler/ml_switch_gen.m 11 Feb 2008 21:26:02 -0000 1.37
+++ compiler/ml_switch_gen.m 14 Jan 2009 14:34:12 -0000
@@ -80,7 +80,7 @@
%
:- pred ml_gen_switch(prog_var::in, can_fail::in, list(case)::in,
code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate an appropriate default for a switch.
@@ -357,7 +357,7 @@
%
:- pred ml_switch_generate_if_then_else_chain(list(tagged_case)::in,
prog_var::in, code_model::in, can_fail::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_switch_generate_if_then_else_chain([], _Var, CodeModel, CanFail, Context,
@@ -402,7 +402,7 @@
%
:- pred ml_switch_generate_mlds_switch(list(tagged_case)::in,
prog_var::in, code_model::in, can_fail::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_switch_generate_mlds_switch(Cases, Var, CodeModel, CanFail, Context,
@@ -492,11 +492,9 @@
(
CanFail = can_fail,
ml_gen_failure(CodeModel, Context, FailStatements, !Info),
- (
- FailStatements = [],
+ ( is_empty(FailStatements) ->
Default = default_do_nothing
;
- FailStatements = [_ | _],
Fail = ml_gen_block([], FailStatements, Context),
Default = default_case(Fail)
)
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.27
diff -u -r1.27 ml_tag_switch.m
--- compiler/ml_tag_switch.m 21 Jan 2008 00:32:52 -0000 1.27
+++ compiler/ml_tag_switch.m 14 Jan 2009 14:34:19 -0000
@@ -31,8 +31,8 @@
%
:- pred ml_generate_tag_switch(list(tagged_case)::in, prog_var::in,
code_model::in, can_fail::in, prog_context::in,
- mlds_defns::out, statements::out, ml_gen_info::in, ml_gen_info::out)
- is det.
+ list(mlds_defn)::out, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.48
diff -u -r1.48 ml_tailcall.m
--- compiler/ml_tailcall.m 21 Jan 2008 00:32:52 -0000 1.48
+++ compiler/ml_tailcall.m 14 Jan 2009 15:44:44 -0000
@@ -90,8 +90,10 @@
%-----------------------------------------------------------------------------%
-ml_mark_tailcalls(MLDS0, MLDS, !IO) :-
- MLDS = MLDS0 ^ defns := mark_tailcalls_in_defns(MLDS0 ^ defns).
+ml_mark_tailcalls(!MLDS, !IO) :-
+ Defns0 = !.MLDS ^ mlds_defns,
+ mark_tailcalls_in_defns(Defns0, Defns),
+ !MLDS ^ mlds_defns := Defns.
%-----------------------------------------------------------------------------%
@@ -105,8 +107,8 @@
% which are in scope.
:- type locals == list(local_defns).
:- type local_defns
- ---> params(mlds_arguments)
- ; defns(mlds_defns).
+ ---> local_params(mlds_arguments)
+ ; local_defns(list(mlds_defn)).
%-----------------------------------------------------------------------------%
@@ -128,20 +130,22 @@
% The `Locals' argument contains a list of the
% local definitions which are in scope at this point.
-:- func mark_tailcalls_in_defns(mlds_defns) = mlds_defns.
+:- pred mark_tailcalls_in_defns(list(mlds_defn)::in, list(mlds_defn)::out)
+ is det.
-mark_tailcalls_in_defns(Defns) = list.map(mark_tailcalls_in_defn, Defns).
+mark_tailcalls_in_defns(Defns0, Defns) :-
+ list.map(mark_tailcalls_in_defn, Defns0, Defns).
-:- func mark_tailcalls_in_defn(mlds_defn) = mlds_defn.
+:- pred mark_tailcalls_in_defn(mlds_defn::in, mlds_defn::out) is det.
-mark_tailcalls_in_defn(Defn0) = Defn :-
+mark_tailcalls_in_defn(Defn0, Defn) :-
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
(
DefnBody0 = mlds_function(PredProcId, Params, FuncBody0, Attributes,
EnvVarNames),
% Compute the initial value of the `Locals' and `AtTail' arguments.
Params = mlds_func_params(Args, RetTypes),
- Locals = [params(Args)],
+ Locals = [local_params(Args)],
(
RetTypes = [],
AtTail = yes([])
@@ -149,7 +153,7 @@
RetTypes = [_ | _],
AtTail = no
),
- FuncBody = mark_tailcalls_in_function_body(FuncBody0, AtTail, Locals),
+ mark_tailcalls_in_function_body(AtTail, Locals, FuncBody0, FuncBody),
DefnBody = mlds_function(PredProcId, Params, FuncBody, Attributes,
EnvVarNames),
Defn = mlds_defn(Name, Context, Flags, DefnBody)
@@ -160,42 +164,54 @@
DefnBody0 = mlds_class(ClassDefn0),
ClassDefn0 = mlds_class_defn(Kind, Imports, BaseClasses, Implements,
CtorDefns0, MemberDefns0),
- CtorDefns = mark_tailcalls_in_defns(CtorDefns0),
- MemberDefns = mark_tailcalls_in_defns(MemberDefns0),
+ mark_tailcalls_in_defns(CtorDefns0, CtorDefns),
+ mark_tailcalls_in_defns(MemberDefns0, MemberDefns),
ClassDefn = mlds_class_defn(Kind, Imports, BaseClasses, Implements,
CtorDefns, MemberDefns),
DefnBody = mlds_class(ClassDefn),
Defn = mlds_defn(Name, Context, Flags, DefnBody)
).
-:- func mark_tailcalls_in_function_body(mlds_function_body, at_tail, locals)
- = mlds_function_body.
+:- pred mark_tailcalls_in_function_body(at_tail::in, locals::in,
+ mlds_function_body::in, mlds_function_body::out) is det.
-mark_tailcalls_in_function_body(body_external, _, _) = body_external.
-mark_tailcalls_in_function_body(body_defined_here(Statement0), AtTail, Locals)
- = body_defined_here(Statement) :-
- Statement = mark_tailcalls_in_statement(Statement0, AtTail, Locals).
-
-:- func mark_tailcalls_in_maybe_statement(maybe(statement), at_tail, locals)
- = maybe(statement).
-
-mark_tailcalls_in_maybe_statement(no, _, _) = no.
-mark_tailcalls_in_maybe_statement(yes(Statement0), AtTail, Locals) =
- yes(Statement) :-
- Statement = mark_tailcalls_in_statement(Statement0, AtTail, Locals).
-
-:- func mark_tailcalls_in_statements(statements, at_tail, locals)
- = statements.
-
-mark_tailcalls_in_statements([], _, _) = [].
-mark_tailcalls_in_statements([First0 | Rest0], AtTail, Locals) =
- [First | Rest] :-
+mark_tailcalls_in_function_body(AtTail, Locals, Body0, Body) :-
+ (
+ Body0 = body_external,
+ Body = body_external
+ ;
+ Body0 = body_defined_here(Statement0),
+ mark_tailcalls_in_statement(AtTail, Locals, Statement0, Statement),
+ Body = body_defined_here(Statement)
+ ).
+
+:- pred mark_tailcalls_in_maybe_statement(at_tail::in, locals::in,
+ maybe(statement)::in, maybe(statement)::out) is det.
+
+mark_tailcalls_in_maybe_statement(AtTail, Locals,
+ MaybeStatement0, MaybeStatement) :-
+ (
+ MaybeStatement0 = no,
+ MaybeStatement = no
+ ;
+ MaybeStatement0 = yes(Statement0),
+ mark_tailcalls_in_statement(AtTail, Locals, Statement0, Statement),
+ MaybeStatement = yes(Statement)
+ ).
+
+:- pred mark_tailcalls_in_statements(at_tail::in, locals::in,
+ list(statement)::in, list(statement)::out) is det.
+
+mark_tailcalls_in_statements(_, _, [], []).
+mark_tailcalls_in_statements(AtTail, Locals,
+ [First0 | Rest0], [First | Rest]) :-
% If there are no statements after the first, then the first statement
% is in a tail call position iff the statement list is in a tail call
% position. If the First statement is followed by a `return' statement,
% then it is in a tailcall position. Otherwise, i.e. if the first statement
% is followed by anything other than a `return' statement, then
% the first statement is not in a tail call position.
+ mark_tailcalls_in_statements(AtTail, Locals, Rest0, Rest),
(
Rest = [],
FirstAtTail = AtTail
@@ -207,19 +223,20 @@
FirstAtTail = no
)
),
- First = mark_tailcalls_in_statement(First0, FirstAtTail, Locals),
- Rest = mark_tailcalls_in_statements(Rest0, AtTail, Locals).
+ mark_tailcalls_in_statement(FirstAtTail, Locals, First0, First).
-:- func mark_tailcalls_in_statement(statement, at_tail, locals) = statement.
+:- pred mark_tailcalls_in_statement(at_tail::in, locals::in,
+ statement::in, statement::out) is det.
-mark_tailcalls_in_statement(Statement0, AtTail, Locals) = Statement :-
+mark_tailcalls_in_statement(AtTail, Locals, Statement0, Statement) :-
Statement0 = statement(Stmt0, Context),
- Stmt = mark_tailcalls_in_stmt(Stmt0, AtTail, Locals),
+ mark_tailcalls_in_stmt(AtTail, Locals, Stmt0, Stmt),
Statement = statement(Stmt, Context).
-:- func mark_tailcalls_in_stmt(mlds_stmt, at_tail, locals) = mlds_stmt.
+:- pred mark_tailcalls_in_stmt(at_tail::in, locals::in,
+ mlds_stmt::in, mlds_stmt::out) is det.
-mark_tailcalls_in_stmt(Stmt0, AtTail, Locals) = Stmt :-
+mark_tailcalls_in_stmt(AtTail, Locals, Stmt0, Stmt) :-
(
% Whenever we encounter a block statement, we recursively mark
% tailcalls in any nested functions defined in that block.
@@ -228,31 +245,31 @@
% statements in that block. The statement list will be in a tail
% position iff the block is in a tail position.
Stmt0 = ml_stmt_block(Defns0, Statements0),
- Defns = mark_tailcalls_in_defns(Defns0),
- NewLocals = [defns(Defns) | Locals],
- Statements = mark_tailcalls_in_statements(Statements0,
- AtTail, NewLocals),
+ mark_tailcalls_in_defns(Defns0, Defns),
+ NewLocals = [local_defns(Defns) | Locals],
+ mark_tailcalls_in_statements(AtTail, NewLocals,
+ Statements0, Statements),
Stmt = ml_stmt_block(Defns, Statements)
;
% The statement in the body of a while loop is never in a tail
% position.
Stmt0 = ml_stmt_while(Rval, Statement0, Once),
- Statement = mark_tailcalls_in_statement(Statement0, no, Locals),
+ mark_tailcalls_in_statement(no, Locals, Statement0, Statement),
Stmt = ml_stmt_while(Rval, Statement, Once)
;
% Both the `then' and the `else' parts of an if-then-else are in a
% tail position iff the if-then-else is in a tail position.
Stmt0 = ml_stmt_if_then_else(Cond, Then0, MaybeElse0),
- Then = mark_tailcalls_in_statement(Then0, AtTail, Locals),
- MaybeElse = mark_tailcalls_in_maybe_statement(MaybeElse0,
- AtTail, Locals),
+ mark_tailcalls_in_statement(AtTail, Locals, Then0, Then),
+ mark_tailcalls_in_maybe_statement(AtTail, Locals,
+ MaybeElse0, MaybeElse),
Stmt = ml_stmt_if_then_else(Cond, Then, MaybeElse)
;
% All of the cases of a switch (including the default) are in a
% tail position iff the switch is in a tail position.
Stmt0 = ml_stmt_switch(Type, Val, Range, Cases0, Default0),
- Cases = mark_tailcalls_in_cases(Cases0, AtTail, Locals),
- Default = mark_tailcalls_in_default(Default0, AtTail, Locals),
+ mark_tailcalls_in_cases(AtTail, Locals, Cases0, Cases),
+ mark_tailcalls_in_default(AtTail, Locals, Default0, Default),
Stmt = ml_stmt_switch(Type, Val, Range, Cases, Default)
;
Stmt0 = ml_stmt_call(Sig, Func, Obj, Args, ReturnLvals, CallKind0),
@@ -288,8 +305,8 @@
% Both the statement inside a `try_commit' and the handler are in
% tail call position iff the `try_commit' statement is in a tail call
% position.
- Statement = mark_tailcalls_in_statement(Statement0, AtTail, Locals),
- Handler = mark_tailcalls_in_statement(Handler0, AtTail, Locals),
+ mark_tailcalls_in_statement(AtTail, Locals, Statement0, Statement),
+ mark_tailcalls_in_statement(AtTail, Locals, Handler0, Handler),
Stmt = ml_stmt_try_commit(Ref, Statement, Handler)
;
( Stmt0 = ml_stmt_label(_)
@@ -302,26 +319,26 @@
Stmt = Stmt0
).
-:- func mark_tailcalls_in_cases(list(mlds_switch_case), at_tail, locals) =
- list(mlds_switch_case).
+:- pred mark_tailcalls_in_cases(at_tail::in, locals::in,
+ list(mlds_switch_case)::in, list(mlds_switch_case)::out) is det.
-mark_tailcalls_in_cases([], _, _) = [].
-mark_tailcalls_in_cases([Case0 | Cases0], AtTail, Locals) = [Case | Cases] :-
- Case = mark_tailcalls_in_case(Case0, AtTail, Locals),
- Cases = mark_tailcalls_in_cases(Cases0, AtTail, Locals).
+mark_tailcalls_in_cases(_, _, [], []).
+mark_tailcalls_in_cases(AtTail, Locals, [Case0 | Cases0], [Case | Cases]) :-
+ mark_tailcalls_in_case(AtTail, Locals, Case0, Case),
+ mark_tailcalls_in_cases(AtTail, Locals, Cases0, Cases).
-:- func mark_tailcalls_in_case(mlds_switch_case, at_tail, locals) =
- mlds_switch_case.
+:- pred mark_tailcalls_in_case(at_tail::in, locals::in,
+ mlds_switch_case::in, mlds_switch_case::out) is det.
-mark_tailcalls_in_case(Case0, AtTail, Locals) = Case :-
+mark_tailcalls_in_case(AtTail, Locals, Case0, Case) :-
Case0 = mlds_switch_case(Cond, Statement0),
- Statement = mark_tailcalls_in_statement(Statement0, AtTail, Locals),
+ mark_tailcalls_in_statement(AtTail, Locals, Statement0, Statement),
Case = mlds_switch_case(Cond, Statement).
-:- func mark_tailcalls_in_default(mlds_switch_default, at_tail, locals) =
- mlds_switch_default.
+:- pred mark_tailcalls_in_default(at_tail::in, locals::in,
+ mlds_switch_default::in, mlds_switch_default::out) is det.
-mark_tailcalls_in_default(Default0, AtTail, Locals) = Default :-
+mark_tailcalls_in_default(AtTail, Locals, Default0, Default) :-
(
( Default0 = default_is_unreachable
; Default0 = default_do_nothing
@@ -329,7 +346,7 @@
Default = Default0
;
Default0 = default_case(Statement0),
- Statement = mark_tailcalls_in_statement(Statement0, AtTail, Locals),
+ mark_tailcalls_in_statement(AtTail, Locals, Statement0, Statement),
Default = default_case(Statement)
).
@@ -548,11 +565,11 @@
locals_member(Name, LocalsList) :-
list.member(Locals, LocalsList),
(
- Locals = defns(Defns),
+ Locals = local_defns(Defns),
list.member(Defn, Defns),
Defn = mlds_defn(Name, _, _, _)
;
- Locals = params(Params),
+ Locals = local_params(Params),
list.member(Param, Params),
Param = mlds_argument(Name, _, _)
).
@@ -578,7 +595,7 @@
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
nontailcall_in_defns(MLDS_ModuleName, Defns, Warning).
-:- pred nontailcall_in_defns(mlds_module_name::in, mlds_defns::in,
+:- pred nontailcall_in_defns(mlds_module_name::in, list(mlds_defn)::in,
tailcall_warning::out) is nondet.
nontailcall_in_defns(ModuleName, Defns, Warning) :-
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.76
diff -u -r1.76 ml_type_gen.m
--- compiler/ml_type_gen.m 5 Jan 2009 01:30:51 -0000 1.76
+++ compiler/ml_type_gen.m 14 Jan 2009 15:16:03 -0000
@@ -5,12 +5,12 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
+%
% File: ml_type_gen.m
% Main author: fjh
-%
+%
% MLDS type generation -- convert HLDS types to MLDS.
-%
+%
% For enumerations, we use a Java-style emulation: we convert them
% to classes with a single int member, plus a bunch of static (one_copy)
% const members for the different enumerations consts.
@@ -20,7 +20,7 @@
% to each of the constructors which are defined from the base class type.
% For constructors which are represented as the addresses of specially reserved
% objects, we generate the static (one_copy) members for those objects.
-%
+%
%-----------------------------------------------------------------------------%
:- module ml_backend.ml_type_gen.
@@ -32,12 +32,14 @@
:- import_module parse_tree.prog_data.
:- import_module io.
+:- import_module list.
%-----------------------------------------------------------------------------%
% Generate MLDS definitions for all the types in the HLDS.
%
-:- pred ml_gen_types(module_info::in, mlds_defns::out, io::di, io::uo) is det.
+:- pred ml_gen_types(module_info::in, list(mlds_defn)::out, io::di, io::uo)
+ is det.
% Given an HLDS type_ctor, generate the MLDS class name and arity
% for the corresponding MLDS type.
@@ -129,7 +131,7 @@
).
:- pred ml_gen_type_defn(module_info::in, type_table::in, type_ctor::in,
- mlds_defns::in, mlds_defns::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_type_defn(ModuleInfo, TypeTable, TypeCtor, MLDS_Defns0, MLDS_Defns) :-
map.lookup(TypeTable, TypeCtor, TypeDefn),
@@ -146,7 +148,7 @@
).
:- pred ml_gen_type_2(hlds_type_body::in, module_info::in, type_ctor::in,
- hlds_type_defn::in, mlds_defns::in, mlds_defns::out) is det.
+ hlds_type_defn::in, list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_type_2(TypeBody, ModuleInfo, TypeCtor, TypeDefn, !Defns) :-
(
@@ -206,8 +208,8 @@
% a C enum rather than a class).
%
:- pred ml_gen_enum_type(type_ctor::in, hlds_type_defn::in,
- list(constructor)::in, cons_tag_values::in, mlds_defns::in,
- mlds_defns::in, mlds_defns::out) is det.
+ list(constructor)::in, cons_tag_values::in, list(mlds_defn)::in,
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_enum_type(TypeCtor, TypeDefn, Ctors, TagValues,
MaybeEqualityMembers, MLDS_Defns0, MLDS_Defns) :-
@@ -222,7 +224,8 @@
ValueMember = ml_gen_enum_value_member(Context),
EnumConstMembers = list.map(ml_gen_enum_constant(Context, TagValues),
Ctors),
- Members = MaybeEqualityMembers ++ [ValueMember | EnumConstMembers],
+ Members = MaybeEqualityMembers ++
+ [ValueMember | EnumConstMembers],
% Enums don't import or inherit anything.
Imports = [],
@@ -383,7 +386,7 @@
%
:- pred ml_gen_du_parent_type(module_info::in, type_ctor::in,
hlds_type_defn::in, list(constructor)::in, cons_tag_values::in,
- mlds_defns::in, mlds_defns::in, mlds_defns::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_du_parent_type(ModuleInfo, TypeCtor, TypeDefn, Ctors, TagValues,
MaybeEqualityMembers, MLDS_Defns0, MLDS_Defns) :-
@@ -403,7 +406,7 @@
(
% If none of the constructors for this type need a secondary tag,
% then we don't need the members for the secondary tag.
- %
+
\+ (some [Ctor] (
list.member(Ctor, Ctors),
ml_needs_secondary_tag(TagValues, Ctor)
@@ -477,7 +480,7 @@
mlds_data(mlds_native_int_type, no_initializer, gc_no_stmt)).
:- func ml_gen_tag_constant(prog_context, cons_tag_values, constructor)
- = mlds_defns.
+ = list(mlds_defn).
ml_gen_tag_constant(Context, ConsTagValues, Ctor) = MLDS_Defns :-
% Check if this constructor uses a secondary tag.
@@ -554,7 +557,7 @@
% constructors use secondary tags.
%
:- pred ml_gen_secondary_tag_class(mlds_context::in, mlds_module_name::in,
- mlds_class_id::in, mlds_defns::in, compilation_target::in,
+ mlds_class_id::in, list(mlds_defn)::in, compilation_target::in,
mlds_defn::out, mlds_class_id::out) is det.
ml_gen_secondary_tag_class(MLDS_Context, BaseClassQualifier, BaseClassId,
@@ -585,8 +588,8 @@
MLDS_TypeFlags = ml_gen_type_decl_flags,
MLDS_TypeDefnBody = mlds_class(mlds_class_defn(mlds_class,
Imports, Inherits, Implements, Ctors, Members)),
- MLDS_TypeDefn = mlds_defn(MLDS_TypeName, MLDS_Context, MLDS_TypeFlags,
- MLDS_TypeDefnBody).
+ MLDS_TypeDefn = mlds_defn(MLDS_TypeName, MLDS_Context,
+ MLDS_TypeFlags, MLDS_TypeDefnBody).
% Generate definitions corresponding to a constructor of a discriminated
% union type. This will be one of the following:
@@ -598,8 +601,9 @@
%
:- pred ml_gen_du_ctor_member(module_info::in, mlds_class_id::in,
mlds_module_name::in, mlds_class_id::in, hlds_type_defn::in,
- cons_tag_values::in, constructor::in, mlds_defns::in,
- mlds_defns::out, mlds_defns::in, mlds_defns::out) is det.
+ cons_tag_values::in, constructor::in,
+ list(mlds_defn)::in, list(mlds_defn)::out,
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
ml_gen_du_ctor_member(ModuleInfo, BaseClassId, BaseClassQualifier,
SecondaryTagClassId, TypeDefn, ConsTagValues, Ctor,
@@ -624,7 +628,7 @@
% back-ends, we need to ensure that the type used for the reserved
% object has at least one data member, to make sure that each
% reserved object gets a distinct address.
- %
+
MLDS_ReservedObjName = ml_format_reserved_object_name(
UnqualCtorName, CtorArity),
MLDS_ReservedObjDefn = ml_gen_static_const_defn(
@@ -672,14 +676,16 @@
list.map_foldl(ml_gen_du_ctor_field(ModuleInfo, Context),
Args, OrdinaryMembers, ArgNum2, _ArgNum3),
- list.append(ExtraMembers, OrdinaryMembers, Members),
+ Members = ExtraMembers ++ OrdinaryMembers,
% Generate a constructor function to initialize the fields, if needed
% (not all back-ends use constructor functions).
MaybeSecTagVal = get_secondary_tag(TagVal),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
- ( target_uses_constructors(Target) = yes ->
+ UsesConstructors = target_uses_constructors(Target),
+ (
+ UsesConstructors = yes,
( ml_tag_uses_base_class(TagVal) ->
CtorClassType = BaseClassId,
CtorClassQualifier = BaseClassQualifier
@@ -715,6 +721,7 @@
Ctors = [CtorFunction]
)
;
+ UsesConstructors = no,
Ctors = []
),
@@ -784,9 +791,9 @@
target_uses_empty_base_classes(target_il) = yes.
target_uses_empty_base_classes(target_java) = yes.
target_uses_empty_base_classes(target_asm) = no.
-target_uses_empty_base_classes(target_x86_64) =
+target_uses_empty_base_classes(target_x86_64) =
unexpected(this_file, "target_x86_64 and --high-level-code").
-target_uses_empty_base_classes(target_erlang) =
+target_uses_empty_base_classes(target_erlang) =
unexpected(this_file, "target erlang").
% This should return yes if references to function parameters in
@@ -803,13 +810,13 @@
target_requires_module_qualified_params(target_il) = no.
target_requires_module_qualified_params(target_java) = yes.
target_requires_module_qualified_params(target_asm) = no.
-target_requires_module_qualified_params(target_x86_64) =
+target_requires_module_qualified_params(target_x86_64) =
unexpected(this_file, "target_x86_64 with --high-level-code").
target_requires_module_qualified_params(target_erlang) =
unexpected(this_file, "target erlang").
:- func gen_constructor_function(globals, mlds_class_id,
- mlds_type, mlds_module_name, mlds_class_id, maybe(int), mlds_defns,
+ mlds_type, mlds_module_name, mlds_class_id, maybe(int), list(mlds_defn),
mlds_context) = mlds_defn.
gen_constructor_function(Globals, BaseClassId, ClassType, ClassQualifier,
@@ -1057,7 +1064,7 @@
ml_gen_exported_enums(ModuleInfo, MLDS_ExportedEnums, !IO) :-
module_info_get_exported_enums(ModuleInfo, ExportedEnumInfo),
- module_info_get_type_table(ModuleInfo, TypeTable),
+ module_info_get_type_table(ModuleInfo, TypeTable),
list.map_foldl(ml_gen_exported_enum(ModuleInfo, TypeTable),
ExportedEnumInfo, MLDS_ExportedEnums, !IO).
@@ -1098,7 +1105,7 @@
(
TagVal = int_tag(Int),
ConstValue = const(mlconst_int(Int))
- ;
+ ;
TagVal = foreign_tag(Lang, String),
ConstValue = const(mlconst_foreign(Lang, String, mlds_native_int_type))
;
@@ -1127,7 +1134,7 @@
UnqualName = unqualify_name(QualName),
UnqualSymName = unqualified(UnqualName),
map.lookup(Mapping, UnqualSymName, ForeignName),
- list.cons(ForeignName - EntityDefn, !NamesAndTags).
+ !:NamesAndTags = [ForeignName - EntityDefn | !.NamesAndTags].
%-----------------------------------------------------------------------------%
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.127
diff -u -r1.127 ml_unify_gen.m
--- compiler/ml_unify_gen.m 14 Jan 2009 08:38:46 -0000 1.127
+++ compiler/ml_unify_gen.m 16 Jan 2009 02:17:18 -0000
@@ -34,7 +34,7 @@
% Generate MLDS code for a unification.
%
:- pred ml_gen_unification(unification::in, code_model::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Convert a cons_id for a given type to a cons_tag.
@@ -53,7 +53,7 @@
% by ConsId.
%
:- pred ml_gen_tag_test(prog_var::in, cons_id::in,
- mlds_defns::out, statements::out, mlds_rval::out,
+ list(mlds_defn)::out, list(statement)::out, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
% ml_gen_secondary_tag_rval(PrimaryTag, VarType, ModuleInfo, VarRval):
@@ -82,8 +82,8 @@
:- 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(int)::in,
- how_to_construct::in, prog_context::in, mlds_defns::out,
- statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+ how_to_construct::in, prog_context::in, list(mlds_defn)::out,
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -124,7 +124,7 @@
(
Unification = assign(TargetVar, SourceVar),
expect(unify(CodeModel, model_det), this_file,
- "ml_code_gen: assign not det"),
+ "ml_gen_unification: assign not det"),
ml_variable_type(!.Info, TargetVar, Type),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
IsDummyType = check_dummy_type(ModuleInfo, Type),
@@ -158,7 +158,7 @@
;
Unification = simple_test(Var1, Var2),
expect(unify(CodeModel, model_semi), this_file,
- "ml_code_gen: simple_test not semidet"),
+ "ml_gen_unification: simple_test not semidet"),
ml_variable_type(!.Info, Var1, Type),
( Type = builtin_type(builtin_type_string) ->
EqualityOp = str_eq
@@ -177,7 +177,7 @@
Unification = construct(Var, ConsId, Args, ArgModes, HowToConstruct,
_CellIsUnique, SubInfo),
expect(unify(CodeModel, model_det), this_file,
- "ml_code_gen: construct not det"),
+ "ml_gen_unification: construct not det"),
(
SubInfo = no_construct_sub_info,
TakeAddr = []
@@ -190,7 +190,7 @@
MaybeTakeAddr = yes(TakeAddr)
),
expect(unify(MaybeSizeProfInfo, no), this_file,
- "ml_code_gen: term size profiling not yet supported")
+ "ml_gen_unification: term size profiling not yet supported")
),
ml_gen_construct(Var, ConsId, Args, ArgModes, TakeAddr, HowToConstruct,
Context, Decls, Statements, !Info)
@@ -209,7 +209,7 @@
Decls, Unif_Statements, !Info)
),
(
- % Note that we can deallocate a cell even if the unification fails,
+ % Note that we can deallocate a cell even if the unification fails;
% it is the responsibility of the structure reuse phase to ensure
% that this is safe.
CanCGC = can_cgc,
@@ -217,12 +217,12 @@
% XXX Avoid strip_tag when we know what tag it will have.
Delete = delete_object(unop(std_unop(strip_tag), lval(VarLval))),
Stmt = ml_stmt_atomic(Delete),
- CGC_Statements = [statement(Stmt, mlds_make_context(Context))]
+ CGC_Statement = statement(Stmt, mlds_make_context(Context)),
+ Statements0 = Unif_Statements ++ [CGC_Statement]
;
CanCGC = cannot_cgc,
- CGC_Statements = []
+ Statements0 = Unif_Statements
),
- Statements0 = Unif_Statements ++ CGC_Statements,
% We used to require that CodeModel = ExpectedCodeModel. But the
% determinism field in the goal_info is allowed to be a conservative
@@ -233,7 +233,7 @@
;
Unification = complicated_unify(_, _, _),
% Simplify.m should have converted these into procedure calls.
- unexpected(this_file, "ml_code_gen: complicated unify")
+ unexpected(this_file, "ml_gen_unification: complicated unify")
).
% ml_gen_construct generates code for a construction unification.
@@ -243,7 +243,7 @@
%
:- pred ml_gen_construct(prog_var::in, cons_id::in, prog_vars::in,
list(uni_mode)::in, list(int)::in, how_to_construct::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_construct(Var, ConsId, Args, ArgModes, TakeAddr, HowToConstruct,
@@ -256,8 +256,8 @@
:- pred ml_gen_construct_2(cons_tag::in, mer_type::in, prog_var::in,
cons_id::in, prog_vars::in, list(uni_mode)::in, list(int)::in,
- how_to_construct::in, prog_context::in, mlds_defns::out,
- statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+ how_to_construct::in, prog_context::in, list(mlds_defn)::out,
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_construct_2(Tag, Type, Var, ConsId, Args, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info) :-
@@ -284,7 +284,7 @@
VarType, Context, [], Statements, !Info),
Decls = []
;
- unexpected(this_file, "ml_code_gen: no_tag: arity != 1")
+ unexpected(this_file, "ml_gen_construct_2: no_tag: arity != 1")
)
;
% Lambda expressions.
@@ -322,7 +322,7 @@
Statements = [Statement]
;
Args = [_ | _],
- unexpected(this_file, "ml_gen_construct: bad constant term")
+ unexpected(this_file, "ml_gen_construct_2: bad constant term")
)
).
@@ -335,7 +335,7 @@
% ml_gen_construct.
%
:- pred ml_gen_static_const_arg(prog_var::in, static_cons::in, prog_context::in,
- mlds_defns::out, mlds_rval::out,
+ list(mlds_defn)::out, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_static_const_arg(Var, StaticCons, Context, Defns, Rval, !Info) :-
@@ -347,7 +347,7 @@
Rval, !Info).
:- pred ml_gen_static_const_arg_2(cons_tag::in, mer_type::in, prog_var::in,
- static_cons::in, prog_context::in, mlds_defns::out, mlds_rval::out,
+ static_cons::in, prog_context::in, list(mlds_defn)::out, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_static_const_arg_2(Tag, VarType, Var, StaticCons, Context, Defns, Rval,
@@ -378,7 +378,8 @@
Rval, !Info),
Defns = ArgDefns ++ BoxDefns
;
- unexpected(this_file, "ml_code_gen: no_tag: arity != 1")
+ unexpected(this_file,
+ "ml_gen_static_const_arg_2: no_tag: arity != 1")
)
;
% Compound terms, including lambda expressions.
@@ -427,7 +428,7 @@
;
StaticArgs = [_ | _],
unexpected(this_file,
- "ml_gen_static_const_arg: unknown compound term")
+ "ml_gen_static_const_arg_2: unknown compound term")
)
).
@@ -578,7 +579,7 @@
%
:- pred ml_gen_compound(cons_tag::in, cons_id::in, prog_var::in, prog_vars::in,
list(uni_mode)::in, list(int)::in, how_to_construct::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_compound(Tag, ConsId, Var, ArgVars, ArgModes, TakeAddr, HowToConstruct,
@@ -842,8 +843,9 @@
% allocated then fall back to dynamic allocation.
ml_gen_new_object(MaybeConsId, Tag, HasSecTag, MaybeCtorName, Var,
ExtraRvals, ExtraTypes, ArgVars, ArgModes, TakeAddr,
- construct_dynamically, Context, DynamicDecls, DynamicStmt, !Info),
- IfElse = statement(ml_stmt_block(DynamicDecls, DynamicStmt),
+ construct_dynamically, Context, DynamicDecls, DynamicStmts, !Info),
+ IfElse = statement(
+ ml_stmt_block(DynamicDecls, DynamicStmts),
MLDS_Context),
IfStatement = statement(
@@ -895,9 +897,9 @@
;
HighLevelData = yes,
(
- % Check for type_infos and typeclass_infos,
- % since these need to be handled specially;
- % their Mercury type definitions are lies.
+ % Check for type_infos and typeclass_infos, since these
+ % need to be handled specially; their Mercury type definitions
+ % are lies.
MLDS_Type = mercury_type(_, TypeCtorCategory, _),
TypeCtorCategory = ctor_cat_system(_)
->
@@ -982,7 +984,7 @@
% With the high-level data representation, we don't box everything,
% but for the MLDS->C and MLDS->asm back-ends we still need to box
% floating point fields.
- %
+
(
HighLevelData = no
;
@@ -1073,7 +1075,7 @@
:- pred ml_gen_box_or_unbox_const_rval_list(list(mer_type)::in,
list(mer_type)::in, list(mlds_rval)::in, prog_context::in,
- mlds_defns::out, list(mlds_rval)::out,
+ list(mlds_defn)::out, list(mlds_rval)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_box_or_unbox_const_rval_list(ArgTypes, FieldTypes, ArgRvals,
@@ -1122,7 +1124,7 @@
).
:- pred ml_gen_box_const_rval_list(list(mlds_type)::in, list(mlds_rval)::in,
- prog_context::in, mlds_defns::out, list(mlds_rval)::out,
+ prog_context::in, list(mlds_defn)::out, list(mlds_rval)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_box_const_rval_list([], [], _, [], [], !Info).
@@ -1138,7 +1140,7 @@
unexpected(this_file, "ml_gen_box_const_rval_list: length mismatch").
:- pred ml_gen_box_const_rval(mlds_type::in, mlds_rval::in, prog_context::in,
- mlds_defns::out, mlds_rval::out,
+ list(mlds_defn)::out, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_box_const_rval(Type, Rval, Context, ConstDefns, BoxedRval, !Info) :-
@@ -1158,7 +1160,7 @@
% [For the .NET and Java back-ends, this code currently never gets
% called, since currently we don't support static ground term
% optimization for those back-ends.]
- %
+
( Type = mercury_type(builtin_type(builtin_type_float), _, _)
; Type = mlds_native_float_type
)
@@ -1187,7 +1189,7 @@
).
:- pred ml_gen_static_const_arg_list(list(prog_var)::in, list(static_cons)::in,
- prog_context::in, mlds_defns::out, list(mlds_rval)::out,
+ prog_context::in, list(mlds_defn)::out, list(mlds_rval)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_static_const_arg_list([], [], _, [], [], !Info).
@@ -1349,7 +1351,7 @@
%
:- pred ml_gen_extra_arg_assign(list(mlds_rval)::in,
list(mlds_type)::in, mer_type::in, mlds_lval::in, int::in, cons_tag::in,
- prog_context::in, statements::out, ml_gen_info::in, ml_gen_info::out)
+ prog_context::in, list(statement)::out, ml_gen_info::in, ml_gen_info::out)
is det.
ml_gen_extra_arg_assign([_ | _], [], _, _, _, _, _, _, !Info) :-
@@ -1395,7 +1397,7 @@
%
:- pred ml_gen_det_deconstruct(prog_var::in, cons_id::in, prog_vars::in,
list(uni_mode)::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_det_deconstruct(Var, ConsId, Args, Modes, Context, Decls, Statements,
@@ -1408,7 +1410,7 @@
:- pred ml_gen_det_deconstruct_2(cons_tag::in, mer_type::in, prog_var::in,
cons_id::in, prog_vars::in, list(uni_mode)::in, prog_context::in,
- statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_det_deconstruct_2(Tag, Type, Var, ConsId, Args, Modes, Context,
Statements, !Info) :-
@@ -1550,7 +1552,7 @@
:- pred ml_gen_unify_args(cons_id::in, prog_vars::in, list(uni_mode)::in,
list(mer_type)::in, list(constructor_arg)::in, mer_type::in,
mlds_lval::in, int::in, int::in, cons_tag::in, prog_context::in,
- statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_unify_args(ConsId, Args, Modes, ArgTypes, Fields, VarType, VarLval,
Offset, ArgNum, Tag, Context, Statements, !Info) :-
@@ -1567,7 +1569,7 @@
:- pred ml_gen_unify_args_2(cons_id::in, prog_vars::in, list(uni_mode)::in,
list(mer_type)::in, list(constructor_arg)::in, mer_type::in,
mlds_lval::in, int::in, int::in, cons_tag::in, prog_context::in,
- statements::in, statements::out,
+ list(statement)::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is semidet.
ml_gen_unify_args_2(_, [], [], [], _, _, _, _, _, _, _, !Statements, !Info).
@@ -1584,7 +1586,7 @@
:- pred ml_gen_unify_args_for_reuse(cons_id::in, prog_vars::in,
list(uni_mode)::in, list(mer_type)::in, list(constructor_arg)::in,
list(int)::in, mer_type::in, mlds_lval::in, int::in, int::in, cons_tag::in,
- prog_context::in, statements::out, list(take_addr_info)::out,
+ prog_context::in, list(statement)::out, list(take_addr_info)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_unify_args_for_reuse(ConsId, Args, Modes, ArgTypes, Fields, TakeAddr,
@@ -1637,7 +1639,7 @@
:- pred ml_gen_unify_arg(cons_id::in, prog_var::in, uni_mode::in, mer_type::in,
constructor_arg::in, mer_type::in, mlds_lval::in, int::in, int::in,
cons_tag::in, prog_context::in,
- statements::in, statements::out,
+ list(statement)::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_unify_arg(ConsId, Arg, Mode, ArgType, Field, VarType, VarLval,
@@ -1692,7 +1694,7 @@
:- pred ml_gen_sub_unify(uni_mode::in, mlds_lval::in, mer_type::in,
mlds_lval::in, mer_type::in, prog_context::in,
- statements::in, statements::out,
+ list(statement)::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_sub_unify(Mode, ArgLval, ArgType, FieldLval, FieldType, Context,
@@ -1765,7 +1767,7 @@
%
:- pred ml_gen_semi_deconstruct(prog_var::in, cons_id::in, prog_vars::in,
list(uni_mode)::in, prog_context::in,
- mlds_defns::out, statements::out,
+ list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_semi_deconstruct(Var, ConsId, Args, ArgModes, Context,
@@ -1778,8 +1780,8 @@
ml_gen_det_deconstruct(Var, ConsId, Args, ArgModes, Context,
GetArgsDecls, GetArgsStatements, !Info),
(
- GetArgsDecls = [],
- GetArgsStatements = []
+ is_empty(GetArgsDecls),
+ is_empty(GetArgsStatements)
->
Decls = TagTestDecls,
Statements = TagTestStatements ++ [SetTagTestResult]
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.61
diff -u -r1.61 ml_util.m
--- compiler/ml_util.m 5 Jan 2009 01:30:51 -0000 1.61
+++ compiler/ml_util.m 10 Jan 2009 09:38:47 -0000
@@ -5,18 +5,18 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
+%
% File: ml_util.m.
% Main author: fjh, trd.
-%
+%
% This module contains utility predicates for manipulating the MLDS.
-%
+%
%-----------------------------------------------------------------------------%
:- module ml_backend.ml_util.
:- interface.
-:- import_module libs.globals. % for foreign_language
+:- import_module libs.globals. % for foreign_language
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_data.
:- import_module ml_backend.mlds.
@@ -31,7 +31,7 @@
% Succeeds iff the definitions contain the entry point to
% the a main predicate.
%
-:- pred defns_contain_main(mlds_defns::in) is semidet.
+:- pred defns_contain_main(list(mlds_defn)::in) is semidet.
%-----------------------------------------------------------------------------%
@@ -48,9 +48,6 @@
% Nondeterministically generates sub-statements from statements.
%
-:- pred statements_contains_statement(statements::in,
- statement::out) is nondet.
-
:- pred statement_contains_statement(statement::in, statement::out)
is multi.
@@ -117,7 +114,7 @@
% Succeeds iff these definitions contains a reference to
% the specified variable.
%
-:- pred defns_contains_var(mlds_defns::in, mlds_data::in) is semidet.
+:- pred defns_contains_var(list(mlds_defn)::in, mlds_data::in) is semidet.
% Succeeds iff this definition contains a reference to
% the specified variable.
@@ -135,8 +132,9 @@
% rval_contains_var:
% lvals_contains_var:
% lval_contains_var:
-% Succeeds iff the specified construct contains a reference to
-% the specified variable.
+%
+% Succeed iff the specified construct contains a reference to
+% the specified variable.
:- pred initializer_contains_var(mlds_initializer::in, mlds_data::in)
is semidet.
@@ -248,7 +246,11 @@
% statement_contains_statement:
% statements_contains_statement:
% maybe_statement_contains_statement:
-% nondeterministically generates sub-statements from statements.
+%
+% Nondeterministically generate sub-statements from statements.
+
+:- pred statements_contains_statement(list(statement)::in,
+ statement::out) is nondet.
statements_contains_statement(Statements, SubStatement) :-
list.member(Statement, Statements),
@@ -284,30 +286,19 @@
; default_contains_statement(Default, SubStatement)
)
;
- Stmt = ml_stmt_label(_Label),
- fail
- ;
- Stmt = ml_stmt_goto(_),
- fail
- ;
- Stmt = ml_stmt_computed_goto(_Rval, _Labels),
- fail
- ;
- Stmt = ml_stmt_call(_Sig, _Func, _Obj, _Args, _RetLvals, _TailCall),
- fail
- ;
- Stmt = ml_stmt_return(_Rvals),
- fail
- ;
- Stmt = ml_stmt_do_commit(_Ref),
- fail
- ;
Stmt = ml_stmt_try_commit(_Ref, Statement, Handler),
( statement_contains_statement(Statement, SubStatement)
; statement_contains_statement(Handler, SubStatement)
)
;
- Stmt = ml_stmt_atomic(_AtomicStmt),
+ ( Stmt = ml_stmt_label(_Label)
+ ; Stmt = ml_stmt_goto(_)
+ ; Stmt = ml_stmt_computed_goto(_Rval, _Labels)
+ ; Stmt = ml_stmt_call(_Sig, _Func, _Obj, _Args, _RetLvals, _TailCall)
+ ; Stmt = ml_stmt_return(_Rvals)
+ ; Stmt = ml_stmt_do_commit(_Ref)
+ ; Stmt = ml_stmt_atomic(_AtomicStmt)
+ ),
fail
).
@@ -332,10 +323,11 @@
% statement_contains_var:
% trail_op_contains_var:
% atomic_stmt_contains_var:
-% Succeeds iff the specified construct contains a reference to
-% the specified variable.
+%
+% Succeed iff the specified construct contains a reference to
+% the specified variable.
-:- pred statements_contains_var(statements::in, mlds_data::in)
+:- pred statements_contains_var(list(statement)::in, mlds_data::in)
is semidet.
statements_contains_var(Statements, Name) :-
@@ -379,10 +371,9 @@
; default_contains_var(Default, Name)
)
;
- Stmt = ml_stmt_label(_Label),
- fail
- ;
- Stmt = ml_stmt_goto(_),
+ ( Stmt = ml_stmt_label(_Label)
+ ; Stmt = ml_stmt_goto(_)
+ ),
fail
;
Stmt = ml_stmt_computed_goto(Rval, _Labels),
@@ -541,9 +532,10 @@
% defn_contains_var:
% defn_body_contains_var:
% function_body_contains_var:
-% Succeeds iff the specified construct contains a reference to
-% the specified variable.
%
+% Succeed iff the specified construct contains a reference to
+% the specified variable.
+
defns_contains_var(Defns, Name) :-
list.member(Defn, Defns),
defn_contains_var(Defn, Name).
@@ -585,8 +577,9 @@
% rval_contains_var:
% lvals_contains_var:
% lval_contains_var:
-% Succeeds iff the specified construct contains a reference to
-% the specified variable.
+%
+% Succeed iff the specified construct contains a reference to
+% the specified variable.
% initializer_contains_var(no_initializer, _) :- fail.
initializer_contains_var(init_obj(Rval), Name) :-
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.166
diff -u -r1.166 mlds.m
--- compiler/mlds.m 5 Jan 2009 01:30:51 -0000 1.166
+++ compiler/mlds.m 14 Jan 2009 15:45:11 -0000
@@ -361,27 +361,27 @@
:- type mlds
---> mlds(
% The original Mercury module name.
- name :: mercury_module_name,
+ mlds_name :: mercury_module_name,
% Code defined in some other language, e.g. for
% `pragma c_header_code', etc.
- foreign_code_map :: map(foreign_language,
- mlds_foreign_code),
+ mlds_foreign_code_map :: map(foreign_language,
+ mlds_foreign_code),
% The MLDS code itself.
% Packages/classes to import
- toplevel_imports :: mlds_imports,
+ mlds_toplevel_imports :: mlds_imports,
% Definitions of code and data
- defns :: mlds_defns,
+ mlds_defns :: list(mlds_defn),
% The names of init and final preds.
% XXX These only work for the C backend because initialisers
% and finalisers do not (yet) work for the other backends.
- init_preds :: list(string),
- final_preds :: list(string),
- exported_enums :: list(mlds_exported_enum)
+ mlds_init_preds :: list(string),
+ mlds_final_preds :: list(string),
+ mlds_exported_enums :: list(mlds_exported_enum)
).
:- func mlds_get_module_name(mlds) = mercury_module_name.
@@ -452,8 +452,8 @@
% Is the current module a member of the std library,
% and if so which module is it?
%
-:- pred is_std_lib_module(mlds_module_name::in,
- mercury_module_name::out) is semidet.
+:- pred is_std_lib_module(mlds_module_name::in, mercury_module_name::out)
+ is semidet.
% Given an MLDS module name (e.g. `foo.bar'), append another class
% qualifier (e.g. for a class `baz'), and return the result (e.g.
@@ -481,8 +481,6 @@
%
:- func wrapper_class_name = string.
-:- type mlds_defns == list(mlds_defn).
-
:- type mlds_defn
---> mlds_defn(
% The name of the entity being declared.
@@ -678,28 +676,29 @@
:- type mlds_class_name == string.
:- type mlds_class == mlds_fully_qualified_name(mlds_class_name).
- % Note that standard C doesn't support empty structs,
- % so when targetting C, it is the MLDS code generator's
- % responsibility to ensure that each generated MLDS class
- % has at least one base class or non-static data member.
+ % Note that standard C doesn't support empty structs, so when targetting C,
+ % it is the MLDS code generator's responsibility to ensure that each
+ % generated MLDS class has at least one base class or non-static
+ % data member.
%
:- type mlds_class_defn
---> mlds_class_defn(
- kind :: mlds_class_kind,
- imports :: mlds_imports,
- % Imports these classes (or modules, packages, ...).
+ mcd_kind :: mlds_class_kind,
+
+ % Imports these classes (or modules, packages, ...).
+ mcd_imports :: mlds_imports,
- inherits :: list(mlds_class_id),
- % Inherits these base classes.
+ % Inherits these base classes.
+ mcd_inherits :: list(mlds_class_id),
- implements :: list(mlds_interface_id),
- % Implements these interfaces.
+ % Implements these interfaces.
+ mcd_implements :: list(mlds_interface_id),
- ctors :: mlds_defns,
- % Has these constructors.
+ % Has these constructors.
+ mcd_ctors :: list(mlds_defn),
- members :: mlds_defns
- % Contains these members.
+ % Contains these members.
+ mcd_members :: list(mlds_defn)
).
:- type mlds_type
@@ -967,8 +966,6 @@
% Statements
%
-:- type statements == list(statement).
-
:- type statement
---> statement(
mlds_stmt,
@@ -978,7 +975,7 @@
:- type mlds_stmt
% Sequence.
- ---> ml_stmt_block(mlds_defns, list(statement))
+ ---> ml_stmt_block(list(mlds_defn), list(statement))
% Iteration.
@@ -1795,7 +1792,7 @@
%-----------------------------------------------------------------------------%
-mlds_get_module_name(MLDS) = MLDS ^ name.
+mlds_get_module_name(MLDS) = MLDS ^ mlds_name.
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.232
diff -u -r1.232 mlds_to_c.m
--- compiler/mlds_to_c.m 5 Jan 2009 01:30:51 -0000 1.232
+++ compiler/mlds_to_c.m 14 Jan 2009 15:45:31 -0000
@@ -325,7 +325,7 @@
io.nl(!IO),
mlds_output_src_end(Indent, ModuleName, !IO).
-:- func mlds_get_env_var_names(mlds_defns) = set(string).
+:- func mlds_get_env_var_names(list(mlds_defn)) = set(string).
mlds_get_env_var_names(Defns) = EnvVarNameSet :-
list.filter_map(mlds_get_env_var_names_from_defn, Defns, EnvVarNameSets),
@@ -595,9 +595,9 @@
io.write_string(";\n", !IO)
).
-:- pred mlds_output_init_fn_defns(mlds_module_name::in, mlds_defns::in,
- mlds_defns::in, list(string)::in, list(string)::in, io::di, io::uo)
- is det.
+:- pred mlds_output_init_fn_defns(mlds_module_name::in,
+ list(mlds_defn)::in, list(mlds_defn)::in,
+ list(string)::in, list(string)::in, io::di, io::uo) is det.
mlds_output_init_fn_defns(ModuleName, FuncDefns, TypeCtorInfoDefns, InitPreds,
FinalPreds, !IO) :-
@@ -724,8 +724,8 @@
% Generate calls to MR_init_entry() for the specified functions.
%
-:- pred mlds_output_calls_to_init_entry(mlds_module_name::in, mlds_defns::in,
- io::di, io::uo) is det.
+:- pred mlds_output_calls_to_init_entry(mlds_module_name::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
mlds_output_calls_to_init_entry(_ModuleName, [], !IO).
mlds_output_calls_to_init_entry(ModuleName, [FuncDefn | FuncDefns], !IO) :-
@@ -740,7 +740,7 @@
% type_ctor_infos.
%
:- pred mlds_output_calls_to_register_tci(mlds_module_name::in,
- mlds_defns::in, io::di, io::uo) is det.
+ list(mlds_defn)::in, io::di, io::uo) is det.
mlds_output_calls_to_register_tci(_ModuleName, [], !IO).
mlds_output_calls_to_register_tci(ModuleName,
@@ -1272,14 +1272,14 @@
% Code to output declarations and definitions
%
-:- pred mlds_output_decls(indent::in, mlds_module_name::in, mlds_defns::in,
- io::di, io::uo) is det.
+:- pred mlds_output_decls(indent::in, mlds_module_name::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
mlds_output_decls(Indent, ModuleName, Defns, !IO) :-
list.foldl(mlds_output_decl_blank_line(Indent, ModuleName), Defns, !IO).
:- pred mlds_output_defns(indent::in, bool::in, mlds_module_name::in,
- mlds_defns::in, io::di, io::uo) is det.
+ list(mlds_defn)::in, io::di, io::uo) is det.
mlds_output_defns(Indent, Separate, ModuleName, Defns, !IO) :-
OutputDefn = mlds_output_defn(Indent, Separate, ModuleName),
@@ -1315,7 +1315,7 @@
% actually use the enum types.
DefnBody = mlds_class(ClassDefn),
- ClassDefn ^ kind = mlds_enum
+ ClassDefn ^ mcd_kind = mlds_enum
->
true
;
@@ -1509,7 +1509,7 @@
mlds_class_defn::in, io::di, io::uo) is det.
mlds_output_class_decl(_Indent, Name, ClassDefn, !IO) :-
- ClassKind = ClassDefn ^ kind,
+ ClassKind = ClassDefn ^ mcd_kind,
(
ClassKind = mlds_enum,
io.write_string("enum ", !IO),
@@ -1645,7 +1645,7 @@
% for an enumeration type.
%
:- pred mlds_output_enum_constants(indent::in, mlds_module_name::in,
- mlds_defns::in, io::di, io::uo) is det.
+ list(mlds_defn)::in, io::di, io::uo) is det.
mlds_output_enum_constants(Indent, EnumModuleName, Members, !IO) :-
% Select the enumeration constants from the list of members
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.141
diff -u -r1.141 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 5 Jan 2009 01:30:51 -0000 1.141
+++ compiler/mlds_to_gcc.m 10 Jan 2009 07:01:45 -0000
@@ -449,8 +449,8 @@
output_init_fn_name(ModuleName, "_debugger"),
io__write_string(";\n").
-:- pred mlds_output_init_fn_defns(mlds_module_name::in, mlds_defns::in,
- mlds_defns::in, io__state::di, io__state::uo) is det.
+:- pred mlds_output_init_fn_defns(mlds_module_name::in, list(mlds_defn)::in,
+ list(mlds_defn)::in, io__state::di, io__state::uo) is det.
mlds_output_init_fn_defns(ModuleName, FuncDefns, TypeCtorInfoDefns) -->
output_init_fn_name(ModuleName, ""),
@@ -499,15 +499,12 @@
% 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), "__",
- ModuleNameString0) },
- {
- string__prefix(ModuleNameString0, "mercury__")
- ->
+ mlds_module_name_to_sym_name(ModuleName), "__",
+ ModuleNameString0) },
+ { string__prefix(ModuleNameString0, "mercury__") ->
ModuleNameString = ModuleNameString0
;
- string__append("mercury__", ModuleNameString0,
- ModuleNameString)
+ string__append("mercury__", ModuleNameString0, ModuleNameString)
},
io__write_string("void "),
io__write_string(ModuleNameString),
@@ -527,8 +524,8 @@
% Generate calls to MR_init_entry() for the specified functions.
%
-:- pred mlds_output_calls_to_init_entry(mlds_module_name::in, mlds_defns::in,
- io__state::di, io__state::uo) is det.
+:- pred mlds_output_calls_to_init_entry(mlds_module_name::in,
+ list(mlds_defn)::in, io__state::di, io__state::uo) is det.
mlds_output_calls_to_init_entry(_ModuleName, []) --> [].
mlds_output_calls_to_init_entry(ModuleName, [FuncDefn | FuncDefns]) -->
@@ -548,7 +545,7 @@
% type_ctor_infos.
%
:- pred mlds_output_calls_to_register_tci(mlds_module_name::in,
- mlds_defns::in, io__state::di, io__state::uo) is det.
+ list(mlds_defn)::in, io__state::di, io__state::uo) is det.
mlds_output_calls_to_register_tci(_ModuleName, []) --> [].
mlds_output_calls_to_register_tci(ModuleName,
@@ -717,7 +714,7 @@
% Handle MLDS definitions that occur at global scope.
-:- pred gen_defns(mlds_module_name, mlds_defns, global_info, global_info,
+:- pred gen_defns(mlds_module_name, list(mlds_defn), global_info, global_info,
io__state, io__state).
:- mode gen_defns(in, in, in, out, di, uo) is det.
@@ -729,8 +726,8 @@
% Handle MLDS definitions that are nested inside a
% function definition (or inside a block within a function),
% and which are hence local to that function.
-:- pred build_local_defns(mlds_defns, mlds_module_name, defn_info, defn_info,
- io__state, io__state).
+:- pred build_local_defns(list(mlds_defn), mlds_module_name,
+ defn_info, defn_info, io__state, io__state).
:- mode build_local_defns(in, in, in, out, di, uo) is det.
build_local_defns([], _, DefnInfo, DefnInfo) --> [].
@@ -750,7 +747,7 @@
% Handle MLDS definitions that are nested inside a type,
% i.e. fields of that type.
-:- pred build_field_defns(mlds_defns, mlds_module_name, global_info,
+:- pred build_field_defns(list(mlds_defn), mlds_module_name, global_info,
gcc__field_decls, field_table, field_table,
io__state, io__state).
:- mode build_field_defns(in, in, in, out, in, out, di, uo) is det.
@@ -1431,7 +1428,7 @@
% for an enumeration type.
%
:- pred mlds_output_enum_constants(indent, mlds_module_name,
- mlds_defns, io__state, io__state).
+ list(mlds_defn), io__state, io__state).
:- mode mlds_output_enum_constants(in, in, in, di, uo) is det.
mlds_output_enum_constants(Indent, EnumModuleName, Members) -->
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.200
diff -u -r1.200 mlds_to_il.m
--- compiler/mlds_to_il.m 6 Jan 2009 03:56:26 -0000 1.200
+++ compiler/mlds_to_il.m 14 Jan 2009 15:56:50 -0000
@@ -5,10 +5,10 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-%
+%
% File: mlds_to_il.m - Convert MLDS to IL.
% Main author: trd, petdr.
-%
+%
% This module generates IL from MLDS. Currently it's pretty tuned
% towards generating assembler -- to generate code using
% Reflection::Emit it is likely some changes will need to be made.
@@ -57,7 +57,7 @@
%
% XXX We should rename this module to mlds_to_ilds, since that is what
% it actually does.
-%
+%
%-----------------------------------------------------------------------------%
:- module ml_backend.mlds_to_il.
@@ -385,25 +385,26 @@
AllExports = list.condense(
list.map(
(func(mlds_foreign_code(_, _, _, Exports)) = Exports),
- map.values(MLDS0 ^ foreign_code_map))
+ map.values(MLDS0 ^ mlds_foreign_code_map))
),
% Generate the exports for this file, they will be placed into
% class methods inside the wrapper class.
list.map(mlds_export_to_mlds_defn, AllExports, ExportDefns),
- list.filter((pred(D::in) is semidet :-
+ list.filter(
+ (pred(D::in) is semidet :-
( D = mlds_defn(_, _, _, mlds_function(_, _, _, _, _))
; D = mlds_defn(_, _, _, mlds_data(_, _, _))
)
- ), MLDS0 ^ defns ++ ExportDefns, MercuryCodeMembers, Others),
- WrapperClass = wrapper_class(
- list.map(rename_defn, MercuryCodeMembers)),
+ ), MLDS0 ^ mlds_defns ++ ExportDefns, MercuryCodeMembers, Others),
+ WrapperClass = wrapper_class(list.map(rename_defn, MercuryCodeMembers)),
% Note that ILASM requires that the type definitions in Others
% must precede the references to those types in WrapperClass.
- MLDS = MLDS0 ^ defns := list.map(rename_defn, Others) ++ [WrapperClass].
+ MLDS = MLDS0 ^ mlds_defns :=
+ list.map(rename_defn, Others) ++ [WrapperClass].
-:- func wrapper_class(mlds_defns) = mlds_defn.
+:- func wrapper_class(list(mlds_defn)) = mlds_defn.
wrapper_class(Members) =
mlds_defn(
@@ -709,8 +710,8 @@
% newobj instruction to allocate instances of the class. So if a class
% doesn't already have one, we add an empty one.
%
-:- func maybe_add_empty_ctor(mlds_defns, mlds_class_kind, mlds_context) =
- mlds_defns.
+:- func maybe_add_empty_ctor(list(mlds_defn), mlds_class_kind, mlds_context) =
+ list(mlds_defn).
maybe_add_empty_ctor(Ctors0, Kind, Context) = Ctors :-
(
@@ -866,7 +867,7 @@
Access = [assembly]
;
AccessFlag = acc_local,
- unexpected(this_file,
+ unexpected(this_file,
"decl_flags_to_methattrs: local access flag")
),
PerInstanceFlag = per_instance(Flags),
@@ -905,7 +906,7 @@
:- func decl_flags_to_fieldattrs(mlds_decl_flags) = list(ilasm.fieldattr).
decl_flags_to_fieldattrs(Flags)
- = list.condense([Access, PerInstance, Constness]) :-
+ = list.condense([Access, PerInstance, Constness]) :-
AccessFlag = access(Flags),
(
AccessFlag = acc_public,
@@ -1527,7 +1528,6 @@
%
data_initializer_to_instrs(init_struct(_StructType, InitList0), Type,
AllocInstrs, InitInstrs, !Info) :-
-
InitList = flatten_inits(InitList0),
data_initializer_to_instrs(init_array(InitList), Type,
AllocInstrs, InitInstrs, !Info).
@@ -1538,7 +1538,6 @@
% allocations.
data_initializer_to_instrs(init_array(InitList), Type,
AllocInstrs, InitInstrs, !Info) :-
-
% Figure out the array element type.
DataRep = !.Info ^ il_data_rep,
( Type = mlds_array_type(ElemType0) ->
@@ -1756,7 +1755,7 @@
ReturnsStoredInstrs.
statement_to_il(statement(IfThenElseStmt, Context), Instrs, !Info) :-
- IfThenElseStmt = ml_stmt_if_then_else(Condition, ThenCase, ElseCase),
+ IfThenElseStmt = ml_stmt_if_then_else(Condition, ThenCase, ElseCase),
generate_condition(Condition, ConditionInstrs, ElseLabel, !Info),
il_info_make_next_label(DoneLabel, !Info),
statement_to_il(ThenCase, ThenInstrs, !Info),
@@ -1874,7 +1873,7 @@
statement_to_il(statement(TryCommitStmt, Context), Instrs, !Info) :-
TryCommitStmt = ml_stmt_try_commit(_Ref, GoalToTry, CommitHandlerGoal),
-
+
% For commits, we use exception handling.
%
% For try_commit instructions, we generate IL code
@@ -1973,7 +1972,7 @@
Num::in, Num + 1::out) is det :-
Instr = ldarg(index(Num))),
TypeParams, LoadArgInstrs, 0, _),
- Instrs =
+ Instrs =
comment_node("outline foreign proc -- call handwritten version") ++
LoadInstrs ++
from_list(LoadArgInstrs) ++
@@ -2587,7 +2586,7 @@
)
;
% Convert an unboxed type to a boxed type: box it first, then cast.
- Instrs =
+ Instrs =
convert_to_object(SrcILType) ++
singleton(castclass(DestILType))
)
@@ -3279,7 +3278,7 @@
% Names that are to be used only in IL are able to include
% spaces, punctuation and other special characters, because they
% are in quotes.
-
+
; mangle_for_csharp.
% Names that are to be used in C# (typically because they are
% foreign procedures) must be mangled in the same way as for C.
@@ -3722,7 +3721,7 @@
MLDSType = mercury_type(IntType, ctor_cat_builtin(cat_builtin_int),
non_foreign_type(IntType)).
rval_const_to_type(mlconst_foreign(_, _, _))
- = sorry(this_file, "IL backend and foreign tag.").
+ = sorry(this_file, "IL backend and foreign tag.").
rval_const_to_type(mlconst_float(_)) = MLDSType :-
FloatType = builtin_type(builtin_type_float),
MLDSType = mercury_type(FloatType, ctor_cat_builtin(cat_builtin_float),
@@ -3738,7 +3737,7 @@
MLDSType = mercury_type(StrType, ctor_cat_builtin(cat_builtin_string),
non_foreign_type(StrType)).
rval_const_to_type(mlconst_named_const(_))
- = sorry(this_file, "IL backend and named const.").
+ = sorry(this_file, "IL backend and named const.").
rval_const_to_type(mlconst_null(MldsType)) = MldsType.
%-----------------------------------------------------------------------------%
@@ -4640,7 +4639,7 @@
:- func il_method_params_to_il_types(list(il_method_param)) = list(il_type).
il_method_params_to_il_types([]) = [].
-il_method_params_to_il_types([ il_method_param(Type, _) | Params]) =
+il_method_params_to_il_types([ il_method_param(Type, _) | Params]) =
[ Type | Types ] :-
Types = il_method_params_to_il_types(Params).
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.105
diff -u -r1.105 mlds_to_java.m
--- compiler/mlds_to_java.m 5 Jan 2009 01:30:52 -0000 1.105
+++ compiler/mlds_to_java.m 10 Jan 2009 07:24:58 -0000
@@ -580,7 +580,7 @@
% Returns code-address information (function label and signature)
% for each method/function which has its address taken in the MLDS.
%
-:- pred find_pointer_addressed_methods(mlds_defns::in,
+:- pred find_pointer_addressed_methods(list(mlds_defn)::in,
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
find_pointer_addressed_methods([], !CodeAddrs).
@@ -608,7 +608,7 @@
method_ptrs_in_defns(Ctors, !CodeAddrs),
method_ptrs_in_defns(Members, !CodeAddrs).
-:- pred method_ptrs_in_statements(statements::in,
+:- pred method_ptrs_in_statements(list(statement)::in,
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
method_ptrs_in_statements([], !CodeAddrs).
@@ -707,7 +707,7 @@
method_ptrs_in_statement(Statement, !CodeAddrs),
method_ptrs_in_switch_cases(Cases, !CodeAddrs).
-:- pred method_ptrs_in_defns(mlds_defns::in, list(mlds_code_addr)::in,
+:- pred method_ptrs_in_defns(list(mlds_defn)::in, list(mlds_code_addr)::in,
list(mlds_code_addr)::out) is det.
method_ptrs_in_defns([], !CodeAddrs).
@@ -804,7 +804,7 @@
% Generates the MLDS to output the required wrapper classes
%
:- pred generate_code_addr_wrappers(indent::in, list(mlds_code_addr)::in,
- mlds_defns::in, mlds_defns::out) is det.
+ list(mlds_defn)::in, list(mlds_defn)::out) is det.
generate_code_addr_wrappers(_, [], !Defns).
generate_code_addr_wrappers(Indent, [CodeAddr | CodeAddrs], !Defns) :-
@@ -1049,7 +1049,7 @@
%
:- pred output_src_start(indent::in, mercury_module_name::in,
- mlds_imports::in, list(foreign_decl_code)::in, mlds_defns::in,
+ mlds_imports::in, list(foreign_decl_code)::in, list(mlds_defn)::in,
io::di, io::uo) is det.
output_src_start(Indent, MercuryModuleName, Imports, ForeignDecls, Defns,
@@ -1088,7 +1088,7 @@
% variable `args' in the class `mercury.runtime.JavaInternal'.
%
:- pred maybe_write_main_driver(indent::in, java_module_name::in,
- mlds_defns::in, io::di, io::uo) is det.
+ list(mlds_defn)::in, io::di, io::uo) is det.
maybe_write_main_driver(Indent, JavaSafeModuleName, Defns, !IO) :-
( defns_contain_main(Defns) ->
@@ -1169,7 +1169,7 @@
; cname(mlds_entity_name). % Constructor class name.
:- pred output_defns(indent::in, module_info::in, mlds_module_name::in,
- ctor_data::in, mlds_defns::in, io::di, io::uo) is det.
+ ctor_data::in, list(mlds_defn)::in, io::di, io::uo) is det.
output_defns(Indent, ModuleInfo, ModuleName, CtorData, Defns, !IO) :-
OutputDefn = output_defn(Indent, ModuleInfo, ModuleName, CtorData),
@@ -1324,7 +1324,7 @@
).
:- pred output_class_body(indent::in, module_info::in, mlds_class_kind::in,
- mlds_qualified_entity_name::in, mlds_defns::in,
+ mlds_qualified_entity_name::in, list(mlds_defn)::in,
mlds_module_name::in, io::di, io::uo) is det.
output_class_body(Indent, ModuleInfo, mlds_class, _, AllMembers, ModuleName,
@@ -1387,7 +1387,7 @@
io.write_string("}\n", !IO).
:- pred output_enum_constants(indent::in, module_info::in,
- mlds_module_name::in, mlds_defns::in, io::di, io::uo) is det.
+ mlds_module_name::in, list(mlds_defn)::in, io::di, io::uo) is det.
output_enum_constants(Indent, ModuleInfo, EnumModuleName, EnumConsts, !IO) :-
io.write_list(EnumConsts, "\n",
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.452
diff -u -r1.452 modules.m
--- compiler/modules.m 5 Sep 2008 03:57:37 -0000 1.452
+++ compiler/modules.m 14 Jan 2009 07:29:47 -0000
@@ -1944,7 +1944,7 @@
append_pseudo_decl(PseudoDecl, Module0, Module) :-
Items0 = Module0 ^ items,
- Items = cord.snoc(Items0, make_pseudo_decl(PseudoDecl)),
+ Items = snoc(Items0, make_pseudo_decl(PseudoDecl)),
Module = Module0 ^ items := Items.
make_pseudo_decl(PseudoDecl) = Item :-
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.85
diff -u -r1.85 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 5 Jan 2009 01:30:52 -0000 1.85
+++ compiler/rtti_to_mlds.m 14 Jan 2009 14:52:52 -0000
@@ -49,7 +49,7 @@
% Return a list of MLDS definitions for the given rtti_data list.
%
-:- func rtti_data_list_to_mlds(module_info, list(rtti_data)) = mlds_defns.
+:- func rtti_data_list_to_mlds(module_info, list(rtti_data)) = list(mlds_defn).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -102,7 +102,7 @@
).
% return a list of MLDS definitions for the given rtti_data.
-:- func rtti_data_to_mlds(module_info, rtti_data) = mlds_defns.
+:- func rtti_data_to_mlds(module_info, rtti_data) = list(mlds_defn).
rtti_data_to_mlds(ModuleInfo, RttiData) = MLDS_Defns :-
( RttiData = rtti_data_pseudo_type_info(type_var(_)) ->
@@ -188,88 +188,92 @@
:- pred gen_init_rtti_data_defn(rtti_data::in, rtti_id::in, module_info::in,
mlds_initializer::out, list(mlds_defn)::out) is det.
-gen_init_rtti_data_defn(RttiData, _RttiId, ModuleInfo, Init, ExtraDefns) :-
- RttiData = rtti_data_base_typeclass_info(_InstanceModule, _ClassId,
- _InstanceStr, BaseTypeClassInfo),
- BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5, Methods),
- NumExtra = BaseTypeClassInfo ^ num_extra,
- list.map_foldl(gen_init_method(ModuleInfo, NumExtra),
- Methods, MethodInitializers, [], ExtraDefns),
- Init = init_array([
- gen_init_boxed_int(N1),
- gen_init_boxed_int(N2),
- gen_init_boxed_int(N3),
- gen_init_boxed_int(N4),
- gen_init_boxed_int(N5)
- | MethodInitializers
- ]).
-gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
- RttiData = rtti_data_type_info(TypeInfo),
- gen_type_info_defn(ModuleInfo, TypeInfo, RttiId, Init, SubDefns).
-gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
- RttiData = rtti_data_pseudo_type_info(PseudoTypeInfo),
- gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, RttiId,
- Init, SubDefns).
-gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
- RttiData = rtti_data_type_class_decl(TCDecl),
- gen_type_class_decl_defn(TCDecl, RttiId, ModuleInfo, Init, SubDefns).
-gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
- RttiData = rtti_data_type_class_instance(Instance),
- gen_type_class_instance_defn(Instance, RttiId, ModuleInfo, Init, SubDefns).
-gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, SubDefns) :-
- RttiData = rtti_data_type_ctor_info(TypeCtorData),
- TypeCtorData = type_ctor_data(Version, TypeModule, TypeName,
- TypeArity, UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
- RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName, TypeArity),
- TypeModuleName = sym_name_to_string(TypeModule),
- NumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
- NumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
- FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_functors),
- LayoutRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_layout),
-
- some [!Defns] (
- gen_functors_layout_info(ModuleInfo, RttiTypeCtor,
- TypeCtorDetails, FunctorsInfo, LayoutInfo, NumberMapInfo, !:Defns),
-
- % Note that gen_init_special_pred will by necessity add an extra level
- % of indirection to calling the special preds. However the backend
- % compiler should be smart enough to ensure that this is inlined away.
- %
- gen_init_special_pred(ModuleInfo, UnifyUniv, UnifyInit, !Defns),
- gen_init_special_pred(ModuleInfo, CompareUniv, CompareInit, !Defns),
-
- SubDefns = !.Defns
- ),
-
- Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_int(TypeArity),
- gen_init_int(Version),
- gen_init_int(NumPtags),
- gen_init_type_ctor_rep(TypeCtorData),
- UnifyInit,
- CompareInit,
- gen_init_string(TypeModuleName),
- gen_init_string(TypeName),
- % In the C back-end, these two "structs" are actually unions.
- % We need to use `init_struct' here so that the initializers
- % get enclosed in curly braces.
- init_struct(mlds_rtti_type(item_type(FunctorsRttiId)), [
- FunctorsInfo
- ]),
- init_struct(mlds_rtti_type(item_type(LayoutRttiId)), [
- LayoutInfo
- ]),
- gen_init_int(NumFunctors),
- gen_init_int(encode_type_ctor_flags(Flags)),
- NumberMapInfo
-
- % These two are commented out while the corresponding fields of the
- % MR_TypeCtorInfo_Struct type are commented out.
- % gen_init_maybe(gen_init_rtti_name(RttiTypeCtor), MaybeHashCons),
- % XXX this may need to change to call
- % gen_init_special_pred, if this is re-enabled.
- % gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
- ]).
+gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo, Init, Defns) :-
+ (
+ RttiData = rtti_data_base_typeclass_info(_InstanceModule, _ClassId,
+ _InstanceStr, BaseTypeClassInfo),
+ BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5, Methods),
+ NumExtra = BaseTypeClassInfo ^ num_extra,
+ list.map_foldl(gen_init_method(ModuleInfo, NumExtra),
+ Methods, MethodInitializers, [], Defns),
+ Init = init_array([
+ gen_init_boxed_int(N1),
+ gen_init_boxed_int(N2),
+ gen_init_boxed_int(N3),
+ gen_init_boxed_int(N4),
+ gen_init_boxed_int(N5)
+ | MethodInitializers
+ ])
+ ;
+ RttiData = rtti_data_type_info(TypeInfo),
+ gen_type_info_defn(ModuleInfo, TypeInfo, RttiId, Init, Defns)
+ ;
+ RttiData = rtti_data_pseudo_type_info(PseudoTypeInfo),
+ gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, RttiId,
+ Init, Defns)
+ ;
+ RttiData = rtti_data_type_class_decl(TCDecl),
+ gen_type_class_decl_defn(TCDecl, RttiId, ModuleInfo, Init, Defns)
+ ;
+ RttiData = rtti_data_type_class_instance(Instance),
+ gen_type_class_instance_defn(Instance, RttiId, ModuleInfo, Init, Defns)
+ ;
+ RttiData = rtti_data_type_ctor_info(TypeCtorData),
+ TypeCtorData = type_ctor_data(Version, TypeModule, TypeName,
+ TypeArity, UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
+ RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName, TypeArity),
+ TypeModuleName = sym_name_to_string(TypeModule),
+ NumPtags = type_ctor_details_num_ptags(TypeCtorDetails),
+ NumFunctors = type_ctor_details_num_functors(TypeCtorDetails),
+ FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_functors),
+ LayoutRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_layout),
+
+ some [!Defns] (
+ gen_functors_layout_info(ModuleInfo, RttiTypeCtor,
+ TypeCtorDetails, FunctorsInfo, LayoutInfo, NumberMapInfo,
+ !:Defns),
+
+ % Note that gen_init_special_pred will by necessity add an extra
+ % level of indirection to calling the special preds. However the
+ % backend compiler should be smart enough to ensure that this is
+ % inlined away.
+ gen_init_special_pred(ModuleInfo, UnifyUniv, UnifyInit, !Defns),
+ gen_init_special_pred(ModuleInfo, CompareUniv, CompareInit,
+ !Defns),
+
+ Defns = !.Defns
+ ),
+
+ Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
+ gen_init_int(TypeArity),
+ gen_init_int(Version),
+ gen_init_int(NumPtags),
+ gen_init_type_ctor_rep(TypeCtorData),
+ UnifyInit,
+ CompareInit,
+ gen_init_string(TypeModuleName),
+ gen_init_string(TypeName),
+ % In the C back-end, these two "structs" are actually unions.
+ % We need to use `init_struct' here so that the initializers
+ % get enclosed in curly braces.
+ init_struct(mlds_rtti_type(item_type(FunctorsRttiId)), [
+ FunctorsInfo
+ ]),
+ init_struct(mlds_rtti_type(item_type(LayoutRttiId)), [
+ LayoutInfo
+ ]),
+ gen_init_int(NumFunctors),
+ gen_init_int(encode_type_ctor_flags(Flags)),
+ NumberMapInfo
+
+ % These two are commented out while the corresponding fields of the
+ % MR_TypeCtorInfo_Struct type are commented out.
+ % gen_init_maybe(gen_init_rtti_name(RttiTypeCtor), MaybeHashCons),
+ % XXX this may need to change to call
+ % gen_init_special_pred, if this is re-enabled.
+ % gen_init_proc_id_from_univ(ModuleInfo, PrettyprinterProc)
+ ])
+ ).
%-----------------------------------------------------------------------------%
@@ -346,7 +350,7 @@
gen_init_int(NumSupers),
SupersInit
]),
- SubDefns = TVarNameDefns ++ MethodIdDefns ++ [TCIdDefn] ++ SuperDefns.
+ SubDefns = TVarNameDefns ++ MethodIdDefns ++ [TCIdDefn | SuperDefns].
:- pred make_decl_super_id(tc_name::in, int::in, int::in, rtti_id::out)
is det.
@@ -418,7 +422,7 @@
gen_init_rtti_id(ModuleName, InstanceTypesRttiId),
gen_init_rtti_id(ModuleName, InstanceConstrsRttiId)
]),
- SubDefns = TypesDefns ++ [TypesDefn] ++ TCConstrDefns ++
+ SubDefns = TypesDefns ++ [TypesDefn | TCConstrDefns] ++
[InstanceConstrsDefn].
:- pred make_instance_constr_id(tc_name::in, list(tc_type)::in,
@@ -433,71 +437,81 @@
:- pred gen_type_info_defn(module_info::in, rtti_type_info::in, rtti_id::in,
mlds_initializer::out, list(mlds_defn)::out) is det.
-gen_type_info_defn(_, plain_arity_zero_type_info(_), _, _, _) :-
- unexpected(this_file, "gen_type_info_defn: plain_arity_zero_type_info").
-gen_type_info_defn(ModuleInfo, plain_type_info(RttiTypeCtor, ArgTypes),
- RttiId, Init, SubDefns) :-
- ArgRttiDatas = list.map(type_info_to_rtti_data, ArgTypes),
- RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
- SubDefnLists = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
- SubDefns = list.condense(SubDefnLists),
- module_info_get_name(ModuleInfo, ModuleName),
- Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_type_ctor_info),
- gen_init_cast_rtti_datas_array(mlds_type_info_type,
- ModuleName, ArgRttiDatas)
- ]).
-gen_type_info_defn(ModuleInfo, var_arity_type_info(VarArityId, ArgTypes),
- RttiId, Init, SubDefns) :-
- ArgRttiDatas = list.map(type_info_to_rtti_data, ArgTypes),
- RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
- SubDefnLists = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
- SubDefns = list.condense(SubDefnLists),
- RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
- module_info_get_name(ModuleInfo, ModuleName),
- Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_type_ctor_info),
- gen_init_int(list.length(ArgTypes)),
- gen_init_cast_rtti_datas_array(mlds_type_info_type,
- ModuleName, ArgRttiDatas)
- ]).
+gen_type_info_defn(ModuleInfo, RttiTypeInfo, RttiId, Init, Defns) :-
+ (
+ RttiTypeInfo = plain_arity_zero_type_info(_),
+ unexpected(this_file, "gen_type_info_defn: plain_arity_zero_type_info")
+ ;
+ RttiTypeInfo = plain_type_info(RttiTypeCtor, ArgTypes),
+ ArgRttiDatas = list.map(type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
+ DefnsList = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ Defns = list.condense(DefnsList),
+ module_info_get_name(ModuleInfo, ModuleName),
+ Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ type_ctor_type_ctor_info),
+ gen_init_cast_rtti_datas_array(mlds_type_info_type,
+ ModuleName, ArgRttiDatas)
+ ])
+ ;
+ RttiTypeInfo = var_arity_type_info(VarArityId, ArgTypes),
+ ArgRttiDatas = list.map(type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
+ DefnsList = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ Defns = list.condense(DefnsList),
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
+ module_info_get_name(ModuleInfo, ModuleName),
+ Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ type_ctor_type_ctor_info),
+ gen_init_int(list.length(ArgTypes)),
+ gen_init_cast_rtti_datas_array(mlds_type_info_type,
+ ModuleName, ArgRttiDatas)
+ ])
+ ).
:- pred gen_pseudo_type_info_defn(module_info::in, rtti_pseudo_type_info::in,
rtti_id::in, mlds_initializer::out, list(mlds_defn)::out) is det.
-gen_pseudo_type_info_defn(_, plain_arity_zero_pseudo_type_info(_), _, _, _) :-
- unexpected(this_file,
- "gen_pseudo_type_info_defn: plain_arity_zero_pseudo_type_info").
-gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, RttiId, Init,
- SubDefns) :-
- PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, ArgTypes),
- ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
- RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
- SubDefnLists = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
- SubDefns = list.condense(SubDefnLists),
- module_info_get_name(ModuleInfo, ModuleName),
- Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_type_ctor_info),
- gen_init_cast_rtti_datas_array(mlds_pseudo_type_info_type,
- ModuleName, ArgRttiDatas)
- ]).
-gen_pseudo_type_info_defn(ModuleInfo, PseudoTypeInfo, RttiId, Init,
- SubDefns) :-
- PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, ArgTypes),
- ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
- RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
- SubDefnLists = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
- SubDefns = list.condense(SubDefnLists),
- RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
- module_info_get_name(ModuleInfo, ModuleName),
- Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
- gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_type_ctor_info),
- gen_init_int(list.length(ArgTypes)),
- gen_init_cast_rtti_datas_array(mlds_pseudo_type_info_type,
- ModuleName, ArgRttiDatas)
- ]).
-gen_pseudo_type_info_defn(_, type_var(_), _, _, _) :-
- unexpected(this_file, "gen_pseudo_type_info_defn: type_var").
+gen_pseudo_type_info_defn(ModuleInfo, RttiPseudoTypeInfo, RttiId,
+ Init, Defns) :-
+ (
+ RttiPseudoTypeInfo = plain_arity_zero_pseudo_type_info(_),
+ unexpected(this_file,
+ "gen_pseudo_type_info_defn: plain_arity_zero_pseudo_type_info")
+ ;
+ RttiPseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, ArgTypes),
+ ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
+ DefnsList = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ Defns = list.condense(DefnsList),
+ module_info_get_name(ModuleInfo, ModuleName),
+ Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ type_ctor_type_ctor_info),
+ gen_init_cast_rtti_datas_array(mlds_pseudo_type_info_type,
+ ModuleName, ArgRttiDatas)
+ ])
+ ;
+ RttiPseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, ArgTypes),
+ ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
+ RealRttiDatas = list.filter(real_rtti_data, ArgRttiDatas),
+ DefnsList = list.map(rtti_data_to_mlds(ModuleInfo), RealRttiDatas),
+ Defns = list.condense(DefnsList),
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
+ module_info_get_name(ModuleInfo, ModuleName),
+ Init = init_struct(mlds_rtti_type(item_type(RttiId)), [
+ gen_init_rtti_name(ModuleName, RttiTypeCtor,
+ type_ctor_type_ctor_info),
+ gen_init_int(list.length(ArgTypes)),
+ gen_init_cast_rtti_datas_array(mlds_pseudo_type_info_type,
+ ModuleName, ArgRttiDatas)
+ ])
+ ;
+ RttiPseudoTypeInfo = type_var(_),
+ unexpected(this_file, "gen_pseudo_type_info_defn: type_var")
+ ).
%-----------------------------------------------------------------------------%
@@ -536,8 +550,7 @@
RttiTypeCtor, ForeignEnumByOrdinal),
ByNameDefn = gen_foreign_enum_name_ordered_table(ModuleInfo,
RttiTypeCtor, ForeignEnumByName),
- NumberMapDefn = gen_functor_number_map(RttiTypeCtor,
- FunctorNumberMap),
+ NumberMapDefn = gen_functor_number_map(RttiTypeCtor, FunctorNumberMap),
LayoutInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
type_ctor_foreign_enum_ordinal_ordered_table),
FunctorInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
@@ -549,9 +562,8 @@
;
TypeCtorDetails = du(_, DuFunctors, DuByPtag,
DuByName, FunctorNumberMap),
- DuFunctorDefnLists = list.map(
+ DuFunctorDefns = list.map(
gen_du_functor_desc(ModuleInfo, RttiTypeCtor), DuFunctors),
- DuFunctorDefns = list.condense(DuFunctorDefnLists),
ByPtagDefns = gen_du_ptag_ordered_table(ModuleInfo,
RttiTypeCtor, DuByPtag),
ByNameDefn = gen_du_name_ordered_table(ModuleInfo,
@@ -563,14 +575,14 @@
type_ctor_du_name_ordered_table),
NumberMapInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
type_ctor_functor_number_map),
- Defns = DuFunctorDefns ++ [ByNameDefn, NumberMapDefn | ByPtagDefns]
+ Defns = list.condense(DuFunctorDefns) ++
+ [ByNameDefn, NumberMapDefn | ByPtagDefns]
;
TypeCtorDetails = reserved(_, MaybeResFunctors, ResFunctors,
DuByPtag, MaybeResByName, FunctorNumberMap),
- MaybeResFunctorDefnLists = list.map(
+ MaybeResFunctorDefns = list.map(
gen_maybe_res_functor_desc(ModuleInfo, RttiTypeCtor),
MaybeResFunctors),
- MaybeResFunctorDefns = list.condense(MaybeResFunctorDefnLists),
ByValueDefns = gen_maybe_res_value_ordered_table(ModuleInfo,
RttiTypeCtor, ResFunctors, DuByPtag),
ByNameDefn = gen_maybe_res_name_ordered_table(ModuleInfo,
@@ -582,8 +594,8 @@
type_ctor_res_name_ordered_table),
NumberMapInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
type_ctor_functor_number_map),
- Defns = [ByNameDefn, NumberMapDefn
- | ByValueDefns ++ MaybeResFunctorDefns]
+ Defns = [ByNameDefn, NumberMapDefn | ByValueDefns] ++
+ list.condense(MaybeResFunctorDefns)
;
TypeCtorDetails = notag(_, NotagFunctor),
NumberMapDefn = gen_functor_number_map(RttiTypeCtor, [0]),
@@ -593,8 +605,9 @@
type_ctor_notag_functor_desc),
NumberMapInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
type_ctor_functor_number_map),
- Defns = [NumberMapDefn | gen_notag_functor_desc(ModuleInfo,
- RttiTypeCtor, NotagFunctor)]
+ FunctorDefn = gen_notag_functor_desc(ModuleInfo, RttiTypeCtor,
+ NotagFunctor),
+ Defns = [NumberMapDefn | FunctorDefn]
;
TypeCtorDetails = eqv(EqvType),
TypeRttiData = maybe_pseudo_type_info_to_rtti_data(EqvType),
@@ -602,7 +615,6 @@
% The type is a lie, but a safe one.
FunctorInit = gen_init_null_pointer(mlds_generic_type),
NumberMapInit = gen_init_null_pointer(mlds_generic_type)
-
;
TypeCtorDetails = builtin(_),
Defns = [],
@@ -697,9 +709,8 @@
),
(
ArgNames = [_ | _],
- ArgNameDefn = gen_field_names(ModuleInfo, RttiTypeCtor,
- Ordinal, MaybeArgNames),
- ArgNameDefns = [ArgNameDefn],
+ ArgNameDefns = [gen_field_names(ModuleInfo, RttiTypeCtor,
+ Ordinal, MaybeArgNames)],
ArgNameInit = gen_init_rtti_name(ModuleName, RttiTypeCtor,
type_ctor_field_names(Ordinal))
;
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.142
diff -u -r1.142 switch_detection.m
--- compiler/switch_detection.m 23 Dec 2008 01:37:41 -0000 1.142
+++ compiler/switch_detection.m 14 Jan 2009 07:29:47 -0000
@@ -463,7 +463,7 @@
State = cons_id_has_conflict,
ConflictConsIds = ConflictConsIds0
),
- Arms = cord.snoc(Arms0, Arm),
+ Arms = snoc(Arms0, Arm),
Entry = cons_id_entry(State, Arms),
map.det_update(CasesMap0, ConsId, Entry, CasesMap)
;
@@ -500,7 +500,7 @@
ConflictConsIds = ConflictConsIds0
),
State = cons_id_has_conflict,
- Arms = cord.snoc(Arms0, Arm),
+ Arms = snoc(Arms0, Arm),
Entry = cons_id_entry(State, Arms),
map.det_update(CasesMap0, ConsId, Entry, CasesMap)
;
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/base64
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/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
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/log4m
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/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
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
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/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
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 messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list