Files
mercury/compiler/lambda.m
Zoltan Somogyi 5013dd9c76 Implement nondet pragma C codes.
Estimated hours taken: 40

Implement nondet pragma C codes.

runtime/mercury_stacks.h:
	Define a new macro, mkpragmaframe, for use in the implementation
	of nondet pragma C codes. This new macro includes space for a
	struct with a given sruct tag in the nondet stack frame being created.

compiler/{prog_data.m,hlds_goal.m}:
	Revise the representation of pragma C codes, both as the item and
	in the HLDS.

compiler/prog_io_pragma.m:
	Parse nondet pragma C declarations.

	Fix the indentation in some places.

compiler/llds.m:
	Include an extra argument in mkframe instructions. This extra argument
	gives the details of the C structure (if any) to be included in the
	nondet stack frame to be created.

	Generalize the LLDS representation of pragma C codes. Instead of a
	fixed sequence of <assign from inputs, user c code, assign to outputs>,
	let the sequence contain these elements, as well as arbitrary
	compiler-generated C code, in any order and possibly with repetitions.
	This flexibility is needed for nondet pragma C codes.

	Add a field to pragma C codes to say whether they can call Mercury.
	Some optimizations can do a better job if they know that a pragma C
	code cannot call Mercury.

	Add another field to pragma C codes to give the name of the label
	they refer to (if any). This is needed to prevent labelopt from
	incorrectly optimizing away the label definition.

	Add a new alternative to the type pragma_c_decl, to describe the
	declaration of the local variable that points to the save struct.

compiler/llds_out.m:
	Output mkframe instructions that specify a struct as invoking the new
	mkpragmaframe macro, and make sure that the struct is declared just
	before the procedure that uses it.

	Other minor changes to keep up with the changes to the representation
	of pragma C code in the LLDS, and to make the output look a bit nicer.

compiler/pragma_c_gen.m:
	Add code to generate code for nondet pragma C codes. Revise the utility
	predicates and their data structures a bit to make this possible.

compiler/code_gen.m:
	Add code for the necessary special handling of prologs and epilogs
	of procedures defined by nondet pragma C codes. The prologs need
	to be modified to include a programmer-defined C structure in the
	nondet stack frame and to communicate the location of this structure
	to the pragma C code, whereas the functionality of the epilog is
	taken care of by the pragma C code itself.

compiler/make_hlds.m:
	When creating a proc_info for a procedure defined by a pragma C code,
	we used to insert unifications between the headvars and the vars of
	the pragma C code into the body goal. We now perform substitutions
	instead. This removes a factor that would complicate the generation
	of code for nondet pragma C codes.

	Pass a moduleinfo down the procedures that warn about singletons
	(and other basic scope errors). When checking whether to warn about
	an argument of a pragma C code not being mentioned in the C code
	fragment, we need to know whether the argument is input or output,
	since input variables should appear in some code fragments in a
	nondet pragma C code and must not appear in others. The
	mode_is_{in,out}put checks need the moduleinfo.

	(We do not need to check for any variables being mentioned where
	they shouldn't be. The C compiler will fail in the presence of any
	errors of that type, and since those variables could be referred
	to via macros whose definitions we do not see, we couldn't implement
	a reliable test anyway.)

compiler/opt_util.m:
	Recognize that some sorts of pragma_c codes cannot affect the data
	structures that control backtracking. This allows peepholing to
	do a better job on code sequences produced for nondet pragma C codes.

	Recognize that the C code strings inside some pragma_c codes refer to
	other labels in the procedure. This prevents labelopt from incorrectly
	optimizing away these labels.

compiler/dupelim.m:
	If a label is referred to from within a C code string, then do not
	attempt to optimize it away.

compiler/det_analysis.m:
	Remove a now incorrect part of an error message.

