mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-21 00:39:37 +00:00
Code Issues Projects Releases Wiki Activity
Files
dae82a8409d4e589e2004c97d713494cc01b7d2c
mercury/compiler/const_prop.m
Zoltan Somogyi f9fe8dcf61 Improve the error messages generated for determinism errors involving committed 
Estimated hours taken: 8
Branches: main

Improve the error messages generated for determinism errors involving committed
choice contexts. Previously, we printed a message to the effect that e.g.
a cc pred is called in context that requires all solutions, but we didn't say
*why* the context requires all solutions. We now keep track of all the goals
to the right that could fail, since it is these goals that may reject the first
solution of a committed choice goal.

The motivation for this diff was the fact that I found that locating the
failing goal can be very difficult if the conjunction to the right is
a couple of hundred lines long. This would have been a nontrivial problem,
since (a) unifications involving values of user-defined types are committed
choice goals, and (b) we can expect uses of user-defined types to increase.

compiler/det_analysis.m:
	Keep track of goals to the right of the current goal that could fail,
	and include them in the error representation if required.

compiler/det_report.m:
	Include the list of failing goals to the right in the representations
	of determinism errors involving committed committed choice goals.

	Convert the last part of this module that wasn't using error_util
	to use error_util. Make most parts of this module just construct
	error message specifications; print those specifications (using
	error_util) in only a few places.

compiler/hlds_out.m:
	Add a function for use by the new code in det_report.m.

compiler/error_util.m:
	Add a function for use by the new code in det_report.m.

compiler/error_util.m:
compiler/compiler_util.m:
	Error_util is still changing reasonably often, and yet it is
	included in lots of modules, most of which need only a few simple
	non-parse-tree-related predicates from it (e.g. unexpected).
	Move those predicates to a new module, compiler_util.m. This also
	eliminates some undesirable dependencies from libs to parse_tree.

compiler/libs.m:
	Include compiler_util.m.

compiler/notes/compiler_design.html:
	Document compiler_util.m, and fix the documentation of some other
	modules.

