[m-dev.] for review: Aditi update round 2 [1]
Simon Taylor
stayl at cs.mu.OZ.AU
Fri Jul 2 15:16:12 AEST 1999
Hi,
This relative diff addresses Fergus' comments,
except for the documentation.
Simon.
--- log 1999/06/27 02:21:21 1.2
+++ log 1999/07/02 04:48:32
@@ -115,11 +115,17 @@
compiler/mode_util.m:
Add predicate `unused_mode/1', which returns `builtin:unused'.
- Added functions `aditi_di_mode/0', `aditi_ui_mode/0' and
+ Add functions `aditi_di_mode/0', `aditi_ui_mode/0' and
`aditi_uo_mode/0' which return `in', `in', and `out', but will
be changed to return `di', `ui' and `uo' when alias tracking
is implemented.
+compiler/goal_util.m:
+ Add predicate `goal_util__generic_call_vars' which returns
+ any arguments to a generic_call which are not in the argument list,
+ for example the closure passed to a higher-order call or
+ the typeclass_info for a class method call.
+
compiler/llds.m:
compiler/exprn_aux.m:
compiler/dupelim.m:
@@ -146,15 +152,24 @@
are found - this avoids spurious "undefined predicate `aditi_insert/3'"
errors.
+ Factor out some common code to handle terms of the form `Head :- Body'.
+ Factor out common code in the handling of pred and func expressions.
+
compiler/typecheck.m:
Typecheck Aditi builtins.
- Change typecheck_call_pred to allow a call to match only
- a certain class of predicates, for example base relations.
-
Allow the argument types of matching predicates to be adjusted
when typechecking the higher-order arguments of Aditi builtins.
+ Change `typecheck__resolve_pred_overloading' to take a list of
+ argument types rather than a `map(var, type)' and a list of
+ arguments to allow a transformation to be performed on the
+ argument types before passing them.
+
+ Export `report_error_num_args' for use by make_hlds.m when
+ reporting errors for Aditi builtins. Change `report_error_num_args'
+ to allow Aditi builtins to be reported properly.
+
compiler/modes.m:
compiler/unique_modes.m:
compiler/modecheck_call.m:
@@ -184,6 +199,7 @@
compiler/rl_gen.m:
compiler/rl.m:
Move some utility code used by magic.m and call_gen.m into rl.m.
+
Remove an XXX comment about reference counting being not yet
implemented - Evan has fixed that.
@@ -191,11 +207,17 @@
compiler/mercury_to_mercury.m:
Add unary prefix operators `aditi_bottom_up' and `aditi_top_down',
used as qualifiers on lambda expressions.
+ Add infix operator `==>' to separate the tuples in an
+ `aditi_modify' call.
compiler/follow_vars.m:
Thread a `map(prog_var, type)' through, needed because
type information is no longer held in higher-order call goals.
+compiler/table_gen.m:
+ Use the `make_*_construction' predicates in hlds_goal.m
+ to construct constants.
+
compiler/*.m:
Trivial changes to add extra fields to hlds_goal structures.
@@ -218,4 +240,11 @@
tests/invalid/Mmakefile
tests/invalid/aditi_update_errors.{m,err_exp}:
Test error messages for Aditi updates.
+
+tests/valid/aditi.m:
+tests/invalid/aditi.m:
+ Cut down version of extras/aditi/aditi.m to provide basic declarations
+ for Aditi compilation such as `aditi__state' and the modes
+ `aditi_di', `aditi_uo' and `aditi_ui'. Installing extras/aditi/aditi.m
+ somewhere would remove the need for these.
--- base_type_layout.m 1999/06/27 01:01:42 1.6
+++ base_type_layout.m 1999/07/01 01:38:16
@@ -1131,6 +1131,8 @@
% argument for their real arity, and then type
% arguments according to their types.
% polymorphism.m has a detailed explanation.
+ % XXX polymorphism.m does not have a
+ % detailed explanation.
type_is_higher_order(Type, _PredFunc,
_EvalMethod, _TypeArgs)
->
--- hlds_goal.m 1999/06/27 01:01:42 1.8
+++ hlds_goal.m 1999/07/02 02:28:46
@@ -53,7 +53,7 @@
% is variable, or they take higher-order arguments of
% variable arity.
% This currently includes higher-order calls, class-method
- % calls, Aditi calls and the Aditi update predicates.
+ % calls, Aditi calls and the Aditi update goals.
; generic_call(
generic_call,
@@ -255,8 +255,9 @@
% Modify the tuples in a relation.
% Arguments:
- % `det' or `semidet' `aditi_top_down' closure to
- % construct a new tuple from an old. This is
+ % semidet `aditi_top_down' closure to construct a
+ % new tuple from the old tuple.
+ % The tuple is not changed if the closure fails.
% aditi__state::di, aditi__state::uo.
; aditi_modify(
pred_id, % base relation to modify
@@ -264,15 +265,18 @@
)
.
- % Which syntax was used for an aditi_delete or aditi_modify
+ % Which syntax was used for an `aditi_delete' or `aditi_modify'
% call. The first syntax is prettier, the second is used
% where the closure to be passed in is not known at the call site.
+ % (See the "Aditi update syntax" section of the Mercury Language
+ % Reference Manual).
:- type aditi_builtin_syntax
---> pred_term % e.g. aditi_delete(p(_, X) :- X = 1).
- ; sym_name_and_closure % e.g. aditi_delete(p/2,
- % (pred(X::in) is semidet :-
- % X = 1)
- % )
+ ; sym_name_and_closure % e.g.
+ % aditi_delete(p/2,
+ % (pred(_::in, X::in) is semidet :-
+ % X = 1)
+ % )
.
:- type aditi_bulk_operation
@@ -383,11 +387,20 @@
cell_is_unique, % Can the cell be allocated
% in shared data.
maybe(rl_exprn_id)
- % Index of the RL expression used to
- % extract the relevant tuples
- % from a relation using an index
- % in the list of expressions for
- % this module.
+ % Used for `aditi_top_down' closures
+ % passed to `aditi_delete' and
+ % `aditi_modify' calls where the
+ % relation being modified has a
+ % B-tree index.
+ % The Aditi-RL expression referred
+ % to by this field constructs a key
+ % range which restricts the deletion
+ % or modification of the relation using
+ % the index so that the deletion or
+ % modification closure is only applied
+ % to tuples for which the closure could
+ % succeed, reducing the number of
+ % tuples read from disk.
)
% A deconstruction unification is a unification with a functor
@@ -498,14 +511,12 @@
% and does not need to be filled in.
).
- % Shared constant cells can be allocated in static data.
- % Others must be created on the heap.
+ % Cells marked `cell_is_shared' can be allocated in read-only memory.
+ % Cells marked `cell_is_unique' must be writeable.
% `cell_is_unique' is always a safe approximation.
:- type cell_is_unique
- ---> cell_is_unique % a unique copy of the cell must
- % be created by the construction
- ; cell_is_shared % the construction may use a shared
- % copy of the cell
+ ---> cell_is_unique
+ ; cell_is_shared
.
:- type hlds_goals == list(hlds_goal).
@@ -1379,7 +1390,10 @@
RHS = functor(ConsId, []),
Inst = bound(unique, [functor(ConsId, [])]),
Mode = (free -> Inst) - (Inst -> Inst),
- Unification = construct(Var, ConsId, [], [], no, cell_is_unique, no),
+ VarToReuse = no,
+ RLExprnId = no,
+ Unification = construct(Var, ConsId, [], [],
+ VarToReuse, cell_is_unique, RLExprnId),
Context = unify_context(explicit, []),
Goal = unify(Var, RHS, Mode, Unification, Context),
set__singleton_set(NonLocals, Var),
--- hlds_out.m 1999/06/27 01:01:42 1.7
+++ hlds_out.m 1999/07/02 04:43:06
@@ -84,8 +84,7 @@
:- mode hlds_out__write_simple_call_id(in, in, in, di, uo) is det.
% Write "argument %i of call to pred_or_func `foo/n'".
-:- pred hlds_out__write_call_arg_id(call_id, int,
- io__state, io__state).
+:- pred hlds_out__write_call_arg_id(call_id, int, io__state, io__state).
:- mode hlds_out__write_call_arg_id(in, in, di, uo) is det.
:- pred hlds_out__write_pred_or_func(pred_or_func, io__state, io__state).
@@ -356,15 +355,10 @@
:- pred hlds_out__write_generic_call_id(generic_call_id, io__state, io__state).
:- mode hlds_out__write_generic_call_id(in, di, uo) is det.
-hlds_out__write_generic_call_id(higher_order(PredOrFunc, Arity)) -->
- {
- PredOrFunc = predicate,
- Name = "call"
- ;
- PredOrFunc = function,
- Name = "apply"
- },
- hlds_out__write_simple_call_id(PredOrFunc, unqualified(Name), Arity).
+hlds_out__write_generic_call_id(higher_order(PredOrFunc, _)) -->
+ io__write_string("higher-order "),
+ hlds_out__write_pred_or_func(PredOrFunc),
+ io__write_string(" call").
hlds_out__write_generic_call_id(class_method(_ClassId, MethodId)) -->
hlds_out__write_simple_call_id(MethodId).
hlds_out__write_generic_call_id(
@@ -381,7 +375,13 @@
hlds_out__write_arg_number(CallId, ArgNum),
io__write_string(" of ")
),
- io__write_string("call to "),
+ ( { CallId = generic_call(higher_order(_, _)) } ->
+ % The text printed for higher-order calls does
+ % not need the "call to" prefix.
+ []
+ ;
+ io__write_string("call to ")
+ ),
hlds_out__write_call_id(CallId).
:- pred hlds_out__write_arg_number(call_id, int, io__state, io__state).
@@ -401,6 +401,9 @@
;
io__write_string("argument "),
io__write_int(ArgNum),
+
+ % Make error messages for higher-order calls
+ % such as `P(A, B)' clearer.
io__write_string(" (i.e. "),
( { ArgNum = 1 } ->
io__write_string("the "),
@@ -493,12 +496,12 @@
hlds_out__write_unify_main_context(First, explicit, _, First) -->
[].
hlds_out__write_unify_main_context(First, head(ArgNum), Context, no) -->
+ % XXX handle function return values better.
hlds_out__write_in_argument(First, ArgNum, Context),
io__write_string(" of clause head:\n").
-hlds_out__write_unify_main_context(First, call(PredId, ArgNum), Context, no) -->
- hlds_out__write_in_argument(First, ArgNum, Context),
- io__write_string(" of call to "),
- hlds_out__write_call_id(PredId),
+hlds_out__write_unify_main_context(First, call(CallId, ArgNum), Context, no) -->
+ hlds_out__start_in_message(First, Context),
+ hlds_out__write_call_arg_id(CallId, ArgNum),
io__write_string(":\n").
:- pred hlds_out__write_unify_sub_contexts(bool, unify_sub_contexts,
@@ -519,13 +522,20 @@
:- mode hlds_out__write_in_argument(in, in, in, di, uo) is det.
hlds_out__write_in_argument(First, ArgNum, Context) -->
+ hlds_out__start_in_message(First, Context),
+ io__write_string("argument "),
+ io__write_int(ArgNum).
+
+:- pred hlds_out__start_in_message(bool, prog_context, io__state, io__state).
+:- mode hlds_out__start_in_message(in, in, di, uo) is det.
+
+hlds_out__start_in_message(First, Context) -->
prog_out__write_context(Context),
( { First = yes } ->
- io__write_string(" In argument ")
+ io__write_string(" In ")
;
- io__write_string(" in argument ")
- ),
- io__write_int(ArgNum).
+ io__write_string(" in ")
+ ).
%-----------------------------------------------------------------------------%
@@ -1520,7 +1530,8 @@
hlds_out__write_aditi_builtin(_ModuleInfo, aditi_insert(PredId), CallId,
ArgVars, VarSet, AppendVarnums, Indent, Follow) -->
- { get_state_args_det(ArgVars, Args, State0, State) },
+ % make_hlds.m checks the arity so this cannot fail.
+ { get_state_args_det(ArgVars, Args, State0Var, StateVar) },
hlds_out__write_indent(Indent),
io__write_string("aditi_insert("),
{ CallId = PredOrFunc - SymName/_ },
@@ -1539,9 +1550,9 @@
io__write_string(")")
),
io__write_string(", "),
- mercury_output_var(State0, VarSet, AppendVarnums),
+ mercury_output_var(State0Var, VarSet, AppendVarnums),
io__write_string(", "),
- mercury_output_var(State, VarSet, AppendVarnums),
+ mercury_output_var(StateVar, VarSet, AppendVarnums),
io__write_string(")"),
io__write_string(Follow),
io__nl,
--- hlds_pred.m 1999/06/27 01:01:42 1.11
+++ hlds_pred.m 1999/07/02 02:37:54
@@ -1877,9 +1877,11 @@
:- pred pred_args_to_func_args(list(T), list(T), T).
:- mode pred_args_to_func_args(in, out, out) is det.
+ % adjust_func_arity(PredOrFunc, FuncArity, PredArity).
+ %
% We internally store the arity as the length of the argument
- % list, which is one more than the arity of a function reported
- % in error messages.
+ % list including the return value, which is one more than the
+ % arity of the function reported in error messages.
:- pred adjust_func_arity(pred_or_func, int, int).
:- mode adjust_func_arity(in, in, out) is det.
:- mode adjust_func_arity(in, out, in) is det.
--- intermod.m 1999/06/27 01:01:42 1.6
+++ intermod.m 1999/06/29 05:13:54
@@ -413,8 +413,9 @@
intermod_info_get_var_types(VarTypes),
intermod_info_get_tvarset(TVarSet),
( { invalid_pred_id(PredId0) } ->
- { typecheck__resolve_pred_overloading(ModuleInfo, Args,
- VarTypes, TVarSet, PredName0, PredName1, PredId) }
+ { map__apply_to_list(Args, VarTypes, ArgTypes) },
+ { typecheck__resolve_pred_overloading(ModuleInfo, ArgTypes,
+ TVarSet, PredName0, PredName1, PredId) }
;
{ PredId = PredId0 },
{ PredName1 = PredName0 }
--- lambda.m 1999/06/27 01:01:42 1.7
+++ lambda.m 1999/06/27 02:16:28
@@ -495,8 +495,10 @@
Functor = functor(cons(PredName, NumArgVars), ArgVars),
ConsId = pred_const(PredId, ProcId, EvalMethod),
+ VarToReuse = no,
+ RLExprnId = no,
Unification = construct(Var, ConsId, ArgVars, UniModes,
- no, cell_is_unique, no).
+ VarToReuse, cell_is_unique, RLExprnId).
:- pred lambda__uni_modes_to_modes(list(uni_mode), list(mode)).
:- mode lambda__uni_modes_to_modes(in, out) is det.
--- magic_util.m 1999/06/27 01:01:42 1.15
+++ magic_util.m 1999/06/27 02:17:39
@@ -470,8 +470,10 @@
{ Rhs = functor(cons(qualified(PredModule, PredName), Arity),
InputVars) },
+ { VarToReuse = no },
+ { RLExprnId = no },
{ Uni = construct(Var, ConsId, InputVars, Modes,
- no, cell_is_unique, no) },
+ VarToReuse, cell_is_unique, RLExprnId) },
{ Goal1 = unify(Var, Rhs, UniMode, Uni, Context) - Info },
{ list__append(InputGoals, [Goal1], InputAndClosure) }
@@ -802,9 +804,12 @@
{ Rhs = functor(cons(qualified(SuppModule, SuppName),
SuppArity), LambdaInputs) },
+ { VarToReuse = no },
+ { RLExprnId = no },
{ Unify = construct(InputVar,
pred_const(SuppPredId, SuppProcId, (aditi_bottom_up)),
- LambdaInputs, UniModes, no, cell_is_unique, no) },
+ LambdaInputs, UniModes, VarToReuse,
+ cell_is_unique, RLExprnId) },
{ UnifyContext = unify_context(explicit, []) },
% Construct a goal_info.
--- make_hlds.m 1999/06/27 01:01:42 1.8
+++ make_hlds.m 1999/07/01 07:58:20
@@ -4188,8 +4188,9 @@
{ qual_info_set_found_syntax_error(no, Info2, Info) },
(
{ FoundError = yes },
- % Don't report spurious type errors for clauses
- % containing other errors.
+ % Don't insert clauses containing syntax errors into
+ % the clauses_info, because doing that would cause
+ % typecheck.m to report spurious type errors.
{ ClausesInfo = ClausesInfo0 }
;
{ FoundError = no },
@@ -4433,12 +4434,17 @@
},
{ HeadVars = [PredVar | RealHeadVars] }
->
- { % initialize some fields to junk
+ {
+ % initialize some fields to junk
Modes = [],
Det = erroneous,
- Call = generic_call(
- higher_order(PredVar, predicate, Arity),
+
+ GenericCall = higher_order(PredVar,
+ predicate, Arity),
+ Call = generic_call(GenericCall,
RealHeadVars, Modes, Det),
+
+ hlds_goal__generic_call_id(GenericCall, CallId),
Purity1 = pure
},
(
@@ -4454,12 +4460,15 @@
io__write_string(" Higher-order goals are always pure.\n")
)
;
- % initialize some fields to junk
- { invalid_pred_id(PredId),
+ {
+ % initialize some fields to junk
+ invalid_pred_id(PredId),
invalid_proc_id(ModeId),
+
MaybeUnifyContext = no,
Call = call(PredId, ModeId, HeadVars, not_builtin,
MaybeUnifyContext, Name),
+ CallId = call(predicate - Name/Arity),
Purity1 = Purity
}
),
@@ -4468,9 +4477,8 @@
{ add_goal_info_purity_feature(GoalInfo1, Purity1, GoalInfo) },
{ Goal0 = Call - GoalInfo },
- { PredCallId = Name/Arity },
insert_arg_unifications(HeadVars, Args,
- Context, call(call(predicate - PredCallId)), no,
+ Context, call(CallId), no,
Goal0, VarSet1, Goal, VarSet, Info0, Info)
).
@@ -4501,6 +4509,8 @@
; "aditi_modify"
).
+ % See the "Aditi update syntax" section of the
+ % Mercury Language Reference Manual.
:- pred transform_aditi_builtin(string, list(prog_term), prog_context,
prog_varset, hlds_goal, prog_varset,
qual_info, qual_info, io__state, io__state).
@@ -4509,25 +4519,41 @@
transform_aditi_builtin("aditi_insert", Args0, Context, VarSet0,
Goal, VarSet, Info0, Info) -->
+ % Build an empty goal_info.
{ goal_info_init(GoalInfo0) },
{ goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
{ add_goal_info_purity_feature(GoalInfo1, pure, GoalInfo) },
- ( { Args0 = [InsertTerm, AditiState0A, AditiStateA] } ->
+
+ %
+ % Syntax -
+ % aditi_insert(p(_DB, X, Y), DB0, DB).
+ %
+ % `p(_DB, X, Y)' is the tuple to insert, not a higher-order term.
+ %
+ ( { Args0 = [InsertTupleTerm, AditiState0Term, AditiStateTerm] } ->
(
- { parse_pred_or_func_and_args(InsertTerm,
- PredOrFunc, SymName, InsertArgs0) }
+ % Parse the tuple to insert.
+ { parse_pred_or_func_and_args(InsertTupleTerm,
+ PredOrFunc, SymName, TupleArgTerms) }
->
{
- make_fresh_arg_var(AditiState0A, AditiState0, [],
+ %
+ % Make new variables for the arguments.
+ % The argument list of the `aditi_insert'
+ % goal contains the arguments of the tuple
+ % to insert and the `aditi__state' arguments.
+ %
+ make_fresh_arg_var(AditiState0Term, AditiState0Var, [],
VarSet0, VarSet1),
- make_fresh_arg_var(AditiStateA, AditiState, [],
+ make_fresh_arg_var(AditiStateTerm, AditiStateVar, [],
VarSet1, VarSet2),
- make_fresh_arg_vars(InsertArgs0, VarSet2,
- InsertArgs, VarSet3),
+ make_fresh_arg_vars(TupleArgTerms, VarSet2,
+ TupleArgVars, VarSet3),
+ list__append(TupleArgVars,
+ [AditiState0Var, AditiStateVar], AllArgs),
+ list__length(TupleArgVars, InsertArity),
+
invalid_pred_id(PredId),
- list__append(InsertArgs, [AditiState0, AditiState],
- AllArgs),
- list__length(InsertArgs, InsertArity),
Builtin = aditi_insert(PredId),
InsertCallId = PredOrFunc - SymName/InsertArity,
Call = generic_call(
@@ -4539,11 +4565,13 @@
ArgContext = functor(cons(SymName, InsertArity),
call(CallId, 1), [])
},
- insert_arg_unifications(InsertArgs, InsertArgs0,
+
+ insert_arg_unifications(TupleArgVars, TupleArgTerms,
Context, ArgContext, no,
Goal0, VarSet3, Goal1, VarSet4, Info0, Info1),
- insert_arg_unifications([AditiState0, AditiState],
- [AditiState0A, AditiStateA],
+ insert_arg_unifications(
+ [AditiState0Var, AditiStateVar],
+ [AditiState0Term, AditiStateTerm],
Context, call(CallId), no,
Goal1, VarSet4, Goal, VarSet, Info1, Info)
;
@@ -4552,7 +4580,7 @@
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
io__set_exit_status(1),
prog_out__write_context(Context),
- io__write(
+ io__write_string(
"Error: expected tuple to insert in call to `aditi_insert'\n")
)
;
@@ -4581,6 +4609,7 @@
:- inst aditi_del_or_mod_str = bound("aditi_delete"; "aditi_modify").
+ % Parse an `aditi_delete' or `aditi_modify' goal.
:- pred transform_delete_or_modify(string, list(prog_term), prog_context,
prog_varset, hlds_goal, prog_varset,
qual_info, qual_info, io__state, io__state).
@@ -4602,42 +4631,24 @@
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
aditi_update_arity_error(Context, DelOrMod, Arity, [3, 4])
;
- { Args0 = [HOTerm, AditiState0A, AditiStateA] },
+
+ %
+ % First syntax -
+ % aditi_delete((p(X, Y, DB0) :- X = 2), DB0, DB).
+ % or
+ % aditi_modify((p(X0, Y0, _DB0) ==> p(X0, Y, _DB) :-
+ % X0 < 100, Y = Y0 + 1), DB0, DB).
+ %
+ { Args0 = [HOTerm, AditiState0Term, AditiStateTerm] },
+ { parse_rule_term(Context, HOTerm, HeadTerm, GoalTerm1) },
{
- % First syntax -
- % aditi_delete((p(X, Y, DB0) :- X = 2), DB0, DB).
DelOrMod = "aditi_delete",
- (
- HOTerm = term__functor(term__atom(":-"),
- [HeadTerm0, GoalTerm0], _)
- ->
- HeadTerm = HeadTerm0,
- GoalTerm1 = GoalTerm0
- ;
- HeadTerm = HOTerm,
- GoalTerm1 = term__functor(term__atom("true"),
- [], Context)
- ),
parse_pred_or_func_and_args(HeadTerm,
PredOrFunc, SymName, HeadArgs1),
list__length(HeadArgs1, PredArity)
;
- % First syntax -
- % aditi_modify((p(X0, Y0, _DB0) = p(X0, Y, _DB) :-
- % X0 < 100, Y = Y0 + 1), DB0, DB).
DelOrMod = "aditi_modify",
- (
- HOTerm = term__functor(term__atom(":-"),
- [HeadTerm0, GoalTerm0], _)
- ->
- HeadTerm = HeadTerm0,
- GoalTerm1 = GoalTerm0
- ;
- HeadTerm = HOTerm,
- GoalTerm1 = term__functor(term__atom("true"),
- [], Context)
- ),
- HeadTerm = term__functor(term__atom("="),
+ HeadTerm = term__functor(term__atom("==>"),
[LeftHeadTerm, RightHeadTerm], _),
parse_pred_or_func_and_args(LeftHeadTerm,
PredOrFunc, SymName, LeftHeadArgs),
@@ -4648,6 +4659,18 @@
list__length(RightHeadArgs, PredArity)
}
->
+ %
+ % This syntax is transformed into a construction of
+ % a lambda expression for the modification condition
+ % and a call to an update goal with that closure.
+ % The transformed code is equivalent to the
+ % `sym_name_and_closure' syntax which is parsed below.
+ %
+ { Syntax = pred_term },
+
+ %
+ % Parse the modification goal as for a lambda expression.
+ %
{ make_fresh_arg_vars(HeadArgs1, VarSet0, HeadArgs, VarSet1) },
{ term__coerce(GoalTerm1, GoalTerm) },
{ parse_goal(GoalTerm, VarSet1, ParsedGoal, VarSet2) },
@@ -4657,84 +4680,117 @@
insert_arg_unifications(HeadArgs, HeadArgs1, Context, head, no,
PredGoal0, VarSet3, PredGoal, VarSet4, Info1, Info2),
- % quantification will reduce this down to
- % the proper set of nonlocal arguments.
+ % Quantification will reduce this down to
+ % the proper set of nonlocal arguments.
{ goal_util__goal_vars(PredGoal, LambdaGoalVars0) },
{ set__delete_list(LambdaGoalVars0,
HeadArgs, LambdaGoalVars1) },
{ set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals) },
- { Syntax = pred_term },
{ in_mode(InMode) },
{ out_mode(OutMode) },
+ { invalid_pred_id(PredId) },
{
DelOrMod = "aditi_delete",
Builtin = aditi_delete(PredId, Syntax),
- % post_typecheck.m will change the mode of the
- % `aditi__state' argument to `unused'.
+
+ % Modes for the arguments of the input tuple.
list__duplicate(PredArity, InMode, Modes),
+
LambdaPredOrFunc = PredOrFunc
;
DelOrMod = "aditi_modify",
Builtin = aditi_modify(PredId, Syntax),
- % purity.m will change the mode of the
- % `aditi__state' arguments to `unused'.
+
+ % Modes for the arguments corresponding to
+ % the input tuple.
list__duplicate(PredArity, InMode, InModes),
+
+ % Modes for the arguments corresponding to
+ % the output tuple.
list__duplicate(PredArity, OutMode, OutModes),
+
list__append(InModes, OutModes, Modes),
- % For aditi_modify, the higher-order argument
+ % For `aditi_modify' the higher-order argument
% is always a predicate.
LambdaPredOrFunc = predicate
},
- { invalid_pred_id(PredId) },
- { ModCallId = PredOrFunc - SymName/PredArity },
+ { ModifiedCallId = PredOrFunc - SymName/PredArity },
{ MainContext =
- call(generic_call(aditi_builtin(Builtin, ModCallId)),
+ call(generic_call(
+ aditi_builtin(Builtin, ModifiedCallId)),
1) },
{ varset__new_var(VarSet4, LambdaVar, VarSet5) },
+
+ % Tell purity.m to change the mode of the `aditi__state'
+ % arguments of the closure to `unused', to make sure
+ % that the closure does not call any Aditi relations.
+ % We don't know which argument is the `aditi__state' until
+ % after typechecking.
+ % The `aditi__state's are passed even though they are not
+ % used to make the arguments of the closure match the
+ % arguments of the relation being updated.
+ { FixModes = modes_need_fixing },
+
+ % Build the lambda expression for the modification condition.
{ create_atomic_unification(LambdaVar,
lambda_goal(LambdaPredOrFunc, (aditi_top_down),
- modes_need_fixing, LambdaNonLocals,
+ FixModes, LambdaNonLocals,
HeadArgs, Modes, semidet, PredGoal),
Context, MainContext, [], LambdaConstruct) },
- { make_fresh_arg_var(AditiState0A, AditiState0, [],
+ { make_fresh_arg_var(AditiState0Term, AditiState0Var, [],
VarSet5, VarSet6) },
- { make_fresh_arg_var(AditiStateA, AditiState, [],
+ { make_fresh_arg_var(AditiStateTerm, AditiStateVar, [],
VarSet6, VarSet7) },
- { AllArgs = [LambdaVar, AditiState0, AditiState] },
- { Call = generic_call(aditi_builtin(Builtin, ModCallId),
- AllArgs, [], det) - GoalInfo },
- insert_arg_unifications(AllArgs,
- [term__variable(LambdaVar), AditiState0A, AditiStateA],
- Context,
- call(generic_call(aditi_builtin(Builtin, ModCallId))),
- no, conj([LambdaConstruct, Call]) - GoalInfo,
- VarSet7, Goal, VarSet, Info2, Info),
+ { AllArgs = [LambdaVar, AditiState0Var, AditiStateVar] },
+
+ % post_typecheck.m will fill this in.
+ { GenericCallModes = [] },
+
+ { Call = generic_call(aditi_builtin(Builtin, ModifiedCallId),
+ AllArgs, GenericCallModes, det) - GoalInfo },
%
% Wrap an explicit quantification around the goal to make
% sure that the closure construction and the
- % aditi_delete or aditi_modify call are not separated.
+ % `aditi_delete' or `aditi_modify' call are not separated.
% Separating the goals would make optimization of the update
% using indexes more difficult.
%
- { UpdateGoal = some([], cannot_remove, Goal) - GoalInfo }
+ { UpdateConj = some([], cannot_remove,
+ conj([LambdaConstruct, Call]) - GoalInfo) - GoalInfo },
+
+ { CallId = call(generic_call(
+ aditi_builtin(Builtin, ModifiedCallId))) },
+ insert_arg_unifications(AllArgs,
+ [term__variable(LambdaVar), AditiState0Term,
+ AditiStateTerm],
+ Context, CallId, no, UpdateConj, VarSet7, UpdateGoal,
+ VarSet, Info2, Info)
;
+ %
% Second syntax -
% aditi_delete(p/3, (aditi_top_down pred(..) :- ..), DB0, DB).
+ % aditi_modify(p/3, (aditi_top_down pred(..) :- ..), DB0, DB).
+ %
+ % The `pred_term' syntax parsed above is transformed
+ % into the equivalent of this syntax.
+ %
{ Args0 = [PredCallIdTerm | OtherArgs0] },
{ OtherArgs0 = [_, _, _] },
+
{ parse_pred_or_func_name_and_arity(PredCallIdTerm,
PredOrFunc, SymName, Arity0) },
{ adjust_func_arity(PredOrFunc, Arity0, Arity) }
->
+ { Syntax = sym_name_and_closure },
+
{ make_fresh_arg_vars(OtherArgs0,
VarSet0, OtherArgs, VarSet1) },
{ invalid_pred_id(PredId) },
- { Syntax = sym_name_and_closure },
{
DelOrMod = "aditi_delete",
Builtin = aditi_delete(PredId, Syntax)
@@ -4743,11 +4799,16 @@
Builtin = aditi_modify(PredId, Syntax)
},
- { ModCallId = PredOrFunc - SymName/Arity },
- { Call = generic_call(aditi_builtin(Builtin, ModCallId),
- OtherArgs, [], det) - GoalInfo },
- insert_arg_unifications(OtherArgs, OtherArgs0, Context,
- call(generic_call(aditi_builtin(Builtin, ModCallId))),
+ { ModifiedCallId = PredOrFunc - SymName/Arity },
+
+ % post_typecheck.m will fill this in.
+ { GenericCallModes = [] },
+
+ { Call = generic_call(aditi_builtin(Builtin, ModifiedCallId),
+ OtherArgs, GenericCallModes, det) - GoalInfo },
+ { CallId = call(generic_call(
+ aditi_builtin(Builtin, ModifiedCallId))) },
+ insert_arg_unifications(OtherArgs, OtherArgs0, Context, CallId,
no, Call, VarSet1, UpdateGoal, VarSet, Info0, Info)
;
{ invalid_aditi_update_goal(DelOrMod, Args0, GoalInfo,
@@ -4765,20 +4826,24 @@
;
{ DelOrMod = "aditi_modify" },
prog_out__write_context(Context),
- io__write_string(" Error: expected\n"),
+ io__write_string(
+ "Error: expected\n"),
prog_out__write_context(Context),
- io__write_string(" `aditi_modify(\n"),
+ io__write_string(
+ " `aditi_modify(\n"),
prog_out__write_context(Context),
io__write_string(
- " (p(<Args0>) = p(<Args>) :- <Goal>),\n"),
+ " (p(<Args0>) ==> p(<Args>) :- <Goal>),\n"),
prog_out__write_context(Context),
- io__write_string(" DB0, DB)'\n"),
+ io__write_string(
+ " DB0, DB)'\n"),
prog_out__write_context(Context),
io__write_string(
" or `aditi_modify(PredOrFunc p/N, Closure, DB0, DB)'.\n")
)
).
+ % Parse an `aditi_bulk_insert' or `aditi_bulk_delete' goal.
:- pred transform_bulk_update(string, aditi_bulk_operation, list(prog_term),
term__context, prog_varset, hlds_goal, prog_varset,
qual_info, qual_info, io__state, io__state).
@@ -4796,6 +4861,11 @@
{ OtherArgs0 = [_, _, _] }
->
(
+ %
+ % Syntax -
+ % aditi_bulk_insert(p/3, Closure, DB0, DB).
+ % aditi_bulk_delete(p/3, Closure, DB0, DB).
+ %
{ parse_pred_or_func_name_and_arity(PredCallIdTerm,
PredOrFunc, SymName, Arity0) },
{ adjust_func_arity(PredOrFunc, Arity0, Arity) }
@@ -4804,13 +4874,17 @@
OtherArgs, VarSet1) },
{ invalid_pred_id(PredId) },
{ Builtin = aditi_bulk_operation(BulkOp, PredId) },
- { ModCallId = PredOrFunc - SymName/Arity },
+ { ModifiedCallId = PredOrFunc - SymName/Arity },
+
+ % post_typecheck.m will fill this in.
+ { GenericCallModes = [] },
+
{ Call = generic_call(
- aditi_builtin(Builtin, ModCallId),
- OtherArgs, [], det) - GoalInfo },
+ aditi_builtin(Builtin, ModifiedCallId),
+ OtherArgs, GenericCallModes, det) - GoalInfo },
insert_arg_unifications(OtherArgs, OtherArgs0, Context,
call(generic_call(
- aditi_builtin(Builtin, ModCallId))),
+ aditi_builtin(Builtin, ModifiedCallId))),
no, Call, VarSet1, Goal, VarSet, Info0, Info)
;
{ invalid_aditi_update_goal(UpdateStr,
@@ -4831,21 +4905,24 @@
aditi_update_arity_error(Context, UpdateStr, Arity, [4])
).
+ % Report an error for an Aditi update with the wrong number
+ % of arguments.
:- pred aditi_update_arity_error(prog_context, string, int, list(int),
io__state, io__state).
:- mode aditi_update_arity_error(in, in, in, in, di, uo) is det.
aditi_update_arity_error(Context, UpdateStr, Arity, ExpectedArities) -->
io__set_exit_status(1),
- report_error_num_args(yes, Context,
- predicate - unqualified(UpdateStr)/Arity, ExpectedArities).
+ { MaybePredOrFunc = no },
+ report_error_num_args(yes, Context, MaybePredOrFunc,
+ unqualified(UpdateStr), Arity, ExpectedArities).
+ % Produce an invalid goal when parsing of an Aditi update fails.
:- pred invalid_aditi_update_goal(string, list(prog_term), hlds_goal_info,
hlds_goal, prog_varset, prog_varset).
:- mode invalid_aditi_update_goal(in, in, in, out, in, out) is det.
invalid_aditi_update_goal(UpdateStr, Args0, GoalInfo, Goal, VarSet0, VarSet) :-
- % initialize some fields to junk
invalid_pred_id(PredId),
invalid_proc_id(ProcId),
make_fresh_arg_vars(Args0, VarSet0, HeadVars, VarSet),
@@ -5120,26 +5197,27 @@
parse_lambda_expression(LambdaExpressionTerm,
Vars0, Modes0, Det0)
->
+ PredOrFunc = predicate,
EvalMethod = EvalMethod0, Vars1 = Vars0,
Modes1 = Modes0, Det1 = Det0, GoalTerm1 = GoalTerm0
;
- % handle higher-order pred expressions -
+ % handle higher-order pred and func expressions -
% same semantics as lambda expressions, different syntax
% (the original lambda expression syntax is now deprecated)
- F = term__atom(":-"),
- Args = [PredTerm0, GoalTerm0],
- term__coerce(PredTerm0, PredTerm),
- parse_pred_expression(PredTerm, EvalMethod0,
- Vars0, Modes0, Det0)
- ->
- EvalMethod = EvalMethod0, Vars1 = Vars0,
- Modes1 = Modes0, Det1 = Det0, GoalTerm1 = GoalTerm0
- ;
- FuncTerm0 = term__functor(F, Args, FunctorContext),
- term__coerce(FuncTerm0, FuncTerm),
- parse_pred_expression(FuncTerm, EvalMethod,
- Vars1, Modes1, Det1),
- GoalTerm1 = term__functor(term__atom("true"), [], Context)
+ parse_rule_term(Context, RHS, HeadTerm0, GoalTerm1),
+ term__coerce(HeadTerm0, HeadTerm),
+ (
+ parse_pred_expression(HeadTerm, EvalMethod0,
+ Vars0, Modes0, Det0)
+ ->
+ PredOrFunc = predicate,
+ EvalMethod = EvalMethod0, Vars1 = Vars0,
+ Modes1 = Modes0, Det1 = Det0
+ ;
+ parse_func_expression(HeadTerm, EvalMethod,
+ Vars1, Modes1, Det1),
+ PredOrFunc = function
+ )
}
->
{ qual_info_get_mq_info(Info0, MQInfo0) },
@@ -5149,7 +5227,7 @@
{ Det = Det1 },
{ term__coerce(GoalTerm1, GoalTerm) },
{ parse_goal(GoalTerm, VarSet0, ParsedGoal, VarSet1) },
- build_lambda_expression(X, predicate, EvalMethod, Vars1,
+ build_lambda_expression(X, PredOrFunc, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
Context, MainContext, SubContext, Goal, VarSet,
Info1, Info)
@@ -5180,37 +5258,6 @@
Context, MainContext, SubContext, Goal, VarSet,
Info1, Info)
;
- {
- % handle higher-order func expressions -
- % like higher-order pred expressions, but for functions
- F = term__atom(":-"),
- Args = [FuncTerm0, GoalTerm0],
- term__coerce(FuncTerm0, FuncTerm),
- parse_func_expression(FuncTerm, EvalMethod0,
- Vars0, Modes0, Det0)
- ->
- EvalMethod = EvalMethod0, Vars1 = Vars0,
- Modes1 = Modes0, Det1 = Det0, GoalTerm1 = GoalTerm0
- ;
- FuncTerm0 = term__functor(F, Args, FunctorContext),
- term__coerce(FuncTerm0, FuncTerm),
- parse_func_expression(FuncTerm, EvalMethod,
- Vars1, Modes1, Det1),
- GoalTerm1 = term__functor(term__atom("true"), [], Context)
- }
- ->
- { qual_info_get_mq_info(Info0, MQInfo0) },
- module_qual__qualify_lambda_mode_list(Modes1, Modes, Context,
- MQInfo0, MQInfo1),
- { qual_info_set_mq_info(Info0, MQInfo1, Info1) },
- { Det = Det1 },
- { term__coerce(GoalTerm1, GoalTerm) },
- { parse_goal(GoalTerm, VarSet0, ParsedGoal, VarSet1) },
- build_lambda_expression(X, function, EvalMethod, Vars1,
- Modes, Det, ParsedGoal, VarSet1,
- Context, MainContext, SubContext, Goal, VarSet,
- Info1, Info)
- ;
% handle if-then-else expressions
{ F = term__atom("else"),
Args = [term__functor(term__atom("if"), [
@@ -5312,6 +5359,27 @@
{ goal_to_conj_list(Goal1, ConjList1) },
{ list__append(ConjList0, ConjList1, ConjList) },
{ conj_list_to_goal(ConjList, GoalInfo, Goal) }.
+
+%-----------------------------------------------------------------------------%
+
+ % Parse a term of the form `Head :- Body', treating
+ % a term not in that form as `Head :- true'.
+:- pred parse_rule_term(term__context, term(T), term(T), term(T)).
+:- mode parse_rule_term(in, in, out, out) is det.
+
+parse_rule_term(Context, RuleTerm, HeadTerm, GoalTerm) :-
+ (
+ RuleTerm = term__functor(term__atom(":-"),
+ [HeadTerm0, GoalTerm0], _)
+ ->
+ HeadTerm = HeadTerm0,
+ GoalTerm = GoalTerm0
+ ;
+ HeadTerm = RuleTerm,
+ GoalTerm = term__functor(term__atom("true"), [], Context)
+ ).
+
+%-----------------------------------------------------------------------------%
:- pred build_lambda_expression(prog_var, pred_or_func, lambda_eval_method,
list(prog_term), list(mode), determinism, goal, prog_varset,
--- mercury_to_mercury.m 1999/06/27 01:01:42 1.8
+++ mercury_to_mercury.m 1999/06/29 07:12:12
@@ -2755,6 +2755,7 @@
mercury_infix_op("to"). /* NU-Prolog */
mercury_infix_op("<=").
mercury_infix_op("<=>").
+mercury_infix_op("==>").
mercury_infix_op("=>").
mercury_infix_op("when"). /* NU-Prolog */
mercury_infix_op("or"). /* NU-Prolog */
--- mode_info.m 1999/06/27 01:01:42 1.3
+++ mode_info.m 1999/06/29 01:03:24
@@ -272,6 +272,11 @@
:- mode mode_info_set_checking_extra_goals(in,
mode_info_di, mode_info_uo) is det.
+ % Find the simple_call_id to use in error messages
+ % for the given pred_id.
+:- pred mode_info_get_call_id(mode_info, pred_id, simple_call_id).
+:- mode mode_info_get_call_id(mode_info_ui, in, out) is det.
+
/*
:- inst uniq_mode_info = bound_unique(
mode_info(
@@ -836,6 +841,13 @@
;
true
).
+
+%-----------------------------------------------------------------------------%
+
+mode_info_get_call_id(ModeInfo, PredId, CallId) :-
+ mode_info_get_module_info(ModeInfo, ModuleInfo),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_call_id(PredInfo, CallId).
%-----------------------------------------------------------------------------%
--- modecheck_call.m 1999/06/27 01:01:42 1.5
+++ modecheck_call.m 1999/07/02 04:52:23
@@ -118,6 +118,8 @@
modecheck_aditi_builtin(AditiBuiltin, Args0, Modes, Det, Args, ExtraGoals) -->
{ aditi_builtin_determinism(AditiBuiltin, Det) },
+ % The argument modes are set by post_typecheck.m, so all
+ % that needs to be done here is to check that they match.
modecheck_arg_list(Args0, Args, Modes, ExtraGoals).
:- pred aditi_builtin_determinism(aditi_builtin, determinism).
--- modecheck_unify.m 1999/06/27 01:01:42 1.5
+++ modecheck_unify.m 1999/07/02 02:37:26
@@ -139,8 +139,13 @@
% and then mode-check it.
%
list__append(FuncArgVars, [X0], AllArgVars),
+
+ % The arity stored in the goal is the length of argument
+ % list, including the closure and return value.
+ adjust_func_arity(function, Arity, FullArity),
+
Goal1 = generic_call(
- higher_order(FuncVar, function, Arity + 1),
+ higher_order(FuncVar, function, FullArity),
AllArgVars, [], det),
modecheck_goal_expr(Goal1, GoalInfo0, Goal,
ModeInfo0, ModeInfo)
--- modes.m 1999/06/27 01:01:42 1.5
+++ modes.m 1999/06/29 07:32:00
@@ -1026,9 +1026,7 @@
GoalInfo0, Goal) -->
mode_checkpoint(enter, "call"),
=(ModeInfo0),
- { mode_info_get_module_info(ModeInfo0, ModuleInfo0) },
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo) },
- { pred_info_get_call_id(PredInfo, CallId) },
+ { mode_info_get_call_id(ModeInfo0, PredId, CallId) },
{ mode_info_get_instmap(ModeInfo0, InstMap0) },
{ DeterminismKnown = no },
@@ -1110,9 +1108,7 @@
ArgNameMap, OrigArgTypes, PragmaCode), GoalInfo, Goal) -->
mode_checkpoint(enter, "pragma_c_code"),
=(ModeInfo0),
- { mode_info_get_module_info(ModeInfo0, ModuleInfo0) },
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo) },
- { pred_info_get_call_id(PredInfo, CallId) },
+ { mode_info_get_call_id(ModeInfo0, PredId, CallId) },
{ mode_info_get_instmap(ModeInfo0, InstMap0) },
{ DeterminismKnown = no },
--- pd_util.m 1999/06/27 01:01:42 1.7
+++ pd_util.m 1999/07/01 05:56:03
@@ -893,6 +893,9 @@
pd_util__collect_matching_arg_types(Args, Types,
Renaming, MatchingTypes1, MatchingTypes).
+ % Check that the shape of the goals matches, and that there
+ % is a mapping from the variables in the old goal to the
+ % variables in the new goal.
:- pred pd_util__goals_match_2(list(hlds_goal)::in,
list(hlds_goal)::in, map(prog_var, prog_var)::in,
map(prog_var, prog_var)::out) is semidet.
@@ -933,14 +936,15 @@
OldGoal = call(PredId, ProcId, OldArgs, _, _, _) - _,
NewGoal = call(PredId, ProcId, NewArgs, _, _, _) - _
;
- % XXX we could do better matching the types and modes
- % here.
+ % We don't need to check the modes here -
+ % if the goals match and the insts of the argument
+ % variables match, the modes of the call must
+ % be the same.
OldGoal = generic_call(OldGenericCall, OldArgs1,
- Modes, Det) - _,
+ _, Det) - _,
NewGoal = generic_call(NewGenericCall, NewArgs1,
- Modes, Det) - _,
- functor(OldGenericCall, GenericCallType, _),
- functor(NewGenericCall, GenericCallType, _),
+ _, Det) - _,
+ match_generic_call(OldGenericCall, NewGenericCall),
goal_util__generic_call_vars(OldGenericCall,
OldArgs0),
goal_util__generic_call_vars(NewGenericCall,
@@ -980,6 +984,31 @@
),
pd_util__goals_match_2(OldGoals, NewGoals,
ONRenaming1, ONRenaming).
+
+ % Check that two `generic_call' goals are equivalent.
+:- pred match_generic_call(generic_call::in, generic_call::in) is semidet.
+
+match_generic_call(higher_order(_, PredOrFunc, Arity),
+ higher_order(_, PredOrFunc, Arity)).
+match_generic_call(class_method(_, MethodNum, ClassId, CallId),
+ class_method(_, MethodNum, ClassId, CallId)).
+match_generic_call(aditi_builtin(Builtin1, CallId),
+ aditi_builtin(Builtin2, CallId)) :-
+ match_aditi_builtin(Builtin1, Builtin2).
+
+ % Check that two `aditi_builtin' goals are equivalent.
+:- pred match_aditi_builtin(aditi_builtin::in, aditi_builtin::in) is semidet.
+
+ % The other fields are all implied by the pred_proc_id.
+match_aditi_builtin(aditi_call(PredProcId, _, _, _),
+ aditi_call(PredProcId, _, _, _)).
+match_aditi_builtin(aditi_insert(PredId), aditi_insert(PredId)).
+ % The syntax used does not change the result of the call.
+match_aditi_builtin(aditi_delete(PredId, _), aditi_delete(PredId, _)).
+match_aditi_builtin(aditi_bulk_operation(Op, PredId),
+ aditi_bulk_operation(Op, PredId)).
+ % The syntax used does not change the result of the call.
+match_aditi_builtin(aditi_modify(PredId, _), aditi_modify(PredId, _)).
%-----------------------------------------------------------------------------%
--- post_typecheck.m 1999/06/27 01:01:42 1.5
+++ post_typecheck.m 1999/07/02 04:45:58
@@ -58,12 +58,17 @@
:- mode post_typecheck__resolve_pred_overloading(in, in, in, in, in,
out, out) is det.
- % Resolve overloading.
+ % Resolve overloading and fill in the argument modes
+ % of a call to an Aditi builtin.
+ % Check that a relation modified by one of the Aditi update
+ % goals is a base relation.
+ %
:- pred post_typecheck__finish_aditi_builtin(module_info, pred_info,
- list(prog_var), aditi_builtin, aditi_builtin,
- simple_call_id, simple_call_id, list(mode)).
-:- mode post_typecheck__finish_aditi_builtin(in, in, in,
- in, out, in, out, out) is det.
+ list(prog_var), term__context, aditi_builtin, aditi_builtin,
+ simple_call_id, simple_call_id, list(mode),
+ io__state, io__state).
+:- mode post_typecheck__finish_aditi_builtin(in, in, in, in,
+ in, out, in, out, out, di, uo) is det.
% Do the stuff needed to initialize the proc_infos so that
% a pred is ready for mode checking (copy clauses from the
@@ -310,7 +315,7 @@
post_typecheck__resolve_pred_overloading(PredId0, Args0, CallerPredInfo,
ModuleInfo, PredName0, PredName, PredId) :-
- ( invalid_pred_id(PredId0) ->
+ ( invalid_pred_id(PredId0) ->
%
% Find the set of candidate pred_ids for predicates which
% have the specified name and arity
@@ -318,43 +323,64 @@
pred_info_typevarset(CallerPredInfo, TVarSet),
pred_info_clauses_info(CallerPredInfo, ClausesInfo),
ClausesInfo = clauses_info(_, _, VarTypes, _, _),
- typecheck__resolve_pred_overloading(ModuleInfo, Args0,
- VarTypes, TVarSet, PredName0, PredName, PredId)
+ map__apply_to_list(Args0, VarTypes, ArgTypes),
+ typecheck__resolve_pred_overloading(ModuleInfo,
+ ArgTypes, TVarSet, PredName0, PredName, PredId)
;
- PredId = PredId0,
- PredName = PredName0
+ PredId = PredId0,
+ PredName = PredName0
).
%-----------------------------------------------------------------------------%
-post_typecheck__finish_aditi_builtin(_, _, _, aditi_call(_, _, _, _),
- _, _, _, _) :-
- error("post_typecheck__finish_aditi_builtin: aditi_call").
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args,
- aditi_insert(PredId0), aditi_insert(PredId),
- PredOrFunc - SymName0/Arity, PredOrFunc - SymName/Arity,
- Modes) :-
+post_typecheck__finish_aditi_builtin(_, _, _, _, aditi_call(_, _, _, _),
+ _, _, _, _) -->
+ % These are only added by magic.m.
+ { error("post_typecheck__finish_aditi_builtin: aditi_call") }.
+post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo,
+ Args, Context, aditi_insert(PredId0), Builtin,
+ PredOrFunc - SymName0/Arity, InsertCallId,
+ Modes, IO0, IO) :-
+ % make_hlds.m checks the arity, so this is guaranteed to succeed.
get_state_args_det(Args, OtherArgs, _, _),
+
+ % The tuple to insert has the same argument types as
+ % the relation being inserted into.
post_typecheck__resolve_pred_overloading(PredId0, OtherArgs,
CallerPredInfo, ModuleInfo, SymName0, SymName, PredId),
- module_info_pred_info(ModuleInfo, PredId, CalledPredInfo),
- pred_info_arg_types(CalledPredInfo, ArgTypes),
+ Builtin = aditi_insert(PredId),
+ InsertCallId = PredOrFunc - SymName/Arity,
+
+ module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
+ check_base_relation(Context, RelationPredInfo,
+ Builtin, InsertCallId, IO0, IO),
+
+ % `aditi_insert' calls do not use the `aditi_state' argument
+ % in the tuple to insert, so set its mode to `unused'.
+ % The other arguments all have mode `in'.
+ pred_info_arg_types(RelationPredInfo, ArgTypes),
in_mode(InMode),
aditi_builtin_modes(InMode, (aditi_top_down),
ArgTypes, InsertArgModes),
list__append(InsertArgModes, [aditi_di_mode, aditi_uo_mode], Modes).
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args,
+post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
aditi_delete(PredId0, Syntax), aditi_delete(PredId, Syntax),
PredOrFunc - SymName0/Arity, PredOrFunc - SymName/Arity,
- Modes) :-
- AdjustArgTypes = lambda([X::in, X::out] is det, true),
+ Modes, IO0, IO) :-
+ AdjustArgTypes = (pred(X::in, X::out) is det),
resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
AdjustArgTypes, PredId0, PredId, SymName0, SymName),
- module_info_pred_info(ModuleInfo, PredId, CalledPredInfo),
- pred_info_arg_types(CalledPredInfo, ArgTypes),
+ Builtin = aditi_delete(PredId, Syntax),
+ DeleteCallId = PredOrFunc - SymName/Arity,
+
+ module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
+ check_base_relation(Context, RelationPredInfo,
+ Builtin, DeleteCallId, IO0, IO),
+
+ pred_info_arg_types(RelationPredInfo, ArgTypes),
in_mode(InMode),
aditi_builtin_modes(InMode, (aditi_top_down),
ArgTypes, DeleteArgModes),
@@ -362,55 +388,70 @@
DeleteArgModes, semidet))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args,
- aditi_bulk_operation(Op, PredId0),
- aditi_bulk_operation(Op, PredId),
- PredOrFunc - SymName0/Arity, PredOrFunc - SymName/Arity,
- Modes) :-
- AdjustArgTypes = lambda([X::in, X::out] is det, true),
+post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
+ aditi_bulk_operation(Op, PredId0), Builtin,
+ PredOrFunc - SymName0/Arity, BulkOpCallId, Modes, IO0, IO) :-
+ AdjustArgTypes = (pred(X::in, X::out) is det),
resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
AdjustArgTypes, PredId0, PredId, SymName0, SymName),
- module_info_pred_info(ModuleInfo, PredId, CalledPredInfo),
- pred_info_arg_types(CalledPredInfo, ArgTypes),
+ Builtin = aditi_bulk_operation(Op, PredId),
+ BulkOpCallId = PredOrFunc - SymName/Arity,
+
+ module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
+ check_base_relation(Context, RelationPredInfo,
+ Builtin, BulkOpCallId, IO0, IO),
+
+ pred_info_arg_types(RelationPredInfo, ArgTypes),
out_mode(OutMode),
aditi_builtin_modes(OutMode, (aditi_bottom_up), ArgTypes, OpArgModes),
Inst = ground(shared, yes(pred_inst_info(PredOrFunc,
OpArgModes, nondet))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args,
- aditi_modify(PredId0, Syntax), aditi_modify(PredId, Syntax),
- PredOrFunc - SymName0/Arity, PredOrFunc - SymName/Arity,
- Modes) :-
+post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
+ aditi_modify(PredId0, Syntax), Builtin,
+ PredOrFunc - SymName0/Arity, ModifyCallId, Modes, IO0, IO) :-
% The argument types of the closure passed to `aditi_modify'
% contain two copies of the arguments of the base relation -
% one set input and one set output.
AdjustArgTypes =
- lambda([Types0::in, Types::out] is det, (
+ (pred(Types0::in, Types::out) is det :-
list__length(Types0, Length),
HalfLength is Length // 2,
( list__split_list(HalfLength, Types0, Types1, _) ->
Types = Types1
;
- error("post_typecheck__finish_aditi_builtin: modify")
+ error(
+ "post_typecheck__finish_aditi_builtin: aditi_modify")
)
- )),
+ ),
resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
AdjustArgTypes, PredId0, PredId, SymName0, SymName),
- module_info_pred_info(ModuleInfo, PredId, CalledPredInfo),
- pred_info_arg_types(CalledPredInfo, ArgTypes),
+
+ Builtin = aditi_delete(PredId, Syntax),
+ ModifyCallId = PredOrFunc - SymName/Arity,
+
+ module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
+ check_base_relation(Context, RelationPredInfo,
+ Builtin, ModifyCallId, IO0, IO),
+
+ % Set up the modes of the closure passed to the call to `aditi_modify'.
+ pred_info_arg_types(RelationPredInfo, ArgTypes),
in_mode(InMode),
out_mode(OutMode),
aditi_builtin_modes(InMode, (aditi_top_down), ArgTypes, InputArgModes),
aditi_builtin_modes(OutMode, (aditi_top_down),
ArgTypes, OutputArgModes),
list__append(InputArgModes, OutputArgModes, ModifyArgModes),
- Inst = ground(shared, yes(pred_inst_info(predicate,
- ModifyArgModes, semidet))),
+ Inst = ground(shared,
+ yes(pred_inst_info(predicate, ModifyArgModes, semidet))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
+ % Use the type of the closure passed to an `aditi_delete',
+ % `aditi_bulk_insert', `aditi_bulk_delete' or `aditi_modify'
+ % call to work out which predicate is being updated.
:- pred resolve_aditi_builtin_overloading(module_info, pred_info,
list(prog_var), pred(list(type), list(type)),
pred_id, pred_id, sym_name, sym_name).
@@ -419,6 +460,7 @@
resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
AdjustArgTypes, PredId0, PredId, SymName0, SymName) :-
+ % make_hlds.m checks the arity, so this is guaranteed to succeed.
get_state_args_det(Args, OtherArgs, _, _),
( invalid_pred_id(PredId0) ->
(
@@ -431,24 +473,21 @@
(aditi_top_down), ArgTypes0)
->
call(AdjustArgTypes, ArgTypes0, ArgTypes),
- FilterPredIds =
- lambda([Module::in, PredIds0::in,
- PredIds::out] is det, (
- list__filter(
- hlds_pred__is_base_relation(Module),
- PredIds0, PredIds)
- )),
- typecheck__resolve_pred_overloading_2(ModuleInfo,
- FilterPredIds, ArgTypes, TVarSet,
- SymName0, SymName, PredId)
+ typecheck__resolve_pred_overloading(ModuleInfo,
+ ArgTypes, TVarSet, SymName0, SymName, PredId)
;
- error("post_typecheck__finish_aditi_builtin: delete")
+ error(
+ "post_typecheck__resolve_aditi_builtin_overloading")
)
;
PredId = PredId0,
SymName = SymName0
).
+ % Work out the modes of the arguments of a closure passed
+ % to an Aditi update.
+ % The `Mode' passed is the mode of all arguments apart
+ % from the `aditi__state'.
:- pred aditi_builtin_modes((mode), lambda_eval_method,
list(type), list(mode)).
:- mode aditi_builtin_modes(in, in, in, out) is det.
@@ -460,8 +499,12 @@
( EvalMethod = (aditi_top_down) ->
% The top-down Aditi closures are not allowed
% to call database predicates, so their aditi__state
- % arguments must have mode `unused'
- ArgMode = (free -> free)
+ % arguments must have mode `unused'.
+ % The `aditi__state's are passed even though
+ % they are not used so that the argument
+ % list of the closure matches the argument list
+ % of the relation being updated.
+ unused_mode(ArgMode)
;
ArgMode = aditi_ui_mode
)
@@ -469,6 +512,30 @@
ArgMode = Mode
),
aditi_builtin_modes(Mode, EvalMethod, ArgTypes, ArgModes).
+
+ % Report an error if a predicate modified by an Aditi builtin
+ % is not a base relation.
+:- pred check_base_relation(prog_context, pred_info, aditi_builtin,
+ simple_call_id, io__state, io__state).
+:- mode check_base_relation(in, in, in, in, di, uo) is det.
+
+check_base_relation(Context, PredInfo, Builtin, CallId) -->
+ ( { hlds_pred__pred_info_is_base_relation(PredInfo) } ->
+ []
+ ;
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string("In call to "),
+ hlds_out__write_call_id(
+ generic_call(aditi_builtin(Builtin, CallId))
+ ),
+ io__write_string(":\n"),
+ prog_out__write_context(Context),
+ io__write_string(" the modified "),
+ { pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+ hlds_out__write_pred_or_func(PredOrFunc),
+ io__write_string(" is not a base relation.\n")
+ ).
%-----------------------------------------------------------------------------%
--- prog_io_goal.m 1999/06/27 01:01:42 1.4
+++ prog_io_goal.m 1999/06/27 23:36:05
@@ -76,7 +76,8 @@
:- mode parse_func_expression(in, out, out, out, out) is semidet.
% parse_lambda_eval_method/3 extracts the `aditi' or `aditi_top_down'
- % annotation from a pred expression and returns the rest of the term.
+ % annotation (if any) from a pred expression and returns the rest
+ % of the term.
:- pred parse_lambda_eval_method(term(T), lambda_eval_method, term(T)).
:- mode parse_lambda_eval_method(in, out, out) is det.
--- purity.m 1999/06/27 01:01:42 1.4
+++ purity.m 1999/06/30 05:02:21
@@ -426,8 +426,9 @@
).
compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det),
generic_call(GenericCall, Args, Modes, Det),
- _GoalInfo, PredInfo, ModuleInfo, _InClosure, pure,
+ GoalInfo, PredInfo, ModuleInfo, _InClosure, Purity,
NumErrors, NumErrors) -->
+ { Purity = pure },
(
{ GenericCall0 = higher_order(_, _, _) },
{ GenericCall = GenericCall0 },
@@ -438,8 +439,10 @@
{ Modes = Modes0 }
;
{ GenericCall0 = aditi_builtin(Builtin0, CallId0) },
- { post_typecheck__finish_aditi_builtin(ModuleInfo, PredInfo,
- Args, Builtin0, Builtin, CallId0, CallId, Modes) },
+ { goal_info_get_context(GoalInfo, Context) },
+ post_typecheck__finish_aditi_builtin(ModuleInfo, PredInfo,
+ Args, Context, Builtin0, Builtin,
+ CallId0, CallId, Modes),
{ GenericCall = aditi_builtin(Builtin, CallId) }
).
compute_expr_purity(switch(Var,Canfail,Cases0,Storemap),
@@ -475,7 +478,11 @@
% `aditi_top_down' predicates can't call
% database predicates, so their `aditi__state'
% arguments must have mode `unused'.
- StateMode = (free -> free)
+ % The `aditi__state's are passed even
+ % though they are not used so that the
+ % arguments of the closure and the
+ % base relation being updated match.
+ unused_mode(StateMode)
;
EvalMethod = (aditi_bottom_up),
% Make sure `aditi_bottom_up' expressions have
@@ -581,14 +588,14 @@
error("purity:fix_aditi_state_modes").
fix_aditi_state_modes(_, [], [_|_], []) :-
error("purity:fix_aditi_state_modes").
-fix_aditi_state_modes(Mode, [Type | Types],
+fix_aditi_state_modes(AditiStateMode, [Type | Types],
[ArgMode0 | Modes0], [ArgMode | Modes]) :-
( type_is_aditi_state(Type) ->
- ArgMode = Mode
+ ArgMode = AditiStateMode
;
ArgMode = ArgMode0
),
- fix_aditi_state_modes(Mode, Types, Modes0, Modes).
+ fix_aditi_state_modes(AditiStateMode, Types, Modes0, Modes).
%-----------------------------------------------------------------------------%
% Print error messages
--- quantification.m 1999/06/27 01:01:42 1.5
+++ quantification.m 1999/06/27 23:38:15
@@ -333,12 +333,11 @@
UnifyRHS, Unification),
quantification__get_nonlocals(VarsUnifyRHS),
{ set__insert(VarsUnifyRHS, Var, GoalVars0) },
- { Unification = construct(_, _, _, _, CellToReuse, _, _) ->
- ( CellToReuse = yes(cell_to_reuse(ReuseVar, _, _)) ->
- set__insert(GoalVars0, ReuseVar, GoalVars)
- ;
- GoalVars = GoalVars0
- )
+ {
+ Unification = construct(_, _, _, _, CellToReuse, _, _),
+ CellToReuse = yes(cell_to_reuse(ReuseVar, _, _))
+ ->
+ set__insert(GoalVars0, ReuseVar, GoalVars)
;
GoalVars = GoalVars0
},
@@ -644,12 +643,11 @@
quantification__goal_vars_2(unify(A, B, _, D, _), Set0, LambdaSet0,
Set, LambdaSet) :-
set__insert(Set0, A, Set1),
- ( D = construct(_, _, _, _, Reuse, _, _) ->
- ( Reuse = yes(cell_to_reuse(ReuseVar, _, _)) ->
- set__insert(Set1, ReuseVar, Set2)
- ;
- Set2 = Set1
- )
+ (
+ D = construct(_, _, _, _, Reuse, _, _),
+ Reuse = yes(cell_to_reuse(ReuseVar, _, _))
+ ->
+ set__insert(Set1, ReuseVar, Set2)
;
Set2 = Set1
),
--- table_gen.m 1999/06/27 01:01:42 1.5
+++ table_gen.m 1999/06/28 02:00:22
@@ -630,20 +630,8 @@
PredId, ProcId, PredTableVar, Goal) :-
generate_new_table_var("PredTable", VarTypes0, VarTypes,
VarSet0, VarSet, PredTableVar),
-
ConsId = tabling_pointer_const(PredId, ProcId),
- VarInst = ground(unique, no),
- UnifyMode = (free -> VarInst) - (VarInst -> VarInst),
- UnifyContext = unify_context(explicit, []),
- GoalExpr = unify(PredTableVar, functor(ConsId, []), UnifyMode,
- construct(PredTableVar, ConsId, [], [], no, cell_is_unique, no),
- UnifyContext),
-
- set__singleton_set(NonLocals, PredTableVar),
- instmap_delta_from_assoc_list([PredTableVar - VarInst],
- InstMapDelta),
- goal_info_init(NonLocals, InstMapDelta, det,
- GoalInfo0),
+ make_const_construction(PredTableVar, ConsId, GoalExpr - GoalInfo0),
goal_info_add_feature(GoalInfo0, impure, GoalInfo),
Goal = GoalExpr - GoalInfo.
@@ -1165,24 +1153,9 @@
gen_int_construction(VarName, VarValue, VarTypes0, VarTypes, VarSet0, VarSet,
Var, Goal) :-
-
- varset__new_named_var(VarSet0, VarName, Var, VarSet),
- term__context_init(Context),
- VarType = term__functor(term__atom("int"), [], Context),
- map__set(VarTypes0, Var, VarType, VarTypes),
-
- Inst = bound(unique, [functor(int_const(VarValue), [])]),
- VarUnify = unify(Var, functor(int_const(VarValue), []),
- (free -> Inst) - (Inst -> Inst),
- construct(Var, int_const(VarValue), [], [],
- no, cell_is_unique, no),
- unify_context(explicit, [])),
- set__singleton_set(VarNonLocals, Var),
- instmap_delta_from_assoc_list([Var - Inst],
- VarInstMapDelta),
- goal_info_init(VarNonLocals, VarInstMapDelta, det,
- VarGoalInfo),
- Goal = VarUnify - VarGoalInfo.
+ make_int_const_construction(VarValue, Goal, Var,
+ VarTypes0, VarTypes, VarSet0, VarSet1),
+ varset__name_var(VarSet1, Var, VarName, VarSet).
:- pred gen_string_construction(string, string, map(prog_var, type),
map(prog_var, type), prog_varset, prog_varset, prog_var,
@@ -1191,24 +1164,9 @@
gen_string_construction(VarName, VarValue, VarTypes0, VarTypes, VarSet0, VarSet,
Var, Goal) :-
-
- varset__new_named_var(VarSet0, VarName, Var, VarSet),
- term__context_init(Context),
- VarType = term__functor(term__atom("string"), [], Context),
- map__set(VarTypes0, Var, VarType, VarTypes),
-
- Inst = bound(unique, [functor(string_const(VarValue), [])]),
- VarUnify = unify(Var, functor(string_const(VarValue), []),
- (free -> Inst) - (Inst -> Inst),
- construct(Var, string_const(VarValue), [], [],
- no, cell_is_unique, no),
- unify_context(explicit, [])),
- set__singleton_set(VarNonLocals, Var),
- instmap_delta_from_assoc_list([Var - Inst],
- VarInstMapDelta),
- goal_info_init(VarNonLocals, VarInstMapDelta, det,
- VarGoalInfo),
- Goal = VarUnify - VarGoalInfo.
+ make_string_const_construction(VarValue, Goal, Var,
+ VarTypes0, VarTypes, VarSet0, VarSet1),
+ varset__name_var(VarSet1, Var, VarName, VarSet).
:- pred get_table_var_type(type).
:- mode get_table_var_type(out) is det.
--- typecheck.m 1999/06/27 01:01:42 1.6
+++ typecheck.m 1999/07/02 02:48:49
@@ -103,7 +103,7 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_data, prog_data.
-:- import_module bool, io, list, map.
+:- import_module bool, io, list, map, std_util.
:- pred typecheck(module_info, module_info, bool, io__state, io__state).
:- mode typecheck(in, out, out, di, uo) is det.
@@ -129,16 +129,9 @@
% Abort if there is no matching pred.
% Abort if there are multiple matching preds.
-:- pred typecheck__resolve_pred_overloading(module_info, list(prog_var),
- map(prog_var, type), tvarset, sym_name, sym_name, pred_id).
-:- mode typecheck__resolve_pred_overloading(in, in, in, in,
- in, out, out) is det.
-
-:- pred typecheck__resolve_pred_overloading_2(module_info,
- pred(module_info, list(pred_id), list(pred_id)),
- list(type), tvarset, sym_name, sym_name, pred_id).
-:- mode typecheck__resolve_pred_overloading_2(in, pred(in, in, out) is det,
- in, in, in, out, out) is det.
+:- pred typecheck__resolve_pred_overloading(module_info, list(type),
+ tvarset, sym_name, sym_name, pred_id).
+:- mode typecheck__resolve_pred_overloading(in, in, in, in, out, out) is det.
% Find a predicate or function from the list of pred_ids
% which matches the given name and argument types.
@@ -160,13 +153,14 @@
:- mode typecheck__reduce_context_by_rule_application(in, in, in, in, in, out,
in, out, in, out) is det.
- % report_error_num_args(IsFirst, Context, CallId, CorrectArities).
+ % report_error_num_args(IsFirst, Context, MaybePredOrFunc,
+ % SymName, Arity, CorrectArities).
% Report an error for a call with the wrong number of arguments.
% `IsFirst' should be `yes' if there are no previous lines in the
% error message.
-:- pred report_error_num_args(bool, term__context, simple_call_id,
- list(int), io__state, io__state).
-:- mode report_error_num_args(in, in, in, in, di, uo) is det.
+:- pred report_error_num_args(bool, term__context, maybe(pred_or_func),
+ sym_name, int, list(int), io__state, io__state).
+:- mode report_error_num_args(in, in, in, in, in, in, di, uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -180,7 +174,7 @@
:- import_module passes_aux, clause_to_proc, special_pred, inst_match.
:- import_module term, varset.
-:- import_module int, set, string, require, std_util, tree234, multi_map.
+:- import_module int, set, string, require, tree234, multi_map.
:- import_module assoc_list, varset, term_io.
%-----------------------------------------------------------------------------%
@@ -940,8 +934,9 @@
{ error("typecheck_goal_2: unexpected class method call") }
;
{ GenericCall0 = aditi_builtin(AditiBuiltin0, PredCallId) },
- typecheck_aditi_builtin(PredCallId,
- AditiBuiltin0, AditiBuiltin, Args),
+ checkpoint("aditi builtin"),
+ typecheck_aditi_builtin(PredCallId, Args,
+ AditiBuiltin0, AditiBuiltin),
{ GenericCall = aditi_builtin(AditiBuiltin, PredCallId) }
).
typecheck_goal_2(unify(A, B0, Mode, Info, UnifyContext),
@@ -1059,111 +1054,128 @@
%-----------------------------------------------------------------------------%
-:- pred typecheck_aditi_builtin(simple_call_id, aditi_builtin, aditi_builtin,
- list(prog_var), typecheck_info, typecheck_info).
-:- mode typecheck_aditi_builtin(in, in, out, in, typecheck_info_di,
+:- pred typecheck_aditi_builtin(simple_call_id, list(prog_var),
+ aditi_builtin, aditi_builtin,
+ typecheck_info, typecheck_info).
+:- mode typecheck_aditi_builtin(in, in, in, out, typecheck_info_di,
typecheck_info_uo) is det.
-typecheck_aditi_builtin(CallId, Builtin0, Builtin, Args) -->
+typecheck_aditi_builtin(CallId, Args, Builtin0, Builtin) -->
+ % This must succeed because make_hlds.m does not add a clause
+ % to the clauses_info if it contains Aditi updates with the
+ % wrong number of arguments.
{ get_state_args_det(Args, OtherArgs, State0, State) },
- typecheck_aditi_builtin_2(CallId, Builtin0, Builtin, OtherArgs),
- check_aditi_state_args(aditi_builtin_first_state_arg(Builtin0, CallId),
+
+ typecheck_aditi_builtin_2(CallId, OtherArgs,
+ Builtin0, Builtin),
+
+ typecheck_aditi_state_args(Builtin0, CallId,
State0, State).
-:- pred typecheck_aditi_builtin_2(simple_call_id, aditi_builtin, aditi_builtin,
- list(prog_var), typecheck_info, typecheck_info).
-:- mode typecheck_aditi_builtin_2(in, in, out, in,
+ % Typecheck the arguments of an Aditi update other than
+ % the `aditi__state' arguments.
+:- pred typecheck_aditi_builtin_2(simple_call_id, list(prog_var),
+ aditi_builtin, aditi_builtin, typecheck_info, typecheck_info).
+:- mode typecheck_aditi_builtin_2(in, in, in, out,
typecheck_info_di, typecheck_info_uo) is det.
-typecheck_aditi_builtin_2(_, aditi_call(_, _, _, _), _, _) -->
+typecheck_aditi_builtin_2(_, _, aditi_call(_, _, _, _), _) -->
+ % There are only added by magic.m.
{ error("typecheck_aditi_builtin: unexpected aditi_call") }.
-typecheck_aditi_builtin_2(CallId, aditi_insert(_),
- aditi_insert(PredId), Args) -->
- % The first `aditi__state' argument is always argument 2.
+typecheck_aditi_builtin_2(CallId, Args, aditi_insert(_),
+ aditi_insert(PredId)) -->
+ % The tuple to insert has the same argument types
+ % as the relation being inserted into.
typecheck_call_pred(CallId, Args, PredId).
-typecheck_aditi_builtin_2(CallId, aditi_delete(_, Syntax),
- aditi_delete(PredId, Syntax), Args) -->
- { CallId = PredOrFunc - _ },
- typecheck_aditi_builtin_higher_order_arg(CallId, PredOrFunc,
+typecheck_aditi_builtin_2(CallId, Args, aditi_delete(_, Syntax),
+ aditi_delete(PredId, Syntax)) -->
+ typecheck_aditi_delete_or_bulk_operation_closure(CallId,
(aditi_top_down), Args, PredId).
-typecheck_aditi_builtin_2(CallId, aditi_bulk_operation(BulkOp, _),
- aditi_bulk_operation(BulkOp, PredId), Args) -->
- { CallId = PredOrFunc - _ },
- typecheck_aditi_builtin_higher_order_arg(CallId, PredOrFunc,
+typecheck_aditi_builtin_2(CallId, Args, aditi_bulk_operation(BulkOp, _),
+ aditi_bulk_operation(BulkOp, PredId)) -->
+ typecheck_aditi_delete_or_bulk_operation_closure(CallId,
(aditi_bottom_up), Args, PredId).
-typecheck_aditi_builtin_2(CallId, aditi_modify(_, Syntax),
- aditi_modify(PredId, Syntax), Args) -->
+typecheck_aditi_builtin_2(CallId, Args, aditi_modify(_, Syntax),
+ aditi_modify(PredId, Syntax)) -->
% `aditi_modify' takes a closure which takes two sets of arguments
% corresponding to those of the base relation - one set input
% and one set output.
{ AdjustArgTypes =
- lambda([ArgTypes0::in, ArgTypes::out] is det, (
- list__append(ArgTypes0, ArgTypes0, ArgTypes1),
+ lambda([RelationArgTypes::in, AditiModifyTypes::out] is det, (
+ list__append(RelationArgTypes, RelationArgTypes,
+ ClosureArgTypes),
construct_higher_order_pred_type((aditi_top_down),
- ArgTypes1, HOType),
- ArgTypes = [HOType]
+ ClosureArgTypes, ClosureType),
+ AditiModifyTypes = [ClosureType]
)) },
- typecheck_aditi_builtin_higher_order_arg_2(CallId,
- Args, AdjustArgTypes, PredId).
-
-:- func aditi_builtin_first_state_arg(aditi_builtin, simple_call_id) = int.
-
-aditi_builtin_first_state_arg(aditi_call(_, _, _, _), _) = _ :-
- error("aditi_builtin_first_state_arg: unexpected_aditi_call").
-aditi_builtin_first_state_arg(aditi_insert(_), _ - _/Arity) = Arity + 1.
-aditi_builtin_first_state_arg(aditi_delete(_, _), _) = 2.
-aditi_builtin_first_state_arg(aditi_bulk_operation(_, _), _) = 2.
-aditi_builtin_first_state_arg(aditi_modify(_, _), _) = 2.
+ typecheck_aditi_builtin_closure(CallId, Args, AdjustArgTypes, PredId).
-:- pred typecheck_aditi_builtin_higher_order_arg(simple_call_id, pred_or_func,
+ % Typecheck the closure passed to an `aditi_delete',
+ % `aditi_bulk_insert' or `aditi_bulk_delete' which
+ % determines which tuples are inserted or deleted.
+ % The argument types of the closure are the same as the
+ % argument types of the base relation being updated.
+:- pred typecheck_aditi_delete_or_bulk_operation_closure(simple_call_id,
lambda_eval_method, list(prog_var), pred_id,
typecheck_info, typecheck_info).
-:- mode typecheck_aditi_builtin_higher_order_arg(in, in, in, in, out,
+:- mode typecheck_aditi_delete_or_bulk_operation_closure(in, in, in, out,
typecheck_info_di, typecheck_info_uo) is det.
-typecheck_aditi_builtin_higher_order_arg(CallId, PredOrFunc,
+typecheck_aditi_delete_or_bulk_operation_closure(CallId,
EvalMethod, Args, PredId) -->
+ { CallId = PredOrFunc - _ },
{ AdjustArgTypes =
- lambda([ArgTypes0::in, ArgTypes::out] is det, (
+ lambda([RelationArgTypes::in, UpdateArgTypes::out] is det, (
construct_higher_order_type(PredOrFunc,
- EvalMethod, ArgTypes0, HOType),
- ArgTypes = [HOType]
+ EvalMethod, RelationArgTypes, ClosureType),
+ UpdateArgTypes = [ClosureType]
)) },
- typecheck_aditi_builtin_higher_order_arg_2(CallId,
- Args, AdjustArgTypes, PredId).
+ typecheck_aditi_builtin_closure(CallId, Args, AdjustArgTypes, PredId).
-:- pred typecheck_aditi_builtin_higher_order_arg_2(simple_call_id,
+ % Check that there is only one argument (other than the `aditi__state'
+ % arguments) passed to an `aditi_delete', `aditi_bulk_insert',
+ % `aditi_bulk_delete' or `aditi_modify', then typecheck that argument.
+:- pred typecheck_aditi_builtin_closure(simple_call_id,
list(prog_var), adjust_arg_types, pred_id,
typecheck_info, typecheck_info).
-:- mode typecheck_aditi_builtin_higher_order_arg_2(in,
+:- mode typecheck_aditi_builtin_closure(in,
in, in(adjust_arg_types), out,
typecheck_info_di, typecheck_info_uo) is det.
-typecheck_aditi_builtin_higher_order_arg_2(CallId,
- OtherArgs, AdjustArgTypes, PredId) -->
+typecheck_aditi_builtin_closure(CallId, OtherArgs, AdjustArgTypes, PredId) -->
( { OtherArgs = [HOArg] } ->
- { FilterPredIds =
- lambda([Module::in, PredIds0::in, PredIds::out] is det, (
- list__filter(hlds_pred__is_base_relation(Module),
- PredIds0, PredIds)
- )) },
- typecheck_call_pred_2(CallId, [HOArg],
- FilterPredIds, AdjustArgTypes, PredId)
+ typecheck_call_pred_adjust_arg_types(CallId, [HOArg],
+ AdjustArgTypes, PredId)
;
+ % An error should have been reported by make_hlds.m.
{ error(
- "typecheck_aditi_builtin: incorrect arity for aditi_delete") }
+ "typecheck_aditi_builtin: incorrect arity for builtin") }
).
-:- pred check_aditi_state_args(int, prog_var, prog_var,
- typecheck_info, typecheck_info).
-:- mode check_aditi_state_args(in, in, in,
+ % Typecheck the DCG state arguments in the argument
+ % list of an Aditi builtin.
+:- pred typecheck_aditi_state_args(aditi_builtin, simple_call_id,
+ prog_var, prog_var, typecheck_info, typecheck_info).
+:- mode typecheck_aditi_state_args(in, in, in, in,
typecheck_info_di, typecheck_info_uo) is det.
-check_aditi_state_args(FirstStateIndex, AditiState0, AditiState) -->
+typecheck_aditi_state_args(Builtin, CallId, AditiState0Var, AditiStateVar) -->
{ construct_type(qualified(unqualified("aditi"), "state") - 0,
[], StateType) },
- typecheck_var_has_type_list([AditiState0, AditiState],
- [StateType, StateType], FirstStateIndex).
+ typecheck_var_has_type_list([AditiState0Var, AditiStateVar],
+ [StateType, StateType],
+ aditi_builtin_first_state_arg(Builtin, CallId)).
+
+ % Return the index in the argument list of the first
+ % `aditi__state' DCG argument.
+:- func aditi_builtin_first_state_arg(aditi_builtin, simple_call_id) = int.
+
+aditi_builtin_first_state_arg(aditi_call(_, _, _, _), _) = _ :-
+ error("aditi_builtin_first_state_arg: unexpected_aditi_call").
+aditi_builtin_first_state_arg(aditi_insert(_), _ - _/Arity) = Arity + 1.
+aditi_builtin_first_state_arg(aditi_delete(_, _), _) = 2.
+aditi_builtin_first_state_arg(aditi_bulk_operation(_, _), _) = 2.
+aditi_builtin_first_state_arg(aditi_modify(_, _), _) = 2.
%-----------------------------------------------------------------------------%
@@ -1173,12 +1185,11 @@
typecheck_info_uo) is det.
typecheck_call_pred(CallId, Args, PredId, TypeCheckInfo0, TypeCheckInfo) :-
- FilterPredIds = lambda([_::in, X::in, X::out] is det, true),
AdjustArgTypes = lambda([X::in, X::out] is det, true),
- typecheck_call_pred_2(CallId, Args, FilterPredIds,
- AdjustArgTypes, PredId, TypeCheckInfo0, TypeCheckInfo).
+ typecheck_call_pred_adjust_arg_types(CallId, Args, AdjustArgTypes,
+ PredId, TypeCheckInfo0, TypeCheckInfo).
- % The higher-order argument here performs a transformation on
+ % A closure of this type performs a transformation on
% the argument types of the called predicate. It is used to
% convert the argument types of the base relation for an Aditi
% update builtin to the type of the higher-order argument of
@@ -1187,20 +1198,14 @@
:- type adjust_arg_types == pred(list(type), list(type)).
:- inst adjust_arg_types = (pred(in, out) is det).
- % Filter out pred_ids which could not be used in the call's context.
- % This is used to remove predicates which aren't base relations
- % when typechecking an Aditi update.
-:- type filter_pred_ids == pred(module_info, list(pred_id), list(pred_id)).
-:- inst filter_pred_ids = (pred(in, in, out) is det).
-
-:- pred typecheck_call_pred_2(simple_call_id, list(prog_var),
- filter_pred_ids, adjust_arg_types, pred_id,
- typecheck_info, typecheck_info).
-:- mode typecheck_call_pred_2(in, in,
- in(filter_pred_ids), in(adjust_arg_types), out,
+ % Typecheck a predicate, performing the given transformation on the
+ % argument types.
+:- pred typecheck_call_pred_adjust_arg_types(simple_call_id, list(prog_var),
+ adjust_arg_types, pred_id, typecheck_info, typecheck_info).
+:- mode typecheck_call_pred_adjust_arg_types(in, in, in(adjust_arg_types), out,
typecheck_info_di, typecheck_info_uo) is det.
-typecheck_call_pred_2(CallId, Args, FilterPredIds, AdjustArgTypes,
+typecheck_call_pred_adjust_arg_types(CallId, Args, AdjustArgTypes,
PredId, TypeCheckInfo1, TypeCheckInfo) :-
typecheck_info_get_type_assign_set(TypeCheckInfo1, OrigTypeAssignSet),
@@ -1210,16 +1215,15 @@
(
CallId = PorF - SymName/Arity,
predicate_table_search_pf_sym_arity(PredicateTable,
- PorF, SymName, Arity, PredIdList0),
- call(FilterPredIds, ModuleInfo, PredIdList0, PredIdList)
+ PorF, SymName, Arity, PredIdList)
->
% handle the case of a non-overloaded predicate specially
% (so that we can optimize the case of a non-overloaded,
% non-polymorphic predicate)
( PredIdList = [PredId0] ->
PredId = PredId0,
- typecheck_call_pred_id_2(PredId, Args, AdjustArgTypes,
- TypeCheckInfo1, TypeCheckInfo2)
+ typecheck_call_pred_id_adjust_arg_types(PredId, Args,
+ AdjustArgTypes, TypeCheckInfo1, TypeCheckInfo2)
;
typecheck_call_overloaded_pred(PredIdList, Args,
AdjustArgTypes, TypeCheckInfo1,
@@ -1252,6 +1256,7 @@
report_pred_call_error(CallId, TypeCheckInfo1, TypeCheckInfo)
).
+ % Typecheck a call to a specific predicate.
:- pred typecheck_call_pred_id(pred_id, list(prog_var),
typecheck_info, typecheck_info).
:- mode typecheck_call_pred_id(in, in, typecheck_info_di,
@@ -1259,15 +1264,17 @@
typecheck_call_pred_id(PredId, Args, TypeCheckInfo0, TypeCheckInfo) :-
AdjustArgTypes = lambda([X::in, X::out] is det, true),
- typecheck_call_pred_id_2(PredId, Args, AdjustArgTypes,
+ typecheck_call_pred_id_adjust_arg_types(PredId, Args, AdjustArgTypes,
TypeCheckInfo0, TypeCheckInfo).
-:- pred typecheck_call_pred_id_2(pred_id, list(prog_var), adjust_arg_types,
- typecheck_info, typecheck_info).
-:- mode typecheck_call_pred_id_2(in, in, in(adjust_arg_types),
+ % Typecheck a call to a specific predicate, performing the given
+ % transformation on the argument types.
+:- pred typecheck_call_pred_id_adjust_arg_types(pred_id, list(prog_var),
+ adjust_arg_types, typecheck_info, typecheck_info).
+:- mode typecheck_call_pred_id_adjust_arg_types(in, in, in(adjust_arg_types),
typecheck_info_di, typecheck_info_uo) is det.
-typecheck_call_pred_id_2(PredId, Args, AdjustArgTypes,
+typecheck_call_pred_id_adjust_arg_types(PredId, Args, AdjustArgTypes,
TypeCheckInfo0, TypeCheckInfo) :-
typecheck_info_get_module_info(TypeCheckInfo0, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
@@ -1400,21 +1407,14 @@
% module qualified, so they should not be considered
% when resolving overloading.
-typecheck__resolve_pred_overloading(ModuleInfo, Args, VarTypes, TVarSet,
+typecheck__resolve_pred_overloading(ModuleInfo, ArgTypes, TVarSet,
PredName0, PredName, PredId) :-
- map__apply_to_list(Args, VarTypes, ArgTypes),
- FilterPredIds = lambda([_::in, X::in, X::out] is det, true),
- typecheck__resolve_pred_overloading_2(ModuleInfo, FilterPredIds,
- ArgTypes, TVarSet, PredName0, PredName, PredId).
-
-typecheck__resolve_pred_overloading_2(ModuleInfo, FilterPredIds,
- ArgTypes, TVarSet, PredName0, PredName, PredId) :-
module_info_get_predicate_table(ModuleInfo, PredTable),
(
predicate_table_search_pred_sym(PredTable, PredName0,
PredIds0)
->
- call(FilterPredIds, ModuleInfo, PredIds0, PredIds)
+ PredIds = PredIds0
;
PredIds = []
),
@@ -5024,12 +5024,15 @@
:- mode report_error_pred_num_args(typecheck_info_no_io, in,
in, di, uo) is det.
-report_error_pred_num_args(TypeCheckInfo, CallId, Arities0) -->
+report_error_pred_num_args(TypeCheckInfo,
+ PredOrFunc - SymName/Arity, Arities) -->
write_context_and_pred_id(TypeCheckInfo),
{ typecheck_info_get_context(TypeCheckInfo, Context) },
- report_error_num_args(no, Context, CallId, Arities0).
+ report_error_num_args(no, Context, yes(PredOrFunc),
+ SymName, Arity, Arities).
-report_error_num_args(First, Context, CallId, Arities0) -->
+report_error_num_args(First, Context, MaybePredOrFunc,
+ SymName, Arity0, Arities0) -->
prog_out__write_context(Context),
(
{ First = yes },
@@ -5041,16 +5044,17 @@
io__write_string("wrong number of arguments ("),
% Adjust arities for functions.
- { CallId = PredOrFunc - SymName/Arity0 },
- {
- PredOrFunc = predicate,
+ { MaybePredOrFunc = yes(function) ->
+ adjust_func_arity(function, Arity0, Arity),
+ list__map(
+ (pred(OtherArity0::in, OtherArity::out) is det :-
+ adjust_func_arity(function,
+ OtherArity0, OtherArity)
+ ),
+ Arities0, Arities)
+ ;
Arity = Arity0,
Arities = Arities0
- ;
- PredOrFunc = function,
- Arity = Arity0 - 1,
- list__map((pred(OtherArity::in, OtherArity - 1::out) is det),
- Arities0, Arities)
},
io__write_int(Arity),
@@ -5059,8 +5063,14 @@
io__write_string(")\n"),
prog_out__write_context(Context),
io__write_string(" in call to "),
- hlds_out__write_pred_or_func(PredOrFunc),
- io__write_string(" `"),
+ (
+ { MaybePredOrFunc = yes(PredOrFunc) },
+ hlds_out__write_pred_or_func(PredOrFunc),
+ io__write_string(" ")
+ ;
+ { MaybePredOrFunc = no }
+ ),
+ io__write_string("`"),
prog_out__write_sym_name(SymName),
io__write_string("'.\n").
@@ -5230,6 +5240,13 @@
language_builtin("semipure", 1).
language_builtin("all", 2).
language_builtin("some", 2).
+language_builtin("aditi_insert", 3).
+language_builtin("aditi_delete", 3).
+language_builtin("aditi_delete", 4).
+language_builtin("aditi_bulk_insert", 4).
+language_builtin("aditi_bulk_delete", 4).
+language_builtin("aditi_modify", 3).
+language_builtin("aditi_modify", 4).
:- pred write_call_context(prog_context, call_id, int, unify_context,
io__state, io__state).
--- unique_modes.m 1999/06/27 01:01:42 1.4
+++ unique_modes.m 1999/06/30 06:57:45
@@ -382,12 +382,6 @@
_GoalInfo0, Goal) -->
{ hlds_goal__generic_call_id(GenericCall, CallId) },
mode_checkpoint(enter, "generic_call"),
- % Setting the context to `higher_order_call(...)' for
- % class method calls is a little white lie.
- % However, since there can't really be a unique
- % mode error in a class_method_call, this lie will never be
- % used. There can't be an error because the class_method_call
- % is introduced by the compiler as the body of a class method.
mode_info_set_call_context(call(CallId)),
{ determinism_components(Det, _, at_most_zero) ->
NeverSucceeds = yes
@@ -404,9 +398,7 @@
PredName), _GoalInfo0, Goal) -->
mode_checkpoint(enter, "call"),
=(ModeInfo),
- { mode_info_get_module_info(ModeInfo, ModuleInfo) },
- { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
- { pred_info_get_call_id(PredInfo, CallId) },
+ { mode_info_get_call_id(ModeInfo, PredId, CallId) },
mode_info_set_call_context(call(call(CallId))),
unique_modes__check_call(PredId, ProcId0, Args, ProcId),
{ Goal = call(PredId, ProcId, Args, Builtin, CallContext, PredName) },
@@ -445,9 +437,7 @@
_GoalInfo, Goal) -->
mode_checkpoint(enter, "pragma_c_code"),
=(ModeInfo),
- { mode_info_get_module_info(ModeInfo, ModuleInfo) },
- { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
- { pred_info_get_call_id(PredInfo, CallId) },
+ { mode_info_get_call_id(ModeInfo, PredId, CallId) },
mode_info_set_call_context(call(call(CallId))),
unique_modes__check_call(PredId, ProcId0, Args, ProcId),
{ Goal = pragma_c_code(IsRecursive, PredId, ProcId, Args,
--- unused_args.m 1999/06/27 01:01:42 1.7
+++ unused_args.m 1999/06/29 00:59:11
@@ -451,9 +451,8 @@
traverse_goal(ModuleInfo, some(_, _, Goal - _), UseInf0, UseInf) :-
traverse_goal(ModuleInfo, Goal, UseInf0, UseInf).
-
% we assume that higher-order predicate calls use all variables involved
-traverse_goal(_, generic_call(GenericCall,Args,_,_), UseInf0, UseInf) :-
+traverse_goal(_, generic_call(GenericCall, Args, _, _), UseInf0, UseInf) :-
goal_util__generic_call_vars(GenericCall, CallArgs),
set_list_vars_used(UseInf0, CallArgs, UseInf1),
set_list_vars_used(UseInf1, Args, UseInf).
library/ops.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/ops.m,v
retrieving revision 1.23
diff -u -u -r1.23 ops.m
--- ops.m 1998/03/03 17:26:02 1.23
+++ ops.m 1999/06/30 03:48:32
@@ -149,6 +149,7 @@
ops__op_table("=:=", after, xfx, 700). % standard ISO Prolog (*)
ops__op_table("=<", after, xfx, 700). % standard ISO Prolog
ops__op_table("==", after, xfx, 700). % standard ISO Prolog (*)
+ops__op_table("==>", after, xfx, 1175). % Mercury extension
ops__op_table("=>", after, xfy, 920). % Mercury/NU-Prolog extension
ops__op_table("=\\=", after, xfx, 700). % standard ISO Prolog (*)
ops__op_table(">", after, xfx, 700). % standard ISO Prolog
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list