mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 06:47:17 +00:00
459847a064
Estimated hours taken: 18 Branches: main Move the univ, maybe, pair and unit types from std_util into their own modules. std_util still contains the general purpose higher-order programming constructs. library/std_util.m: Move univ, maybe, pair and unit (plus any other related types and procedures) into their own modules. library/maybe.m: New module. This contains the maybe and maybe_error types and the associated procedures. library/pair.m: New module. This contains the pair type and associated procedures. library/unit.m: New module. This contains the types unit/0 and unit/1. library/univ.m: New module. This contains the univ type and associated procedures. library/library.m: Add the new modules. library/private_builtin.m: Update the declaration of the type_ctor_info struct for univ. runtime/mercury.h: Update the declaration for the type_ctor_info struct for univ. runtime/mercury_mcpp.h: runtime/mercury_hlc_types.h: Update the definition of MR_Univ. runtime/mercury_init.h: Fix a comment: ML_type_name is now exported from type_desc.m. compiler/mlds_to_il.m: Update the the name of the module that defines univs (which are handled specially by the il code generator.) library/*.m: compiler/*.m: browser/*.m: mdbcomp/*.m: profiler/*.m: deep_profiler/*.m: Conform to the above changes. Import the new modules where they are needed; don't import std_util where it isn't needed. Fix formatting in lots of modules. Delete duplicate module imports. tests/*: Update the test suite to confrom to the above changes.
589 lines
21 KiB
Mathematica
589 lines
21 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1997-2006 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 maybe.
|
|
:- import_module pair.
|
|
:- 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) :-
|
|
ModuleName =predicate_module(ModuleInfo, PredId),
|
|
PredName = predicate_name(ModuleInfo, PredId),
|
|
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("builtin", "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, true_goal_expr).
|
|
make_true_or_fail(no, fail_goal_expr).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "const_prop.m".
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module const_prop.
|
|
%---------------------------------------------------------------------------%
|