compiler/*.m:
	Import compiler_util instead of or in addition to error_util.
	To make this easier, consistently use . instead of __ for module
	qualifying module names.

tests/invalid/det_errors_cc.{m,err_exp}:
	Add this new test case to test the error messages for cc contexts.

tests/invalid/det_errors_deet.{m,err_exp}:
	Add this new test case to test the error messages for unifications
	inside function symbols.

tests/invalid/Mmakefile:
	Add the new test cases.

tests/invalid/det_errors.err_exp:
tests/invalid/magicbox.err_exp:
	Change the expected output to conform to the change in det_report.m,
	which is now more consistent.
2005-10-28 02:11:03 +00:00

583 lines
21 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1997-2005 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: const_prop.m
% main author: conway.
%
% This module provides the facility to evaluate calls to standard library
% routines at compile time, transforming them to simpler goals such as
% construction unifications.
%
% XXX We should check for overflow. This is particularly important when
% cross-compiling, since the overflow behaviour of the host machine might
% not be the same as that of the target machine, e.g. if they have different
% word sizes.
%
%---------------------------------------------------------------------------%
:- module transform_hlds__const_prop.
:- interface.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.instmap.
:- import_module parse_tree.prog_data.
:- import_module list.
% evaluate_call(PredId, ProcId, Args, VarTypes, Instmap, ModuleInfo,
% GoalExpr, GoalInfo):
%
% This attempts to evaluate a call to the specified procedure with the
% specified arguments. If the call can be statically evaluated,
% evaluate_builtin will succeed, returning the new goal in GoalExpr
% (and updating GoalInfo). Otherwise it fails.
%
:- pred evaluate_call(pred_id::in, proc_id::in, list(prog_var)::in,
vartypes::in, instmap::in, module_info::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out) is semidet.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.det_analysis.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.modes.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_out.
:- import_module hlds.instmap.
:- import_module hlds.passes_aux.
:- import_module hlds.quantification.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module bool.
:- import_module float.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module require.
:- import_module std_util.
:- import_module string.
%---------------------------------------------------------------------------%
% This type groups the information from the HLDS
% about a procedure call argument.
:- type arg_hlds_info
---> arg_hlds_info(
arg_var :: prog_var,
arg_type :: mer_type,
arg_inst :: mer_inst
).
evaluate_call(PredId, ProcId, Args, VarTypes, InstMap, ModuleInfo, Goal,
GoalInfo0, GoalInfo) :-
predicate_module(ModuleInfo, PredId, ModuleName),
predicate_name(ModuleInfo, PredId, PredName),
proc_id_to_int(ProcId, ProcInt),
LookupArgs = (func(Var) = arg_hlds_info(Var, Type, Inst) :-
instmap__lookup_var(InstMap, Var, Inst),
Type = VarTypes ^ det_elem(Var)
),
ArgHldsInfos = list__map(LookupArgs, Args),
evaluate_call_2(ModuleName, PredName, ProcInt, ArgHldsInfos,
Goal, GoalInfo0, GoalInfo).
:- pred evaluate_call_2(module_name::in, string::in, int::in,
list(arg_hlds_info)::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out) is semidet.
evaluate_call_2(Module, Pred, ModeNum, Args, Goal, !GoalInfo) :-
% -- not yet:
% Module = qualified(unqualified("std"), Mod),
Module = unqualified(Mod),
( evaluate_det_call(Mod, Pred, ModeNum, Args, OutputArg, Cons) ->
make_construction_goal(OutputArg, Cons, Goal, !GoalInfo)
; evaluate_test(Mod, Pred, ModeNum, Args, Succeeded) ->
make_true_or_fail(Succeeded, Goal)
; evaluate_semidet_call(Mod, Pred, ModeNum, Args, Result) ->
(
Result = yes(OutputArg - const(Cons)),
make_construction_goal(OutputArg, Cons, Goal, !GoalInfo)
;
Result = yes(OutputArg - var(InputArg)),
make_assignment_goal(OutputArg, InputArg, Goal, !GoalInfo)
;
Result = no,
make_true_or_fail(no, Goal)
)
;
fail
).
%---------------------------------------------------------------------------%
% evaluate_det_call(ModuleName, ProcName, ModeNum,
% Args, OutputArg, OutputArgVal):
%
% This attempts to evaluate a call to
% ModuleName.ProcName(Args)
% whose mode is specified by ModeNum.
% If the call is a det call with one output that can be
% statically evaluated, evaluate_det_call succeeds with
% OutputArg being whichever of Args is output,
% and with OutputArgVal being the computed value of OutputArg.
% Otherwise it fails.
%
:- pred evaluate_det_call(string::in, string::in, int::in,
list(arg_hlds_info)::in, arg_hlds_info::out, cons_id::out) is semidet.
%
% Unary operators
%
% Integer arithmetic
evaluate_det_call("int", "+", 0, [X, Y], Y, int_const(YVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
YVal = XVal.
evaluate_det_call("int", "-", 0, [X, Y], Y, int_const(YVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
YVal = -XVal.
evaluate_det_call("int", "\\", 0, [X, Y], Y, int_const(YVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
YVal = \ XVal.
% Floating point arithmetic
evaluate_det_call("float", "+", 0, [X, Y], Y, int_const(YVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
YVal = XVal.
evaluate_det_call("float", "-", 0, [X, Y], Y, int_const(YVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
YVal = -XVal.
%
% Binary operators
%
% Integer arithmetic
evaluate_det_call("int", "+", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal + YVal.
evaluate_det_call("int", "+", 1, [X, Y, Z], X, int_const(XVal)) :-
Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
XVal = ZVal - YVal.
evaluate_det_call("int", "+", 2, [X, Y, Z], Y, int_const(YVal)) :-
Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
YVal = ZVal - XVal.
evaluate_det_call("int", "-", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal - YVal.
evaluate_det_call("int", "-", 1, [X, Y, Z], X, int_const(XVal)) :-
Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
XVal = YVal + ZVal.
evaluate_det_call("int", "-", 2, [X, Y, Z], Y, int_const(YVal)) :-
Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
YVal = XVal - ZVal.
evaluate_det_call("int", "*", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal * YVal.
evaluate_det_call("int", "//", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
ZVal = XVal // YVal.
evaluate_det_call("int", "plus", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal + YVal.
evaluate_det_call("int", "minus", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal - YVal.
evaluate_det_call("int", "times", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal * YVal.
evaluate_det_call("int", "unchecked_quotient", 0, [X, Y, Z], Z,
int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
ZVal = unchecked_quotient(XVal, YVal).
evaluate_det_call("int", "mod", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
ZVal = XVal mod YVal.
evaluate_det_call("int", "rem", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
ZVal = XVal rem YVal.
evaluate_det_call("int", "unchecked_rem", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
ZVal = unchecked_rem(XVal, YVal).
evaluate_det_call("int", "unchecked_left_shift",
0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = unchecked_left_shift(XVal, YVal).
evaluate_det_call("int", "<<", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal << YVal.
evaluate_det_call("int", "unchecked_right_shift",
0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = unchecked_right_shift(XVal, YVal).
evaluate_det_call("int", ">>", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal >> YVal.
evaluate_det_call("int", "/\\", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal /\ YVal.
evaluate_det_call("int", "\\/", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal \/ YVal.
evaluate_det_call("int", "xor", 0, [X, Y, Z], Z, int_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal = XVal `xor` YVal.
% float arithmetic
evaluate_det_call("float", "+", 0, [X, Y, Z], Z, float_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal = XVal + YVal.
evaluate_det_call("float", "-", 0, [X, Y, Z], Z, float_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal = XVal - YVal.
evaluate_det_call("float", "*", 0, [X, Y, Z], Z, float_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal = XVal * YVal.
evaluate_det_call("float", "/", 0, [X, Y, Z], Z, float_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
ZVal = XVal / YVal.
evaluate_det_call("float", "unchecked_quotient", 0, [X, Y, Z], Z,
float_const(ZVal)) :-
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
ZVal = unchecked_quotient(XVal, YVal).
% string operations
evaluate_det_call("string", Name, _, [X, Y, Z], Z, string_const(ZVal)) :-
( Name = "++"
; Name = "append"
),
X ^ arg_inst = bound(_XUniq, [functor(string_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(string_const(YVal), [])]),
% We can only do the append if Z is free (this allows
% us to ignore the mode number and pick up both the
% predicate and function versions of append)
Z ^ arg_inst = free,
ZVal = XVal ++ YVal.
%---------------------------------------------------------------------------%
% evaluate_test(ModuleName, ProcName, ModeNum, ArgList, Result):
%
% This attempts to evaluate a call to
% ModuleName.ProcName(ArgList)
% whose mode is specified by ModeNum.
%
% If the call is a semidet call with no outputs that can be
% statically evaluated, evaluate_test succeeds with
% Result being "yes" if the call will succeed and "no" if the
% call will fail.
% Otherwise (i.e. if the call is not semidet, has any outputs,
% or cannot be statically evaluated), evaluate_test fails.
:- pred evaluate_test(string::in, string::in, int::in,
list(arg_hlds_info)::in, bool::out) is semidet.
% Integer comparisons
evaluate_test("int", "<", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
Result = no
).
evaluate_test("int", "=<", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
Result = no
).
evaluate_test("int", ">", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
Result = no
).
evaluate_test("int", ">=", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
Result = no
).
% Float comparisons
evaluate_test("float", "<", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
Result = no
).
evaluate_test("float", "=<", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
Result = no
).
evaluate_test("float", ">", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
Result = no
).
evaluate_test("float", ">=", 0, Args, Result) :-
Args = [X, Y],
X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
Result = no
).
evaluate_test("private_builtin", "typed_unify", Mode, Args, Result) :-
% mode 0 is the (in, in) mode
% mode 1 is the (in, out) mode
% both modes are semidet
Mode = 0,
Args = [TypeOfX, TypeOfY, X, Y],
eval_unify(TypeOfX, TypeOfY, Result0),
(
Result0 = no,
Result = no
;
Result0 = yes,
eval_unify(X, Y, Result)
).
% evaluate_semidet_call(ModuleName, ProcName, ModeNum,
% Args, Result):
%
% This attempts to evaluate a call to
% ModuleName.ProcName(Args)
% whose mode is specified by ModeNum.
%
% If the call is a semidet call with one output that can be
% statically evaluated, evaluate_semidet_call succeeds with
% Result being "no" if the call will fail, or
% yes(OutputArg - OutputArgValue) if it will succeed, with
% OutputArg being whichever of the arguments is output,
% and with OutputArgVal being the computed value of OutputArg.
%
% Otherwise (i.e. if the call is not semidet, or has no outputs
% or more than one output, or cannot be statically evaluated),
% evaluate_semidet_call fails.
:- type arg_val
---> const(cons_id)
; var(arg_hlds_info).
:- pred evaluate_semidet_call(string::in, string::in, int::in,
list(arg_hlds_info)::in, maybe(pair(arg_hlds_info, arg_val))::out)
is semidet.
evaluate_semidet_call("std_util", "dynamic_cast", 0, Args, Result) :-
evaluate_semidet_call("private_builtin", "typed_unify", 1,
Args, Result).
evaluate_semidet_call("private_builtin", "typed_unify", Mode, Args, Result) :-
% mode 0 is the (in, in) mode
% mode 1 is the (in, out) mode
% both modes are semidet
Mode = 1,
Args = [TypeOfX, TypeOfY, X, Y],
eval_unify(TypeOfX, TypeOfY, Result0),
(
Result0 = no,
Result = no
;
Result0 = yes,
Result = yes(Y - var(X))
).
% evaluate_unify(FirstArg, SecondArg, Result):
%
% This attempts to evaluate a call to
% builtin.unify(FirstArg, SecondArg)
% with mode (in, in).
% If the unification can be statically evaluated,
% evaluate_builtin_test succeeds with Result being "yes"
% if the unification will succeed and "no" if the
% unification will fail. Otherwise (i.e. if the unification
% cannot be statically evaluated), evaluate_unify fails.
:- pred eval_unify(arg_hlds_info::in, arg_hlds_info::in, bool::out) is semidet.
eval_unify(X, Y, Result) :-
(
X ^ arg_var = Y ^ arg_var
->
Result = yes
;
X ^ arg_inst = bound(_, [functor(XCtor, XArgVars)]),
Y ^ arg_inst = bound(_, [functor(YCtor, YArgVars)])
->
( XCtor = YCtor, XArgVars = YArgVars ->
Result = yes
;
( XCtor \= YCtor
; length(XArgVars) \= length(YArgVars) `with_type` int
)
->
Result = no
;
fail
)
;
fail
).
%---------------------------------------------------------------------------%
:- pred make_assignment_goal(arg_hlds_info::in, arg_hlds_info::in,
hlds_goal_expr::out, hlds_goal_info::in, hlds_goal_info::out) is det.
make_assignment_goal(OutputArg, InputArg, Goal, !GoalInfo) :-
make_assignment(OutputArg, InputArg, Goal),
goal_info_get_instmap_delta(!.GoalInfo, Delta0),
instmap_delta_set(OutputArg ^ arg_var, InputArg ^ arg_inst,
Delta0, Delta),
goal_info_set_instmap_delta(Delta, !GoalInfo),
goal_info_set_determinism(det, !GoalInfo).
:- pred make_construction_goal(arg_hlds_info::in, cons_id::in,
hlds_goal_expr::out, hlds_goal_info::in, hlds_goal_info::out) is det.
make_construction_goal(OutputArg, Cons, Goal, !GoalInfo) :-
make_construction(OutputArg, Cons, Goal),
goal_info_get_instmap_delta(!.GoalInfo, Delta0),
instmap_delta_set(OutputArg ^ arg_var, bound(unique, [functor(Cons, [])]),
Delta0, Delta),
goal_info_set_instmap_delta(Delta, !GoalInfo),
goal_info_set_determinism(det, !GoalInfo).
:- pred make_assignment(arg_hlds_info::in, arg_hlds_info::in,
hlds_goal_expr::out) is det.
make_assignment(OutputArg, InputArg, Goal) :-
OutVar = OutputArg ^ arg_var,
InVar = InputArg ^ arg_var,
Inst = InputArg ^ arg_inst,
OutputArgMode = (free -> Inst),
InputArgMode = (Inst -> Inst),
UniMode = OutputArgMode - InputArgMode,
Context = unify_context(explicit, []),
Goal = unify(OutVar, var(InVar), UniMode, assign(OutVar, InVar), Context).
% recompute_instmap_delta is run by simplify.m if anything changes,
% so the insts are not important here.
:- pred make_construction(arg_hlds_info::in, cons_id::in, hlds_goal_expr::out)
is det.
make_construction(Arg, ConsId, Goal) :-
make_const_construction(Arg ^ arg_var, ConsId, Goal - _).
%---------------------------------------------------------------------------%
:- pred make_true_or_fail(bool::in, hlds_goal_expr::out) is det.
make_true_or_fail(yes, conj([])).
make_true_or_fail(no, disj([])).
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink