mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-18 15:26:31 +00:00
Estimated hours taken: 16 (some work done in tandem with fjh) Extend MLDS to cope with alternate backends, and hopefully to allow easier implementation of high level data structures in the C backend. Add type information that is required for more heavily typed backends (with C you can just cast to void * to escape the type system when it is inconvenient, with other systems this is impossible, e.g. a Java backend). Introduce new "cast" unop, that does casts. compiler/mercury_compile.m: Split the generation of MLDS from outputting high-level C code. MLDS can be connected up to other backends. compiler/ml_base_type_info.m: compiler/ml_call_gen.m: compiler/ml_code_gen.m: compiler/ml_code_util.m: compiler/ml_tailcall.m: compiler/ml_unify_gen.m: Add a type to code address constants (the type signature of the function). Add the type of the field and the type of the object to field instructions. Add a type to mem_ref (the type of the reference). Don't create local definitions if the locals are dummy types. compiler/ml_elim_nested.m: Add types to code addresses, fields and mem_refs. Use cast where appropriate. compiler/mlds.m: Add cast statement. Add types to code addresses, fields and mem_refs. compiler/mlds_to_c.m: Output casts, generally ignore the types in code addresses, fields and mem_refs (high level C code doesn't really need them, although it might be nice to use them in future).
1326 lines
41 KiB
Mathematica
1326 lines
41 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1999-2000 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% File: ml_elim_nested.m
|
|
% Main author: fjh
|
|
|
|
% This module is an MLDS-to-MLDS transformation
|
|
% that eliminates nested functions.
|
|
|
|
% Note that this module does not attempt to handle arbitrary MLDS
|
|
% as input; it will only work with the output of the current MLDS
|
|
% code generator. In particular, it assumes that local variables
|
|
% in nested functions can be hoisted into the outermost function's
|
|
% environment. That's not true in general (e.g. if the nested
|
|
% functions are recursive), but it's true for the code that ml_code_gen
|
|
% generates.
|
|
|
|
% As well as eliminating nested functions, this transformation
|
|
% also has the effect of fixing up the dangling `env_ptr' references
|
|
% that ml_code_gen.m leaves in the code.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
% TRANSFORMATION SUMMARY
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% We transform code of the form e.g.
|
|
%
|
|
% <OuterRet> outer(<OuterArgs>) {
|
|
% <OuterLocals>
|
|
%
|
|
% <Inner1Ret> inner(<Inner1Args>, void *env_ptr_arg) {
|
|
% <Inner1Locals>
|
|
%
|
|
% <NestedInnerRet> nested_inner(<NestedInnerArgs>,
|
|
% void *env_ptr_arg)
|
|
% {
|
|
% <NestedInnerLocals>
|
|
%
|
|
% <NestedInnerCode>
|
|
% }
|
|
%
|
|
% <Inner1Code>
|
|
% }
|
|
%
|
|
% <Inner2Ret> inner(<Inner2Args>, void *env_ptr_arg) {
|
|
% <Inner2Locals>
|
|
%
|
|
% <Inner2Code>
|
|
% }
|
|
%
|
|
% <OuterCode>
|
|
% }
|
|
%
|
|
% into
|
|
%
|
|
% struct OuterLocals_struct {
|
|
% <OuterArgs>
|
|
% <OuterLocals>
|
|
% <Inner1Locals>
|
|
% };
|
|
%
|
|
% <NestedInnerRet> nested_inner(<NestedInnerArgs>, void *env_ptr_arg) {
|
|
% OuterLocals *env_ptr = env_ptr_arg;
|
|
% <NestedInnerLocals>
|
|
%
|
|
% <NestedInnerCode'>
|
|
% }
|
|
%
|
|
% <Inner1Ret> inner(<Inner1Args>, void *env_ptr_arg) {
|
|
% OuterLocals *env_ptr = env_ptr_arg;
|
|
%
|
|
% <Inner1Code'>
|
|
% }
|
|
%
|
|
% <Inner2Ret> inner(<Inner2Args>, void *env_ptr_arg) {
|
|
% OuterLocals *env_ptr = env_ptr_arg;
|
|
% <Inner2Locals>
|
|
%
|
|
% <Inner2Code'>
|
|
% }
|
|
%
|
|
% <OuterRet> outer(<OuterArgs>) {
|
|
% OuterLocals env;
|
|
% OuterLocals *env_ptr = &env;
|
|
%
|
|
% env_ptr-><OuterArgs> = <OuterArgs>;
|
|
% <OuterCode'>
|
|
% }
|
|
%
|
|
% where <Inner1Code'>, <Inner2Code'> and <NestedInnerCode'> are the
|
|
% same as <Inner1Code>, <Inner2Code> and <NestedInnerCode> (respectively)
|
|
% except that any references to a local variable <Var> declared in
|
|
% outer() are replaced with `env_ptr -> <Var>',
|
|
% and likewise <OuterCode'> is the same as <OuterCode> with references to
|
|
% local variables replaced with `env_ptr->foo'. In the latter
|
|
% case it could (depending on how smart the C compiler is) potentially
|
|
% be more efficient to generate `env.foo', but currently we don't do that.
|
|
%
|
|
% Actually the description above is slightly over-simplified: not all local
|
|
% variables need to be put in the environment struct. Only those local
|
|
% variables which are referenced by nested functions need to be
|
|
% put in the environment struct.
|
|
%
|
|
% The `env_ptr' variables generated here serve as definitions for
|
|
% the (previously dangling) references to such variables that
|
|
% ml_code_gen puts in calls to the nested functions.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module ml_elim_nested.
|
|
|
|
:- interface.
|
|
|
|
:- import_module mlds.
|
|
:- import_module io.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Eliminated nested functions for the whole MLDS.
|
|
%
|
|
:- pred ml_elim_nested(mlds, mlds, io__state, io__state).
|
|
:- mode ml_elim_nested(in, out, di, uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
:- import_module int, list, std_util, string, require.
|
|
% the following imports are needed for mangling pred names
|
|
:- import_module hlds_pred, prog_data, prog_out.
|
|
|
|
% Eliminated nested functions for the whole MLDS.
|
|
%
|
|
ml_elim_nested(MLDS0, MLDS) -->
|
|
{ MLDS0 = mlds(ModuleName, ForeignCode, Imports, Defns0) },
|
|
{ MLDS = mlds(ModuleName, ForeignCode, Imports, Defns) },
|
|
{ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName) },
|
|
{ OuterVars = [] },
|
|
{ DefnsList = list__map(
|
|
ml_elim_nested_defns(MLDS_ModuleName, OuterVars),
|
|
Defns0) },
|
|
{ Defns = list__condense(DefnsList) }.
|
|
|
|
% Hoist out any nested function occurring in a single mlds__defn.
|
|
% Return a list of mlds__defns that contains no nested functions.
|
|
%
|
|
:- func ml_elim_nested_defns(mlds_module_name, outervars, mlds__defn) =
|
|
list(mlds__defn).
|
|
ml_elim_nested_defns(ModuleName, OuterVars, Defn0) = FlatDefns :-
|
|
Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
|
|
( DefnBody0 = mlds__function(PredProcId, Params, yes(FuncBody0)) ->
|
|
EnvName = ml_env_name(Name),
|
|
% XXX this should be optimized to generate
|
|
% EnvTypeName from just EnvName
|
|
ml_create_env(EnvName, [], Context, ModuleName,
|
|
_EnvType, EnvTypeName, _EnvDecls, _InitEnv),
|
|
|
|
%
|
|
% traverse the function body, finding (and removing)
|
|
% any nested functions, and fixing up any references
|
|
% to the arguments or to local variables which
|
|
% occur in nested functions
|
|
%
|
|
ElimInfo0 = elim_info_init(ModuleName, OuterVars, EnvTypeName),
|
|
Params = mlds__func_params(Arguments, _RetValues),
|
|
ml_maybe_add_args(Arguments, FuncBody0, ModuleName,
|
|
Context, ElimInfo0, ElimInfo1),
|
|
flatten_statement(FuncBody0, FuncBody1, ElimInfo1, ElimInfo),
|
|
elim_info_finish(ElimInfo, NestedFuncs0, LocalVars),
|
|
|
|
%
|
|
% if there were no nested functions, then we're done
|
|
%
|
|
( NestedFuncs0 = [] ->
|
|
FuncBody = FuncBody1,
|
|
HoistedDefns = []
|
|
;
|
|
%
|
|
% Create a struct to hold the local variables,
|
|
% and initialize the environment pointers for
|
|
% both the containing function and the nested
|
|
% functions
|
|
%
|
|
ml_create_env(EnvName, LocalVars, Context, ModuleName,
|
|
EnvType, _EnvTypeName, EnvDecls, InitEnv),
|
|
list__map(ml_insert_init_env(EnvName, ModuleName),
|
|
NestedFuncs0, NestedFuncs),
|
|
|
|
%
|
|
% If the function's arguments are referenced by
|
|
% nested functions, then we need to copy them to
|
|
% local variables in the environment structure.
|
|
%
|
|
ml_maybe_copy_args(Arguments, FuncBody0, ModuleName,
|
|
EnvTypeName, Context, _ArgsToCopy,
|
|
CodeToCopyArgs),
|
|
|
|
%
|
|
% insert the definition and initialization of the
|
|
% environment struct variable at the start of the
|
|
% top-level function's body
|
|
%
|
|
FuncBody = ml_block(EnvDecls,
|
|
list__append([InitEnv | CodeToCopyArgs],
|
|
[FuncBody1]),
|
|
Context),
|
|
%
|
|
% hoist the nested functions out, by
|
|
% inserting the environment struct type
|
|
% and the previously nested functions
|
|
% at the start of the list of definitions,
|
|
% followed by the new version of the top-level function
|
|
%
|
|
HoistedDefns = [EnvType | NestedFuncs]
|
|
),
|
|
DefnBody = mlds__function(PredProcId, Params, yes(FuncBody)),
|
|
Defn = mlds__defn(Name, Context, Flags, DefnBody),
|
|
FlatDefns = list__append(HoistedDefns, [Defn])
|
|
;
|
|
% leave definitions of things other than functions unchanged
|
|
FlatDefns = [Defn0]
|
|
).
|
|
|
|
%
|
|
% Add any arguments which are used in nested functions
|
|
% to the local_vars field in the elim_info.
|
|
%
|
|
:- pred ml_maybe_add_args(mlds__arguments, mlds__statement,
|
|
mlds_module_name, mlds__context, elim_info, elim_info).
|
|
:- mode ml_maybe_add_args(in, in, in, in, in, out) is det.
|
|
|
|
ml_maybe_add_args([], _, _, _) --> [].
|
|
ml_maybe_add_args([Arg|Args], FuncBody, ModuleName, Context) -->
|
|
(
|
|
{ Arg = data(var(VarName)) - _Type },
|
|
{ ml_should_add_local_var(ModuleName, VarName, [], [FuncBody]) }
|
|
->
|
|
{ ml_conv_arg_to_var(Context, Arg, ArgToCopy) },
|
|
elim_info_add_local_var(ArgToCopy)
|
|
;
|
|
[]
|
|
),
|
|
ml_maybe_add_args(Args, FuncBody, ModuleName, Context).
|
|
|
|
%
|
|
% Generate code to copy any arguments which are used in nested functions
|
|
% to the environment struct.
|
|
%
|
|
:- pred ml_maybe_copy_args(mlds__arguments, mlds__statement,
|
|
mlds_module_name, mlds__type, mlds__context,
|
|
mlds__defns, mlds__statements).
|
|
:- mode ml_maybe_copy_args(in, in, in, in, in, out, out) is det.
|
|
|
|
ml_maybe_copy_args([], _, _, _, _, [], []).
|
|
ml_maybe_copy_args([Arg|Args], FuncBody, ModuleName, ClassType, Context,
|
|
ArgsToCopy, CodeToCopyArgs) :-
|
|
ml_maybe_copy_args(Args, FuncBody, ModuleName, ClassType, Context,
|
|
ArgsToCopy0, CodeToCopyArgs0),
|
|
(
|
|
Arg = data(var(VarName)) - FieldType,
|
|
ml_should_add_local_var(ModuleName, VarName, [], [FuncBody])
|
|
->
|
|
ml_conv_arg_to_var(Context, Arg, ArgToCopy),
|
|
|
|
%
|
|
% Generate code to copy this arg to the environment
|
|
% struct:
|
|
% env_ptr->foo = foo;
|
|
%
|
|
QualVarName = qual(ModuleName, VarName),
|
|
FieldName = named_field(QualVarName),
|
|
Tag = yes(0),
|
|
EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
|
|
EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType,
|
|
ClassType),
|
|
ArgRval = lval(var(QualVarName)),
|
|
AssignToEnv = assign(EnvArgLval, ArgRval),
|
|
CodeToCopyArg = mlds__statement(atomic(AssignToEnv), Context),
|
|
|
|
ArgsToCopy = [ArgToCopy | ArgsToCopy0],
|
|
CodeToCopyArgs = [CodeToCopyArg | CodeToCopyArgs0]
|
|
;
|
|
ArgsToCopy = ArgsToCopy0,
|
|
CodeToCopyArgs = CodeToCopyArgs0
|
|
).
|
|
|
|
% Create the environment struct type,
|
|
% the declaration of the environment variable,
|
|
% and the declaration and initializer for the environment
|
|
% pointer variable:
|
|
%
|
|
% struct <EnvClassName> {
|
|
% <LocalVars>
|
|
% };
|
|
% struct <EnvClassName> env;
|
|
% struct <EnvClassName> *env_ptr;
|
|
% env_ptr = &env;
|
|
%
|
|
:- pred ml_create_env(mlds__class_name, list(mlds__defn), mlds__context,
|
|
mlds_module_name, mlds__defn, mlds__type,
|
|
list(mlds__defn), mlds__statement).
|
|
:- mode ml_create_env(in, in, in, in, out, out, out, out) is det.
|
|
|
|
ml_create_env(EnvClassName, LocalVars, Context, ModuleName,
|
|
EnvType, EnvTypeName, EnvDecls, InitEnv) :-
|
|
%
|
|
% generate the following type:
|
|
%
|
|
% struct <EnvClassName> {
|
|
% <LocalVars>
|
|
% };
|
|
%
|
|
EnvTypeEntityName = type(EnvClassName, 0),
|
|
EnvTypeName = class_type(qual(ModuleName, EnvClassName), 0),
|
|
EnvTypeFlags = env_decl_flags,
|
|
EnvTypeDefnBody = mlds__class(mlds__class_defn(mlds__struct, [],
|
|
[mlds__generic_env_ptr_type], [], LocalVars)),
|
|
EnvType = mlds__defn(EnvTypeEntityName, Context, EnvTypeFlags,
|
|
EnvTypeDefnBody),
|
|
|
|
%
|
|
% generate the following variable declaration:
|
|
%
|
|
% struct <EnvClassName> env;
|
|
%
|
|
EnvVarName = data(var("env")),
|
|
EnvVarFlags = env_decl_flags,
|
|
EnvVarType = mlds__class_type(qual(ModuleName, EnvClassName), 0),
|
|
EnvVarInitializer = no,
|
|
EnvVarDefnBody = mlds__data(EnvVarType, EnvVarInitializer),
|
|
EnvVarDecl = mlds__defn(EnvVarName, Context, EnvVarFlags, EnvVarDefnBody),
|
|
|
|
%
|
|
% declare the `env_ptr' var, and
|
|
% initialize the `env_ptr' with the address of `env'
|
|
%
|
|
EnvVar = qual(ModuleName, "env"),
|
|
EnvVarAddr = mem_addr(var(EnvVar)),
|
|
ml_init_env(EnvClassName, EnvVarAddr, Context, ModuleName,
|
|
EnvPtrVarDecl, InitEnv),
|
|
|
|
% group those two declarations together
|
|
EnvDecls = [EnvVarDecl, EnvPtrVarDecl].
|
|
|
|
% ml_insert_init_env:
|
|
% If the definition is a nested function definition, and it's
|
|
% body makes use of the environment pointer (`env_ptr'), then
|
|
% insert code to declare and initialize the environment pointer.
|
|
%
|
|
% We transform code of the form
|
|
% <Ret> <Func>(<Args>) {
|
|
% <Body>
|
|
% }
|
|
% to
|
|
% <Ret> <Func>(<Args>) {
|
|
% struct <EnvClassName> *env_ptr;
|
|
% env_ptr = &env_ptr_arg;
|
|
% <Body>
|
|
% }
|
|
%
|
|
:- pred ml_insert_init_env(mlds__class_name, mlds_module_name,
|
|
mlds__defn, mlds__defn).
|
|
:- mode ml_insert_init_env(in, in, in, out) is det.
|
|
ml_insert_init_env(ClassName, ModuleName, Defn0, Defn) :-
|
|
Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
|
|
(
|
|
DefnBody0 = mlds__function(PredProcId, Params, yes(FuncBody0)),
|
|
statement_contains_var(FuncBody0, qual(ModuleName, "env_ptr"))
|
|
->
|
|
EnvPtrVal = lval(var(qual(ModuleName, "env_ptr_arg"))),
|
|
ml_init_env(ClassName, EnvPtrVal, Context, ModuleName,
|
|
EnvPtrDecl, InitEnvPtr),
|
|
FuncBody = mlds__statement(block([EnvPtrDecl],
|
|
[InitEnvPtr, FuncBody0]), Context),
|
|
DefnBody = mlds__function(PredProcId, Params, yes(FuncBody)),
|
|
Defn = mlds__defn(Name, Context, Flags, DefnBody)
|
|
;
|
|
Defn = Defn0
|
|
).
|
|
|
|
% Create the environment pointer and initialize it:
|
|
%
|
|
% struct <EnvClassName> *env_ptr;
|
|
% env_ptr = <EnvPtrVal>;
|
|
%
|
|
:- pred ml_init_env(mlds__class_name, mlds__rval,
|
|
mlds__context, mlds_module_name, mlds__defn, mlds__statement).
|
|
:- mode ml_init_env(in, in, in, in, out, out) is det.
|
|
|
|
ml_init_env(EnvClassName, EnvPtrVal, Context, ModuleName,
|
|
EnvPtrVarDecl, InitEnvPtr) :-
|
|
|
|
% compute the `struct <EnvClassName>' type
|
|
EnvVarType = mlds__class_type(qual(ModuleName, EnvClassName), 0),
|
|
|
|
%
|
|
% generate the following variable declaration:
|
|
%
|
|
% struct <EnvClassName> *env_ptr;
|
|
%
|
|
EnvPtrVarName = data(var("env_ptr")),
|
|
EnvPtrVarFlags = env_decl_flags,
|
|
EnvPtrVarType = mlds__ptr_type(EnvVarType),
|
|
EnvPtrVarInitializer = no,
|
|
EnvPtrVarDefnBody = mlds__data(EnvPtrVarType, EnvPtrVarInitializer),
|
|
EnvPtrVarDecl = mlds__defn(EnvPtrVarName, Context, EnvPtrVarFlags,
|
|
EnvPtrVarDefnBody),
|
|
|
|
%
|
|
% generate the following statement:
|
|
%
|
|
% env_ptr = (EnvPtrVarType) <EnvPtrVal>;
|
|
%
|
|
EnvPtrVar = qual(ModuleName, "env_ptr"),
|
|
AssignEnvPtr = assign(var(EnvPtrVar), unop(cast(EnvPtrVarType),
|
|
EnvPtrVal)),
|
|
InitEnvPtr = mlds__statement(atomic(AssignEnvPtr), Context).
|
|
|
|
% Given the declaration for a function parameter, produce a
|
|
% declaration for a corresponding local variable or environment
|
|
% struct field. We need to do this so as to include function
|
|
% parameter in the environment struct.
|
|
%
|
|
:- pred ml_conv_arg_to_var(mlds__context, pair(entity_name, mlds__type),
|
|
mlds__defn).
|
|
:- mode ml_conv_arg_to_var(in, in, out) is det.
|
|
|
|
ml_conv_arg_to_var(Context, Name - Type, LocalVar) :-
|
|
Flags = env_decl_flags,
|
|
Initializer = no,
|
|
DefnBody = mlds__data(Type, Initializer),
|
|
LocalVar = mlds__defn(Name, Context, Flags, DefnBody).
|
|
|
|
% Return the declaration flags appropriate for a local variable.
|
|
:- func env_decl_flags = mlds__decl_flags.
|
|
env_decl_flags = MLDS_DeclFlags :-
|
|
Access = public,
|
|
PerInstance = per_instance,
|
|
Virtuality = non_virtual,
|
|
Finality = overridable,
|
|
Constness = modifiable,
|
|
Abstractness = concrete,
|
|
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
|
|
Virtuality, Finality, Constness, Abstractness).
|
|
|
|
% 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_block(mlds__defns, mlds__statements, mlds__context) =
|
|
mlds__statement.
|
|
|
|
ml_block(VarDecls, Statements, Context) =
|
|
(if VarDecls = [], Statements = [SingleStatement] then
|
|
SingleStatement
|
|
else
|
|
mlds__statement(block(VarDecls, Statements), Context)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% This code does some name mangling.
|
|
% It essentially duplicates the functionality in mlds_output_name.
|
|
%
|
|
% Doing name mangling here is probably a bad idea;
|
|
% it might be better to change the MLDS data structure
|
|
% to allow structured type names, so that we don't have to
|
|
% do any name mangling at this point.
|
|
%
|
|
|
|
% Compute the name to use for the environment struct
|
|
% for the specified function.
|
|
:- func ml_env_name(mlds__entity_name) = mlds__class_name.
|
|
|
|
ml_env_name(type(_, _)) = _ :-
|
|
error("ml_env_name: expected function, got type").
|
|
ml_env_name(data(_)) = _ :-
|
|
error("ml_env_name: expected function, got data").
|
|
ml_env_name(function(PredLabel, ProcId, MaybeSeqNum, _PredId)) = ClassName :-
|
|
PredLabelString = ml_pred_label_name(PredLabel),
|
|
proc_id_to_int(ProcId, ModeNum),
|
|
( MaybeSeqNum = yes(SeqNum) ->
|
|
string__format("%s_%d_%d_env",
|
|
[s(PredLabelString), i(ModeNum), i(SeqNum)],
|
|
ClassName)
|
|
;
|
|
string__format("%s_%d_env",
|
|
[s(PredLabelString), i(ModeNum)],
|
|
ClassName)
|
|
).
|
|
|
|
:- func ml_pred_label_name(mlds__pred_label) = string.
|
|
|
|
ml_pred_label_name(pred(PredOrFunc, MaybeDefiningModule, Name, Arity))
|
|
= LabelName :-
|
|
( PredOrFunc = predicate, Suffix = "p"
|
|
; PredOrFunc = function, Suffix = "f"
|
|
),
|
|
( MaybeDefiningModule = yes(DefiningModule) ->
|
|
ModuleNameString = ml_module_name_string(DefiningModule),
|
|
string__format("%s_%d_%s_in__%s",
|
|
[s(Name), i(Arity), s(Suffix), s(ModuleNameString)],
|
|
LabelName)
|
|
;
|
|
string__format("%s_%d_%s",
|
|
[s(Name), i(Arity), s(Suffix)],
|
|
LabelName)
|
|
).
|
|
ml_pred_label_name(special_pred(PredName, MaybeTypeModule,
|
|
TypeName, TypeArity)) = LabelName :-
|
|
( MaybeTypeModule = yes(TypeModule) ->
|
|
TypeModuleString = ml_module_name_string(TypeModule),
|
|
string__format("%s__%s__%s_%d",
|
|
[s(PredName), s(TypeModuleString),
|
|
s(TypeName), i(TypeArity)],
|
|
LabelName)
|
|
;
|
|
string__format("%s__%s_%d",
|
|
[s(PredName), s(TypeName), i(TypeArity)],
|
|
LabelName)
|
|
).
|
|
|
|
:- func ml_module_name_string(mercury_module_name) = string.
|
|
ml_module_name_string(ModuleName) = ModuleNameString :-
|
|
Separator = "__",
|
|
prog_out__sym_name_to_string(ModuleName, Separator, ModuleNameString).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% flatten_maybe_statement:
|
|
% flatten_statements:
|
|
% flatten_statement:
|
|
% Recursively process the statement(s), calling fixup_var on every
|
|
% use of a variable inside them, and calling flatten_nested_defns
|
|
% for every definition they contain (e.g. definitions of local
|
|
% variables and nested functions).
|
|
%
|
|
|
|
:- pred flatten_maybe_statement(maybe(mlds__statement), maybe(mlds__statement),
|
|
elim_info, elim_info).
|
|
:- mode flatten_maybe_statement(in, out, in, out) is det.
|
|
|
|
flatten_maybe_statement(no, no) --> [].
|
|
flatten_maybe_statement(yes(Statement0), yes(Statement)) -->
|
|
flatten_statement(Statement0, Statement).
|
|
|
|
:- pred flatten_statements(mlds__statements, mlds__statements,
|
|
elim_info, elim_info).
|
|
:- mode flatten_statements(in, out, in, out) is det.
|
|
|
|
flatten_statements(Statements0, Statements) -->
|
|
list__map_foldl(flatten_statement, Statements0, Statements).
|
|
|
|
:- pred flatten_statement(mlds__statement, mlds__statement,
|
|
elim_info, elim_info).
|
|
:- mode flatten_statement(in, out, in, out) is det.
|
|
|
|
flatten_statement(Statement0, Statement) -->
|
|
{ Statement0 = mlds__statement(Stmt0, Context) },
|
|
flatten_stmt(Stmt0, Stmt),
|
|
{ Statement = mlds__statement(Stmt, Context) }.
|
|
|
|
:- pred flatten_stmt(mlds__stmt, mlds__stmt, elim_info, elim_info).
|
|
:- mode flatten_stmt(in, out, in, out) is det.
|
|
|
|
flatten_stmt(Stmt0, Stmt) -->
|
|
(
|
|
{ Stmt0 = block(Defns0, Statements0) },
|
|
flatten_nested_defns(Defns0, Statements0, Defns),
|
|
flatten_statements(Statements0, Statements),
|
|
{ Stmt = block(Defns, Statements) }
|
|
;
|
|
{ Stmt0 = while(Rval0, Statement0, Once) },
|
|
fixup_rval(Rval0, Rval),
|
|
flatten_statement(Statement0, Statement),
|
|
{ Stmt = while(Rval, Statement, Once) }
|
|
;
|
|
{ Stmt0 = if_then_else(Cond0, Then0, MaybeElse0) },
|
|
fixup_rval(Cond0, Cond),
|
|
flatten_statement(Then0, Then),
|
|
flatten_maybe_statement(MaybeElse0, MaybeElse),
|
|
{ Stmt = if_then_else(Cond, Then, MaybeElse) }
|
|
;
|
|
{ Stmt0 = label(_) },
|
|
{ Stmt = Stmt0 }
|
|
;
|
|
{ Stmt0 = goto(_) },
|
|
{ Stmt = Stmt0 }
|
|
;
|
|
{ Stmt0 = computed_goto(Rval0, Labels) },
|
|
fixup_rval(Rval0, Rval),
|
|
{ Stmt = computed_goto(Rval, Labels) }
|
|
;
|
|
{ Stmt0 = call(Sig, Func0, Obj0, Args0, RetLvals0, TailCall) },
|
|
fixup_rval(Func0, Func),
|
|
fixup_maybe_rval(Obj0, Obj),
|
|
fixup_rvals(Args0, Args),
|
|
fixup_lvals(RetLvals0, RetLvals),
|
|
{ Stmt = call(Sig, Func, Obj, Args, RetLvals, TailCall) }
|
|
;
|
|
{ Stmt0 = return(Rvals0) },
|
|
fixup_rvals(Rvals0, Rvals),
|
|
{ Stmt = return(Rvals) }
|
|
;
|
|
{ Stmt0 = do_commit(Ref0) },
|
|
fixup_rval(Ref0, Ref),
|
|
{ Stmt = do_commit(Ref) }
|
|
;
|
|
{ Stmt0 = try_commit(Ref0, Statement0, Handler0) },
|
|
fixup_lval(Ref0, Ref),
|
|
flatten_statement(Statement0, Statement),
|
|
flatten_statement(Handler0, Handler),
|
|
{ Stmt = try_commit(Ref, Statement, Handler) }
|
|
;
|
|
{ Stmt0 = atomic(AtomicStmt0) },
|
|
fixup_atomic_stmt(AtomicStmt0, AtomicStmt),
|
|
{ Stmt = atomic(AtomicStmt) }
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% flatten_nested_defns:
|
|
% flatten_nested_defn:
|
|
% Hoist out nested function definitions and local variables
|
|
% referenced by nested functions, storing them both in the elim_info.
|
|
%
|
|
|
|
:- pred flatten_nested_defns(mlds__defns, mlds__statements, mlds__defns,
|
|
elim_info, elim_info).
|
|
:- mode flatten_nested_defns(in, in, out, in, out) is det.
|
|
|
|
flatten_nested_defns([], _, []) --> [].
|
|
flatten_nested_defns([Defn0 | Defns0], FollowingStatements, Defns) -->
|
|
flatten_nested_defn(Defn0, Defns0, FollowingStatements, Defns1),
|
|
flatten_nested_defns(Defns0, FollowingStatements, Defns2),
|
|
{ Defns = list__append(Defns1, Defns2) }.
|
|
|
|
:- pred flatten_nested_defn(mlds__defn, mlds__defns, mlds__statements,
|
|
mlds__defns, elim_info, elim_info).
|
|
:- mode flatten_nested_defn(in, in, in, out, in, out) is det.
|
|
|
|
flatten_nested_defn(Defn0, FollowingDefns, FollowingStatements, Defns) -->
|
|
{ Defn0 = mlds__defn(Name, Context, Flags, DefnBody0) },
|
|
(
|
|
{ DefnBody0 = mlds__function(PredProcId, Params, FuncBody0) },
|
|
%
|
|
% recursively flatten the nested function
|
|
%
|
|
flatten_maybe_statement(FuncBody0, FuncBody),
|
|
{ DefnBody = mlds__function(PredProcId, Params, FuncBody) },
|
|
{ Defn = mlds__defn(Name, Context, Flags, DefnBody) },
|
|
|
|
% Note that we assume that we can safely hoist stuff
|
|
% inside nested functions into the containing function.
|
|
% If that wasn't the case, we'd need code something
|
|
% like this:
|
|
/***************
|
|
{ LocalVars = elim_info_get_local_vars(ElimInfo) },
|
|
{ OuterVars0 = elim_info_get_outer_vars(ElimInfo) },
|
|
{ OuterVars = [LocalVars | OuterVars0] },
|
|
{ FlattenedDefns = ml_elim_nested_defns(ModuleName,
|
|
OuterVars, Defn0) },
|
|
list__foldl(elim_info_add_nested_func, FlattenedDefns),
|
|
***************/
|
|
|
|
%
|
|
% strip out the now flattened nested function,
|
|
% and store it in the elim_info
|
|
%
|
|
elim_info_add_nested_func(Defn),
|
|
{ Defns = [] }
|
|
;
|
|
{ DefnBody0 = mlds__data(_, _) },
|
|
%
|
|
% for local variable definitions, if they are
|
|
% referenced by any nested functions, then
|
|
% strip them out and store them in the elim_info
|
|
%
|
|
=(ElimInfo),
|
|
{ ModuleName = elim_info_get_module_name(ElimInfo) },
|
|
(
|
|
{ Name = data(var(VarName)) },
|
|
{ ml_should_add_local_var(ModuleName, VarName,
|
|
FollowingDefns, FollowingStatements) }
|
|
->
|
|
elim_info_add_local_var(Defn0),
|
|
{ Defns = [] }
|
|
;
|
|
{ Defns = [Defn0] }
|
|
)
|
|
;
|
|
{ DefnBody0 = mlds__class(_) },
|
|
%
|
|
% leave nested class declarations alone
|
|
%
|
|
% XXX that might not be the right thing to do,
|
|
% but currently ml_code_gen.m doesn't generate
|
|
% any of these, so it doesn't matter what we do
|
|
%
|
|
{ Defns = [Defn0] }
|
|
).
|
|
|
|
%
|
|
% check for a nested function definition
|
|
% that references this variable
|
|
%
|
|
:- pred ml_should_add_local_var(mlds_module_name, mlds__var_name,
|
|
mlds__defns, mlds__statements).
|
|
:- mode ml_should_add_local_var(in, in, in, in) is semidet.
|
|
|
|
ml_should_add_local_var(ModuleName, VarName,
|
|
FollowingDefns, FollowingStatements) :-
|
|
QualVarName = qual(ModuleName, VarName),
|
|
(
|
|
list__member(FollowingDefn, FollowingDefns)
|
|
;
|
|
statements_contains_defn(FollowingStatements,
|
|
FollowingDefn)
|
|
),
|
|
FollowingDefn = mlds__defn(_, _, _,
|
|
mlds__function(_, _, _)),
|
|
defn_contains_var(FollowingDefn, QualVarName).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% fixup_atomic_stmt:
|
|
% fixup_rvals:
|
|
% fixup_maybe_rval:
|
|
% fixup_rval:
|
|
% fixup_trail_op:
|
|
% fixup_lvals:
|
|
% fixup_lval:
|
|
% Recursively process the specified construct, calling fixup_var on
|
|
% every variable inside it.
|
|
%
|
|
|
|
:- pred fixup_atomic_stmt(mlds__atomic_statement, mlds__atomic_statement,
|
|
elim_info, elim_info).
|
|
:- mode fixup_atomic_stmt(in, out, in, out) is det.
|
|
|
|
fixup_atomic_stmt(comment(C), comment(C)) --> [].
|
|
fixup_atomic_stmt(assign(Lval0, Rval0), assign(Lval, Rval)) -->
|
|
fixup_lval(Lval0, Lval),
|
|
fixup_rval(Rval0, Rval).
|
|
fixup_atomic_stmt(new_object(Target0, MaybeTag, Type, MaybeSize, MaybeCtorName,
|
|
Args0, ArgTypes),
|
|
new_object(Target, MaybeTag, Type, MaybeSize, MaybeCtorName,
|
|
Args, ArgTypes)) -->
|
|
fixup_lval(Target0, Target),
|
|
fixup_rvals(Args0, Args).
|
|
fixup_atomic_stmt(mark_hp(Lval0), mark_hp(Lval)) -->
|
|
fixup_lval(Lval0, Lval).
|
|
fixup_atomic_stmt(restore_hp(Rval0), restore_hp(Rval)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
fixup_atomic_stmt(trail_op(TrailOp0), trail_op(TrailOp)) -->
|
|
fixup_trail_op(TrailOp0, TrailOp).
|
|
fixup_atomic_stmt(target_code(Lang, String), target_code(Lang, String)) --> [].
|
|
|
|
:- pred fixup_trail_op(trail_op, trail_op, elim_info, elim_info).
|
|
:- mode fixup_trail_op(in, out, in, out) is det.
|
|
|
|
fixup_trail_op(store_ticket(Lval0), store_ticket(Lval)) -->
|
|
fixup_lval(Lval0, Lval).
|
|
fixup_trail_op(reset_ticket(Rval0, Reason), reset_ticket(Rval, Reason)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
fixup_trail_op(discard_ticket, discard_ticket) --> [].
|
|
fixup_trail_op(prune_ticket, prune_ticket) --> [].
|
|
fixup_trail_op(mark_ticket_stack(Lval0), mark_ticket_stack(Lval)) -->
|
|
fixup_lval(Lval0, Lval).
|
|
fixup_trail_op(prune_tickets_to(Rval0), prune_tickets_to(Rval)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
|
|
:- pred fixup_rvals(list(mlds__rval), list(mlds__rval), elim_info, elim_info).
|
|
:- mode fixup_rvals(in, out, in, out) is det.
|
|
|
|
fixup_rvals([], []) --> [].
|
|
fixup_rvals([X0|Xs0], [X|Xs]) -->
|
|
fixup_rval(X0, X),
|
|
fixup_rvals(Xs0, Xs).
|
|
|
|
:- pred fixup_maybe_rval(maybe(mlds__rval), maybe(mlds__rval),
|
|
elim_info, elim_info).
|
|
:- mode fixup_maybe_rval(in, out, in, out) is det.
|
|
|
|
fixup_maybe_rval(no, no) --> [].
|
|
fixup_maybe_rval(yes(Rval0), yes(Rval)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
|
|
:- pred fixup_rval(mlds__rval, mlds__rval, elim_info, elim_info).
|
|
:- mode fixup_rval(in, out, in, out) is det.
|
|
|
|
fixup_rval(lval(Lval0), lval(Lval)) -->
|
|
fixup_lval(Lval0, Lval).
|
|
fixup_rval(mkword(Tag, Rval0), mkword(Tag, Rval)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
fixup_rval(const(Const), const(Const)) --> [].
|
|
fixup_rval(unop(Op, Rval0), unop(Op, Rval)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
fixup_rval(binop(Op, X0, Y0), binop(Op, X, Y)) -->
|
|
fixup_rval(X0, X),
|
|
fixup_rval(Y0, Y).
|
|
fixup_rval(mem_addr(Lval0), mem_addr(Lval)) -->
|
|
fixup_lval(Lval0, Lval).
|
|
|
|
:- pred fixup_lvals(list(mlds__lval), list(mlds__lval), elim_info, elim_info).
|
|
:- mode fixup_lvals(in, out, in, out) is det.
|
|
|
|
fixup_lvals([], []) --> [].
|
|
fixup_lvals([X0|Xs0], [X|Xs]) -->
|
|
fixup_lval(X0, X),
|
|
fixup_lvals(Xs0, Xs).
|
|
|
|
:- pred fixup_lval(mlds__lval, mlds__lval, elim_info, elim_info).
|
|
:- mode fixup_lval(in, out, in, out) is det.
|
|
|
|
fixup_lval(field(MaybeTag, Rval0, FieldId, FieldType, ClassType),
|
|
field(MaybeTag, Rval, FieldId, FieldType, ClassType)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
fixup_lval(mem_ref(Rval0, Type), mem_ref(Rval, Type)) -->
|
|
fixup_rval(Rval0, Rval).
|
|
fixup_lval(var(Var0), VarLval) -->
|
|
fixup_var(Var0, VarLval).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% fixup_var:
|
|
% change up any references to local vars in the
|
|
% containing function to go via the environment pointer
|
|
%
|
|
|
|
:- pred fixup_var(mlds__var, mlds__lval, elim_info, elim_info).
|
|
:- mode fixup_var(in, out, in, out) is det.
|
|
|
|
fixup_var(ThisVar, Lval, ElimInfo, ElimInfo) :-
|
|
ThisVar = qual(ThisVarModuleName, ThisVarName),
|
|
ModuleName = elim_info_get_module_name(ElimInfo),
|
|
LocalVars = elim_info_get_local_vars(ElimInfo),
|
|
ClassType = elim_info_get_env_type_name(ElimInfo),
|
|
(
|
|
%
|
|
% Check for references to local variables
|
|
% that are used by nested functions,
|
|
% and replace them with `env_ptr->foo'.
|
|
%
|
|
ThisVarModuleName = ModuleName,
|
|
IsLocal = (pred(VarType::out) is nondet :-
|
|
list__member(Var, LocalVars),
|
|
Var = mlds__defn(data(var(ThisVarName)), _, _,
|
|
data(VarType, _))
|
|
),
|
|
solutions(IsLocal, [FieldType])
|
|
->
|
|
EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
|
|
FieldName = named_field(ThisVar),
|
|
Tag = yes(0),
|
|
Lval = field(Tag, EnvPtr, FieldName, FieldType, ClassType)
|
|
;
|
|
%
|
|
% leave everything else unchanged
|
|
%
|
|
Lval = var(ThisVar)
|
|
).
|
|
/*****************************
|
|
The following code is what we would have to use if we couldn't
|
|
just hoist all local variables out to the outermost function.
|
|
(
|
|
%
|
|
% Check for references to local variables
|
|
% that are used by nested functions,
|
|
% and replace them with `(&env)->foo'.
|
|
% (The MLDS doesn't have any representation
|
|
% for `env.foo'.)
|
|
%
|
|
ThisVarModuleName = ModuleName,
|
|
list__member(Var, LocalVars),
|
|
Var = mlds__defn(data(var(ThisVarName)), _, _, _)
|
|
->
|
|
Env = var(qual(ModuleName, "env")),
|
|
FieldName = named_field(ThisVar),
|
|
Tag = yes(0),
|
|
Lval = field(Tag, mem_addr(Env), FieldName)
|
|
;
|
|
%
|
|
% Check for references to variables in the
|
|
% containing function(s), and replace them
|
|
% with envptr->foo, envptr->envptr->foo, etc.
|
|
% depending on the depth of nesting.
|
|
%
|
|
ThisVarModuleName = ModuleName,
|
|
outervar_member(ThisVarName, OuterVars, 1, Depth)
|
|
->
|
|
EnvPtrName = qual(ModuleName, "env_ptr"),
|
|
EnvPtr = lval(var(EnvPtrName)),
|
|
Lval = make_envptr_ref(Depth, EnvPtr, EnvPtrName, ThisVar)
|
|
;
|
|
%
|
|
% leave everything else unchanged
|
|
%
|
|
Lval = var(ThisVar)
|
|
).
|
|
|
|
% check if the specified variable is contained in the
|
|
% outervars, and if so, return the depth of nesting
|
|
%
|
|
:- pred outervar_member(mlds__var_name, outervars, int, int).
|
|
:- mode outervar_member(in, in, in, out) is semidet.
|
|
|
|
outervar_member(ThisVarName, [OuterVars | OtherOuterVars], Depth0, Depth) :-
|
|
(
|
|
list__member(Var, OuterVars),
|
|
Var = mlds__defn(data(var(ThisVarName)), _, _, _)
|
|
->
|
|
Depth = Depth0
|
|
;
|
|
outervar_member(ThisVarName, OtherOuterVars, Depth0 + 1, Depth)
|
|
).
|
|
|
|
% Produce a reference to a variable via `Depth' levels
|
|
% of `envptr->' indirections.
|
|
%
|
|
:- func make_envptr_ref(int, mlds__rval, mlds__var, mlds__var) = lval.
|
|
|
|
make_envptr_ref(Depth, CurEnvPtr, EnvPtrVar, Var) = Lval :-
|
|
( Depth = 1 ->
|
|
Tag = yes(0),
|
|
Lval = field(Tag, CurEnvPtr, named_field(Var))
|
|
;
|
|
Tag = yes(0),
|
|
NewEnvPtr = lval(field(Tag, CurEnvPtr, named_field(EnvPtrVar))),
|
|
Lval = make_envptr_ref(Depth - 1, NewEnvPtr, EnvPtrVar, Var)
|
|
).
|
|
*********/
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% defns_contains_defn:
|
|
% defn_contains_defn:
|
|
% defn_body_contains_defn:
|
|
% maybe_statement_contains_defn:
|
|
% statements_contains_defn:
|
|
% statement_contains_defn:
|
|
% Nondeterministically return all the definitions contained
|
|
% in the specified construct.
|
|
%
|
|
|
|
:- pred defns_contains_defn(mlds__defns, mlds__defn).
|
|
:- mode defns_contains_defn(in, out) is nondet.
|
|
|
|
defns_contains_defn(Defns, Name) :-
|
|
list__member(Defn, Defns),
|
|
defn_contains_defn(Defn, Name).
|
|
|
|
:- pred defn_contains_defn(mlds__defn, mlds__defn).
|
|
:- mode defn_contains_defn(in, out) is multi.
|
|
|
|
defn_contains_defn(Defn, Defn). /* this is where we succeed! */
|
|
defn_contains_defn(mlds__defn(_Name, _Context, _Flags, DefnBody), Defn) :-
|
|
defn_body_contains_defn(DefnBody, Defn).
|
|
|
|
:- pred defn_body_contains_defn(mlds__entity_defn, mlds__defn).
|
|
:- mode defn_body_contains_defn(in, out) is nondet.
|
|
|
|
defn_body_contains_defn(mlds__data(_Type, _Initializer), _Defn) :- fail.
|
|
defn_body_contains_defn(mlds__function(_PredProcId, _Params, MaybeBody),
|
|
Name) :-
|
|
maybe_statement_contains_defn(MaybeBody, Name).
|
|
defn_body_contains_defn(mlds__class(ClassDefn), Name) :-
|
|
ClassDefn = mlds__class_defn(_Kind, _Imports, _Inherits, _Implements,
|
|
FieldDefns),
|
|
defns_contains_defn(FieldDefns, Name).
|
|
|
|
:- pred statements_contains_defn(mlds__statements, mlds__defn).
|
|
:- mode statements_contains_defn(in, out) is nondet.
|
|
|
|
statements_contains_defn(Statements, Defn) :-
|
|
list__member(Statement, Statements),
|
|
statement_contains_defn(Statement, Defn).
|
|
|
|
:- pred maybe_statement_contains_defn(maybe(mlds__statement), mlds__defn).
|
|
:- mode maybe_statement_contains_defn(in, out) is nondet.
|
|
|
|
maybe_statement_contains_defn(no, _Defn) :- fail.
|
|
maybe_statement_contains_defn(yes(Statement), Defn) :-
|
|
statement_contains_defn(Statement, Defn).
|
|
|
|
:- pred statement_contains_defn(mlds__statement, mlds__defn).
|
|
:- mode statement_contains_defn(in, out) is nondet.
|
|
|
|
statement_contains_defn(Statement, Defn) :-
|
|
Statement = mlds__statement(Stmt, _Context),
|
|
stmt_contains_defn(Stmt, Defn).
|
|
|
|
:- pred stmt_contains_defn(mlds__stmt, mlds__defn).
|
|
:- mode stmt_contains_defn(in, out) is nondet.
|
|
|
|
stmt_contains_defn(Stmt, Defn) :-
|
|
(
|
|
Stmt = block(Defns, Statements),
|
|
( defns_contains_defn(Defns, Defn)
|
|
; statements_contains_defn(Statements, Defn)
|
|
)
|
|
;
|
|
Stmt = while(_Rval, Statement, _Once),
|
|
statement_contains_defn(Statement, Defn)
|
|
;
|
|
Stmt = if_then_else(_Cond, Then, MaybeElse),
|
|
( statement_contains_defn(Then, Defn)
|
|
; maybe_statement_contains_defn(MaybeElse, Defn)
|
|
)
|
|
;
|
|
Stmt = label(_Label),
|
|
fail
|
|
;
|
|
Stmt = goto(_),
|
|
fail
|
|
;
|
|
Stmt = computed_goto(_Rval, _Labels),
|
|
fail
|
|
;
|
|
Stmt = call(_Sig, _Func, _Obj, _Args, _RetLvals, _TailCall),
|
|
fail
|
|
;
|
|
Stmt = return(_Rvals),
|
|
fail
|
|
;
|
|
Stmt = do_commit(_Ref),
|
|
fail
|
|
;
|
|
Stmt = try_commit(_Ref, Statement, Handler),
|
|
( statement_contains_defn(Statement, Defn)
|
|
; statement_contains_defn(Handler, Defn)
|
|
)
|
|
;
|
|
Stmt = atomic(_AtomicStmt),
|
|
fail
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% defns_contains_var:
|
|
% defn_contains_var:
|
|
% defn_body_contains_var:
|
|
% maybe_statement_contains_var:
|
|
% statements_contains_var:
|
|
% statement_contains_var:
|
|
% atomic_stmt_contains_var:
|
|
% rvals_contains_var:
|
|
% maybe_rval_contains_var:
|
|
% rval_contains_var:
|
|
% trail_op_contains_var:
|
|
% lvals_contains_var:
|
|
% lval_contains_var:
|
|
% Succeeds iff the specified construct contains a reference to
|
|
% the specified variable.
|
|
%
|
|
|
|
:- pred defns_contains_var(mlds__defns, mlds__var).
|
|
:- mode defns_contains_var(in, in) is semidet.
|
|
|
|
defns_contains_var(Defns, Name) :-
|
|
list__member(Defn, Defns),
|
|
defn_contains_var(Defn, Name).
|
|
|
|
:- pred defn_contains_var(mlds__defn, mlds__var).
|
|
:- mode defn_contains_var(in, in) is semidet.
|
|
|
|
defn_contains_var(mlds__defn(_Name, _Context, _Flags, DefnBody), Name) :-
|
|
defn_body_contains_var(DefnBody, Name).
|
|
|
|
:- pred defn_body_contains_var(mlds__entity_defn, mlds__var).
|
|
:- mode defn_body_contains_var(in, in) is semidet.
|
|
|
|
defn_body_contains_var(mlds__data(_Type, yes(Initializer)), Name) :-
|
|
rvals_contains_var(Initializer, Name).
|
|
defn_body_contains_var(mlds__function(_PredProcId, _Params, MaybeBody),
|
|
Name) :-
|
|
maybe_statement_contains_var(MaybeBody, Name).
|
|
defn_body_contains_var(mlds__class(ClassDefn), Name) :-
|
|
ClassDefn = mlds__class_defn(_Kind, _Imports, _Inherits, _Implements,
|
|
FieldDefns),
|
|
defns_contains_var(FieldDefns, Name).
|
|
|
|
:- pred maybe_statement_contains_var(maybe(mlds__statement), mlds__var).
|
|
:- mode maybe_statement_contains_var(in, in) is semidet.
|
|
|
|
maybe_statement_contains_var(no, _) :- fail.
|
|
maybe_statement_contains_var(yes(Statement), Name) :-
|
|
statement_contains_var(Statement, Name).
|
|
|
|
:- pred statements_contains_var(mlds__statements, mlds__var).
|
|
:- mode statements_contains_var(in, in) is semidet.
|
|
|
|
statements_contains_var(Statements, Name) :-
|
|
list__member(Statement, Statements),
|
|
statement_contains_var(Statement, Name).
|
|
|
|
:- pred statement_contains_var(mlds__statement, mlds__var).
|
|
:- mode statement_contains_var(in, in) is semidet.
|
|
|
|
statement_contains_var(Statement, Name) :-
|
|
Statement = mlds__statement(Stmt, _Context),
|
|
stmt_contains_var(Stmt, Name).
|
|
|
|
:- pred stmt_contains_var(mlds__stmt, mlds__var).
|
|
:- mode stmt_contains_var(in, in) is semidet.
|
|
|
|
stmt_contains_var(Stmt, Name) :-
|
|
(
|
|
Stmt = block(Defns, Statements),
|
|
( defns_contains_var(Defns, Name)
|
|
; statements_contains_var(Statements, Name)
|
|
)
|
|
;
|
|
Stmt = while(Rval, Statement, _Once),
|
|
( rval_contains_var(Rval, Name)
|
|
; statement_contains_var(Statement, Name)
|
|
)
|
|
;
|
|
Stmt = if_then_else(Cond, Then, MaybeElse),
|
|
( rval_contains_var(Cond, Name)
|
|
; statement_contains_var(Then, Name)
|
|
; maybe_statement_contains_var(MaybeElse, Name)
|
|
)
|
|
;
|
|
Stmt = label(_Label),
|
|
fail
|
|
;
|
|
Stmt = goto(_),
|
|
fail
|
|
;
|
|
Stmt = computed_goto(Rval, _Labels),
|
|
rval_contains_var(Rval, Name)
|
|
;
|
|
Stmt = call(_Sig, Func, Obj, Args, RetLvals, _TailCall),
|
|
( rval_contains_var(Func, Name)
|
|
; maybe_rval_contains_var(Obj, Name)
|
|
; rvals_contains_var(Args, Name)
|
|
; lvals_contains_var(RetLvals, Name)
|
|
)
|
|
;
|
|
Stmt = return(Rvals),
|
|
rvals_contains_var(Rvals, Name)
|
|
;
|
|
Stmt = do_commit(Ref),
|
|
rval_contains_var(Ref, Name)
|
|
;
|
|
Stmt = try_commit(Ref, Statement, Handler),
|
|
( lval_contains_var(Ref, Name)
|
|
; statement_contains_var(Statement, Name)
|
|
; statement_contains_var(Handler, Name)
|
|
)
|
|
;
|
|
Stmt = atomic(AtomicStmt),
|
|
atomic_stmt_contains_var(AtomicStmt, Name)
|
|
).
|
|
|
|
:- pred atomic_stmt_contains_var(mlds__atomic_statement, mlds__var).
|
|
:- mode atomic_stmt_contains_var(in, in) is semidet.
|
|
|
|
atomic_stmt_contains_var(comment(_), _Name) :- fail.
|
|
atomic_stmt_contains_var(assign(Lval, Rval), Name) :-
|
|
( lval_contains_var(Lval, Name)
|
|
; rval_contains_var(Rval, Name)
|
|
).
|
|
atomic_stmt_contains_var(new_object(Target, _MaybeTag, _Type, _MaybeSize,
|
|
_MaybeCtorName, Args, _ArgTypes), Name) :-
|
|
( lval_contains_var(Target, Name)
|
|
; rvals_contains_var(Args, Name)
|
|
).
|
|
atomic_stmt_contains_var(mark_hp(Lval), Name) :-
|
|
lval_contains_var(Lval, Name).
|
|
atomic_stmt_contains_var(restore_hp(Rval), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
atomic_stmt_contains_var(trail_op(TrailOp), Name) :-
|
|
trail_op_contains_var(TrailOp, Name).
|
|
atomic_stmt_contains_var(target_code(_Lang, _String), _) :- fail.
|
|
|
|
:- pred trail_op_contains_var(trail_op, mlds__var).
|
|
:- mode trail_op_contains_var(in, in) is semidet.
|
|
|
|
trail_op_contains_var(store_ticket(Lval), Name) :-
|
|
lval_contains_var(Lval, Name).
|
|
trail_op_contains_var(reset_ticket(Rval, _Reason), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
trail_op_contains_var(discard_ticket, _Name) :- fail.
|
|
trail_op_contains_var(prune_ticket, _Name) :- fail.
|
|
trail_op_contains_var(mark_ticket_stack(Lval), Name) :-
|
|
lval_contains_var(Lval, Name).
|
|
trail_op_contains_var(prune_tickets_to(Rval), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
|
|
:- pred rvals_contains_var(list(mlds__rval), mlds__var).
|
|
:- mode rvals_contains_var(in, in) is semidet.
|
|
|
|
rvals_contains_var(Rvals, Name) :-
|
|
list__member(Rval, Rvals),
|
|
rval_contains_var(Rval, Name).
|
|
|
|
:- pred maybe_rval_contains_var(maybe(mlds__rval), mlds__var).
|
|
:- mode maybe_rval_contains_var(in, in) is semidet.
|
|
|
|
maybe_rval_contains_var(no, _Name) :- fail.
|
|
maybe_rval_contains_var(yes(Rval), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
|
|
:- pred rval_contains_var(mlds__rval, mlds__var).
|
|
:- mode rval_contains_var(in, in) is semidet.
|
|
|
|
rval_contains_var(lval(Lval), Name) :-
|
|
lval_contains_var(Lval, Name).
|
|
rval_contains_var(mkword(_Tag, Rval), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
rval_contains_var(const(_Const), _Name) :- fail.
|
|
rval_contains_var(unop(_Op, Rval), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
rval_contains_var(binop(_Op, X, Y), Name) :-
|
|
( rval_contains_var(X, Name)
|
|
; rval_contains_var(Y, Name)
|
|
).
|
|
rval_contains_var(mem_addr(Lval), Name) :-
|
|
lval_contains_var(Lval, Name).
|
|
|
|
:- pred lvals_contains_var(list(mlds__lval), mlds__var).
|
|
:- mode lvals_contains_var(in, in) is semidet.
|
|
|
|
lvals_contains_var(Lvals, Name) :-
|
|
list__member(Lval, Lvals),
|
|
lval_contains_var(Lval, Name).
|
|
|
|
:- pred lval_contains_var(mlds__lval, mlds__var).
|
|
:- mode lval_contains_var(in, in) is semidet.
|
|
|
|
lval_contains_var(field(_MaybeTag, Rval, _FieldId, _, _), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
lval_contains_var(mem_ref(Rval, _Type), Name) :-
|
|
rval_contains_var(Rval, Name).
|
|
lval_contains_var(var(Name), Name). /* this is where we can succeed! */
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
%
|
|
% The elim_info type holds information that we use or accumulate
|
|
% as we traverse through the function body.
|
|
%
|
|
|
|
:- type elim_info
|
|
---> elim_info(
|
|
% The name of the current module.
|
|
mlds_module_name,
|
|
|
|
% The lists of local variables for
|
|
% each of the containing functions,
|
|
% innermost first
|
|
% XXX this is not used.
|
|
% It would be needed if we want to
|
|
% handle arbitrary nesting.
|
|
% Currently we assume that any variables
|
|
% can safely be hoisted to the outermost
|
|
% function, so this field is not needed.
|
|
outervars,
|
|
|
|
% The list of nested function definitions
|
|
% that we must hoist out.
|
|
% This list is stored in reverse order.
|
|
list(mlds__defn),
|
|
|
|
% The list of local variables that we must
|
|
% put in the environment structure
|
|
% This list is stored in reverse order.
|
|
list(mlds__defn),
|
|
|
|
% Type of the introduced environment struct
|
|
mlds__type
|
|
).
|
|
|
|
% The lists of local variables for
|
|
% each of the containing functions,
|
|
% innermost first
|
|
:- type outervars == list(list(mlds__defn)).
|
|
|
|
:- func elim_info_init(mlds_module_name, outervars, mlds__type) = elim_info.
|
|
elim_info_init(ModuleName, OuterVars, EnvTypeName) =
|
|
elim_info(ModuleName, OuterVars, [], [], EnvTypeName).
|
|
|
|
:- func elim_info_get_module_name(elim_info) = mlds_module_name.
|
|
elim_info_get_module_name(elim_info(ModuleName, _, _, _, _)) = ModuleName.
|
|
|
|
:- func elim_info_get_outer_vars(elim_info) = outervars.
|
|
elim_info_get_outer_vars(elim_info(_, OuterVars, _, _, _)) = OuterVars.
|
|
|
|
:- func elim_info_get_local_vars(elim_info) = list(mlds__defn).
|
|
elim_info_get_local_vars(elim_info(_, _, _, LocalVars, _)) = LocalVars.
|
|
|
|
:- func elim_info_get_env_type_name(elim_info) = mlds__type.
|
|
elim_info_get_env_type_name(elim_info(_, _, _, _, EnvTypeName)) = EnvTypeName.
|
|
|
|
:- pred elim_info_add_nested_func(mlds__defn, elim_info, elim_info).
|
|
:- mode elim_info_add_nested_func(in, in, out) is det.
|
|
elim_info_add_nested_func(NestedFunc, elim_info(A, B, NestedFuncs0, D, E),
|
|
elim_info(A, B, NestedFuncs, D, E)) :-
|
|
NestedFuncs = [NestedFunc | NestedFuncs0].
|
|
|
|
:- pred elim_info_add_local_var(mlds__defn, elim_info, elim_info).
|
|
:- mode elim_info_add_local_var(in, in, out) is det.
|
|
elim_info_add_local_var(LocalVar, elim_info(A, B, C, LocalVars0, E),
|
|
elim_info(A, B, C, LocalVars, E)) :-
|
|
LocalVars = [LocalVar | LocalVars0].
|
|
|
|
:- pred elim_info_finish(elim_info, list(mlds__defn), list(mlds__defn)).
|
|
:- mode elim_info_finish(in, out, out) is det.
|
|
elim_info_finish(elim_info(_ModuleName, _OuterVars, RevFuncs, RevLocalVars, _),
|
|
Funcs, LocalVars) :-
|
|
Funcs = list__reverse(RevFuncs),
|
|
LocalVars = list__reverse(RevLocalVars).
|
|
|
|
%-----------------------------------------------------------------------------%
|