compiler/*.m:
	Minor changes to conform to changes to the HLDS and LLDS data
	structures.
1998-01-13 10:14:23 +00:00

489 lines
18 KiB
Mathematica

%-----------------------------------------------------------------------------%
% Copyright (C) 1995-1998 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: lambda.m
% main author: fjh
% This module is a pass over the HLDS to deal with lambda expressions.
%
% Lambda expressions are converted into separate predicates, so for
% example we translate
%
% :- pred p(int::in) is det.
% p(X) :-
% V__1 = lambda([Y::out] is nondet, q(Y, X))),
% solutions(V__1, List),
% ...
% :- pred q(int::out, int::in) is nondet.
%
% into
%
% p(X) :-
% V__1 = '__LambdaGoal__1'(X)
% solutions(V__1, List),
% ...
%
% :- pred '__LambdaGoal__1'(int::in, int::out) is nondet.
% '__LambdaGoal__1'(X, Y) :- q(Y, X).
%
%
%
% Note: Support for lambda expressions which involve class constraints
% is not yet complete.
%-----------------------------------------------------------------------------%
:- module (lambda).
:- interface.
:- import_module hlds_module, hlds_pred, prog_data.
:- import_module list, set, map, term, varset.
:- pred lambda__process_pred(pred_id, module_info, module_info).
:- mode lambda__process_pred(in, in, out) is det.
:- pred lambda__transform_lambda(pred_or_func, string, list(var), list(mode),
determinism, set(var), hlds_goal, unification,
varset, map(var, type), list(class_constraint), tvarset,
map(tvar, type_info_locn), map(class_constraint, var),
module_info, unify_rhs, unification, module_info).
:- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in, in,
in, in, in, out, out, out) is det.
% Permute the list of variables so that inputs come before outputs.
:- pred lambda__permute_argvars(list(var), list(mode), module_info,
list(var), list(mode)).
:- mode lambda__permute_argvars(in, in, in, out, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_goal, hlds_data, make_hlds.
:- import_module prog_util, mode_util, inst_match, llds.
:- import_module bool, string, std_util, require.
:- type lambda_info --->
lambda_info(
varset, % from the proc_info
map(var, type), % from the proc_info
list(class_constraint), % from the pred_info
tvarset, % from the proc_info
map(tvar, type_info_locn),
% from the proc_info
% (typeinfos)
map(class_constraint, var),
% from the proc_info
% (typeclass_infos)
pred_or_func,
string, % pred/func name
module_info
).
%-----------------------------------------------------------------------------%
% This whole section just traverses the module structure.
lambda__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
pred_info_procids(PredInfo, ProcIds),
lambda__process_procs(PredId, ProcIds, ModuleInfo0, ModuleInfo).
:- pred lambda__process_procs(pred_id, list(proc_id), module_info, module_info).
:- mode lambda__process_procs(in, in, in, out) is det.
lambda__process_procs(_PredId, [], ModuleInfo, ModuleInfo).
lambda__process_procs(PredId, [ProcId | ProcIds], ModuleInfo0, ModuleInfo) :-
lambda__process_proc(PredId, ProcId, ModuleInfo0, ModuleInfo1),
lambda__process_procs(PredId, ProcIds, ModuleInfo1, ModuleInfo).
:- pred lambda__process_proc(pred_id, proc_id, module_info, module_info).
:- mode lambda__process_proc(in, in, in, out) is det.
lambda__process_proc(PredId, ProcId, ModuleInfo0, ModuleInfo) :-
module_info_preds(ModuleInfo0, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
lambda__process_proc_2(ProcInfo0, PredInfo0, ModuleInfo0,
ProcInfo, PredInfo1, ModuleInfo1),
pred_info_procedures(PredInfo1, ProcTable1),
map__det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(PredInfo1, ProcTable, PredInfo),
module_info_preds(ModuleInfo1, PredTable1),
map__det_update(PredTable1, PredId, PredInfo, PredTable),
module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo).
:- pred lambda__process_proc_2(proc_info, pred_info, module_info,
proc_info, pred_info, module_info).
:- mode lambda__process_proc_2(in, in, in, out, out, out) is det.
lambda__process_proc_2(ProcInfo0, PredInfo0, ModuleInfo0,
ProcInfo, PredInfo, ModuleInfo) :-
% grab the appropriate fields from the pred_info and proc_info
pred_info_name(PredInfo0, PredName),
pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
pred_info_typevarset(PredInfo0, TypeVarSet0),
pred_info_get_class_context(PredInfo0, Constraints0),
proc_info_varset(ProcInfo0, VarSet0),
proc_info_vartypes(ProcInfo0, VarTypes0),
proc_info_goal(ProcInfo0, Goal0),
proc_info_typeinfo_varmap(ProcInfo0, TVarMap0),
proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap0),
% process the goal
Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
TVarMap0, TCVarMap0, PredOrFunc, PredName, ModuleInfo0),
lambda__process_goal(Goal0, Goal, Info0, Info),
Info = lambda_info(VarSet, VarTypes, Constraints, TypeVarSet,
TVarMap, TCVarMap, _, _, ModuleInfo),
% set the new values of the fields in proc_info and pred_info
proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
proc_info_set_varset(ProcInfo1, VarSet, ProcInfo2),
proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo3),
proc_info_set_typeinfo_varmap(ProcInfo3, TVarMap, ProcInfo4),
proc_info_set_typeclass_info_varmap(ProcInfo4, TCVarMap, ProcInfo),
pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
pred_info_set_class_context(PredInfo1, Constraints, PredInfo).
:- pred lambda__process_goal(hlds_goal, hlds_goal,
lambda_info, lambda_info).
:- mode lambda__process_goal(in, out, in, out) is det.
lambda__process_goal(Goal0 - GoalInfo0, Goal) -->
lambda__process_goal_2(Goal0, GoalInfo0, Goal).
:- pred lambda__process_goal_2(hlds_goal_expr, hlds_goal_info,
hlds_goal, lambda_info, lambda_info).
:- mode lambda__process_goal_2(in, in, out, in, out) is det.
lambda__process_goal_2(unify(XVar, Y, Mode, Unification, Context), GoalInfo,
Unify - GoalInfo) -->
( { Y = lambda_goal(PredOrFunc, Vars, Modes, Det, LambdaGoal0) } ->
% for lambda expressions, we must convert the lambda expression
% into a new predicate
{ LambdaGoal0 = _ - GoalInfo0 },
{ goal_info_get_nonlocals(GoalInfo0, NonLocals0) },
lambda__process_lambda(PredOrFunc, Vars, Modes, Det, NonLocals0,
LambdaGoal0, Unification, Y1, Unification1),
{ Unify = unify(XVar, Y1, Mode, Unification1, Context) }
;
% ordinary unifications are left unchanged
{ Unify = unify(XVar, Y, Mode, Unification, Context) }
).
% the rest of the clauses just process goals recursively
lambda__process_goal_2(conj(Goals0), GoalInfo, conj(Goals) - GoalInfo) -->
lambda__process_goal_list(Goals0, Goals).
lambda__process_goal_2(disj(Goals0, SM), GoalInfo, disj(Goals, SM) - GoalInfo)
-->
lambda__process_goal_list(Goals0, Goals).
lambda__process_goal_2(not(Goal0), GoalInfo, not(Goal) - GoalInfo) -->
lambda__process_goal(Goal0, Goal).
lambda__process_goal_2(switch(Var, CanFail, Cases0, SM), GoalInfo,
switch(Var, CanFail, Cases, SM) - GoalInfo) -->
lambda__process_cases(Cases0, Cases).
lambda__process_goal_2(some(Vars, Goal0), GoalInfo,
some(Vars, Goal) - GoalInfo) -->
lambda__process_goal(Goal0, Goal).
lambda__process_goal_2(if_then_else(Vars, A0, B0, C0, SM), GoalInfo,
if_then_else(Vars, A, B, C, SM) - GoalInfo) -->
lambda__process_goal(A0, A),
lambda__process_goal(B0, B),
lambda__process_goal(C0, C).
lambda__process_goal_2(higher_order_call(A,B,C,D,E,F), GoalInfo,
higher_order_call(A,B,C,D,E,F) - GoalInfo) -->
[].
lambda__process_goal_2(class_method_call(A,B,C,D,E,F), GoalInfo,
class_method_call(A,B,C,D,E,F) - GoalInfo) -->
[].
lambda__process_goal_2(call(A,B,C,D,E,F), GoalInfo,
call(A,B,C,D,E,F) - GoalInfo) -->
[].
lambda__process_goal_2(pragma_c_code(A,B,C,D,E,F,G), GoalInfo,
pragma_c_code(A,B,C,D,E,F,G) - GoalInfo) -->
[].
:- pred lambda__process_goal_list(list(hlds_goal), list(hlds_goal),
lambda_info, lambda_info).
:- mode lambda__process_goal_list(in, out, in, out) is det.
lambda__process_goal_list([], []) --> [].
lambda__process_goal_list([Goal0 | Goals0], [Goal | Goals]) -->
lambda__process_goal(Goal0, Goal),
lambda__process_goal_list(Goals0, Goals).
:- pred lambda__process_cases(list(case), list(case),
lambda_info, lambda_info).
:- mode lambda__process_cases(in, out, in, out) is det.
lambda__process_cases([], []) --> [].
lambda__process_cases([case(ConsId, Goal0) | Cases0],
[case(ConsId, Goal) | Cases]) -->
lambda__process_goal(Goal0, Goal),
lambda__process_cases(Cases0, Cases).
:- pred lambda__process_lambda(pred_or_func, list(var), list(mode), determinism,
set(var), hlds_goal, unification, unify_rhs, unification,
lambda_info, lambda_info).
:- mode lambda__process_lambda(in, in, in, in, in, in, in, out, out,
in, out) is det.
lambda__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals0, LambdaGoal,
Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, POF, PredName, ModuleInfo0),
lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
Unification, ModuleInfo),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, POF, PredName, ModuleInfo).
lambda__transform_lambda(PredOrFunc, OrigPredName, Vars, Modes, Detism,
OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
Unification, ModuleInfo) :-
(
Unification0 = construct(Var0, _, _, UniModes0)
->
Var = Var0,
UniModes = UniModes0
;
error("polymorphism__transform_lambda: weird unification")
),
% Optimize a special case: replace
% `lambda([Y1, Y2, ...] is Detism, p(X1, X2, ..., Y1, Y2, ...))'
% where `p' has determinism `Detism' with
% `p(X1, X2, ...)'
%
% This optimization is only valid if the modes of the Xi are
% input, since only input arguments can be curried.
% It's also only valid if all the inputs in the Yi precede the
% outputs. It's also not valid if any of the Xi are in the Yi.
LambdaGoal = _ - LambdaGoalInfo,
goal_info_get_nonlocals(LambdaGoalInfo, NonLocals0),
set__delete_list(NonLocals0, Vars, NonLocals),
set__to_sorted_list(NonLocals, ArgVars1),
(
LambdaGoal = call(PredId0, ProcId0, CallVars,
_, _, PredName0) - _,
list__remove_suffix(CallVars, Vars, InitialVars),
% check that none of the variables that we're trying to
% use as curried arguments are lambda-bound variables
\+ (
list__member(InitialVar, InitialVars),
list__member(InitialVar, Vars)
),
module_info_pred_proc_info(ModuleInfo0, PredId0, ProcId0, _,
Call_ProcInfo),
proc_info_interface_code_model(Call_ProcInfo, Call_CodeModel),
determinism_to_code_model(Detism, CodeModel),
% Check that the code models are compatible.
% Note that det is not compatible with semidet,
% and semidet is not compatible with nondet,
% since the arguments go in different registers.
% But det is compatible with nondet.
( CodeModel = Call_CodeModel
; CodeModel = model_non, Call_CodeModel = model_det
),
% check that the curried arguments are all input
proc_info_argmodes(Call_ProcInfo, Call_ArgModes),
list__length(InitialVars, NumInitialVars),
list__split_list(NumInitialVars, Call_ArgModes,
CurriedArgModes, UncurriedArgModes),
\+ ( list__member(Mode, CurriedArgModes),
\+ mode_is_input(ModuleInfo0, Mode)
),
% and that all the inputs precede the outputs
inputs_precede_outputs(UncurriedArgModes, ModuleInfo0)
->
ArgVars = InitialVars,
PredId = PredId0,
ProcId = ProcId0,
PredName = PredName0,
ModuleInfo = ModuleInfo0,
NumArgVars = NumInitialVars
;
% Prepare to create a new predicate for the lambda
% expression: work out the arguments, module name, predicate
% name, arity, arg types, determinism,
% context, status, etc. for the new predicate,
% and permute the arguments so that all inputs come before
% all outputs. (When the predicate is called, the arguments
% will be similarly permuted, so they will match up.)
ArgVars = ArgVars1,
list__append(ArgVars, Vars, AllArgVars),
module_info_name(ModuleInfo0, ModuleName),
module_info_next_lambda_count(ModuleInfo0, LambdaCount,
ModuleInfo1),
goal_info_get_context(LambdaGoalInfo, OrigContext),
term__context_line(OrigContext, OrigLine),
make_lambda_name(ModuleName, PredOrFunc, OrigPredName,
OrigLine, LambdaCount, PredName),
goal_info_get_context(LambdaGoalInfo, LambdaContext),
% the TVarSet is a superset of what it really ought be,
% but that shouldn't matter
lambda__uni_modes_to_modes(UniModes, OrigArgModes),
% We have to jump through hoops to work out the mode
% of the lambda predicate. For introduced
% type_info arguments, we use the mode "in". For the original
% non-local vars, we use the modes from `UniModes'.
% For the lambda var arguments at the end,
% we use the mode in the lambda expression.
list__length(ArgVars, NumArgVars),
In = user_defined_mode(qualified("mercury_builtin", "in"), []),
list__duplicate(NumArgVars, In, InModes),
map__from_corresponding_lists(ArgVars, InModes,
ArgModesMap),
set__delete_list(OrigNonLocals0, Vars, OrigNonLocals),
set__to_sorted_list(OrigNonLocals, OrigArgVars),
map__from_corresponding_lists(OrigArgVars, OrigArgModes,
OrigArgModesMap),
map__overlay(ArgModesMap, OrigArgModesMap, ArgModesMap1),
map__values(ArgModesMap1, ArgModes1),
list__append(ArgModes1, Modes, AllArgModes),
% Even after we've done all that, we still need to
% permute the argument variables so that all the inputs
% come before all the outputs.
lambda__permute_argvars(AllArgVars, AllArgModes, ModuleInfo1,
PermutedArgVars, PermutedArgModes),
map__apply_to_list(PermutedArgVars, VarTypes, ArgTypes),
% Now construct the proc_info and pred_info for the new
% single-mode predicate, using the information computed above
proc_info_create(VarSet, VarTypes, PermutedArgVars,
PermutedArgModes, Detism, LambdaGoal, LambdaContext,
TVarMap, TCVarMap, ProcInfo),
init_markers(Markers),
pred_info_create(ModuleName, PredName, TVarSet, ArgTypes,
true, LambdaContext, local, Markers, PredOrFunc,
Constraints, ProcInfo, ProcId, PredInfo),
% save the new predicate in the predicate table
module_info_get_predicate_table(ModuleInfo1, PredicateTable0),
predicate_table_insert(PredicateTable0, PredInfo,
PredId, PredicateTable),
module_info_set_predicate_table(ModuleInfo1, PredicateTable,
ModuleInfo)
),
Functor = functor(cons(PredName, NumArgVars), ArgVars),
ConsId = pred_const(PredId, ProcId),
Unification = construct(Var, ConsId, ArgVars, UniModes).
:- pred make_lambda_name(string, pred_or_func, string, int, int, sym_name).
:- mode make_lambda_name(in, in, in, in, in, out) is det.
make_lambda_name(ModuleName, PredOrFunc, PredName, Line, Counter, SymName) :-
(
PredOrFunc = predicate,
PFS = "pred"
;
PredOrFunc = function,
PFS = "func"
),
string__format("IntroducedFrom__%s__%s__%d__%d",
[s(PFS), s(PredName), i(Line), i(Counter)], Name),
SymName = qualified(ModuleName, Name).
:- pred lambda__uni_modes_to_modes(list(uni_mode), list(mode)).
:- mode lambda__uni_modes_to_modes(in, out) is det.
% This predicate works out the modes of the original non-local
% variables of a lambda expression based on the list of uni_mode
% in the unify_info for the lambda unification.
lambda__uni_modes_to_modes([], []).
lambda__uni_modes_to_modes([UniMode | UniModes], [Mode | Modes]) :-
UniMode = ((_Initial0 - Initial1) -> (_Final0 - _Final1)),
Mode = (Initial1 -> Initial1),
lambda__uni_modes_to_modes(UniModes, Modes).
:- pred inputs_precede_outputs(list(mode), module_info).
:- mode inputs_precede_outputs(in, in) is semidet.
% succeed iff all the inputs in the list of modes precede the outputs
inputs_precede_outputs([], _).
inputs_precede_outputs([Mode | Modes], ModuleInfo) :-
( mode_is_input(ModuleInfo, Mode) ->
inputs_precede_outputs(Modes, ModuleInfo)
;
% the following is an if-then-else rather than a
% negation purely because the compiler got an internal
% error compiling it when it was a negation
(
list__member(OtherMode, Modes),
mode_is_input(ModuleInfo, OtherMode)
->
fail
;
true
)
).
% permute a list of variables and a corresponding list of their modes
% so that all the input variables precede all the output variables.
lambda__permute_argvars(AllArgVars, AllArgModes, ModuleInfo,
PermutedArgVars, PermutedArgModes) :-
( split_argvars(AllArgVars, AllArgModes, ModuleInfo,
InArgVars, InArgModes, OutArgVars, OutArgModes) ->
list__append(InArgVars, OutArgVars, PermutedArgVars),
list__append(InArgModes, OutArgModes, PermutedArgModes)
;
error("lambda__permute_argvars: split_argvars failed")
).
:- pred split_argvars(list(var), list(mode), module_info,
list(var), list(mode), list(var), list(mode)).
:- mode split_argvars(in, in, in, out, out, out, out) is semidet.
% split a list of variables and a corresponding list of their modes
% into the input vars/modes and the output vars/modes.
split_argvars([], [], _, [], [], [], []).
split_argvars([Var|Vars], [Mode|Modes], ModuleInfo,
InVars, InModes, OutVars, OutModes) :-
split_argvars(Vars, Modes, ModuleInfo,
InVars0, InModes0, OutVars0, OutModes0),
( mode_is_input(ModuleInfo, Mode) ->
InVars = [Var|InVars0],
InModes = [Mode|InModes0],
OutVars = OutVars0,
OutModes = OutModes0
;
InVars = InVars0,
InModes = InModes0,
OutVars = [Var|OutVars0],
OutModes = [Mode|OutModes0]
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%