[m-dev.] diff: MLDS back-end: boxing/unboxing changes
Fergus Henderson
fjh at cs.mu.OZ.AU
Wed Nov 17 04:23:32 AEDT 1999
Estimated hours taken: 12
compiler/ml_code_gen.m:
Make a start towards implementing polymorphism:
change the code for procedure calls so that it
properly boxes/unboxes the arguments to convert
from concrete types to polymorphic types or
vice versa. This also fixes some of the warnings
in the code generated for wrapper functions.
Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.17
diff -u -d -d -r1.17 ml_code_gen.m
--- compiler/ml_code_gen.m 1999/11/15 10:35:17 1.17
+++ compiler/ml_code_gen.m 1999/11/16 17:10:38
@@ -554,7 +554,8 @@
% - disjunctions
% - negation
% - if-then-else
-% - predicate calls
+% - predicate/function calls
+% - higher-order calls
% - unifications
% - assignment
% - simple tests
@@ -563,10 +564,10 @@
% - switches
% - commits
% TODO:
+% - type_infos
% - c_code pragmas
% - no_tag types
-% - construction of closures, and higher-order calls
-% - class method calls
+% - typeclass_infos and class method calls
% - type declarations for user-defined types
% ...
%
@@ -902,6 +903,9 @@
DeclFlags = ml_gen_var_decl_flags,
MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
+:- func ml_gen_var_names(prog_varset, list(prog_var)) = list(string).
+ml_gen_var_names(VarSet, Vars) = list__map(ml_gen_var_name(VarSet), Vars).
+
:- func ml_gen_var_name(prog_varset, prog_var) = string.
ml_gen_var_name(VarSet, Var) = UniqueVarName :-
varset__lookup_name(VarSet, Var, VarName),
@@ -1304,8 +1308,12 @@
{ BuiltinState = not_builtin }
->
ml_gen_var_list(ArgVars, ArgLvals),
- ml_gen_call(PredId, ProcId, ArgLvals, CodeModel, Context,
- MLDS_Decls, MLDS_Statements)
+ =(MLDSGenInfo),
+ { ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
+ { ArgNames = ml_gen_var_names(VarSet, ArgVars) },
+ ml_variable_types(ArgVars, ActualArgTypes),
+ ml_gen_call(PredId, ProcId, ArgNames, ArgLvals, ActualArgTypes,
+ CodeModel, Context, MLDS_Decls, MLDS_Statements)
;
ml_gen_builtin(PredId, ProcId, ArgVars, CodeModel, Context,
MLDS_Decls, MLDS_Statements)
@@ -1352,8 +1360,8 @@
=(MLDSGenInfo),
{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
- { ArgVarNames = list__map(ml_gen_var_name(VarSet), ArgVars) },
- { Params0 = ml_gen_params(ModuleInfo, ArgVarNames,
+ { ArgNames = ml_gen_var_names(VarSet, ArgVars) },
+ { Params0 = ml_gen_params(ModuleInfo, ArgNames,
BoxedArgTypes, ArgModes, CodeModel) },
%
@@ -1384,47 +1392,178 @@
),
%
- % Generate the call, passing the closure as the first argument
+ % Generate code to box/unbox the arguments
+ % and compute the list of properly converted rvals/lvals
+ % to pass as the function call's arguments and return values
%
- { ObjectRval = no },
ml_gen_var_list(ArgVars, ArgLvals),
- ml_gen_arg_list(ArgLvals, BoxedArgTypes, ArgModes, ArgRvals, RetLvals),
- ml_gen_mlds_call(Signature, ObjectRval, FuncRval,
- [lval(ClosureLval) | ArgRvals], RetLvals,
- CodeModel, Context, MLDS_Decls, MLDS_Statements).
+ ml_variable_types(ArgVars, ActualArgTypes),
+ ml_gen_arg_list(ArgNames, ArgLvals, ActualArgTypes, BoxedArgTypes,
+ ArgModes, Context, InputRvals, OutputLvals, ConvArgDecls,
+ ConvOutputStatements),
-:- pred ml_gen_call(pred_id, proc_id, list(mlds__lval), code_model,
- prog_context, mlds__defns, mlds__statements,
- ml_gen_info, ml_gen_info).
-:- mode ml_gen_call(in, in, in, in, in, out, out, in, out) is det.
+ %
+ % Prepare to generate the call, passing the closure as the first
+ % argument.
+ % (We can't actually generate the call yet, since it might be nondet,
+ % and we don't yet know what its success continuation will be;
+ % instead for now we just construct a higher-order term `DoGenCall',
+ % which when called will generate it.)
+ %
+ { ObjectRval = no },
+ { DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncRval,
+ [lval(ClosureLval) | InputRvals], OutputLvals,
+ CodeModel, Context) },
-ml_gen_call(PredId, ProcId, ArgLvals, CodeModel, Context,
- MLDS_Decls, MLDS_Statements) -->
+ ( { ConvArgDecls = [], ConvOutputStatements = [] } ->
+ DoGenCall(MLDS_Decls, MLDS_Statements)
+ ;
+ %
+ % Construct a closure to generate code to
+ % convert the output arguments and then succeed
+ %
+ { DoGenConvOutputAndSucceed = (
+ pred(COAS_Decls::out, COAS_Statements::out, in, out)
+ is det -->
+ { COAS_Decls = [] },
+ ml_gen_success(CodeModel, Context,
+ SucceedStmts),
+ { COAS_Statements = list__append(
+ ConvOutputStatements, SucceedStmts) }
+ ) },
- % compute the function signature
+ %
+ % 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),
+ { MLDS_Decls = list__append(ConvArgDecls,
+ CallAndConvOutputDecls) },
+ { MLDS_Statements = CallAndConvOutputStatements }
+ ).
+
+ %
+ % Generate code for a procedure call, making sure to
+ % box/unbox the arguments if necessary.
+ %
+:- pred ml_gen_call(pred_id, proc_id, list(var_name), list(mlds__lval),
+ list(prog_data__type), code_model, prog_context,
+ mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_gen_call(in, in, in, in, in, in, in, out, out, in, out) is det.
+
+ %
+ % Generate code for the various parts that are needed for
+ % a procedure call: declarations of variables needed for
+ % boxing/unboxing output arguments,
+ % a closure to generate code to call the function
+ % with the input arguments appropriate boxed,
+ % and code to unbox/box the return values.
+ %
+ % For example, if the callee is declared as
+ %
+ % :- some [T2]
+ % pred callee(float::in, T1::in, float::out, T2::out, ...).
+ %
+ % then for a call `callee(Arg1, Arg2, Arg3, Arg4, ...)'
+ % with arguments of types `U1, float, U2, float, ...',
+ % we generate the following fragments:
+ %
+ % /* declarations of variables needed for boxing/unboxing */
+ % Float conv_Arg3;
+ % MR_Box conv_Arg4;
+ % ...
+ %
+ % /* code to call the function */
+ % func(unbox(Arg1), box(Arg2), &boxed_Arg3, &unboxed_Arg4);
+ %
+ % /* code to box/unbox the output arguments */
+ % *Arg3 = unbox(boxed_Arg3);
+ % *Arg4 = box(unboxed_Arg4);
+ % ...
+ %
+ % Note that of course in general not every argument will need
+ % to be boxed/unboxed; for those where no conversion is required,
+ % we just pass the original argument unchanged.
+ %
+ml_gen_call(PredId, ProcId, ArgNames, ArgLvals, ActualArgTypes, CodeModel,
+ Context, MLDS_Decls, MLDS_Statements) -->
+ %
+ % Compute the function signature
+ %
{ Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId) },
{ Signature = mlds__get_func_signature(Params) },
- % compute the function address
+ %
+ % Compute the function address
+ %
ml_gen_proc_addr_rval(PredId, ProcId, FuncRval),
- % compute the ordinary function arguments & return values
+ %
+ % Compute the callee's Mercury argument types and modes
+ %
=(MLDSGenInfo),
{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo) },
- { pred_info_arg_types(PredInfo, ArgTypes) },
+ { pred_info_arg_types(PredInfo, PredArgTypes) },
{ proc_info_argmodes(ProcInfo, ArgModes) },
- % generate the call
+ %
+ % Generate code to box/unbox the arguments
+ % and compute the list of properly converted rvals/lvals
+ % to pass as the function call's arguments and return values
+ %
+ ml_gen_arg_list(ArgNames, ArgLvals, ActualArgTypes, PredArgTypes,
+ ArgModes, Context, InputRvals, OutputLvals, ConvArgDecls,
+ ConvOutputStatements),
+
+ %
+ % Construct a closure to generate the call
+ % (We can't actually generate the call yet, since it might be nondet,
+ % and we don't yet know what its success continuation will be;
+ % that's why for now we just construct a closure `DoGenCall'
+ % to generate it.)
+ %
{ ObjectRval = no },
- ml_gen_arg_list(ArgLvals, ArgTypes, ArgModes, ArgRvals0, RetLvals0),
- ml_gen_mlds_call(Signature, ObjectRval, FuncRval, ArgRvals0, RetLvals0,
- CodeModel, Context, MLDS_Decls, MLDS_Statements).
+ { DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncRval,
+ InputRvals, OutputLvals, CodeModel, Context) },
+ ( { ConvArgDecls = [], ConvOutputStatements = [] } ->
+ DoGenCall(MLDS_Decls, MLDS_Statements)
+ ;
+ %
+ % Construct a closure to generate code to
+ % convert the output arguments and then succeed
+ %
+ { DoGenConvOutputAndSucceed = (
+ pred(COAS_Decls::out, COAS_Statements::out, in, out)
+ is det -->
+ { COAS_Decls = [] },
+ ml_gen_success(CodeModel, Context,
+ SucceedStmts),
+ { COAS_Statements = list__append(
+ ConvOutputStatements, SucceedStmts) }
+ ) },
+
+ %
+ % 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),
+ { MLDS_Decls = list__append(ConvArgDecls,
+ CallAndConvOutputDecls) },
+ { MLDS_Statements = CallAndConvOutputStatements }
+ ).
+
%
% This generates a call in the specified code model.
- % This is a lower-level routine called by both ml_gen_call
+ % This is a lower-level routine called by both ml_gen_call_parts
% and ml_gen_generic_call.
%
:- pred ml_gen_mlds_call(mlds__func_signature, maybe(mlds__rval), mlds__rval,
@@ -1493,50 +1632,181 @@
%
% Generate rvals and lvals for the arguments of a procedure call
%
-:- pred ml_gen_arg_list(list(mlds__lval), list(prog_type), list(mode),
- list(mlds__rval), list(mlds__lval),
+:- pred ml_gen_arg_list(list(var_name), list(mlds__lval), list(prog_type),
+ list(prog_type), list(mode), prog_context, list(mlds__rval),
+ list(mlds__lval), mlds__defns, mlds__statements,
ml_gen_info, ml_gen_info).
-:- mode ml_gen_arg_list(in, in, in, out, out, in, out) is det.
+:- mode ml_gen_arg_list(in, in, in, in, in, in, out, out, out, out,
+ in, out) is det.
-ml_gen_arg_list(VarLvals, Types, Modes, InputRvals, OutputLvals) -->
+ml_gen_arg_list(VarNames, VarLvals, CallerTypes, CalleeTypes, Modes, Context,
+ InputRvals, OutputLvals, ConvDecls, ConvOutputStatements) -->
(
- { VarLvals = [], Types = [], Modes = [] }
+ { VarNames = [] },
+ { VarLvals = [] },
+ { CallerTypes = [] },
+ { CalleeTypes = [] },
+ { Modes = [] }
->
{ InputRvals = [] },
- { OutputLvals = [] }
+ { OutputLvals = [] },
+ { ConvDecls = [] },
+ { ConvOutputStatements = [] }
;
- { VarLvals = [VarLval|VarLvals1] },
- { Types = [Type|Types1] },
- { Modes = [Mode|Modes1] }
+ { VarNames = [VarName | VarNames1] },
+ { VarLvals = [VarLval | VarLvals1] },
+ { CallerTypes = [CallerType | CallerTypes1] },
+ { CalleeTypes = [CalleeType | CalleeTypes1] },
+ { Modes = [Mode | Modes1] }
->
- ml_gen_arg_list(VarLvals1, Types1, Modes1,
- InputRvals1, OutputLvals1),
+ ml_gen_arg_list(VarNames1, VarLvals1,
+ CallerTypes1, CalleeTypes1, Modes1, Context,
+ InputRvals1, OutputLvals1,
+ ConvDecls1, ConvOutputStatements1),
=(MLDSGenInfo),
{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
- ( { type_util__is_dummy_argument_type(Type) } ->
+ ( { type_util__is_dummy_argument_type(CalleeType) } ->
+ %
% exclude arguments of type io__state etc.
+ %
{ InputRvals = InputRvals1 },
- { OutputLvals = OutputLvals1 }
- ; { mode_to_arg_mode(ModuleInfo, Mode, Type, top_in) } ->
- { InputRvals = [lval(VarLval) | InputRvals1] },
- { OutputLvals = OutputLvals1 }
- /************
- ; { UseMultipleOutputs = yes } ->
- { InputRvals = InputLvals1 },
- { OutputLvals = [VarLval | OutputLvals1] },
- ************/
+ { OutputLvals = OutputLvals1 },
+ { ConvDecls = ConvDecls1 },
+ { ConvOutputStatements = ConvOutputStatements1 }
+ ; { mode_to_arg_mode(ModuleInfo, Mode, CalleeType, top_in) } ->
+ %
+ % it's an input argument
+ %
+ { ml_gen_box_or_unbox_rval(CallerType, CalleeType,
+ lval(VarLval), ArgRval) },
+ { InputRvals = [ArgRval | InputRvals1] },
+ { OutputLvals = OutputLvals1 },
+ { ConvDecls = ConvDecls1 },
+ { ConvOutputStatements = ConvOutputStatements1 }
;
- { InputRvals = [ml_gen_mem_addr(VarLval) | InputRvals1] },
- { OutputLvals = OutputLvals1 }
+ %
+ % it's an output argument
+ %
+ ml_gen_box_or_unbox_lval(CallerType, CalleeType,
+ VarLval, VarName, Context, ArgLval,
+ ThisArgConvDecls, ThisArgConvOutput),
+ { ConvDecls = list__append(ThisArgConvDecls,
+ ConvDecls1) },
+ { ConvOutputStatements = list__append(
+ ThisArgConvOutput, ConvOutputStatements1) },
+ (
+ /************
+ %
+ % if the target language allows multiple
+ % return values, then use them
+ %
+ { UseMultipleOutputs = yes }
+ ->
+ { InputRvals = InputLvals1 },
+ { OutputLvals = [ArgLval | OutputLvals1] },
+ ;
+ ************/
+ %
+ % otherwise use the traditional C style
+ % of passing the address of the output value
+ %
+ { InputRvals = [ml_gen_mem_addr(ArgLval)
+ | InputRvals1] },
+ { OutputLvals = OutputLvals1 }
+ )
)
;
{ error("ml_gen_arg_list: length mismatch") }
).
+ % ml_gen_mem_addr(Lval) returns a value equal to &Lval.
+ % For the case where Lval = *Rval, for some Rval,
+ % we optimize &*Rval to just Rval.
:- func ml_gen_mem_addr(mlds__lval) = mlds__rval.
ml_gen_mem_addr(Lval) =
(if Lval = mem_ref(Rval) then Rval else mem_addr(Lval)).
+:- pred ml_gen_box_or_unbox_rval(prog_type, prog_type, mlds__rval, mlds__rval).
+:- mode ml_gen_box_or_unbox_rval(in, in, in, out) is det.
+
+ml_gen_box_or_unbox_rval(SourceType, DestType, VarRval, ArgRval) :-
+ (
+ %
+ % if converting from polymorphic type to concrete type,
+ % then unbox
+ %
+ SourceType = term__variable(_),
+ DestType = term__functor(_, _, _)
+ ->
+ ArgRval = unop(unbox(mercury_type(DestType)), VarRval)
+ ;
+ %
+ % if converting from concrete type to polymorphic type,
+ % then box
+ %
+ SourceType = term__functor(_, _, _),
+ DestType = term__variable(_)
+ ->
+ ArgRval = unop(box(mercury_type(SourceType)), VarRval)
+ ;
+ %
+ % otherwise leave unchanged
+ %
+ ArgRval = VarRval
+ ).
+
+:- pred ml_gen_box_or_unbox_lval(prog_type, prog_type, mlds__lval, var_name,
+ prog_context, mlds__lval, mlds__defns, mlds__statements,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_box_or_unbox_lval(in, in, in, in, in, out, out, out,
+ in, out) is det.
+
+ml_gen_box_or_unbox_lval(CallerType, CalleeType, VarLval, VarName, Context,
+ ArgLval, ConvDecls, ConvStatements) -->
+ %
+ % First see if we can just convert the lval as an rval;
+ % if no boxing/unboxing is required, then ml_box_or_unbox_rval
+ % will return its argument unchanged, and so we're done.
+ %
+ (
+ { ml_gen_box_or_unbox_rval(CalleeType, CallerType,
+ lval(VarLval), lval(VarLval)) }
+ ->
+ { ArgLval = VarLval },
+ { ConvDecls = [] },
+ { ConvStatements = [] }
+ ;
+ %
+ % If that didn't work, then we need to declare a fresh variable
+ % to use as the arg, and to generate a statement to box/unbox
+ % that fresh arg variable and assign it to the output argument
+ % whose address we were passed.
+ %
+
+ % generate a declaration for the fresh variable
+ { ArgVarName = string__append("conv_", VarName) },
+ { ArgVarDecl = ml_gen_var_decl(ArgVarName, CalleeType,
+ mlds__make_context(Context)) },
+ { ConvDecls = [ArgVarDecl] },
+
+ % create the lval for the variable and use it for the
+ % argument lval
+ ml_qualify_var(ArgVarName, ArgLval),
+
+ % generate a statement to box/unbox the fresh variable
+ % and assign it to the output argument whose address
+ % we were passed. Note that we swap the caller type
+ % and the callee type, since this is an output not
+ % an input, so the callee type is the source type
+ % and the caller type is the destination type.
+ { ml_gen_box_or_unbox_rval(CalleeType, CallerType,
+ lval(ArgLval), ConvertedArgRval) },
+ { AssignStmt = assign(VarLval, ConvertedArgRval) },
+ { AssignStatement = mlds__statement(atomic(AssignStmt),
+ mlds__make_context(Context)) },
+ { ConvStatements = [AssignStatement] }
+ ).
+
%-----------------------------------------------------------------------------%
%
% Code for builtins
@@ -2162,8 +2432,8 @@
{ IfStatement = mlds__statement(IfStmt,
mlds__make_context(Context)) },
{ MLDS_Decls = FirstDecls },
- { MLDS_Statements = list__append(
- FirstStatements, [IfStatement]) }
+ { MLDS_Statements = list__append(FirstStatements,
+ [IfStatement]) }
;
% model_non goal:
% <First, Rest>
@@ -2192,7 +2462,8 @@
RestFunc),
ml_get_env_ptr(EnvPtrRval),
- { SuccessCont = success_cont(RestFuncLabelRval, EnvPtrRval) },
+ { SuccessCont = success_cont(RestFuncLabelRval,
+ EnvPtrRval) },
ml_gen_info_push_success_cont(SuccessCont),
DoGenFirst(FirstDecls, FirstStatements),
ml_gen_info_pop_success_cont,
@@ -2765,6 +3036,7 @@
mlds__make_context(Context)) },
{ MLDS_Statements = [MLDS_Statement] }.
+%-----------------------------------------------------------------------------%
%
% ml_gen_closure_wrapper:
% Generate a wrapper function which unboxes the input arguments,
@@ -2776,30 +3048,40 @@
% MR_Box arg1, MR_Box *arg2, ..., MR_Box argn)
% {
% FooClosure *closure;
- % Arg1Type unboxed_arg1;
- % Arg2Type unboxed_arg2;
% ...
- % ArgNType unboxed_argn;
+ % /* declarations needed for converting output args */
+ % Arg2Type conv_arg2;
+ % ...
% bool succeeded;
%
% closure = closure_arg; /* XXX should add cast */
%
- % /* unbox input arguments */
- % unboxed_arg1 = unbox(arg1);
+ % CONJ(code_model,
+ % /* call function, boxing/unboxing inputs if needed */
+ % foo(closure->f1, unbox(closure->f2), ...,
+ % unbox(arg1), &unboxed_arg2, arg3, ...);
+ % ,
+ % /* box output arguments */
+ % *arg2 = box(unboxed_arg2);
% ...
- %
+ % )
+ % }
+ %
+ % where the stuff in CONJ() expands to the appropriate code
+ % for a conjunction, which depends on the code model:
+ %
% #if MODEL_DET
- % /* call function */
- % foo(closure->f1, closure->f2, ...,
- % unboxed_arg1, &unboxed_arg2, ...);
+ % /* call function, boxing/unboxing inputs if needed */
+ % foo(closure->f1, unbox(closure->f2), ...,
+ % unbox(arg1), &unboxed_arg2, arg3, ...);
%
% /* box output arguments */
% *arg2 = box(unboxed_arg2);
% ...
% #elif MODEL_SEMI
- % /* call function */
- % succeeded = foo(closure->f1, closure->f2, ...,
- % unboxed_arg1, &unboxed_arg2, ...);
+ % /* call function, boxing/unboxing inputs if needed */
+ % succeeded = foo(closure->f1, unbox(closure->f2), ...,
+ % unbox(arg1), &unboxed_arg2, arg3, ...);
%
% if (succeeded) {
% /* box output arguments */
@@ -2817,12 +3099,12 @@
% (*succ_cont)();
% }
%
- % /* call function */
- % foo(closure->f1, closure->f2, ...,
- % unboxed_arg1, &unboxed_arg2, ..., foo_1);
+ % /* call function, boxing/unboxing inputs if needed */
+ % foo(closure->f1, unbox(closure->f2), ...,
+ % unbox(arg1), &unboxed_arg2, arg3, ...,
+ % foo_1);
% #endif
%
- %
:- pred ml_gen_closure_wrapper(pred_id, proc_id, int, prog_type, prog_context,
mlds__defn, mlds__rval, mlds__type,
ml_gen_info, ml_gen_info).
@@ -2837,24 +3119,23 @@
=(Info),
{ ml_gen_info_get_module_info(Info, ModuleInfo) },
{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, ProcInfo) },
+ _PredInfo, ProcInfo) },
{ proc_info_headvars(ProcInfo, ProcHeadVars) },
- { pred_info_arg_types(PredInfo, ProcArgTypes) },
{ proc_info_argmodes(ProcInfo, ProcArgModes) },
{ proc_info_interface_code_model(ProcInfo, CodeModel) },
+ { proc_info_varset(ProcInfo, ProcVarSet) },
{ ProcArity = list__length(ProcHeadVars) },
-
-
+ { ProcHeadVarNames = ml_gen_var_names(ProcVarSet, ProcHeadVars) },
%
% allocate some fresh type variables to use as the Mercury types
% of the boxed arguments
%
{ varset__init(TypeVarSet0) },
- { varset__new_vars(TypeVarSet0, NumWrapperArgs, WrapperArgTypeVars,
+ { varset__new_vars(TypeVarSet0, ProcArity, ProcBoxedArgTypeVars,
_TypeVarSet) },
- { term__var_list_to_term_list(WrapperArgTypeVars,
- WrapperBoxedArgTypes) },
+ { term__var_list_to_term_list(ProcBoxedArgTypeVars,
+ ProcBoxedArgTypes) },
%
% compute the parameters for the wrapper function
@@ -2863,13 +3144,15 @@
%
% first generate the declarations for the boxed arguments
- { NumWrapperArgs = ProcArity - NumClosureArgs },
{
list__drop(NumClosureArgs, ProcHeadVars, WrapperHeadVars0),
- list__drop(NumClosureArgs, ProcArgModes, WrapperArgModes0)
+ list__drop(NumClosureArgs, ProcArgModes, WrapperArgModes0),
+ list__drop(NumClosureArgs, ProcBoxedArgTypes,
+ WrapperBoxedArgTypes0)
->
WrapperHeadVars = WrapperHeadVars0,
- WrapperArgModes = WrapperArgModes0
+ WrapperArgModes = WrapperArgModes0,
+ WrapperBoxedArgTypes = WrapperBoxedArgTypes0
;
error("ml_gen_closure_wrapper: list__drop failed")
},
@@ -2909,7 +3192,8 @@
%
% if the wrapper function is model_non, then
- % set up the initial success continuation
+ % set up the initial success continuation;
+ % this is needed by ml_gen_call which we call below
%
( { CodeModel = model_non } ->
ml_initial_cont(InitialCont),
@@ -2918,58 +3202,19 @@
[]
),
- %
- % generate declarations for the unboxed args:
- % Arg1Type unboxed_arg1;
- % Arg2Type unboxed_arg2;
- % ...
- % and code to unbox the input arguments
- % unboxed_arg1 = unbox(arg1);
- % ...
- % and to box the output arguments
- % *arg2 = box(unboxed_arg2);
- % ...
- %
- {
- list__split_list(NumClosureArgs, ProcArgTypes,
- ClosureFieldTypes0, UnboxedVarTypes0)
- ->
- ClosureFieldTypes = ClosureFieldTypes0,
- UnboxedVarTypes = UnboxedVarTypes0
- ;
- error("ml_gen_closure_wrapper: list__drop failed")
- },
- ml_gen_box_and_unbox_args(WrapperHeadVarNames, UnboxedVarTypes,
- WrapperArgModes, MLDS_Context,
- UnboxedVarNames, UnboxInputArgsCode, BoxOutputArgsCode),
- { UnboxedArgDecls = ml_gen_var_decls(UnboxedVarNames, UnboxedVarTypes,
- MLDS_Context) },
-
- %
- % Generate code to succeed and return
- %
- ml_gen_success(CodeModel, Context, SucceedStmts),
- { DoGenBoxOutputsAndSucceed = (
- pred(BOAS_Decls::out, BOAS_Statements::out, in, out) is det -->
- { BOAS_Decls = [] },
- { BOAS_Statements = list__append(BoxOutputArgsCode,
- SucceedStmts) }
- ) },
-
- %
% prepare to generate code to call the function:
% XXX currently we're using a low-level data representation
% in the closure
%
% foo(
% #if HIGH_LEVEL_DATA
- % closure->f1, closure->f2, ...,
+ % closure->arg1, closure->arg2, ...,
% #else
% MR_field(MR_mktag(0), closure, 3),
% MR_field(MR_mktag(0), closure, 4),
% ...
% #endif
- % unboxed_arg1, &unboxed_arg2, ...
+ % unbox(arg1), &unboxed_arg2, arg3, ...
% );
%
% field 0 is the closure layout
@@ -2978,34 +3223,16 @@
% field 3 is the first argument field
{ Offset = 2 },
ml_gen_closure_field_lvals(ClosureLval, Offset, 1, NumClosureArgs,
- ClosureFieldTypes, ClosureArgLvals),
- list__map_foldl(ml_qualify_var, UnboxedVarNames, UnboxedVarLvals),
- { CallLvals = list__append(ClosureArgLvals, UnboxedVarLvals) },
- { DoGenCall = ml_gen_call(PredId, ProcId, CallLvals, CodeModel,
- Context) },
-
- %
- % generate code which calls the function, and then if it succeeds,
- % boxes the output arguments and succeeds
- %
- ml_combine_conj(CodeModel, Context,
- DoGenCall, DoGenBoxOutputsAndSucceed,
- CallAndBoxDecls, CallAndBoxStatements),
-
- %
- % if the wrapper function was model_non, then
- % pop the success continuation that we pushed
- %
- ( { CodeModel = model_non } ->
- ml_gen_info_pop_success_cont
- ;
- []
- ),
+ ClosureArgLvals),
+ ml_gen_wrapper_arg_lvals(WrapperHeadVarNames, WrapperBoxedArgTypes,
+ WrapperArgModes, WrapperHeadVarLvals),
+ { CallLvals = list__append(ClosureArgLvals, WrapperHeadVarLvals) },
+ ml_gen_call(PredId, ProcId, ProcHeadVarNames, CallLvals,
+ ProcBoxedArgTypes, CodeModel, Context, Decls0, Statements0),
- { Decls0 = list__append([ClosureDecl | UnboxedArgDecls],
- CallAndBoxDecls) },
- { Statements0 = list__append([InitClosure | UnboxInputArgsCode],
- CallAndBoxStatements) },
+ % insert the stuff to declare and initialize the closure
+ { Decls1 = [ClosureDecl | Decls0] },
+ { Statements1 = [InitClosure | Statements0] },
%
% For semidet code, add the declaration `bool succeeded;'
@@ -3013,14 +3240,24 @@
%
( { CodeModel = model_semi } ->
{ SucceededVarDecl = ml_gen_succeeded_var_decl(MLDS_Context) },
- { Decls = [SucceededVarDecl | Decls0] },
+ { Decls = [SucceededVarDecl | Decls1] },
ml_gen_test_success(Succeeded),
{ ReturnStmt = return([Succeeded]) },
{ ReturnStatement = mlds__statement(ReturnStmt, MLDS_Context) },
- { Statements = list__append(Statements0, [ReturnStatement]) }
+ { Statements = list__append(Statements1, [ReturnStatement]) }
;
- { Decls = Decls0 },
- { Statements = Statements0 }
+ { Decls = Decls1 },
+ { Statements = Statements1 }
+ ),
+
+ %
+ % if the wrapper function was model_non, then
+ % pop the success continuation that we pushed
+ %
+ ( { CodeModel = model_non } ->
+ ml_gen_info_pop_success_cont
+ ;
+ []
),
%
@@ -3032,6 +3269,7 @@
WrapperFuncBody, WrapperFunc),
{ WrapperFuncType = mlds__func_type(WrapperParams) }.
+
:- func ml_gen_wrapper_head_var_names(int, int) = list(string).
ml_gen_wrapper_head_var_names(Num, Max) = Names :-
( Num > Max ->
@@ -3042,130 +3280,63 @@
Names = [Name | Names1]
).
+ % ml_gen_wrapper_arg_lvals(HeadVarNames, ArgModes, HeadVarLvals):
+ % Generate lvals for the specified head variables
+ % passed in the specified modes.
+ %
+:- pred ml_gen_wrapper_arg_lvals(list(var_name), list(prog_type), list(mode),
+ list(mlds__lval), ml_gen_info, ml_gen_info).
+:- mode ml_gen_wrapper_arg_lvals(in, in, in, out, in, out) is det.
+
+ml_gen_wrapper_arg_lvals(Names, Types, Modes, Lvals) -->
+ (
+ { Names = [], Types = [], Modes = [] }
+ ->
+ { Lvals = [] }
+ ;
+ { Names = [Name|Names1] },
+ { Types = [Type|Types1] },
+ { Modes = [Mode|Modes1] }
+ ->
+ ml_qualify_var(Name, VarLval),
+ =(Info),
+ { ml_gen_info_get_module_info(Info, ModuleInfo) },
+ { mode_to_arg_mode(ModuleInfo, Mode, Type, top_in) ->
+ Lval = VarLval
+ ;
+ % output arguments are passed by reference,
+ % so we need to dereference them
+ Lval = mem_ref(lval(VarLval))
+ },
+ ml_gen_wrapper_arg_lvals(Names1, Types1, Modes1, Lvals1),
+ { Lvals = [Lval|Lvals1] }
+ ;
+ { error("ml_gen_wrapper_arg_lvals: length mismatch") }
+ ).
+
:- pred ml_gen_closure_field_lvals(mlds__lval, int, int, int,
- list(prog_data__type), list(mlds__lval),
+ list(mlds__lval),
ml_gen_info, ml_gen_info).
-:- mode ml_gen_closure_field_lvals(in, in, in, in, in, out, in, out) is det.
+:- mode ml_gen_closure_field_lvals(in, in, in, in, out, in, out) is det.
ml_gen_closure_field_lvals(ClosureLval, Offset, ArgNum, NumClosureArgs,
- UnboxedFieldTypes, ClosureArgLvals) -->
- (
- { UnboxedFieldTypes = [_FieldType | UnboxedFieldTypes1] },
- { require(ArgNum =< NumClosureArgs,
- "ml_gen_closure_field_lvals") },
+ ClosureArgLvals) -->
+ ( { ArgNum > NumClosureArgs } ->
+ { ClosureArgLvals = [] }
+ ;
%
% generate `MR_field(MR_mktag(0), closure, <N>)'
%
{ FieldId = offset(const(int_const(ArgNum + Offset))) },
{ FieldLval = field(yes(0), lval(ClosureLval), FieldId) },
%
- % XXX We should unbox the field.
- % Unfortunately that is tricky, because we have to return
- % an lval here, not an rval, because ml_gen_call takes
- % lvals not rvals.
- %
- /***
- { MLDS_Type = mercury_type_to_mlds_type(FieldType) },
- { ArgRval = unop(unbox(MLDS_Type), FieldLval) },
- ***/
- { ArgLval = FieldLval },
- %
% recursively handle the remaining fields
%
ml_gen_closure_field_lvals(ClosureLval, Offset, ArgNum + 1,
- NumClosureArgs, UnboxedFieldTypes1, ClosureArgLvals0),
- { ClosureArgLvals = [ArgLval | ClosureArgLvals0] }
- ;
- { UnboxedFieldTypes = [] },
- { ClosureArgLvals = [] }
+ NumClosureArgs, ClosureArgLvals0),
+ { ClosureArgLvals = [FieldLval | ClosureArgLvals0] }
).
- %
- % generate names for the unboxed args (unboxed_arg1, unboxed_arg2, ..)
- % and code to unbox the input arguments
- % unboxed_arg1 = unbox(arg1);
- % ...
- % and to box the output arguments
- % *arg2 = box(unboxed_arg2);
- % ...
- %
-:- pred ml_gen_box_and_unbox_args(list(var_name), list(prog_type), list(mode),
- mlds__context, list(var_name),
- list(mlds__statement), list(mlds__statement),
- ml_gen_info, ml_gen_info).
-:- mode ml_gen_box_and_unbox_args(in, in, in, in, out, out, out, in, out)
- is det.
-
-ml_gen_box_and_unbox_args(VarNames, UnboxedTypes, Modes, Context,
- UnboxedVarNames, UnboxInputArgsCode, BoxOutputArgsCode) -->
- (
- { VarNames = [] },
- { UnboxedTypes = [] },
- { Modes = [] }
- ->
- { UnboxedVarNames = [] },
- { UnboxInputArgsCode = [] },
- { BoxOutputArgsCode = [] }
- ;
- { VarNames = [VarName | VarNames1] },
- { UnboxedTypes = [UnboxedType | UnboxedTypes1] },
- { Modes = [Mode | Modes1] }
- ->
- ml_gen_box_and_unbox_args(VarNames1, UnboxedTypes1, Modes1,
- Context, UnboxedVarNames1, UnboxInputArgsCode1,
- BoxOutputArgsCode1),
- { UnboxedVarName = string__append("unboxed_", VarName) },
- { UnboxedVarNames = [UnboxedVarName | UnboxedVarNames1] },
- =(Info),
- { ml_gen_info_get_module_info(Info, ModuleInfo) },
- (
- { mode_to_arg_mode(ModuleInfo, Mode, UnboxedType,
- top_in) }
- ->
- ml_gen_unbox_arg(VarName, UnboxedVarName, UnboxedType,
- Context, UnboxInputArg),
- { UnboxInputArgsCode = [UnboxInputArg |
- UnboxInputArgsCode1] },
- { BoxOutputArgsCode = BoxOutputArgsCode1 }
- ;
- ml_gen_box_arg(VarName, UnboxedVarName, UnboxedType,
- Context, BoxOutputArg),
- { BoxOutputArgsCode = [BoxOutputArg |
- BoxOutputArgsCode1] },
- { UnboxInputArgsCode = UnboxInputArgsCode1 }
- )
- ;
- { error("ml_gen_box_and_unbox_args: length mismatch") }
- ).
-
- % generate code to unbox an input argument
- % unboxed_arg = unbox(arg);
-:- pred ml_gen_unbox_arg(var_name, var_name, prog_type, mlds__context,
- mlds__statement, ml_gen_info, ml_gen_info).
-:- mode ml_gen_unbox_arg(in, in, in, in, out, in, out) is det.
-
-ml_gen_unbox_arg(BoxedVarName, UnboxedVarName, Type, Context, Code) -->
- ml_qualify_var(BoxedVarName, BoxedVarLval),
- ml_qualify_var(UnboxedVarName, UnboxedVarLval),
- { MLDS_Type = mercury_type_to_mlds_type(Type) },
- { Assign = assign(UnboxedVarLval,
- unop(unbox(MLDS_Type), lval(BoxedVarLval))) },
- { Code = mlds__statement(atomic(Assign), Context) }.
-
- % generate code to box an output argument
- % *arg = box(unboxed_arg);
-:- pred ml_gen_box_arg(var_name, var_name, prog_type, mlds__context,
- mlds__statement, ml_gen_info, ml_gen_info).
-:- mode ml_gen_box_arg(in, in, in, in, out, in, out) is det.
-
-ml_gen_box_arg(BoxedVarName, UnboxedVarName, Type, Context, Code) -->
- ml_qualify_var(BoxedVarName, BoxedVarLval),
- ml_qualify_var(UnboxedVarName, UnboxedVarLval),
- { MLDS_Type = mercury_type_to_mlds_type(Type) },
- { Assign = assign(mem_ref(lval(BoxedVarLval)),
- unop(box(MLDS_Type), lval(UnboxedVarLval))) },
- { Code = mlds__statement(atomic(Assign), Context) }.
-
% convert a cons_id for a given type to a cons_tag
:- pred ml_cons_id_to_tag(cons_id, prog_type, cons_tag,
ml_gen_info, ml_gen_info).
@@ -4019,7 +4190,7 @@
pred_info_arg_types(PredInfo, HeadTypes),
proc_info_argmodes(ProcInfo, HeadModes),
proc_info_interface_code_model(ProcInfo, CodeModel),
- HeadVarNames = list__map(ml_gen_var_name(VarSet), HeadVars),
+ HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
FuncParams = ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes,
HeadModes, CodeModel).
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list