mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-20 00:15:27 +00:00
Code Issues Projects Releases Wiki Activity
Files
270c12e80e64c84b5725c44cd1618ff145f5899b
mercury/compiler/const_prop.m
Fergus Henderson 11d8161692 Add support for nested modules. 
Estimated hours taken: 50

Add support for nested modules.

- module names may themselves be module-qualified
- modules may contain `:- include_module' declarations
  which name sub-modules
- a sub-module has access to all the declarations in the
  parent module (including its implementation section).

This support is not yet complete; see the BUGS and LIMITATIONS below.

LIMITATIONS
- source file names must match module names
	(just as they did previously)
- mmc doesn't allow path names on the command line any more
	(e.g. `mmc --make-int ../library/foo.m').
- import_module declarations must use the fully-qualified module name
- module qualifiers must use the fully-qualified module name
- no support for root-qualified module names
	(e.g. `:parent:child' instead of `parent:child').
- modules may not be physically nested (only logical nesting, via
  `include_module').

BUGS
- doesn't check that the parent module is imported/used before allowing
	import/use of its sub-modules.
- doesn't check that there is an include_module declaration in the
	parent for each module claiming to be a child of that parent
- privacy of private modules is not enforced

-------------------

NEWS:
	Mention that we support nested modules.

library/ops.m:
library/nc_builtin.nl:
library/sp_builtin.nl:
compiler/mercury_to_mercury.m:
	Add `include_module' as a new prefix operator.
	Change the associativity of `:' from xfy to yfx
	(since this made parsing module qualifiers slightly easier).

compiler/prog_data.m:
	Add new `include_module' declaration.
	Change the `module_name' and `module_specifier' types
	from strings to sym_names, so that module names can
	themselves be module qualified.

compiler/modules.m:
	Add predicates module_name_to_file_name/2 and
	file_name_to_module_name/2.
	Lots of changes to handle parent module dependencies,
	to create parent interface (`.int0') files, to read them in,
	to output correct dependencies information for them to the
	`.d' and `.dep' files, etc.
	Rewrite a lot of the code to improve the readability
	(add comments, use subroutines, better variable names).
	Also fix a couple of bugs:
	- generate_dependencies was using the transitive implementation
	  dependencies rather than the transitive interface dependencies
	  to compute the `.int3' dependencies when writing `.d' files
	  (this bug was introduced during crs's changes to support
	  `.trans_opt' files)
	- when creating the `.int' file, it was reading in the
	  interfaces for modules imported in the implementation section,
	  not just those in the interface section.
	  This meant that the compiler missed a lot of errors.

library/graph.m:
library/lexer.m:
library/term.m:
library/term_io.m:
library/varset.m:
compiler/*.m:
	Add `:- import_module' declarations to the interface needed
	by declarations in the interface.  (The previous version
	of the compiler did not detect these missing interface imports,
	due to the above-mentioned bug in modules.m.)

compiler/mercury_compile.m:
compiler/intermod.m:
	Change mercury_compile__maybe_grab_optfiles and
	intermod__grab_optfiles so that they grab the opt files for
	parent modules as well as the ones for imported modules.

compiler/mercury_compile.m:
	Minor changes to handle parent module dependencies.
	(Also improve the wording of the warning about trans-opt
	dependencies.)

compiler/make_hlds.m:
compiler/module_qual.m:
	Ignore `:- include_module' declarations.

compiler/module_qual.m:
	A couple of small changes to handle nested module names.

compiler/prog_out.m:
compiler/prog_util.m:
	Add new predicates string_to_sym_name/3 (prog_util.m) and
	sym_name_to_string/{2,3} (prog_out.m).

compiler/*.m:
	Replace many occurrences of `string' with `module_name'.
	Change code that prints out module names or converts
	them to strings or filenames to handle the fact that
	module names are now sym_names intead of strings.
	Also change a few places (e.g. in intermod.m, hlds_module.m)
	where the code assumed that any qualified symbol was
	fully-qualified.

compiler/prog_io.m:
compiler/prog_io_goal.m:
	Move sym_name_and_args/3, parse_qualified_term/4 and
	parse_qualified_term/5 preds from prog_io_goal.m to prog_io.m,
	since they are very similar to the parse_symbol_name/2 predicate
	already in prog_io.m.  Rewrite these predicates, both
	to improve maintainability, and to handle the newly
	allowed syntax (module-qualified module names).
	Rename parse_qualified_term/5 as `parse_implicit_qualified_term'.

compiler/prog_io.m:
	Rewrite the handling of `:- module' and `:- end_module'
	declarations, so that it can handle nested modules.
	Add code to parse `include_module' declarations.

compiler/prog_util.m:
compiler/*.m:
	Add new predicates mercury_public_builtin_module/1 and
	mercury_private_builtin_module/1 in prog_util.m.
	Change most of the hard-coded occurrences of "mercury_builtin"
	to call mercury_private_builtin_module/1 or
	mercury_public_builtin_module/1 or both.

compiler/llds_out.m:
	Add llds_out__sym_name_mangle/2, for mangling module names.

compiler/special_pred.m:
compiler/mode_util.m:
compiler/clause_to_proc.m:
compiler/prog_io_goal.m:
compiler/lambda.m:
compiler/polymorphism.m:
	Move the predicates in_mode/1, out_mode/1, and uo_mode/1
	from special_pred.m to mode_util.m, and change various
	hard-coded definitions to instead call these predicates.

compiler/polymorphism.m:
	Ensure that the type names `type_info' and `typeclass_info' are
	module-qualified in the generated code.  This avoids a problem
	where the code generated by polymorphism.m was not considered
	type-correct, due to the type `type_info' not matching
	`mercury_builtin:type_info'.

compiler/check_typeclass.m:
	Simplify the code for check_instance_pred and
	get_matching_instance_pred_ids.

compiler/mercury_compile.m:
compiler/modules.m:
	Disallow directory names in command-line arguments.

compiler/options.m:
compiler/handle_options.m:
compiler/mercury_compile.m:
compiler/modules.m:
	Add a `--make-private-interface' option.
	The private interface file `<module>.int0' contains
	all the declarations in the module; it is used for
	compiling sub-modules.

scripts/Mmake.rules:
scripts/Mmake.vars.in:
	Add support for creating `.int0' and `.date0' files
	by invoking mmc with `--make-private-interface'.

doc/user_guide.texi:
	Document `--make-private-interface' and the `.int0'
	and `.date0' file extensions.

doc/reference_manual.texi:
	Document nested modules.

util/mdemangle.c:
profiler/demangle.m:
	Demangle names with multiple module qualifiers.

tests/general/Mmakefile:
tests/general/string_format_test.m:
tests/general/string_format_test.exp:
tests/general/string__format_test.m:
tests/general/string__format_test.exp:
tests/general/.cvsignore:
	Change the `:- module string__format_test' declaration in
	`string__format_test.m' to `:- module string_format_test',
	because with the original declaration the `__' was taken
	as a module qualifier, which lead to an error message.
	Hence rename the file accordingly, to avoid the warning
	about file name not matching module name.

tests/invalid/Mmakefile:
tests/invalid/missing_interface_import.m:
tests/invalid/missing_interface_import.err_exp:
	Regression test to check that the compiler reports
	errors for missing `import_module' in the interface section.

tests/invalid/*.err_exp:
tests/warnings/unused_args_test.exp:
tests/warnings/unused_import.exp:
	Update the expected diagnostics output for the test cases to
	reflect a few minor changes to the warning messages.

tests/hard_coded/Mmakefile:
tests/hard_coded/parent.m:
tests/hard_coded/parent.child.m:
tests/hard_coded/parent.exp:
tests/hard_coded/parent2.m:
tests/hard_coded/parent2.child.m:
tests/hard_coded/parent2.exp:
	Two simple tests case for the use of nested modules with
	separate compilation.
1998-03-03 17:48:14 +00:00

390 lines
14 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% Copyright (C) 1997-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: const_prop.m
% main author: conway.
%
% This module provides the facility to evaluate calls at compile time -
% transforming them to simpler goals such as construction unifications.
%
%------------------------------------------------------------------------------%
:- module const_prop.
:- interface.
:- import_module hlds_module, hlds_goal, hlds_pred, instmap.
:- import_module list, term.
:- pred evaluate_builtin(pred_id, proc_id, list(var), hlds_goal_info,
hlds_goal_expr, hlds_goal_info, instmap,
module_info, module_info).
:- mode evaluate_builtin(in, in, in, in, out, out, in, in, out) is semidet.
%------------------------------------------------------------------------------%
:- implementation.
:- import_module code_aux, det_analysis, follow_code, goal_util.
:- import_module hlds_goal, hlds_data, instmap, inst_match.
:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes.
:- import_module bool, list, int, float, map, require.
:- import_module (inst), hlds_out, std_util, term, varset.
%------------------------------------------------------------------------------%
evaluate_builtin(PredId, ProcId, Args, GoalInfo0, Goal, GoalInfo,
InstMap, ModuleInfo0, ModuleInfo) :-
predicate_module(ModuleInfo0, PredId, ModuleName),
predicate_name(ModuleInfo0, PredId, PredName),
proc_id_to_int(ProcId, ProcInt),
LookupVarInsts = lambda([V::in, J::out] is det, (
instmap__lookup_var(InstMap, V, VInst),
J = V - VInst
)),
list__map(LookupVarInsts, Args, ArgInsts),
evaluate_builtin_2(ModuleName, PredName, ProcInt, ArgInsts, GoalInfo0,
Goal, GoalInfo, ModuleInfo0, ModuleInfo).
:- pred evaluate_builtin_2(module_name, string, int, list(pair(var, (inst))),
hlds_goal_info, hlds_goal_expr, hlds_goal_info,
module_info, module_info).
:- mode evaluate_builtin_2(in, in, in, in, in, out, out, in, out) is semidet.
% Module_info is not actually used at the moment.
evaluate_builtin_2(Module, Pred, ModeNum, Args, GoalInfo0, Goal, GoalInfo,
ModuleInfo, ModuleInfo) :-
% -- not yet:
% Module = qualified(unqualified("std"), Mod),
Module = unqualified(Mod),
(
Args = [X, Y],
evaluate_builtin_bi(Mod, Pred, ModeNum, X, Y, W, Cons)
->
make_construction(W, Cons, Goal),
goal_info_get_instmap_delta(GoalInfo0, Delta0),
W = Var - _WInst,
instmap_delta_set(Delta0, Var,
bound(unique, [functor(Cons, [])]), Delta),
goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo)
;
Args = [X, Y, Z],
evaluate_builtin_tri(Mod, Pred, ModeNum, X, Y, Z, W, Cons)
->
make_construction(W, Cons, Goal),
goal_info_get_instmap_delta(GoalInfo0, Delta0),
W = Var - _WInst,
instmap_delta_set(Delta0, Var,
bound(unique, [functor(Cons, [])]), Delta),
goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo)
;
evaluate_builtin_test(Mod, Pred, ModeNum, Args, Result)
->
make_true_or_fail(Result, GoalInfo0, Goal, GoalInfo)
;
fail
).
%------------------------------------------------------------------------------%
:- pred evaluate_builtin_bi(string, string, int,
pair(var, (inst)), pair(var, (inst)),
pair(var, (inst)), cons_id).
:- mode evaluate_builtin_bi(in, in, in, in, in, out, out) is semidet.
% Integer arithmetic
evaluate_builtin_bi("int", "+", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is XVal.
evaluate_builtin_bi("int", "-", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is -XVal.
evaluate_builtin_bi("int", "\\", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is \ XVal.
% Floating point arithmetic
evaluate_builtin_bi("float", "+", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is XVal.
evaluate_builtin_bi("float", "-", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is -XVal.
%------------------------------------------------------------------------------%
:- pred evaluate_builtin_tri(string, string, int,
pair(var, (inst)), pair(var, (inst)), pair(var, (inst)),
pair(var, (inst)), cons_id).
:- mode evaluate_builtin_tri(in, in, in, in, in, in, out, out) is semidet.
%
% Integer arithmetic
%
evaluate_builtin_tri("int", "+", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal + YVal.
evaluate_builtin_tri("int", "+", 1, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
XVal is ZVal - YVal.
evaluate_builtin_tri("int", "+", 2, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
YVal is ZVal - XVal.
evaluate_builtin_tri("int", "-", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal - YVal.
evaluate_builtin_tri("int", "-", 1, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
XVal is YVal + ZVal.
evaluate_builtin_tri("int", "-", 2, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
YVal is XVal - ZVal.
evaluate_builtin_tri("int", "*", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal * YVal.
/****
evaluate_builtin_tri("int", "*", 1, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
XVal is ZVal // YVal.
evaluate_builtin_tri("int", "*", 2, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
XVal \= 0,
YVal is ZVal // XVal.
****/
evaluate_builtin_tri("int", "//", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
ZVal is XVal // YVal.
/****
evaluate_builtin_tri("int", "//", 1, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
XVal is ZVal * YVal.
evaluate_builtin_tri("int", "//", 2, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal \= 0,
YVal is XVal // ZVal.
****/
evaluate_builtin_tri("int", "mod", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal mod YVal.
evaluate_builtin_tri("int", "<<", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal << YVal.
evaluate_builtin_tri("int", ">>", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal >> YVal.
evaluate_builtin_tri("int", "/\\", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal /\ YVal.
evaluate_builtin_tri("int", "\\/", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal \/ YVal.
evaluate_builtin_tri("int", "^", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal ^ YVal.
%
% float arithmetic
%
evaluate_builtin_tri("float", "+", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal is XVal + YVal.
evaluate_builtin_tri("float", "+", 1, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
XVal is ZVal - YVal.
evaluate_builtin_tri("float", "+", 2, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
YVal is ZVal - XVal.
evaluate_builtin_tri("float", "-", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal is XVal - YVal.
evaluate_builtin_tri("float", "-", 1, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
XVal is YVal + ZVal.
evaluate_builtin_tri("float", "-", 2, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
YVal is XVal - ZVal.
evaluate_builtin_tri("float", "*", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal is XVal * YVal.
evaluate_builtin_tri("float", "*", 1, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
XVal is ZVal / YVal.
evaluate_builtin_tri("float", "*", 2, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
XVal \= 0.0,
YVal is ZVal / XVal.
evaluate_builtin_tri("float", "//", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
ZVal is XVal / YVal.
evaluate_builtin_tri("float", "//", 1, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
XVal is ZVal * YVal.
evaluate_builtin_tri("float", "//", 2, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
ZVal \= 0.0,
YVal is XVal / ZVal.
%------------------------------------------------------------------------------%
:- pred evaluate_builtin_test(string, string, int, list(pair(var, inst)), bool).
:- mode evaluate_builtin_test(in, in, in, in, out) is semidet.
% Integer comparisons
evaluate_builtin_test("int", "<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("int", "=<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("int", ">", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("int", ">=", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
Result = no
).
% Float comparisons
evaluate_builtin_test("float", "<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("float", "=<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("float", ">", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("float", ">=", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
Result = no
).
%------------------------------------------------------------------------------%
:- pred make_construction(pair(var, inst), cons_id, hlds_goal_expr).
:- mode make_construction(in, in, out) is det.
make_construction(Var - VarInst, ConsId, Goal) :-
RHS = functor(ConsId, []),
CInst = bound(unique, [functor(ConsId, [])]),
Mode = (VarInst -> CInst) - (CInst -> CInst),
Unification = construct(Var, ConsId, [], []),
Context = unify_context(explicit, []),
Goal = unify(Var, RHS, Mode, Unification, Context).
%------------------------------------------------------------------------------%
:- pred make_true_or_fail(bool, hlds_goal_info, hlds_goal_expr, hlds_goal_info).
:- mode make_true_or_fail(in, in, out, out) is det.
make_true_or_fail(yes, GoalInfo, conj([]), GoalInfo).
make_true_or_fail(no, GoalInfo, disj([], SM), GoalInfo) :-
map__init(SM).
%------------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink