mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 09:23:44 +00:00
Code Issues Projects Releases Wiki Activity
Files
814f644c73dbb8fc272cceb01c52bb90b45eb63c
mercury/compiler/superhomogeneous_lambda.m
Zoltan Somogyi b560f66ab9 Move four modules from check_hlds.m to hlds.m. 
After this, I think all modules in the check_hlds package belong there.

compiler/inst_match.m:
compiler/mode_test.m:
    Move these modules from the check_hlds package to the hlds package
    because most of their uses are outside the semantic analysis passes
    that the check_hlds package is intended to contain.

compiler/inst_merge.m:
    Move this module from the check_hlds package to the hlds package
    because it is imported by only two modules, instmap.m and inst_match.m,
    and after this diff, both are in the hlds package.

compiler/implementation_defined_literals.m:
    Move this module from the check_hlds package to the hlds package
    because it does a straightforward program transformation that
    does not have anything to do with semantic analysis (though its
    invocation does happen between semantic analysis passes).

compiler/notes/compiler_design.html:
    Update the documentation of the goal_path.m module. (I checked the
    documentation of the moved modules, which did not need updates,
    and found the need for this instead.)

compiler/*.m:
    Conform to the changes above. (For many modules, this deletes
    their import of the check_hlds package itself.)
2026-02-27 15:16:44 +11:00

995 lines
41 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% Copyright (C) 2014-2021, 2025-2026 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: superhomogeneous_lambda.m.
% Main author of the original version of this module: fjh.
% Main author of the current version of this module: zs.
%
% This module performs the conversion of lambda expressions in clause bodies
% to superhomogeneous form.
%
%---------------------------------------------------------------------------%
:- module hlds.make_hlds.superhomogeneous_lambda.
:- interface.
:- import_module hlds.hlds_goal.
:- import_module hlds.make_hlds.state_var.
:- import_module hlds.make_hlds.superhomogeneous_util.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module list.
:- import_module maybe.
:- type lambda_body_kind
---> lambda_body_ordinary
; lambda_body_dcg.
:- pred parse_lambda_expr(prog_var::in, purity::in,
prog_context::in, unify_main_context::in, list(unify_sub_context)::in,
prog_term::in, maybe({lambda_body_kind, prog_term})::in, expansion::out,
svar_state::in, unravel_info::in, unravel_info::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module hlds.goal_vars.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_goal.
:- import_module hlds.make_goal.
:- import_module hlds.make_hlds.goal_expr_to_goal.
:- import_module hlds.make_hlds.qual_info.
:- import_module hlds.make_hlds.superhomogeneous.
:- import_module hlds.mode_test.
:- import_module hlds.mode_util.
:- import_module hlds.passes_aux.
:- import_module hlds.status.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.module_qual.
:- import_module parse_tree.module_qual.id_set.
:- import_module parse_tree.module_qual.mq_info.
:- import_module parse_tree.module_qual.qualify_items.
:- import_module parse_tree.parse_dcg_goal.
:- import_module parse_tree.parse_goal.
:- import_module parse_tree.parse_inst_mode_name.
:- import_module parse_tree.parse_tree_out_misc.
:- import_module parse_tree.parse_tree_out_term.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_util.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_db.
:- import_module cord.
:- import_module int.
:- import_module io.
:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term.
:- import_module term_vars.
:- import_module varset.
%---------------------------------------------------------------------------%
%
% Code for parsing pred/func expressions.
%
parse_lambda_expr(XVar, Purity, Context, MainContext, SubContext,
PurityPFArgsDetTerm, MaybeLambdaBody, Expansion, SVarState, !UrInfo) :-
(
MaybeLambdaBody = no,
TrueGoal = true_expr(Context),
MaybeBodyGoal = ok1(TrueGoal),
MaybeDCGVars = no_dcg_vars
;
MaybeLambdaBody = yes({LambdaBodyKind, BodyGoalTerm}),
ContextPieces = cord.singleton(
words("In the body of lambda expression:")),
term.coerce(BodyGoalTerm, GenericBodyGoalTerm),
VarSet0 = !.UrInfo ^ ui_varset,
(
LambdaBodyKind = lambda_body_ordinary,
parse_goal(GenericBodyGoalTerm, ContextPieces,
MaybeBodyGoal0, VarSet0, VarSet),
MaybeDCGVars = no_dcg_vars
;
LambdaBodyKind = lambda_body_dcg,
parse_dcg_pred_goal(GenericBodyGoalTerm, ContextPieces,
MaybeBodyGoal0, DCGVar0, DCGVarN, VarSet0, VarSet),
MaybeDCGVars = dcg_vars(DCGVar0, DCGVarN)
),
!UrInfo ^ ui_varset := VarSet,
(
MaybeBodyGoal0 = ok2(BodyGoal, BodyGoalWarningSpecs),
add_unravel_specs(BodyGoalWarningSpecs, !UrInfo),
MaybeBodyGoal = ok1(BodyGoal)
;
MaybeBodyGoal0 = error2(BodyGoalSpecs),
MaybeBodyGoal = error1(BodyGoalSpecs)
)
),
parse_lambda_purity_pf_args_det_term(PurityPFArgsDetTerm, MaybeDCGVars,
MaybeLambdaHead, !UrInfo),
(
MaybeLambdaHead = error1(LambdaHeadSpecs),
add_unravel_specs(LambdaHeadSpecs, !UrInfo),
record_unravel_found_syntax_error(!UrInfo),
Expansion = expansion(not_fgti, cord.empty)
;
MaybeLambdaHead = ok1(LambdaHead),
build_lambda_expression(XVar, Purity, Context, MainContext, SubContext,
LambdaHead, MaybeBodyGoal, Expansion, SVarState, !UrInfo)
).
:- type maybe_dcg_vars
---> no_dcg_vars
; dcg_vars(prog_var, prog_var).
:- pred parse_lambda_purity_pf_args_det_term(prog_term::in, maybe_dcg_vars::in,
maybe1(lambda_head)::out,
unravel_info::in, unravel_info::out) is det.
parse_lambda_purity_pf_args_det_term(PurityPFArgsDetTerm, MaybeDCGVars,
MaybeLambdaHead, !UrInfo) :-
term.coerce(PurityPFArgsDetTerm, GenericPurityPFArgsDetTerm),
parse_purity_annotation(GenericPurityPFArgsDetTerm, LambdaPurity,
PFArgsDetTerm),
% A summary of the term structures that the two conditions of the nested
% if-then-else below look for:
%
% (
% % Condition 1p:
% PFArgsDetTerm = is(BeforeIsTerm, DetismTerm),
% ( BeforeIsTerm = pred(...) ; BeforeIsTerm = any_pred(...) )
% ;
% % Condition 1f:
% PFArgsDetTerm = is(BeforeIsTerm, DetismTerm),
% BeforeIsTerm = "="(FuncArgsTerm, FuncRetTerm),
% ( FuncArgsTerm = func(...) ; FuncArgsTerm = any_func(...) )
% ;
% % Condition 2f:
% PFArgsDetTerm = "="(FuncArgsTerm, FuncRetTerm),
% ( FuncArgsTerm = func(...) ; FuncArgsTerm = any_func(...) )
% )
( if
PFArgsDetTerm = term.functor(term.atom("is"),
[BeforeIsTerm, DetismTerm], _),
BeforeIsTerm = term.functor(term.atom(BeforeIsFunctor),
BeforeIsArgTerms, Context),
(
% Condition 1p.
(
BeforeIsFunctor = "pred",
Groundness = ho_ground
;
BeforeIsFunctor = "any_pred",
Groundness = ho_any
),
ArgModeTerms0 = BeforeIsArgTerms,
MaybeFuncRetArgModeTerm = no
;
% Condition 1f.
BeforeIsFunctor = "=",
BeforeIsArgTerms = [FuncArgsTerm, FuncRetArgModeTerm0],
FuncArgsTerm = term.functor(term.atom(FuncTermFunctor),
ArgModeTerms0, _),
(
FuncTermFunctor = "func",
Groundness = ho_ground
;
FuncTermFunctor = "any_func",
Groundness = ho_any
),
MaybeFuncRetArgModeTerm = yes(FuncRetArgModeTerm0)
)
then
VarSet0 = !.UrInfo ^ ui_varset,
parse_lambda_detism(VarSet0, DetismTerm, MaybeDetism),
(
MaybeFuncRetArgModeTerm = no,
PredOrFunc = pf_predicate,
(
MaybeDCGVars = no_dcg_vars,
ArgModeTerms = ArgModeTerms0,
parse_lambda_args_pred(Context, ArgModeTerms,
LambdaArgs, BadModeSpecs, SVarSpecs, !UrInfo),
LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
LambdaArgs, BadModeSpecs, SVarSpecs, MaybeDetism),
MaybeLambdaHead = ok1(LambdaHead)
;
MaybeDCGVars = dcg_vars(DCGVar0, DCGVarN),
(
( ArgModeTerms0 = []
; ArgModeTerms0 = [_]
),
Pieces = [words("Error:")] ++
color_as_subject([words("the head of a"),
words("lambda expression that is defined"),
words("by a DCG clause")]) ++
color_as_incorrect([words("must have"),
words("at least two arguments.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h,
Context, Pieces),
MaybeLambdaHead =
error1([Spec | get_any_errors1(MaybeDetism)])
;
ArgModeTerms0 =
[ArgModeTerm1, ArgModeTerm2 | ArgModeTerms3plus],
split_last_two(
ArgModeTerm1, ArgModeTerm2, ArgModeTerms3plus,
NonDCGArgModeTerms, DCGModeTerm0, DCGModeTermN),
DCGContext0 = get_term_context(DCGModeTerm0),
DCGContextN = get_term_context(DCGModeTermN),
DCGVarTerm0 = term.variable(DCGVar0, DCGContext0),
DCGVarTermN = term.variable(DCGVarN, DCGContextN),
term.coerce(DCGVarTerm0, GenericDCGVarTerm0),
term.coerce(DCGVarTermN, GenericDCGVarTermN),
DCGArgModeTerm0 = term.functor(term.atom("::"),
[GenericDCGVarTerm0, DCGModeTerm0], DCGContext0),
DCGArgModeTermN = term.functor(term.atom("::"),
[GenericDCGVarTermN, DCGModeTermN], DCGContextN),
ArgModeTerms = NonDCGArgModeTerms ++
[DCGArgModeTerm0, DCGArgModeTermN],
parse_lambda_args_pred(Context, ArgModeTerms,
LambdaArgs, BadModeSpecs, SVarSpecs, !UrInfo),
LambdaHead = lambda_head(LambdaPurity, Groundness,
PredOrFunc, LambdaArgs,
BadModeSpecs, SVarSpecs, MaybeDetism),
MaybeLambdaHead = ok1(LambdaHead)
)
)
;
MaybeFuncRetArgModeTerm = yes(FuncRetArgModeTerm),
PredOrFunc = pf_function,
(
MaybeDCGVars = no_dcg_vars,
parse_lambda_args_func(Context,
ArgModeTerms0, FuncRetArgModeTerm,
LambdaArgs, BadModeSpecs, SVarSpecs, !UrInfo),
LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
LambdaArgs, BadModeSpecs, SVarSpecs, MaybeDetism),
MaybeLambdaHead = ok1(LambdaHead)
;
MaybeDCGVars = dcg_vars(_, _),
Pieces = [words("Error: DCG notation is")] ++
color_as_incorrect([words("not allowed")]) ++
[words("in")] ++
color_as_subject([words("clauses for functions.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h,
Context, Pieces),
MaybeLambdaHead = error1([Spec | get_any_errors1(MaybeDetism)])
)
)
else if
% Condition 2f.
%
% We are looking for the same term structure as condition 1b,
% minus the outer "is detism" wrapper. This is why the structure
% of this code, and the variable names, resemble condition 1b.
PFArgsDetTerm = term.functor(term.atom(BeforeIsFunctor),
BeforeIsArgTerms, Context),
BeforeIsFunctor = "=",
BeforeIsArgTerms = [FuncArgsTerm, FuncRetArgModeTerm],
FuncArgsTerm = term.functor(term.atom(FuncTermFunctor),
ArgModeTerms, _),
(
FuncTermFunctor = "func",
Groundness = ho_ground
;
FuncTermFunctor = "any_func",
Groundness = ho_any
)
then
PredOrFunc = pf_function,
% XXX Should we require that ArgModeTerms and FuncRetArgModeTerm
% *must* have no explicit mode annotations?
(
MaybeDCGVars = no_dcg_vars,
parse_lambda_args_func(Context, ArgModeTerms, FuncRetArgModeTerm,
LambdaArgs, BadModeSpecs, SVarSpecs, !UrInfo),
MaybeDetism = ok1(detism_det),
LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
LambdaArgs, BadModeSpecs, SVarSpecs, MaybeDetism),
MaybeLambdaHead = ok1(LambdaHead)
;
MaybeDCGVars = dcg_vars(_, _),
Pieces = [words("Error: DCG notation is")] ++
color_as_incorrect([words("not allowed")]) ++
[words("in")] ++
color_as_subject([words("clauses for functions.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
MaybeLambdaHead = error1([Spec])
)
else
Form1 = "pred(<args>) is <determinism>",
Form2 = "any_pred(<args>) is <determinism>",
Form3 = "func(<args>) = <retarg> is <determinism>",
Form4 = "any_func(<args>) = <retarg> is <determinism>",
Form5 = "func(<args>) = <retarg>",
Form6 = "any_func(<args>) = <retarg>",
Pieces =
[words("Error: the clause head part of a lambda expression")] ++
color_as_incorrect(
[words("must have one of the following forms:")]) ++
color_as_correct([quote(Form1)]) ++ [nl] ++
color_as_correct([quote(Form2)]) ++ [nl] ++
color_as_correct([quote(Form3)]) ++ [nl] ++
color_as_correct([quote(Form4)]) ++ [nl] ++
color_as_correct([quote(Form5)]) ++ [nl] ++
color_as_correct([quote(Form6)]) ++ [suffix(","), nl,
words("or one of those forms preceded by either"),
quote("semipure"), words("or"), quote("impure"), suffix("."), nl],
Context = get_term_context(PFArgsDetTerm),
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
record_unravel_found_syntax_error(!UrInfo),
MaybeLambdaHead = error1([Spec])
).
:- pred split_last_two(T::in, T::in, list(T)::in, list(T)::out, T::out, T::out)
is det.
split_last_two(Element1, Element2, Elements3plus, Main, LastButOne, Last) :-
(
Elements3plus = [],
Main = [],
LastButOne = Element1,
Last = Element2
;
Elements3plus = [Element3 | Elements4plus],
split_last_two(Element2, Element3, Elements4plus, MainTail,
LastButOne, Last),
Main = [Element1 | MainTail]
).
%---------------------------------------------------------------------------%
:- pred parse_lambda_args_func(term.context::in, list(term)::in, term::in,
list(lambda_arg)::out, list(error_spec)::out, list(error_spec)::out,
unravel_info::in, unravel_info::out) is det.
parse_lambda_args_func(Context, ArgModeTerms, FuncRetArgModeTerm,
LambdaArgs, !:BadModeSpecs, !:SVarSpecs, !UrInfo) :-
!:BadModeSpecs = [],
!:SVarSpecs = [],
parse_lambda_args(lambda_arg_ordinary,
ArgModeTerms, OrdinaryLambdaArgs, 1, ResultArgNum,
!BadModeSpecs, !SVarSpecs, !UrInfo),
parse_lambda_arg(lambda_arg_func_result,
FuncRetArgModeTerm, FuncRetLambdaArg, ResultArgNum, _,
!BadModeSpecs, !SVarSpecs, !UrInfo),
LambdaArgs = OrdinaryLambdaArgs ++ [FuncRetLambdaArg],
classify_lambda_arg_modes_present_absent(LambdaArgs,
PresentArgs, AbsentArgs),
(
AbsentArgs = []
% All arguments have explicit mode annotations.
;
AbsentArgs = [_ | _],
(
PresentArgs = []
% No arguments have explicit mode annotations.
% The argument modes that together constitute the default
% function mode have already been filled in.
;
PresentArgs = [_ | _],
add_some_not_all_args_have_modes_error(Context, AbsentArgs,
!BadModeSpecs)
)
).
:- pred parse_lambda_args_pred(term.context::in, list(term)::in,
list(lambda_arg)::out, list(error_spec)::out, list(error_spec)::out,
unravel_info::in, unravel_info::out) is det.
parse_lambda_args_pred(Context, ArgModeTerms,
LambdaArgs, !:BadModeSpecs, !:SVarSpecs, !UrInfo) :-
!:BadModeSpecs = [],
!:SVarSpecs = [],
parse_lambda_args(lambda_arg_ordinary, ArgModeTerms, LambdaArgs, 1, _,
!BadModeSpecs, !SVarSpecs, !UrInfo),
classify_lambda_arg_modes_present_absent(LambdaArgs,
PresentArgs, AbsentArgs),
(
AbsentArgs = []
% All arguments have explicit mode annotations.
;
AbsentArgs = [_ | _],
(
PresentArgs = [],
add_pred_no_args_have_modes_error(Context, !BadModeSpecs)
;
PresentArgs = [_ | _],
add_some_not_all_args_have_modes_error(Context, AbsentArgs,
!BadModeSpecs)
)
).
:- pred classify_lambda_arg_modes_present_absent(list(lambda_arg)::in,
list(lambda_arg)::out, list(lambda_arg)::out) is det.
classify_lambda_arg_modes_present_absent([], [], []).
classify_lambda_arg_modes_present_absent([LambdaArg | LambdaArgs],
PresentArgs, AbsentArgs) :-
classify_lambda_arg_modes_present_absent(LambdaArgs,
PresentArgsTail, AbsentArgsTail),
PresentOrAbsent = LambdaArg ^ la_arg_mode_presence,
(
PresentOrAbsent = lam_present,
PresentArgs = [LambdaArg | PresentArgsTail],
AbsentArgs = AbsentArgsTail
;
PresentOrAbsent = lam_absent,
PresentArgs = PresentArgsTail,
AbsentArgs = [LambdaArg | AbsentArgsTail]
).
:- pred add_some_not_all_args_have_modes_error(prog_context::in,
list(lambda_arg)::in,
list(error_spec)::in, list(error_spec)::out) is det.
add_some_not_all_args_have_modes_error(Context, AbsentArgs, !Specs) :-
AbsentArgPieces =
list.map(func(Arg) = nth_fixed(Arg ^ la_arg_num), AbsentArgs),
AbsentArgsDotPieces = piece_list_to_color_pieces(color_incorrect, "and",
[suffix(".")], AbsentArgPieces),
Pieces = [words("Error: in head of lambda expression:")] ++
color_as_incorrect(
[words("some but not all arguments have modes.")]) ++
[nl,
words("The arguments without modes are the")] ++
AbsentArgsDotPieces ++ [nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
!:Specs = [Spec | !.Specs].
:- pred add_pred_no_args_have_modes_error(prog_context::in,
list(error_spec)::in, list(error_spec)::out) is det.
add_pred_no_args_have_modes_error(Context, !Specs) :-
% We could use _AbsentArgs to make the error message more detailed.
Pieces = [words("Error: in head of predicate lambda expression:")] ++
color_as_incorrect([words("none of the arguments have modes.")]) ++
[nl],
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
!:Specs = [Spec | !.Specs].
%---------------------------------------------------------------------------%
:- type lambda_arg_kind
---> lambda_arg_ordinary
; lambda_arg_func_result.
:- type lambda_arg_mode_presence
---> lam_absent
; lam_present.
:- type lambda_arg
---> lambda_arg(
la_arg_num :: int,
la_arg_term :: prog_term,
la_arg_var :: prog_var,
la_kind :: lambda_arg_kind,
% If the lambda argument does not have a "::mode" annotation,
% the la_arg_mode_presence field will contain lam_absent,
% and the la_arg_mode field will contain the default mode
% for the argument position ("in" for ordinary arguments,
% "out" for function results).
%
% If the lambda argument does have a "::mode" annotation,
% the la_arg_mode_presence field will contain lam_present.
% If the mode annotation can be successfully parsed,
% the la_arg_mode field will contain that mode.
% If the mode annotation cannot be parsed, then
% the la_arg_mode field will contain the default mode
% for the argument position, as above, but the messages
% descrbing the error will be added to !BadModeSpecs.
la_arg_mode_presence :: lambda_arg_mode_presence,
la_arg_mode :: mer_mode,
% The context of the mode annotation, or if it is absent,
% the context of the argument.
la_arg_mode_context :: prog_context
).
:- func project_lambda_arg_term(lambda_arg) = prog_term.
project_lambda_arg_term(LambdaArg) = ArgTerm :-
ArgTerm = LambdaArg ^ la_arg_term.
:- func project_lambda_var(lambda_arg) = prog_var.
project_lambda_var(LambdaArg) = LambdaVar :-
LambdaVar = LambdaArg ^ la_arg_var.
:- func project_lambda_arg_mode(lambda_arg) = mer_mode.
project_lambda_arg_mode(LambdaArg) = Mode :-
Mode = LambdaArg ^ la_arg_mode.
:- func project_lambda_var_arg_mode(lambda_arg) = pair(prog_var, mer_mode).
project_lambda_var_arg_mode(LambdaArg) = LambdaVar - Mode :-
LambdaVar = LambdaArg ^ la_arg_var,
Mode = LambdaArg ^ la_arg_mode.
%---------------------------------------------------------------------------%
% Parse a list of lambda argument terms, each which should be of the form
% argterm::modeterm.
%
:- pred parse_lambda_args(lambda_arg_kind::in,
list(term)::in, list(lambda_arg)::out, int::in, int::out,
list(error_spec)::in, list(error_spec)::out,
list(error_spec)::in, list(error_spec)::out,
unravel_info::in, unravel_info::out) is det.
parse_lambda_args(_Kind, [], [], !ArgNum, !BadModeSpecs, !SVarSpecs, !UrInfo).
parse_lambda_args(Kind, [HeadArgModeTerm | TailArgModeTerms],
[HeadLambdaArg | TailLambdaArgs],
!ArgNum, !BadModeSpecs, !SVarSpecs, !UrInfo) :-
parse_lambda_arg(Kind, HeadArgModeTerm, HeadLambdaArg,
!ArgNum, !BadModeSpecs, !SVarSpecs, !UrInfo),
parse_lambda_args(Kind, TailArgModeTerms, TailLambdaArgs,
!ArgNum, !BadModeSpecs, !SVarSpecs, !UrInfo).
:- pred parse_lambda_arg(lambda_arg_kind::in,
term::in, lambda_arg::out, int::in, int::out,
list(error_spec)::in, list(error_spec)::out,
list(error_spec)::in, list(error_spec)::out,
unravel_info::in, unravel_info::out) is det.
parse_lambda_arg(Kind, ArgModeTerm, LambdaArg, !ArgNum,
!BadModeSpecs, !SVarSpecs, !UrInfo) :-
( if
ArgModeTerm = term.functor(term.atom("::"),
[ArgTermPrime, ModeTerm], _)
then
ArgTerm = ArgTermPrime,
PresentOrAbsent = lam_present,
ModeContext = get_term_context(ModeTerm),
ContextPieces = cord.from_list([words("In the"), nth_fixed(!.ArgNum),
words("argument of the lambda expression:")]),
VarSet0 = !.UrInfo ^ ui_varset,
varset.coerce(VarSet0, GenericVarSet),
parse_mode(allow_constrained_inst_var, GenericVarSet, ContextPieces,
ModeTerm, MaybeMode0),
(
MaybeMode0 = ok1(Mode0),
constrain_inst_vars_in_mode(Mode0, Mode)
;
MaybeMode0 = error1(ModeSpecs),
!:BadModeSpecs = ModeSpecs ++ !.BadModeSpecs,
Mode = default_mode_for_lambda_arg(Kind)
)
else
ArgTerm = ArgModeTerm,
PresentOrAbsent = lam_absent,
Mode = default_mode_for_lambda_arg(Kind),
ModeContext = get_term_context(ArgModeTerm)
),
term.coerce(ArgTerm, ProgArgTerm),
% We currently do not allow !X to appear as a lambda head argument, though
% we might later extend the syntax still further to accommodate this
% using syntax such as !IO::(di, uo).
( if is_term_a_bang_state_pair(ProgArgTerm, StateVar, StateVarContext) then
VarSet1 = !.UrInfo ^ ui_varset,
(
Kind = lambda_arg_ordinary,
SVarSpec = report_illegal_bang_svar_lambda_arg_raw(StateVarContext,
VarSet1, StateVar)
;
Kind = lambda_arg_func_result,
SVarSpec = report_illegal_func_svar_result_raw(StateVarContext,
VarSet1, StateVar)
),
!:SVarSpecs = [SVarSpec | !.SVarSpecs]
else
true
),
% We always allocate a new variable for each lambda argument,
% even if the argument term is already a variable (which is what
% make_fresh_arg_vars_subst_svars does). This is because for functions,
% we need to ensure that the variable corresponding to the function
% result term is a new variable, to avoid the function result term
% becoming lambda-quantified.
LambdaVarName = "LambdaHeadVar__" ++ string.int_to_string(!.ArgNum),
create_new_named_unravel_var(LambdaVarName, LambdaVar, !UrInfo),
LambdaArg = lambda_arg(!.ArgNum, ProgArgTerm, LambdaVar, Kind,
PresentOrAbsent, Mode, ModeContext),
!:ArgNum = !.ArgNum + 1.
:- func default_mode_for_lambda_arg(lambda_arg_kind) = mer_mode.
default_mode_for_lambda_arg(Kind) = Mode :-
(
Kind = lambda_arg_ordinary,
in_mode(Mode)
;
Kind = lambda_arg_func_result,
out_mode(Mode)
).
%---------------------------------------------------------------------------%
:- pred parse_purity_annotation(term(T)::in, purity::out, term(T)::out) is det.
parse_purity_annotation(Term0, Purity, Term) :-
( if
Term0 = term.functor(term.atom(PurityName), [Term1], _),
purity_name(Purity0, PurityName)
then
Purity = Purity0,
Term = Term1
else
Purity = purity_pure,
Term = Term0
).
:- pred parse_lambda_detism(prog_varset::in, term::in,
maybe1(determinism)::out) is det.
parse_lambda_detism(VarSet, DetismTerm, MaybeDetism) :-
( if
DetismTerm = term.functor(term.atom(DetString), [], _),
standard_det(DetString, Detism)
then
MaybeDetism = ok1(Detism)
else
varset.coerce(VarSet, GenericVarSet),
TermStr = describe_error_term(GenericVarSet, DetismTerm),
Pieces = [words("Error:")] ++ color_as_incorrect([words(TermStr)]) ++
[words("is not a valid determinism."), nl],
Spec = spec($pred, severity_error, phase_t2pt,
get_term_context(DetismTerm), Pieces),
MaybeDetism = error1([Spec])
).
%---------------------------------------------------------------------------%
%
% Code for building lambda expressions.
%
:- type lambda_head
---> lambda_head(
purity,
ho_groundness,
pred_or_func,
list(lambda_arg),
list(error_spec), % Errors about unparseable and/or
% missing arg modes.
list(error_spec), % Errors about !X arguments.
maybe1(determinism) % The determinism of the lambda expr.
).
% In the parse tree, the lambda arguments can be any terms, but in the HLDS
% they must be distinct variables. So we introduce fresh variables
% for the lambda arguments, and add appropriate unifications.
%
% For example, we convert from:
%
% X = (func(f(A, B), c) = D :- Body )
%
% to:
%
% X =
% ( func(H1, H2) = H3 :-
% some [A, B] (
% H1 = f(A, B),
% H2 = c,
% Body,
% H3 = D
% )
% )
%
% Note that the quantification is important here. That is why we need
% to introduce the explicit `some [...]'. Variables in the argument
% positions are lambda-quantified, so when we move them to the body,
% we need to make them explicitly existentially quantified to avoid
% capturing any variables of the same name that occur outside this scope.
%
% Also, note that any introduced unifications that construct the output
% arguments for the lambda expression, need to occur *after* the body
% of the lambda expression. This is in case the body of the lambda
% expression is impure, in which case the mode analyser cannot reorder
% the unifications; this results in a mode error.
%
% XXX The mode analyser *should* be able to reorder such unifications,
% especially ones that the compiler introduced itself.
%
% For predicates, all variables occurring in the lambda arguments are
% locally quantified to the lambda goal. For functions, we need to
% be careful because variables in arguments should similarly be quantified,
% but variables in the function return value term (and not in the
% arguments) should *not* be locally quantified.
%
:- pred build_lambda_expression(prog_var::in, purity::in,
prog_context::in, unify_main_context::in, list(unify_sub_context)::in,
lambda_head::in, maybe1(goal)::in, expansion::out,
svar_state::in, unravel_info::in, unravel_info::out) is det.
build_lambda_expression(LHSVar, UnificationPurity,
Context, MainContext, SubContext, LambdaHead, MaybeBodyGoal,
Expansion, OutsideSVarState, !UrInfo) :-
LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
LambdaArgs0, BadModeSpecs, SVarSpecs, MaybeDetism),
qualify_lambda_arg_modes_if_not_opt_imported(LambdaArgs0, LambdaArgs1,
Modes, !UrInfo),
VarSet0 = !.UrInfo ^ ui_varset,
varset.coerce(VarSet0, TVarSet),
varset.coerce(VarSet0, InstVarSet),
warn_about_any_inconsistent_inst_vars(InstVarSet, Context, Modes, !UrInfo),
(
MaybeDetism = ok1(Detism)
;
MaybeDetism = error1(DetismSpecs),
add_unravel_specs(DetismSpecs, !UrInfo),
% Due to the error, this dummy value won't be used.
Detism = detism_det
),
(
MaybeBodyGoal = ok1(BodyGoal)
;
MaybeBodyGoal = error1(BodyGoalSpecs),
add_unravel_specs(BodyGoalSpecs, !UrInfo),
record_unravel_found_syntax_error(!UrInfo),
% Due to the error, this dummy value won't be used.
BodyGoal = true_expr(Context)
),
ArgSpecs = BadModeSpecs ++ SVarSpecs,
(
ArgSpecs = [_ | _],
add_unravel_specs(ArgSpecs, !UrInfo),
record_unravel_found_syntax_error(!UrInfo),
Goal = true_goal_with_context(Context)
;
ArgSpecs = [],
some [!SVarState] (
ArgTerms1 = list.map(project_lambda_arg_term, LambdaArgs1),
svar_prepare_for_lambda_head(Context, ArgTerms1, ArgTerms,
FinalSVarMap, NewSVars, OutsideSVarState,
!:SVarState, !UrInfo),
InitialSVarState = !.SVarState,
% Partition the arguments (and their corresponding lambda vars)
% into two sets: those that are not output, i.e. input and unused,
% and those that are output.
%
% The call to svar_prepare_for_lambda_head obsoletes the arg term
% fields of LambdaArgs1, so we must pass the new arg terms
% separately. We don't need to put them back into the lambda args,
% since the lambda args won't be needed later.
ModuleInfo0 = !.UrInfo ^ ui_module_info,
partition_args_and_lambda_vars(ModuleInfo0, LambdaArgs1, ArgTerms,
NonOutputLambdaVarsArgs, OutputLambdaVarsArgs),
PredFormArity = arg_list_arity(ArgTerms),
ArgContext = ac_head(PredOrFunc, PredFormArity),
% Create the unifications that need to come before the body of the
% lambda expression; those corresponding to args whose mode is
% input or unused.
HeadBefore0 = true_goal_with_context(Context),
insert_arg_unifications(NonOutputLambdaVarsArgs,
Context, ArgContext, HeadBefore0, HeadBefore,
!SVarState, !UrInfo),
map.init(EmptyRenaming),
transform_parse_tree_goal_to_hlds(loc_whole_goal, EmptyRenaming,
BodyGoal, Body, !SVarState, !UrInfo),
% Create the unifications that need to come after the body of the
% lambda expression; those corresponding to args whose mode is
% output.
HeadAfter0 = true_goal_with_context(Context),
insert_arg_unifications(OutputLambdaVarsArgs, Context, ArgContext,
HeadAfter0, HeadAfter, !SVarState, !UrInfo),
LambdaVarsModes =
list.map(project_lambda_var_arg_mode, LambdaArgs1),
LambdaVars =
list.map(project_lambda_var, LambdaArgs1),
trace [compiletime(flag("debug-statevar-lambda")), io(!IO)] (
get_debug_output_stream(ModuleInfo0, DebugStream, !IO),
io.write_string(DebugStream, "\nLAMBDA EXPRESSION\n", !IO),
io.write_string(DebugStream, "arg terms before:\n", !IO),
list.foldl(io.write_line(DebugStream), ArgTerms1, !IO),
io.write_string(DebugStream, "arg terms after:\n", !IO),
list.foldl(io.write_line(DebugStream), ArgTerms, !IO),
io.write_string(DebugStream, "lambda arg vars:\n", !IO),
io.write_line(DebugStream, LambdaVars, !IO),
io.write_string(DebugStream,
"lambda arg unifies before:\n", !IO),
dump_goal_nl(DebugStream, ModuleInfo0, vns_varset(VarSet0),
TVarSet, InstVarSet, HeadBefore, !IO),
io.write_string(DebugStream, "lambda body:\n", !IO),
dump_goal_nl(DebugStream, ModuleInfo0, vns_varset(VarSet0),
TVarSet, InstVarSet, Body, !IO),
io.write_string(DebugStream,
"lambda arg unifies after:\n", !IO),
dump_goal_nl(DebugStream, ModuleInfo0, vns_varset(VarSet0),
TVarSet, InstVarSet, HeadAfter, !IO),
map.to_assoc_list(FinalSVarMap, FinalSVarList),
io.write_string(DebugStream, "FinalSVarMap:\n", !IO),
io.write_line(DebugStream, FinalSVarList, !IO)
),
% Fix up any state variable unifications.
FinalSVarState = !.SVarState,
svar_finish_lambda_body(Context, Modes, NewSVars, FinalSVarMap,
BodyGoal, [HeadBefore, Body, HeadAfter], HLDS_Goal0,
InitialSVarState, FinalSVarState, !UrInfo),
% Figure out which variables we need to explicitly existentially
% quantify.
(
PredOrFunc = pf_predicate,
QuantifiedArgTerms = ArgTerms
;
PredOrFunc = pf_function,
pred_args_to_func_args(ArgTerms, QuantifiedArgTerms,
_ReturnValTerm)
),
term_vars.vars_in_terms(QuantifiedArgTerms, QuantifiedVars0),
list.sort_and_remove_dups(QuantifiedVars0, QuantifiedVars),
goal_info_init(Context, GoalInfo),
Reason = exist_quant(QuantifiedVars, compiler_quant),
HLDS_GoalExpr = scope(Reason, HLDS_Goal0),
HLDS_Goal = hlds_goal(HLDS_GoalExpr, GoalInfo),
% We set the lambda nonlocals here to anything that could
% possibly be nonlocal. Quantification will reduce this down
% to the proper set of nonlocal arguments.
some [!LambdaGoalVars] (
vars_in_goal(HLDS_Goal, !:LambdaGoalVars),
set_of_var.delete_list(LambdaVars, !LambdaGoalVars),
set_of_var.delete_list(QuantifiedVars, !LambdaGoalVars),
LambdaNonLocals = set_of_var.to_sorted_list(!.LambdaGoalVars)
),
LambdaRHS = rhs_lambda_goal(LambdaPurity, Groundness, PredOrFunc,
LambdaNonLocals, LambdaVarsModes, Detism, HLDS_Goal),
create_atomic_complicated_unification(LHSVar, LambdaRHS,
Context, MainContext, SubContext, UnificationPurity, Goal)
)
),
Expansion = expansion(not_fgti, cord.singleton(Goal)).
:- pred warn_about_any_inconsistent_inst_vars(inst_varset::in,
prog_context::in, list(mer_mode)::in,
unravel_info::in, unravel_info::out) is det.
warn_about_any_inconsistent_inst_vars(InstVarSet, Context, Modes, !UrInfo) :-
inconsistent_constrained_inst_vars_in_modes(Modes, InconsistentVars),
(
InconsistentVars = []
;
InconsistentVars = [_ | _],
VarPieces = list.map(var_to_quote_piece(InstVarSet), InconsistentVars),
Pieces = [words("Error: the constraints on the inst"),
words(choose_number(InconsistentVars, "variable", "variables"))] ++
piece_list_to_color_pieces(color_subject, "and", [], VarPieces) ++
color_as_incorrect([words("are inconsistent.")]) ++ [nl],
Spec = spec($pred, severity_error, phase_t2pt, Context, Pieces),
add_unravel_spec(Spec, !UrInfo)
).
% Partition the lists of arguments and variables into lists
% of non-output and output arguments and variables.
%
:- pred partition_args_and_lambda_vars(module_info::in,
list(lambda_arg)::in, list(prog_term)::in,
list(unify_var_term)::out, list(unify_var_term)::out) is det.
partition_args_and_lambda_vars(_, [], [], [], []).
partition_args_and_lambda_vars(_, [], [_ | _], _, _) :-
unexpected($pred, "mismatched lists").
partition_args_and_lambda_vars(_, [_ | _], [], _, _) :-
unexpected($pred, "mismatched lists").
partition_args_and_lambda_vars(ModuleInfo,
[LambdaArg | LambdaArgs], [ArgTerm | ArgTerms],
InputLambdaVarsArgTerms, OutputLambdaVarsArgTerms) :-
partition_args_and_lambda_vars(ModuleInfo, LambdaArgs, ArgTerms,
InputLambdaVarsArgTermsTail, OutputLambdaVarsArgTermsTail),
LambdaArg = lambda_arg(_ArgNum, _SupersededArgTerm, LambdaVar,
_Kind, _PresentOrAbsent, Mode, _ModeContext),
LambdaVarArgTerm = unify_var_term(LambdaVar, ArgTerm),
% If the mode is undefined, calling mode_is_output/2 directly would cause
% the compiler to abort, so we don't want to do that.
%
% It does not really matter whether we consider an argument with an
% undefined mode input or output, because mode analysis will fail anyway.
% The code here is slightly simpler if we consider it input.
( if
mode_is_defined(ModuleInfo, Mode),
mode_is_output(ModuleInfo, Mode)
then
% defined and output
InputLambdaVarsArgTerms = InputLambdaVarsArgTermsTail,
OutputLambdaVarsArgTerms =
[LambdaVarArgTerm | OutputLambdaVarsArgTermsTail]
else
% undefined or (defined and not output)
InputLambdaVarsArgTerms =
[LambdaVarArgTerm | InputLambdaVarsArgTermsTail],
OutputLambdaVarsArgTerms = OutputLambdaVarsArgTermsTail
).
% Succeeds iff the given mode is defined.
%
:- pred mode_is_defined(module_info::in, mer_mode::in) is semidet.
mode_is_defined(ModuleInfo, Mode) :-
mode_get_insts_semidet(ModuleInfo, Mode, _, _).
:- pred qualify_lambda_arg_modes_if_not_opt_imported(
list(lambda_arg)::in, list(lambda_arg)::out, list(mer_mode)::out,
unravel_info::in, unravel_info::out) is det.
qualify_lambda_arg_modes_if_not_opt_imported(LambdaArgs0, LambdaArgs,
Modes, !UrInfo) :-
QualInfo0 = !.UrInfo ^ ui_qual_info,
qual_info_get_maybe_opt_imported(QualInfo0, MaybeOptImported),
(
MaybeOptImported = is_not_opt_imported,
% Lambda expressions cannot appear in the interface of a module.
InInt = mq_not_used_in_interface,
qual_info_get_mq_info(QualInfo0, MQInfo0),
qualify_lambda_arg_modes(InInt, LambdaArgs0, LambdaArgs, Modes,
MQInfo0, MQInfo, [], Specs),
qual_info_set_mq_info(MQInfo, QualInfo0, QualInfo),
!UrInfo ^ ui_qual_info := QualInfo,
% Note: Specs will almost always be [].
add_unravel_specs(Specs, !UrInfo)
;
MaybeOptImported = is_opt_imported,
% The modes in `.opt' files are already fully module qualified.
LambdaArgs = LambdaArgs0,
Modes = list.map(project_lambda_arg_mode, LambdaArgs)
).
:- pred qualify_lambda_arg_modes(mq_in_interface::in,
list(lambda_arg)::in, list(lambda_arg)::out, list(mer_mode)::out,
mq_info::in, mq_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
qualify_lambda_arg_modes(_InInt, [], [], [], !MQInfo, !Specs).
qualify_lambda_arg_modes(InInt, [LambdaArg0 | LambdaArgs0],
[LambdaArg | LambdaArgs], [Mode | Modes], !MQInfo, !Specs) :-
LambdaArg0 = lambda_arg(ArgNum, ProgArgTerm, LambdaVar,
Kind, PresentOrAbsent, Mode0, ModeContext),
qualify_lambda_mode(InInt, ModeContext, Mode0, Mode, !MQInfo, !Specs),
LambdaArg = lambda_arg(ArgNum, ProgArgTerm, LambdaVar,
Kind, PresentOrAbsent, Mode, ModeContext),
qualify_lambda_arg_modes(InInt, LambdaArgs0,
LambdaArgs, Modes, !MQInfo, !Specs).
%---------------------------------------------------------------------------%
:- end_module hlds.make_hlds.superhomogeneous_lambda.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink