[m-dev.] for review: Aditi updates[3]
Simon Taylor
stayl at cs.mu.OZ.AU
Sat Jun 5 14:46:53 AEST 1999
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.295
diff -u -u -r1.295 make_hlds.m
--- make_hlds.m 1999/06/01 09:43:58 1.295
+++ make_hlds.m 1999/06/03 04:49:14
@@ -62,6 +62,7 @@
:- import_module code_util, unify_proc, special_pred, type_util, mode_util.
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
:- import_module fact_table, purity, goal_util, term_util, export, llds, rl.
+:- import_module typecheck.
:- import_module string, char, int, set, bintree, map, multi_map, require.
:- import_module term, varset, getopt, assoc_list, term_io.
@@ -1098,7 +1099,8 @@
{ pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) },
prog_out__write_context(Context),
io__write_string("In `:- pragma type_spec' declaration for "),
- hlds_out__write_call_id(PredOrFunc, qualified(Module, Name)/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc,
+ qualified(Module, Name)/Arity),
io__write_string(":\n").
:- pred report_variables(list(tvar), tvarset, io__state, io__state).
@@ -1199,14 +1201,14 @@
"Error: `:- pragma termination_info' "),
io__write_string(
"declaration for undeclared mode of "),
- hlds_out__write_call_id(PredOrFunc,
+ hlds_out__write_simple_call_id(PredOrFunc,
SymName/Arity),
io__write_string(".\n")
)
;
prog_out__write_context(Context),
io__write_string("Error: ambiguous predicate name"),
- hlds_out__write_call_id(PredOrFunc, SymName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, SymName/Arity),
io__nl,
prog_out__write_context(Context),
io__write_string(
@@ -1329,7 +1331,7 @@
prog_out__write_context(Context),
io__write_string(
"In `:- pragma aditi_index' declaration for `"),
- hlds_out__write_pred_call_id(Name/Arity),
+ prog_out__write_sym_name_and_arity(Name/Arity),
io__write_string("':\n"),
prog_out__write_context(Context),
io__write_string(" attribute "),
@@ -1357,7 +1359,7 @@
io__nl,
prog_out__write_context(Context),
io__write_string(" for "),
- hlds_out__write_call_id(PredOrFunc, Name/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(" without preceding\n"),
prog_out__write_context(Context),
io__write_string(
@@ -1379,7 +1381,7 @@
prog_out__write_context(Context),
io__write_string(
"In `:- pragma aditi_index' declaration for "),
- hlds_out__write_call_id(PredOrFunc, Name/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(":\n"),
prog_out__write_context(Context),
io__write_string(" attribute "),
@@ -2677,7 +2679,7 @@
( { VeryVerbose = yes } ->
{ list__length(Args, Arity) },
io__write_string("% Processing clause for predicate `"),
- hlds_out__write_pred_call_id(PredName/Arity),
+ prog_out__write_sym_name_and_arity(PredName/Arity),
io__write_string("'...\n")
;
[]
@@ -2698,7 +2700,7 @@
( { VeryVerbose = yes } ->
io__write_string("% Processing clause for function `"),
{ list__length(Args0, Arity) },
- hlds_out__write_pred_call_id(FuncName/Arity),
+ prog_out__write_sym_name_and_arity(FuncName/Arity),
io__write_string("'...\n")
;
[]
@@ -2755,7 +2757,7 @@
{ module_info_incr_errors(ModuleInfo0, ModuleInfo) },
prog_out__write_context(Context),
io__write_string("Error: clause for "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string("\n"),
prog_out__write_context(Context),
io__write_string(" with `:- pragma c_code' declaration preceding.\n"),
@@ -2811,8 +2813,8 @@
maybe_warn_singletons(VarSet,
PredOrFunc - PredName/Arity, ModuleInfo, Goal),
% warn about variables with overlapping scopes
- maybe_warn_overlap(Warnings, VarSet, PredOrFunc,
- PredName/Arity)
+ maybe_warn_overlap(Warnings, VarSet,
+ PredOrFunc - PredName/Arity)
;
[]
)
@@ -2876,7 +2878,7 @@
{ VeryVerbose = yes }
->
io__write_string("% Processing `:- pragma import' for "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string("...\n")
;
[]
@@ -2922,7 +2924,7 @@
prog_out__write_context(Context),
io__write_string("Error: `:- pragma import' "),
io__write_string("declaration for imported "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string(".\n"),
{ Info = Info0 }
;
@@ -2932,7 +2934,7 @@
prog_out__write_context(Context),
io__write_string("Error: `:- pragma import' declaration "),
io__write_string("for "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string("\n"),
prog_out__write_context(Context),
io__write_string(" with preceding clauses.\n"),
@@ -2964,7 +2966,8 @@
io__write_string("Error: `:- pragma import' "),
io__write_string("declaration for undeclared mode "),
io__write_string("of "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc,
+ PredName/Arity),
io__write_string(".\n"),
io__set_output_stream(OldStream, _),
{ Info = Info0 }
@@ -3182,7 +3185,7 @@
{ VeryVerbose = yes }
->
io__write_string("% Processing `:- pragma c_code' for "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string("...\n")
;
[]
@@ -3225,7 +3228,7 @@
prog_out__write_context(Context),
io__write_string("Error: `:- pragma c_code' "),
io__write_string("declaration for imported "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string(".\n"),
{ Info = Info0 }
;
@@ -3235,7 +3238,7 @@
prog_out__write_context(Context),
io__write_string("Error: `:- pragma c_code' declaration "),
io__write_string("for "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string("\n"),
prog_out__write_context(Context),
io__write_string(" with preceding clauses.\n"),
@@ -3277,7 +3280,8 @@
io__write_string("Error: `:- pragma c_code' "),
io__write_string("declaration for undeclared mode "),
io__write_string("of "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc,
+ PredName/Arity),
io__write_string(".\n"),
io__set_output_stream(OldStream, _),
{ Info = Info0 }
@@ -3374,13 +3378,7 @@
;
{ pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) }
),
- (
- { PredOrFunc = predicate },
- { Arity = Arity0 }
- ;
- { PredOrFunc = function },
- { Arity is Arity0 + 1 }
- ),
+ { adjust_func_arity(PredOrFunc, Arity0, Arity) },
% print out a progress message
{ eval_method_to_string(EvalMethod, EvalMethodS) },
@@ -3391,7 +3389,7 @@
io__write_string("% Processing `:- pragma "),
io__write_string(EvalMethodS),
io__write_string("' for "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string("...\n")
;
[]
@@ -3405,7 +3403,7 @@
io__write_string("Error: `:- pragma "),
io__write_string(EvalMethodS),
io__write_string("' declaration for imported "),
- hlds_out__write_call_id(PredOrFunc, PredName/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
io__write_string(".\n")
;
% do we have to make sure the tabled preds are stratified?
@@ -3449,7 +3447,7 @@
io__write_string(EvalMethodS),
io__write_string(
"' declaration for undeclared mode of "),
- hlds_out__write_call_id(PredOrFunc,
+ hlds_out__write_simple_call_id(PredOrFunc,
PredName/Arity),
io__write_string(".\n")
)
@@ -3627,31 +3625,30 @@
% but occur more than once.
%
:- pred maybe_warn_overlap(list(quant_warning), prog_varset,
- pred_or_func, pred_call_id,
- io__state, io__state).
-:- mode maybe_warn_overlap(in, in, in, in, di, uo) is det.
+ simple_call_id, io__state, io__state).
+:- mode maybe_warn_overlap(in, in, in, di, uo) is det.
-maybe_warn_overlap(Warnings, VarSet, PredOrFunc, PredCallId) -->
+maybe_warn_overlap(Warnings, VarSet, PredCallId) -->
globals__io_lookup_bool_option(warn_overlapping_scopes,
WarnOverlappingScopes),
( { WarnOverlappingScopes = yes } ->
- warn_overlap(Warnings, VarSet, PredOrFunc, PredCallId)
+ warn_overlap(Warnings, VarSet, PredCallId)
;
[]
).
-:- pred warn_overlap(list(quant_warning), prog_varset, pred_or_func,
- pred_call_id, io__state, io__state).
-:- mode warn_overlap(in, in, in, in, di, uo) is det.
+:- pred warn_overlap(list(quant_warning), prog_varset, simple_call_id,
+ io__state, io__state).
+:- mode warn_overlap(in, in, in, di, uo) is det.
-warn_overlap([], _, _, _) --> [].
-warn_overlap([Warn|Warns], VarSet, PredOrFunc, PredCallId) -->
+warn_overlap([], _, _) --> [].
+warn_overlap([Warn|Warns], VarSet, PredCallId) -->
{ Warn = warn_overlap(Vars, Context) },
io__stderr_stream(StdErr),
io__set_output_stream(StdErr, OldStream),
prog_out__write_context(Context),
io__write_string(StdErr, "In clause for "),
- hlds_out__write_call_id(PredOrFunc, PredCallId),
+ hlds_out__write_simple_call_id(PredCallId),
io__write_string(StdErr, ":\n"),
prog_out__write_context(Context),
( { Vars = [Var] } ->
@@ -3666,18 +3663,16 @@
report_warning(StdErr, " each have overlapping scopes.\n")
),
io__set_output_stream(OldStream, _),
- warn_overlap(Warns, VarSet, PredOrFunc, PredCallId).
+ warn_overlap(Warns, VarSet, PredCallId).
%-----------------------------------------------------------------------------%
-:- type pred_or_func_call_id == pair(pred_or_func, pred_call_id).
-
% Warn about variables which occur only once but don't start with
% an underscore, or about variables which do start with an underscore
% but occur more than once, or about variables that do not occur in
% C code strings when they should.
%
-:- pred maybe_warn_singletons(prog_varset, pred_or_func_call_id, module_info,
+:- pred maybe_warn_singletons(prog_varset, simple_call_id, module_info,
hlds_goal, io__state, io__state).
:- mode maybe_warn_singletons(in, in, in, in, di, uo) is det.
@@ -3692,7 +3687,7 @@
).
:- pred warn_singletons_in_goal(hlds_goal, set(prog_var), prog_varset,
- pred_or_func_call_id, module_info, io__state, io__state).
+ simple_call_id, module_info, io__state, io__state).
:- mode warn_singletons_in_goal(in, in, in, in, in, di, uo) is det.
warn_singletons_in_goal(Goal - GoalInfo, QuantVars, VarSet, PredCallId, MI) -->
@@ -3700,7 +3695,7 @@
PredCallId, MI).
:- pred warn_singletons_in_goal_2(hlds_goal_expr, hlds_goal_info, set(prog_var),
- prog_varset, pred_or_func_call_id, module_info,
+ prog_varset, simple_call_id, module_info,
io__state, io__state).
:- mode warn_singletons_in_goal_2(in, in, in, in, in, in, di, uo) is det.
@@ -3724,7 +3719,7 @@
PredCallId, MI) -->
warn_singletons_in_goal(Goal, QuantVars, VarSet, PredCallId, MI).
-warn_singletons_in_goal_2(some(Vars, SubGoal), GoalInfo, QuantVars, VarSet,
+warn_singletons_in_goal_2(some(Vars, _, SubGoal), GoalInfo, QuantVars, VarSet,
PredCallId, MI) -->
%
% warn if any quantified variables occur only in the quantifier
@@ -3771,16 +3766,10 @@
warn_singletons(Args, NonLocals, QuantVars, VarSet, Context,
PredCallId).
-warn_singletons_in_goal_2(higher_order_call(_, Args, _, _, _, _),
- GoalInfo, QuantVars, VarSet, PredCallId, _) -->
- { goal_info_get_nonlocals(GoalInfo, NonLocals) },
- { goal_info_get_context(GoalInfo, Context) },
- warn_singletons(Args, NonLocals, QuantVars, VarSet, Context,
- PredCallId).
-
- % This code should never be called anyway.
-warn_singletons_in_goal_2(class_method_call(_, _, Args, _, _, _),
+warn_singletons_in_goal_2(generic_call(GenericCall, Args0, _, _),
GoalInfo, QuantVars, VarSet, PredCallId, _) -->
+ { goal_util__generic_call_vars(GenericCall, Args1) },
+ { list__append(Args0, Args1, Args) },
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
{ goal_info_get_context(GoalInfo, Context) },
warn_singletons(Args, NonLocals, QuantVars, VarSet, Context,
@@ -3798,7 +3787,7 @@
PredCallId, MI).
:- pred warn_singletons_in_goal_list(list(hlds_goal), set(prog_var),
- prog_varset, pred_or_func_call_id, module_info,
+ prog_varset, simple_call_id, module_info,
io__state, io__state).
:- mode warn_singletons_in_goal_list(in, in, in, in, in, di, uo) is det.
@@ -3809,7 +3798,7 @@
warn_singletons_in_goal_list(Goals, QuantVars, VarSet, CallPredId, MI).
:- pred warn_singletons_in_cases(list(case), set(prog_var), prog_varset,
- pred_or_func_call_id, module_info, io__state, io__state).
+ simple_call_id, module_info, io__state, io__state).
:- mode warn_singletons_in_cases(in, in, in, in, in, di, uo) is det.
warn_singletons_in_cases([], _, _, _, _) --> [].
@@ -3819,7 +3808,7 @@
warn_singletons_in_cases(Cases, QuantVars, VarSet, CallPredId, MI).
:- pred warn_singletons_in_unify(prog_var, unify_rhs, hlds_goal_info,
- set(prog_var), prog_varset, pred_or_func_call_id, module_info,
+ set(prog_var), prog_varset, simple_call_id, module_info,
io__state, io__state).
:- mode warn_singletons_in_unify(in, in, in, in, in, in, in, di, uo) is det.
@@ -3837,8 +3826,8 @@
warn_singletons([X | Vars], NonLocals, QuantVars, VarSet,
Context, CallPredId).
-warn_singletons_in_unify(X, lambda_goal(_PredOrFunc, _NonLocals, LambdaVars,
- _Modes, _Det, LambdaGoal),
+warn_singletons_in_unify(X, lambda_goal(_PredOrFunc, _Eval, _Fix, _NonLocals,
+ LambdaVars, _Modes, _Det, LambdaGoal),
GoalInfo, QuantVars, VarSet, CallPredId, MI) -->
%
% warn if any lambda-quantified variables occur only in the quantifier
@@ -3864,7 +3853,7 @@
%-----------------------------------------------------------------------------%
:- pred maybe_warn_pragma_singletons(pragma_c_code_impl,
- list(maybe(pair(string, mode))), prog_context, pred_or_func_call_id,
+ list(maybe(pair(string, mode))), prog_context, simple_call_id,
module_info, io__state, io__state).
:- mode maybe_warn_pragma_singletons(in, in, in, in, in, di, uo) is det.
@@ -3881,12 +3870,12 @@
% mentioned at least once in the c code fragments that ought to
% mention it. If not, it gives a warning.
:- pred warn_singletons_in_pragma_c_code(pragma_c_code_impl,
- list(maybe(pair(string, mode))), prog_context, pred_or_func_call_id,
+ list(maybe(pair(string, mode))), prog_context, simple_call_id,
module_info, io__state, io__state).
:- mode warn_singletons_in_pragma_c_code(in, in, in, in, in, di, uo) is det.
warn_singletons_in_pragma_c_code(PragmaImpl, ArgInfo,
- Context, PredOrFunc - PredCallId, ModuleInfo) -->
+ Context, PredOrFuncCallId, ModuleInfo) -->
(
{ PragmaImpl = ordinary(C_Code, _) },
{ c_code_to_name_list(C_Code, C_CodeList) },
@@ -3902,7 +3891,7 @@
io__set_output_stream(StdErr1, OldStream1),
prog_out__write_context(Context),
io__write_string("In `:- pragma c_code' for "),
- hlds_out__write_call_id(PredOrFunc, PredCallId),
+ hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
( { UnmentionedVars = [_] } ->
@@ -3935,7 +3924,7 @@
io__set_output_stream(StdErr2, OldStream2),
prog_out__write_context(Context),
io__write_string("In `:- pragma c_code' for "),
- hlds_out__write_call_id(PredOrFunc, PredCallId),
+ hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
( { UnmentionedInputVars = [_] } ->
@@ -3963,7 +3952,7 @@
io__set_output_stream(StdErr3, OldStream3),
prog_out__write_context(Context),
io__write_string("In `:- pragma c_code' for "),
- hlds_out__write_call_id(PredOrFunc, PredCallId),
+ hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
( { UnmentionedFirstOutputVars = [_] } ->
@@ -3991,7 +3980,7 @@
io__set_output_stream(StdErr4, OldStream4),
prog_out__write_context(Context),
io__write_string("In `:- pragma c_code' for "),
- hlds_out__write_call_id(PredOrFunc, PredCallId),
+ hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(":\n"),
prog_out__write_context(Context),
( { UnmentionedLaterOutputVars = [_] } ->
@@ -4093,12 +4082,12 @@
% in Vars do occur in NonLocals.
:- pred warn_singletons(list(prog_var), set(prog_var), set(prog_var),
- prog_varset, prog_context, pred_or_func_call_id,
+ prog_varset, prog_context, simple_call_id,
io__state, io__state).
:- mode warn_singletons(in, in, in, in, in, in, di, uo) is det.
warn_singletons(GoalVars, NonLocals, QuantVars, VarSet, Context,
- PredOrFunc - CallId) -->
+ PredOrFuncCallId) -->
io__stderr_stream(StdErr),
% find all the variables in the goal that don't occur outside the
@@ -4125,7 +4114,7 @@
;
prog_out__write_context(Context),
io__write_string(StdErr, "In clause for "),
- hlds_out__write_call_id(PredOrFunc, CallId),
+ hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(StdErr, ":\n"),
prog_out__write_context(Context),
( { SingletonVars = [_] } ->
@@ -4157,7 +4146,7 @@
;
prog_out__write_context(Context),
io__write_string(StdErr, "In clause for "),
- hlds_out__write_call_id(PredOrFunc, CallId),
+ hlds_out__write_simple_call_id(PredOrFuncCallId),
io__write_string(StdErr, ":\n"),
prog_out__write_context(Context),
( { MultiVars = [_] } ->
@@ -4194,13 +4183,23 @@
{ update_qual_info(Info0, TVarSet0, VarTypes0, PredId, Info1) },
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context,
- Goal, VarSet, Warnings, Info1, Info),
- % XXX we should avoid append - this gives O(N*N)
- { list__append(ClauseList0, [clause(ModeIds, Goal, Context)],
- ClauseList) },
- { qual_info_get_var_types(Info, VarTypes) },
- { ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1,
- HeadVars, ClauseList) }.
+ Goal, VarSet, Warnings, Info1, Info2),
+ { qual_info_get_found_syntax_error(Info2, FoundError) },
+ { qual_info_set_found_syntax_error(no, Info2, Info) },
+ (
+ { FoundError = yes },
+ % Don't report spurious type errors for clauses
+ % containing other errors.
+ { ClausesInfo = ClausesInfo0 }
+ ;
+ { FoundError = no },
+ % XXX we should avoid append - this gives O(N*N)
+ { list__append(ClauseList0, [clause(ModeIds, Goal, Context)],
+ ClauseList) },
+ { qual_info_get_var_types(Info, VarTypes) },
+ { ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1,
+ HeadVars, ClauseList) }
+ ).
%-----------------------------------------------------------------------------
@@ -4270,7 +4269,7 @@
list(quant_warning), qual_info, qual_info,
io__state, io__state).
:- mode transform(in, in, in, in, in, in, out, out, out,
- in, out, di, uo) is det.
+ in, out, di, uo) is det.
transform(Subst, HeadVars, Args0, Body, VarSet0, Context,
Goal, VarSet, Warnings, Info0, Info) -->
@@ -4324,7 +4323,8 @@
Goal, VarSet, Info0, Info).
transform_goal_2(some(Vars0, Goal0), _, VarSet0, Subst,
- some(Vars, Goal) - GoalInfo, VarSet, Info0, Info) -->
+ some(Vars, can_remove, Goal) - GoalInfo,
+ VarSet, Info0, Info) -->
{ substitute_vars(Vars0, Subst, Vars) },
transform_goal(Goal0, VarSet0, Subst, Goal, VarSet, Info0, Info),
{ goal_info_init(GoalInfo) }.
@@ -4409,8 +4409,22 @@
transform_goal_2(not(unify(LHS, RHS) - Context), Context,
VarSet0, Subst, Goal, VarSet, Info0, Info)
;
+ { Purity = pure },
+ { Name = unqualified(Name1) },
+ { Name1 = "aditi_insert"
+ ; Name1 = "aditi_delete"
+ ; Name1 = "aditi_bulk_insert"
+ ; Name1 = "aditi_bulk_delete"
+ ; Name1 = "aditi_modify"
+ }
+ ->
+ { term__apply_substitution_to_list(Args0, Subst, Args1) },
+ transform_aditi_builtin(Name1, Args1, Context, VarSet0,
+ Goal, VarSet, Info0, Info)
+ ;
{ term__apply_substitution_to_list(Args0, Subst, Args) },
{ make_fresh_arg_vars(Args, VarSet0, HeadVars, VarSet1) },
+ { list__length(Args, Arity) },
(
% check for a higher-order call,
% i.e. a call to either call/N or ''/N.
@@ -4420,12 +4434,11 @@
{ HeadVars = [PredVar | RealHeadVars] }
->
{ % initialize some fields to junk
- Types = [],
Modes = [],
Det = erroneous,
- Call = higher_order_call(PredVar, RealHeadVars,
- Types, Modes, Det,
- predicate),
+ Call = generic_call(
+ higher_order(PredVar, predicate, Arity),
+ RealHeadVars, Modes, Det),
Purity1 = pure
},
(
@@ -4455,10 +4468,9 @@
{ add_goal_info_purity_feature(GoalInfo1, Purity1, GoalInfo) },
{ Goal0 = Call - GoalInfo },
- { list__length(Args, Arity) },
{ PredCallId = Name/Arity },
insert_arg_unifications(HeadVars, Args,
- Context, call(PredCallId), no,
+ Context, call(call(predicate - PredCallId)), no,
Goal0, VarSet1, Goal, VarSet, Info0, Info)
).
@@ -4481,6 +4493,366 @@
all_negated(NegatedGoals, Goals2),
list__append(Goals1, Goals2, Goals).
+:- inst aditi_update_str =
+ bound( "aditi_insert"
+ ; "aditi_delete"
+ ; "aditi_bulk_insert"
+ ; "aditi_bulk_delete"
+ ; "aditi_modify"
+ ).
+
+:- pred transform_aditi_builtin(string, list(prog_term), prog_context,
+ prog_varset, hlds_goal, prog_varset,
+ qual_info, qual_info, io__state, io__state).
+:- mode transform_aditi_builtin(in(aditi_update_str), in,
+ in, in, out, out, in, out, di, uo) is det.
+
+transform_aditi_builtin("aditi_insert", Args0, Context, VarSet0,
+ Goal, VarSet, Info0, Info) -->
+ { goal_info_init(GoalInfo0) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
+ { add_goal_info_purity_feature(GoalInfo1, pure, GoalInfo) },
+ ( { Args0 = [InsertTerm, AditiState0A, AditiStateA] } ->
+ (
+ { parse_pred_or_func_and_args(InsertTerm,
+ PredOrFunc, SymName, InsertArgs0) }
+ ->
+ {
+ make_fresh_arg_var(AditiState0A, AditiState0, [],
+ VarSet0, VarSet1),
+ make_fresh_arg_var(AditiStateA, AditiState, [],
+ VarSet1, VarSet2),
+ make_fresh_arg_vars(InsertArgs0, VarSet2,
+ InsertArgs, VarSet3),
+ 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(
+ aditi_builtin(Builtin, InsertCallId),
+ AllArgs, [], det),
+ Goal0 = Call - GoalInfo,
+ CallId = generic_call(aditi_builtin(Builtin,
+ InsertCallId)),
+ ArgContext = functor(cons(SymName, InsertArity),
+ call(CallId, 1), [])
+ },
+ insert_arg_unifications(InsertArgs, InsertArgs0,
+ Context, ArgContext, no,
+ Goal0, VarSet3, Goal1, VarSet4, Info0, Info1),
+ insert_arg_unifications([AditiState0, AditiState],
+ [AditiState0A, AditiStateA],
+ Context, call(CallId), no,
+ Goal1, VarSet4, Goal, VarSet, Info1, Info)
+ ;
+ { invalid_aditi_update_goal("aditi_insert",
+ Args0, GoalInfo, Goal, VarSet0, VarSet) },
+ { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write(
+ "Error: expected tuple to insert in call to `aditi_insert'\n")
+ )
+ ;
+ { invalid_aditi_update_goal("aditi_insert", Args0, GoalInfo,
+ Goal, VarSet0, VarSet) },
+ { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { list__length(Args0, Arity) },
+ aditi_update_arity_error(Context, "aditi_insert", Arity, [3])
+ ).
+transform_aditi_builtin("aditi_delete", Args0, Context, VarSet0,
+ Goal, VarSet, Info0, Info) -->
+ transform_delete_or_modify("aditi_delete", Args0, Context, VarSet0,
+ Goal, VarSet, Info0, Info).
+transform_aditi_builtin("aditi_bulk_insert", Args0, Context, VarSet0,
+ Goal, VarSet, Info0, Info) -->
+ transform_bulk_update("aditi_bulk_insert", insert, Args0, Context,
+ VarSet0, Goal, VarSet, Info0, Info).
+transform_aditi_builtin("aditi_bulk_delete", Args0, Context, VarSet0,
+ Goal, VarSet, Info0, Info) -->
+ transform_bulk_update("aditi_bulk_delete", delete, Args0, Context,
+ VarSet0, Goal, VarSet, Info0, Info).
+transform_aditi_builtin("aditi_modify", Args0, Context, VarSet0,
+ Goal, VarSet, Info0, Info) -->
+ transform_delete_or_modify("aditi_modify", Args0, Context, VarSet0,
+ Goal, VarSet, Info0, Info).
+
+:- inst aditi_del_or_mod_str = bound("aditi_delete"; "aditi_modify").
+
+:- 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).
+:- mode transform_delete_or_modify(in(aditi_del_or_mod_str), in,
+ in, in, out, out, in, out, di, uo) is det.
+
+transform_delete_or_modify(DelOrMod, Args0, Context, VarSet0,
+ UpdateGoal, VarSet, Info0, Info) -->
+ { goal_info_init(GoalInfo0) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
+ { add_goal_info_purity_feature(GoalInfo1, pure, GoalInfo) },
+ (
+ { list__length(Args0, Arity) },
+ { Arity \= 3 },
+ { Arity \= 4 }
+ ->
+ { invalid_aditi_update_goal(DelOrMod, Args0, GoalInfo,
+ UpdateGoal, VarSet0, VarSet) },
+ { 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).
+ 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("="),
+ [LeftHeadTerm, RightHeadTerm], _),
+ parse_pred_or_func_and_args(LeftHeadTerm,
+ PredOrFunc, SymName, LeftHeadArgs),
+ parse_pred_or_func_and_args(RightHeadTerm,
+ PredOrFunc, SymName, RightHeadArgs),
+ list__append(LeftHeadArgs, RightHeadArgs, HeadArgs1),
+ list__length(LeftHeadArgs, PredArity),
+ list__length(RightHeadArgs, PredArity)
+ }
+ ->
+ { make_fresh_arg_vars(HeadArgs1, VarSet0, HeadArgs, VarSet1) },
+ { term__coerce(GoalTerm1, GoalTerm) },
+ { parse_goal(GoalTerm, VarSet1, ParsedGoal, VarSet2) },
+ { map__init(Substitution) },
+ transform_goal(ParsedGoal, VarSet2, Substitution,
+ PredGoal0, VarSet3, Info0, Info1),
+ 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.
+ { 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) },
+ {
+ DelOrMod = "aditi_delete",
+ Builtin = aditi_delete(PredId, Syntax),
+ % post_typecheck.m will change the mode of the
+ % `aditi__state' argument to `unused'.
+ 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'.
+ list__duplicate(PredArity, InMode, InModes),
+ list__duplicate(PredArity, OutMode, OutModes),
+ list__append(InModes, OutModes, Modes),
+
+ % For aditi_modify, the higher-order argument
+ % is always a predicate.
+ LambdaPredOrFunc = predicate
+ },
+ { invalid_pred_id(PredId) },
+
+ { ModCallId = PredOrFunc - SymName/PredArity },
+ { MainContext =
+ call(generic_call(aditi_builtin(Builtin, ModCallId)),
+ 1) },
+ { varset__new_var(VarSet4, LambdaVar, VarSet5) },
+ { create_atomic_unification(LambdaVar,
+ lambda_goal(LambdaPredOrFunc, (aditi_top_down),
+ modes_need_fixing, LambdaNonLocals,
+ HeadArgs, Modes, semidet, PredGoal),
+ Context, MainContext, [], LambdaConstruct) },
+
+ { make_fresh_arg_var(AditiState0A, AditiState0, [],
+ VarSet5, VarSet6) },
+ { make_fresh_arg_var(AditiStateA, AditiState, [],
+ 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),
+
+ %
+ % 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.
+ % Separating the goals would make optimization of the update
+ % using indexes more difficult.
+ %
+ { UpdateGoal = some([], cannot_remove, Goal) - GoalInfo }
+ ;
+ % Second syntax -
+ % aditi_delete(p/3, (aditi_top_down pred(..) :- ..), DB0, DB).
+ { Args0 = [PredCallIdTerm | OtherArgs0] },
+ { OtherArgs0 = [_, _, _] },
+ { parse_pred_or_func_name_and_arity(PredCallIdTerm,
+ PredOrFunc, SymName, Arity0) },
+ { adjust_func_arity(PredOrFunc, Arity0, Arity) }
+ ->
+ { 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)
+ ;
+ DelOrMod = "aditi_modify",
+ 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))),
+ no, Call, VarSet1, UpdateGoal, VarSet, Info0, Info)
+ ;
+ { invalid_aditi_update_goal(DelOrMod, Args0, GoalInfo,
+ UpdateGoal, VarSet0, VarSet) },
+ { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ io__set_exit_status(1),
+ (
+ { DelOrMod = "aditi_delete" },
+ prog_out__write_context(Context),
+ io__write_string(
+ "Error: expected `aditi_delete((p(<Args>) :- <Goal>), DB0, DB)'\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+ " or `aditi_delete(PredOrFunc p/N, Closure, DB0, DB)'.\n")
+ ;
+ { DelOrMod = "aditi_modify" },
+ prog_out__write_context(Context),
+ io__write_string(" Error: expected\n"),
+ prog_out__write_context(Context),
+ io__write_string(" `aditi_modify(\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+ " (p(<Args0>) = p(<Args>) :- <Goal>),\n"),
+ prog_out__write_context(Context),
+ io__write_string(" DB0, DB)'\n"),
+ prog_out__write_context(Context),
+ io__write_string(
+ " or `aditi_modify(PredOrFunc p/N, Closure, DB0, DB)'.\n")
+ )
+ ).
+
+:- 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).
+:- mode transform_bulk_update(in, in, in, in, in, out, out,
+ in, out, di, uo) is det.
+
+transform_bulk_update(UpdateStr, BulkOp, Args0, Context, VarSet0, Goal, VarSet,
+ Info0, Info) -->
+ { goal_info_init(GoalInfo0) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
+ { add_goal_info_purity_feature(GoalInfo1, pure, GoalInfo) },
+ (
+ { Args0 = [PredCallIdTerm | OtherArgs0] },
+ % Higher-order term + threaded `aditi__state's
+ { OtherArgs0 = [_, _, _] }
+ ->
+ (
+ { parse_pred_or_func_name_and_arity(PredCallIdTerm,
+ PredOrFunc, SymName, Arity0) },
+ { adjust_func_arity(PredOrFunc, Arity0, Arity) }
+ ->
+ { make_fresh_arg_vars(OtherArgs0, VarSet0,
+ OtherArgs, VarSet1) },
+ { invalid_pred_id(PredId) },
+ { Builtin = aditi_bulk_operation(BulkOp, PredId) },
+ { 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))),
+ no, Call, VarSet1, Goal, VarSet, Info0, Info)
+ ;
+ { invalid_aditi_update_goal(UpdateStr,
+ Args0, GoalInfo, Goal, VarSet0, VarSet) },
+ { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string(
+ "Error: expected `PredOrFunc Name/Arity' in call to `"),
+ io__write_string(UpdateStr),
+ io__write_string("'.\n")
+ )
+ ;
+ { invalid_aditi_update_goal(UpdateStr, Args0, GoalInfo, Goal,
+ VarSet0, VarSet) },
+ { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { list__length(Args0, Arity) },
+ aditi_update_arity_error(Context, UpdateStr, Arity, [4])
+ ).
+
+:- 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).
+
+:- 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),
+ MaybeUnifyContext = no,
+ Goal = call(PredId, ProcId, HeadVars, not_builtin,
+ MaybeUnifyContext, unqualified(UpdateStr)) - GoalInfo.
+
%-----------------------------------------------------------------------------
% `insert_arg_unifications' takes a list of variables,
@@ -4504,7 +4876,7 @@
:- type arg_context
---> head % the arguments in the head of the clause
- ; call(pred_call_id) % the arguments in a call to a predicate
+ ; call(call_id) % the arguments in a call to a predicate
; functor( % the arguments in a functor
cons_id,
unify_main_context,
@@ -4680,13 +5052,20 @@
make_fresh_arg_vars_2([], Vars, VarSet, Vars, VarSet).
make_fresh_arg_vars_2([Arg | Args], Vars0, VarSet0, Vars, VarSet) :-
+ make_fresh_arg_var(Arg, Var, Vars0, VarSet0, VarSet1),
+ make_fresh_arg_vars_2(Args, [Var | Vars0], VarSet1, Vars, VarSet).
+
+:- pred make_fresh_arg_var(prog_term, prog_var, list(prog_var),
+ prog_varset, prog_varset).
+:- mode make_fresh_arg_var(in, out, in, in, out) is det.
+
+make_fresh_arg_var(Arg, Var, Vars0, VarSet0, VarSet) :-
( Arg = term__variable(ArgVar), \+ list__member(ArgVar, Vars0) ->
Var = ArgVar,
- VarSet1 = VarSet0
+ VarSet = VarSet0
;
- varset__new_var(VarSet0, Var, VarSet1)
- ),
- make_fresh_arg_vars_2(Args, [Var | Vars0], VarSet1, Vars, VarSet).
+ varset__new_var(VarSet0, Var, VarSet)
+ ).
%-----------------------------------------------------------------------------%
@@ -4734,14 +5113,15 @@
;
{
% handle lambda expressions
- F = term__atom("lambda"),
- Args = [LambdaExpressionTerm0, GoalTerm0],
+ parse_lambda_eval_method(RHS, EvalMethod0, RHS1),
+ RHS1 = term__functor(term__atom("lambda"), Args1, _),
+ Args1 = [LambdaExpressionTerm0, GoalTerm0],
term__coerce(LambdaExpressionTerm0, LambdaExpressionTerm),
parse_lambda_expression(LambdaExpressionTerm,
Vars0, Modes0, Det0)
->
- Vars1 = Vars0, Modes1 = Modes0, Det1 = Det0,
- GoalTerm1 = GoalTerm0
+ EvalMethod = EvalMethod0, Vars1 = Vars0,
+ Modes1 = Modes0, Det1 = Det0, GoalTerm1 = GoalTerm0
;
% handle higher-order pred expressions -
% same semantics as lambda expressions, different syntax
@@ -4749,14 +5129,16 @@
F = term__atom(":-"),
Args = [PredTerm0, GoalTerm0],
term__coerce(PredTerm0, PredTerm),
- parse_pred_expression(PredTerm, Vars0, Modes0, Det0)
+ parse_pred_expression(PredTerm, EvalMethod0,
+ Vars0, Modes0, Det0)
->
- Vars1 = Vars0, Modes1 = Modes0, Det1 = Det0,
- GoalTerm1 = GoalTerm0
+ EvalMethod = EvalMethod0, Vars1 = Vars0,
+ Modes1 = Modes0, Det1 = Det0, GoalTerm1 = GoalTerm0
;
FuncTerm0 = term__functor(F, Args, FunctorContext),
term__coerce(FuncTerm0, FuncTerm),
- parse_pred_expression(FuncTerm, Vars1, Modes1, Det1),
+ parse_pred_expression(FuncTerm, EvalMethod,
+ Vars1, Modes1, Det1),
GoalTerm1 = term__functor(term__atom("true"), [], Context)
}
->
@@ -4767,7 +5149,7 @@
{ Det = Det1 },
{ term__coerce(GoalTerm1, GoalTerm) },
{ parse_goal(GoalTerm, VarSet0, ParsedGoal, VarSet1) },
- build_lambda_expression(X, predicate, Vars1,
+ build_lambda_expression(X, predicate, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
Context, MainContext, SubContext, Goal, VarSet,
Info1, Info)
@@ -4780,7 +5162,8 @@
F = term__atom("-->"),
Args = [PredTerm0, GoalTerm0],
term__coerce(PredTerm0, PredTerm),
- parse_dcg_pred_expression(PredTerm, Vars0, Modes0, Det)
+ parse_dcg_pred_expression(PredTerm, EvalMethod,
+ Vars0, Modes0, Det)
}
->
{ qual_info_get_mq_info(Info0, MQInfo0) },
@@ -4792,7 +5175,7 @@
ParsedGoal, DCG0, DCGn, VarSet1) },
{ list__append(Vars0, [term__variable(DCG0),
term__variable(DCGn)], Vars1) },
- build_lambda_expression(X, predicate, Vars1,
+ build_lambda_expression(X, predicate, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
Context, MainContext, SubContext, Goal, VarSet,
Info1, Info)
@@ -4803,14 +5186,16 @@
F = term__atom(":-"),
Args = [FuncTerm0, GoalTerm0],
term__coerce(FuncTerm0, FuncTerm),
- parse_func_expression(FuncTerm, Vars0, Modes0, Det0)
+ parse_func_expression(FuncTerm, EvalMethod0,
+ Vars0, Modes0, Det0)
->
- Vars1 = Vars0, Modes1 = Modes0, Det1 = Det0,
- GoalTerm1 = GoalTerm0
+ EvalMethod = EvalMethod0, Vars1 = Vars0,
+ Modes1 = Modes0, Det1 = Det0, GoalTerm1 = GoalTerm0
;
FuncTerm0 = term__functor(F, Args, FunctorContext),
term__coerce(FuncTerm0, FuncTerm),
- parse_func_expression(FuncTerm, Vars1, Modes1, Det1),
+ parse_func_expression(FuncTerm, EvalMethod,
+ Vars1, Modes1, Det1),
GoalTerm1 = term__functor(term__atom("true"), [], Context)
}
->
@@ -4821,7 +5206,7 @@
{ Det = Det1 },
{ term__coerce(GoalTerm1, GoalTerm) },
{ parse_goal(GoalTerm, VarSet0, ParsedGoal, VarSet1) },
- build_lambda_expression(X, function, Vars1,
+ build_lambda_expression(X, function, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
Context, MainContext, SubContext, Goal, VarSet,
Info1, Info)
@@ -4928,17 +5313,17 @@
{ list__append(ConjList0, ConjList1, ConjList) },
{ conj_list_to_goal(ConjList, GoalInfo, Goal) }.
-:- pred build_lambda_expression(prog_var, pred_or_func, list(prog_term),
- list(mode), determinism, goal, prog_varset,
+:- pred build_lambda_expression(prog_var, pred_or_func, lambda_eval_method,
+ list(prog_term), list(mode), determinism, goal, prog_varset,
prog_context, unify_main_context, unify_sub_contexts,
hlds_goal, prog_varset, qual_info, qual_info,
io__state, io__state).
-:- mode build_lambda_expression(in, in, in, in, in, in, in,
+:- mode build_lambda_expression(in, in, in, in, in, in, in, in,
in, in, in, out, out, in, out, di, uo) is det.
-build_lambda_expression(X, PredOrFunc, Args, Modes, Det, ParsedGoal, VarSet0,
- Context, MainContext, SubContext, Goal, VarSet,
- Info1, Info) -->
+build_lambda_expression(X, PredOrFunc, EvalMethod, Args, Modes, Det,
+ ParsedGoal, VarSet0, Context, MainContext, SubContext,
+ Goal, VarSet, Info1, Info) -->
%
% In the parse tree, the lambda arguments can be any terms.
% But in the HLDS, they must be distinct variables. So we introduce
@@ -4998,7 +5383,8 @@
{ goal_info_init(GoalInfo0) },
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
- { HLDS_Goal = some(QuantifiedVars, HLDS_Goal1) - GoalInfo },
+ { HLDS_Goal = some(QuantifiedVars, can_remove, HLDS_Goal1)
+ - GoalInfo },
%
% We set the lambda nonlocals here to anything that could possibly
@@ -5011,8 +5397,8 @@
{ set__to_sorted_list(LambdaGoalVars2, LambdaNonLocals) },
{ create_atomic_unification(X,
- lambda_goal(PredOrFunc, LambdaNonLocals, LambdaVars,
- Modes, Det, HLDS_Goal),
+ lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
+ LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
Context, MainContext, SubContext, Goal) }.
% create the hlds_goal for a unification which cannot be
@@ -5038,7 +5424,7 @@
process_type_qualification(Var, Type0, VarSet, Context, Info0, Info) -->
{ Info0 = qual_info(EqvMap, TVarSet0, TVarRenaming0, Index0,
- VarTypes0, PredId, MQInfo0) },
+ VarTypes0, PredId, MQInfo0, FoundError) },
module_qual__qualify_type_qualification(Type0, Type1,
Context, MQInfo0, MQInfo),
@@ -5058,7 +5444,7 @@
},
update_var_types(VarTypes0, Var, Type, Context, VarTypes),
{ Info = qual_info(EqvMap, TVarSet, TVarRenaming,
- Index, VarTypes, PredId, MQInfo) }.
+ Index, VarTypes, PredId, MQInfo, FoundError) }.
:- pred update_var_types(map(prog_var, type), prog_var, type, prog_context,
map(prog_var, type), io__state, io__state).
@@ -5215,7 +5601,9 @@
% Type variables in tvarset indexed by name.
map(prog_var, type), % Var types
pred_id, % Last pred processed.
- mq_info % Module qualification info.
+ mq_info, % Module qualification info.
+ bool % Was there a syntax error
+ % in an Aditi update.
).
:- pred init_qual_info(mq_info, eqv_map, qual_info).
@@ -5228,8 +5616,9 @@
map__init(Index),
map__init(VarTypes),
invalid_pred_id(PredId),
+ FoundSyntaxError = no,
QualInfo = qual_info(EqvMap, TVarSet, Renaming,
- Index, VarTypes, PredId, MQInfo).
+ Index, VarTypes, PredId, MQInfo, FoundSyntaxError).
% Update the qual_info when processing a new clause.
:- pred update_qual_info(qual_info, tvarset, map(prog_var, type),
@@ -5238,17 +5627,17 @@
update_qual_info(QualInfo0, TVarSet, VarTypes, PredId, QualInfo) :-
QualInfo0 = qual_info(EqvMap, TVarSet0, _Renaming0, Index0,
- VarTypes0, PredId0, MQInfo),
+ VarTypes0, PredId0, MQInfo, FoundError),
( PredId = PredId0 ->
% The renaming for one clause is useless in the others.
map__init(Renaming),
QualInfo = qual_info(EqvMap, TVarSet0, Renaming,
- Index0, VarTypes0, PredId0, MQInfo)
+ Index0, VarTypes0, PredId0, MQInfo, FoundError)
;
varset__create_name_var_map(TVarSet, Index),
map__init(Renaming),
QualInfo = qual_info(EqvMap, TVarSet, Renaming,
- Index, VarTypes, PredId, MQInfo)
+ Index, VarTypes, PredId, MQInfo, FoundError)
).
% All the other items are needed all at once in one or two places,
@@ -5257,18 +5646,30 @@
:- pred qual_info_get_mq_info(qual_info, mq_info).
:- mode qual_info_get_mq_info(in, out) is det.
-qual_info_get_mq_info(qual_info(_,_,_,_,_,_,MQInfo), MQInfo).
+qual_info_get_mq_info(qual_info(_,_,_,_,_,_,MQInfo, _), MQInfo).
:- pred qual_info_set_mq_info(qual_info, mq_info, qual_info).
:- mode qual_info_set_mq_info(in, in, out) is det.
-qual_info_set_mq_info(qual_info(A,B,C,D,E,F,_), MQInfo,
- qual_info(A,B,C,D,E,F, MQInfo)).
+qual_info_set_mq_info(qual_info(A,B,C,D,E,F,_,H), MQInfo,
+ qual_info(A,B,C,D,E,F, MQInfo,H)).
:- pred qual_info_get_var_types(qual_info, map(prog_var, type)).
:- mode qual_info_get_var_types(in, out) is det.
-qual_info_get_var_types(qual_info(_,_,_,_,VarTypes,_,_), VarTypes).
+qual_info_get_var_types(qual_info(_,_,_,_,VarTypes,_,_,_), VarTypes).
+
+:- pred qual_info_get_found_syntax_error(qual_info, bool).
+:- mode qual_info_get_found_syntax_error(in, out) is det.
+
+qual_info_get_found_syntax_error(qual_info(_,_,_,_,_,_,_,FoundError),
+ FoundError).
+
+:- pred qual_info_set_found_syntax_error(bool, qual_info, qual_info).
+:- mode qual_info_set_found_syntax_error(in, in, out) is det.
+
+qual_info_set_found_syntax_error(FoundError, qual_info(A,B,C,D,E,F,G,_),
+ qual_info(A,B,C,D,E,F,G,FoundError)).
%-----------------------------------------------------------------------------%
@@ -5318,7 +5719,7 @@
io__write_string("Error: "),
io__write_string(Description),
io__write_string(" for "),
- hlds_out__write_pred_call_id(Name/Arity),
+ prog_out__write_sym_name_and_arity(Name/Arity),
io__write_string("\n"),
prog_out__write_context(Context),
% This used to say `preceding' instead of `corresponding.'
@@ -5337,7 +5738,7 @@
io__write_string(" for\n"),
prog_out__write_context(Context),
io__write_string(" `"),
- hlds_out__write_pred_call_id(Name/Arity),
+ prog_out__write_sym_name_and_arity(Name/Arity),
io__write_string("' specifies non-existent mode.\n").
:- pred maybe_undefined_pred_error(sym_name, int, pred_or_func, prog_context,
@@ -5358,7 +5759,7 @@
io__write_string("Error: "),
io__write_string(Description),
io__write_string(" for "),
- hlds_out__write_call_id(PredOrFunc, Name/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string("\n"),
prog_out__write_context(Context),
io__write_string(" without preceding `"),
@@ -5379,7 +5780,7 @@
io__write_string(" for\n"),
prog_out__write_context(Context),
io__write_string(" `"),
- hlds_out__write_pred_call_id(ClassName/Arity),
+ prog_out__write_sym_name_and_arity(ClassName/Arity),
io__write_string("' without preceding typeclass declaration.\n").
:- pred unspecified_det_for_local(sym_name, arity, pred_or_func, prog_context,
@@ -5391,7 +5792,7 @@
report_warning("Error: no determinism declaration for local\n"),
prog_out__write_context(Context),
io__write_string(" "),
- hlds_out__write_call_id(PredOrFunc, Name/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(".\n"),
globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
( { VerboseErrors = yes } ->
@@ -5417,7 +5818,7 @@
io__write_string("Error: no determinism declaration for exported\n"),
prog_out__write_context(Context),
io__write_string(" "),
- hlds_out__write_call_id(PredOrFunc, Name/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(".\n").
:- pred clause_for_imported_pred_error(sym_name, arity, pred_or_func,
@@ -5428,7 +5829,7 @@
io__set_exit_status(1),
prog_out__write_context(Context),
io__write_string("Error: clause for imported "),
- hlds_out__write_call_id(PredOrFunc, Name/Arity),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
io__write_string(".\n").
:- pred unqualified_pred_error(sym_name, int, prog_context,
@@ -5458,7 +5859,7 @@
io__write_string("' declaration for exported\n"),
prog_out__write_context(Context),
io__write_string("predicate or function "),
- hlds_out__write_pred_call_id(Name/Arity),
+ prog_out__write_sym_name_and_arity(Name/Arity),
io__write_string(" must also be exported.\n").
:- pred pragma_conflict_error(sym_name, int, prog_context, string,
@@ -5473,7 +5874,7 @@
io__write_string("' declaration conflicts with\n"),
prog_out__write_context(Context),
io__write_string(" previous pragma for "),
- hlds_out__write_pred_call_id(Name/Arity),
+ prog_out__write_sym_name_and_arity(Name/Arity),
io__write_string(".\n").
%-----------------------------------------------------------------------------%
@@ -5512,13 +5913,7 @@
{ pred_info_procids(PredInfo, ProcIDs) },
{ pred_info_arg_types(PredInfo, ArgTypes) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
- {
- PredOrFunc = predicate,
- NumArgs = Arity
- ;
- PredOrFunc = function,
- NumArgs is Arity + 1
- },
+ { adjust_func_arity(PredOrFunc, Arity, NumArgs) },
% create pragma c_header_code to declare extern variables
{ module_add_c_header(C_HeaderCode, Context, Module1, Module2)},
@@ -5540,7 +5935,7 @@
io__set_exit_status(1),
prog_out__write_context(Context),
io__write_string("In pragma fact_table for `"),
- hlds_out__write_pred_call_id(Pred/Arity),
+ prog_out__write_sym_name_and_arity(Pred/Arity),
io__write_string("':\n"),
prog_out__write_context(Context),
io__write_string(
Index: compiler/mercury_to_c.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_c.m,v
retrieving revision 1.38
diff -u -u -r1.38 mercury_to_c.m
--- mercury_to_c.m 1998/11/20 04:08:18 1.38
+++ mercury_to_c.m 1999/05/14 05:08:20
@@ -540,7 +540,7 @@
mercury_output_newline(Indent),
io__write_string(")").
-c_gen_goal_2(some(Vars, Goal), Indent, CGenInfo0, CGenInfo) -->
+c_gen_goal_2(some(Vars, _, Goal), Indent, CGenInfo0, CGenInfo) -->
{ sorry(8) },
io__write_string("some ["),
mercury_output_vars(Vars, _VarSet, no),
@@ -631,10 +631,9 @@
c_gen_failure(Indent, CGenInfo0, CGenInfo)
).
-c_gen_goal_2(higher_order_call(_, _, _, _, _, _), _, _, _) -->
- { error("mercury_to_c: higher_order_call not implemented") }.
-c_gen_goal_2(class_method_call(_, _, _, _, _, _), _, _, _) -->
- { error("mercury_to_c: class_method_call not implemented") }.
+c_gen_goal_2(generic_call(_, _, _, _), _, _, _) -->
+ { error(
+ "mercury_to_c: higher-order and class-method calls not implemented") }.
c_gen_goal_2(call(PredId, ProcId, ArgVars, _, _, _PredName),
Indent, CGenInfo0, CGenInfo) -->
{ c_gen_info_get_module_info(CGenInfo0, ModuleInfo) },
@@ -721,7 +720,8 @@
io__write_string(")\n"),
{ Indent1 is Indent + 1 },
c_gen_failure(Indent1, CGenInfo2, CGenInfo).
-c_gen_unification(construct(_, _, _, _), _Indent, CGenInfo, CGenInfo) -->
+c_gen_unification(construct(_, _, _, _, _, _, _),
+ _Indent, CGenInfo, CGenInfo) -->
{ sorry(1) },
io__write_string(" :=: ").
c_gen_unification(deconstruct(_, _, _, _, _), _Indent, CGenInfo, CGenInfo) -->
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.156
diff -u -u -r1.156 mercury_to_mercury.m
--- mercury_to_mercury.m 1999/04/23 01:02:51 1.156
+++ mercury_to_mercury.m 1999/05/23 23:48:23
@@ -1044,7 +1044,7 @@
io__write_float(X).
mercury_output_cons_id(string_const(X), _) -->
term_io__quote_string(X).
-mercury_output_cons_id(pred_const(PredId, ProcId), _) -->
+mercury_output_cons_id(pred_const(PredId, ProcId, EvalMethod), _) -->
% XXX Sufficient, but probably should print this out in
% name/arity form.
@@ -1054,6 +1054,8 @@
io__write_int(PredInt),
io__write_string(", "),
io__write_int(ProcInt),
+ io__write_string(", "),
+ io__write(EvalMethod),
io__write_string(")>").
mercury_output_cons_id(code_addr_const(PredId, ProcId), _) -->
% XXX Sufficient, but probably should print this out in
@@ -2801,6 +2803,8 @@
mercury_unary_prefix_op("?-").
mercury_unary_prefix_op("\\").
mercury_unary_prefix_op("\\+").
+mercury_unary_prefix_op("aditi_bottom_up").
+mercury_unary_prefix_op("aditi_top_down").
mercury_unary_prefix_op("delete").
mercury_unary_prefix_op("dynamic").
mercury_unary_prefix_op("end_module").
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_errors.m,v
retrieving revision 1.62
diff -u -u -r1.62 mode_errors.m
--- mode_errors.m 1999/03/12 06:14:15 1.62
+++ mode_errors.m 1999/05/18 04:40:19
@@ -493,7 +493,6 @@
{ mode_info_get_context(ModeInfo, Context) },
{ mode_info_get_varset(ModeInfo, VarSet) },
{ mode_info_get_instvarset(ModeInfo, InstVarSet) },
- { mode_info_get_module_info(ModeInfo, ModuleInfo) },
mode_info_write_context(ModeInfo),
prog_out__write_context(Context),
io__write_string(" mode error: arguments `"),
@@ -506,8 +505,8 @@
prog_out__write_context(Context),
io__write_string(" which does not match any of the modes for "),
{ mode_info_get_mode_context(ModeInfo, ModeContext) },
- ( { ModeContext = call(PredId, _) } ->
- hlds_out__write_pred_id(ModuleInfo, PredId)
+ ( { ModeContext = call(CallId, _) } ->
+ hlds_out__write_call_id(CallId)
;
{ error("report_mode_error_no_matching_mode: invalid context") }
),
@@ -855,48 +854,10 @@
write_mode_context(uninitialized, _Context, _ModuleInfo) -->
[].
-write_mode_context(higher_order_call(PredOrFunc, ArgNum), Context, _ModuleInfo)
- -->
+write_mode_context(call(CallId, ArgNum), Context, _ModuleInfo) -->
prog_out__write_context(Context),
io__write_string(" in "),
- ( { ArgNum = 0 } ->
- io__write_string("higher-order "),
- hlds_out__write_pred_or_func(PredOrFunc),
- io__write_string(" call:\n")
- ;
- io__write_string("argument "),
- io__write_int(ArgNum),
- io__write_string(" of higher-order "),
- hlds_out__write_pred_or_func(PredOrFunc),
- io__write_string(" call\n"),
- prog_out__write_context(Context),
- io__write_string(" (i.e. in "),
- ( { ArgNum = 1 } ->
- io__write_string("the "),
- hlds_out__write_pred_or_func(PredOrFunc),
- io__write_string(" term")
- ;
- io__write_string("argument "),
- { ArgNum1 is ArgNum - 1 },
- io__write_int(ArgNum1),
- io__write_string(" of the called "),
- hlds_out__write_pred_or_func(PredOrFunc)
- ),
- io__write_string("):\n")
- ).
-
-write_mode_context(call(PredId, ArgNum), Context, ModuleInfo) -->
- prog_out__write_context(Context),
- io__write_string(" in "),
- ( { ArgNum = 0 } ->
- []
- ;
- io__write_string("argument "),
- io__write_int(ArgNum),
- io__write_string(" of ")
- ),
- io__write_string("call to "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
+ hlds_out__write_call_arg_id(CallId, ArgNum),
io__write_string(":\n").
write_mode_context(unify(UnifyContext, _Side), Context, _ModuleInfo) -->
Index: compiler/mode_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_info.m,v
retrieving revision 1.49
diff -u -u -r1.49 mode_info.m
--- mode_info.m 1999/05/18 03:08:55 1.49
+++ mode_info.m 1999/05/21 04:24:48
@@ -27,12 +27,7 @@
% XXX `side' is not used
:- type mode_context
---> call(
- pred_id, % pred name / arity
- int % argument number
- )
- ; higher_order_call(
- pred_or_func, % is it call/N (higher-order pred call)
- % or apply/N (higher-order func call)?
+ call_id,
int % argument number
)
; unify(
@@ -53,8 +48,7 @@
:- type call_context
---> unify(unify_context)
- ; call(pred_id)
- ; higher_order_call(pred_or_func).
+ ; call(call_id).
:- type var_lock_reason
---> negation
@@ -559,19 +553,13 @@
mode_info_set_call_context(unify(UnifyContext)) -->
mode_info_set_mode_context(unify(UnifyContext, left)).
-mode_info_set_call_context(call(PredId)) -->
- mode_info_set_mode_context(call(PredId, 0)).
-mode_info_set_call_context(higher_order_call(PredOrFunc)) -->
- mode_info_set_mode_context(higher_order_call(PredOrFunc, 0)).
+mode_info_set_call_context(call(CallId)) -->
+ mode_info_set_mode_context(call(CallId, 0)).
mode_info_set_call_arg_context(ArgNum, ModeInfo0, ModeInfo) :-
mode_info_get_mode_context(ModeInfo0, ModeContext0),
- ( ModeContext0 = call(PredId, _) ->
- mode_info_set_mode_context(call(PredId, ArgNum),
- ModeInfo0, ModeInfo)
- ; ModeContext0 = higher_order_call(PredOrFunc, _) ->
- mode_info_set_mode_context(
- higher_order_call(PredOrFunc, ArgNum),
+ ( ModeContext0 = call(CallId, _) ->
+ mode_info_set_mode_context(call(CallId, ArgNum),
ModeInfo0, ModeInfo)
;
error("mode_info_set_call_arg_context")
Index: compiler/mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.114
diff -u -u -r1.114 mode_util.m
--- mode_util.m 1998/12/06 23:43:52 1.114
+++ mode_util.m 1999/06/03 01:27:41
@@ -172,10 +172,18 @@
%-----------------------------------------------------------------------------%
% Construct a mode corresponding to the standard `in',
- % `out', or `uo' mode.
+ % `out', `uo' or `unused' mode.
:- pred in_mode((mode)::out) is det.
:- pred out_mode((mode)::out) is det.
:- pred uo_mode((mode)::out) is det.
+:- pred unused_mode((mode)::out) is det.
+
+ % Construct the modes used for `aditi__state' arguments.
+ % XXX These should be unique, but are not yet because that
+ % would require alias tracking.
+:- func aditi_ui_mode = (mode).
+:- func aditi_di_mode = (mode).
+:- func aditi_uo_mode = (mode).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -625,7 +633,7 @@
Inst = bound(Uniq, BoundInsts)
).
propagate_ctor_info(ground(Uniq, no), Type, Constructors, ModuleInfo, Inst) :-
- ( type_is_higher_order(Type, function, ArgTypes) ->
+ ( type_is_higher_order(Type, function, _, ArgTypes) ->
default_higher_order_func_inst(ArgTypes, ModuleInfo,
HigherOrderInstInfo),
Inst = ground(Uniq, yes(HigherOrderInstInfo))
@@ -640,7 +648,7 @@
PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, Det),
PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
(
- type_is_higher_order(Type, PredOrFunc, ArgTypes),
+ type_is_higher_order(Type, PredOrFunc, _, ArgTypes),
list__same_length(ArgTypes, Modes0)
->
propagate_types_into_mode_list(ArgTypes, ModuleInfo,
@@ -686,7 +694,7 @@
).
propagate_ctor_info_lazily(ground(Uniq, no), Type0, Subst, ModuleInfo, Inst) :-
apply_type_subst(Type0, Subst, Type),
- ( type_is_higher_order(Type, function, ArgTypes) ->
+ ( type_is_higher_order(Type, function, _, ArgTypes) ->
default_higher_order_func_inst(ArgTypes, ModuleInfo,
HigherOrderInstInfo),
Inst = ground(Uniq, yes(HigherOrderInstInfo))
@@ -706,7 +714,7 @@
PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det),
apply_type_subst(Type0, Subst, Type),
(
- type_is_higher_order(Type, PredOrFunc, ArgTypes),
+ type_is_higher_order(Type, PredOrFunc, _, ArgTypes),
list__same_length(ArgTypes, Modes0)
->
propagate_types_into_mode_list(ArgTypes, ModuleInfo,
@@ -1084,7 +1092,7 @@
;
% Lambda expressions always need to be processed.
{ Goal0 = unify(_, Rhs, _, _, _) },
- { Rhs \= lambda_goal(_, _, _, _, _, _) }
+ { Rhs \= lambda_goal(_, _, _, _, _, _, _, _) }
)
->
{ Goal = Goal0 },
@@ -1154,19 +1162,13 @@
merge_instmap_delta(InstMap0, NonLocals, InstMapDelta3,
InstMapDelta4, InstMapDelta).
-recompute_instmap_delta_2(Atomic, some(Vars, Goal0), _, some(Vars, Goal),
+recompute_instmap_delta_2(Atomic, some(Vars, CanRemove, Goal0), _,
+ some(Vars, CanRemove, Goal),
InstMap, InstMapDelta) -->
recompute_instmap_delta(Atomic, Goal0, Goal, InstMap, InstMapDelta).
-recompute_instmap_delta_2(_, higher_order_call(A, Vars, B, Modes, C, D), _,
- higher_order_call(A, Vars, B, Modes, C, D),
- _InstMap, InstMapDelta) -->
- =(ModuleInfo),
- { instmap_delta_from_mode_list(Vars, Modes,
- ModuleInfo, InstMapDelta) }.
-
-recompute_instmap_delta_2(_, class_method_call(A, B, Vars, C, Modes, D), _,
- class_method_call(A, B, Vars, C, Modes, D),
+recompute_instmap_delta_2(_, generic_call(A, Vars, Modes, D), _,
+ generic_call(A, Vars, Modes, D),
_InstMap, InstMapDelta) -->
=(ModuleInfo),
{ instmap_delta_from_mode_list(Vars, Modes,
@@ -1180,15 +1182,15 @@
recompute_instmap_delta_2(Atomic, unify(A, Rhs0, UniMode0, Uni, E), GoalInfo,
unify(A, Rhs, UniMode, Uni, E), InstMap0, InstMapDelta) -->
(
- { Rhs0 = lambda_goal(PorF, NonLocals,
+ { Rhs0 = lambda_goal(PorF, EvalMethod, FixModes, NonLocals,
LambdaVars, Modes, Det, Goal0) }
->
=(ModuleInfo0),
{ instmap__pre_lambda_update(ModuleInfo0, LambdaVars, Modes,
InstMap0, InstMap) },
recompute_instmap_delta(Atomic, Goal0, Goal, InstMap),
- { Rhs = lambda_goal(PorF, NonLocals, LambdaVars,
- Modes, Det, Goal) }
+ { Rhs = lambda_goal(PorF, EvalMethod, FixModes, NonLocals,
+ LambdaVars, Modes, Det, Goal) }
;
{ Rhs = Rhs0 }
),
@@ -1569,6 +1571,14 @@
out_mode(Mode) :- make_std_mode("out", [], Mode).
uo_mode(Mode) :- make_std_mode("uo", [], Mode).
+
+unused_mode(Mode) :- make_std_mode("unused", [], Mode).
+
+aditi_ui_mode = Mode :- in_mode(Mode).
+
+aditi_di_mode = Mode :- in_mode(Mode).
+
+aditi_uo_mode = Mode :- out_mode(Mode).
:- pred make_std_mode(string, list(inst), mode).
:- mode make_std_mode(in, in, out) is det.
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.29
diff -u -u -r1.29 modecheck_call.m
--- modecheck_call.m 1999/06/01 09:44:07 1.29
+++ modecheck_call.m 1999/06/02 01:21:09
@@ -32,19 +32,15 @@
mode_info_di, mode_info_uo) is det.
:- pred modecheck_higher_order_call(pred_or_func, prog_var, list(prog_var),
- list(type), list(mode), determinism, list(prog_var),
+ list(mode), determinism, list(prog_var),
extra_goals, mode_info, mode_info).
-:- mode modecheck_higher_order_call(in, in, in, out, out, out, out, out,
+:- mode modecheck_higher_order_call(in, in, in, out, out, out, out,
mode_info_di, mode_info_uo) is det.
-:- pred modecheck_higher_order_pred_call(prog_var, list(prog_var), pred_or_func,
- hlds_goal_info, hlds_goal_expr, mode_info, mode_info).
-:- mode modecheck_higher_order_pred_call(in, in, in, in, out,
- mode_info_di, mode_info_uo) is det.
-
-:- pred modecheck_higher_order_func_call(prog_var, list(prog_var), prog_var,
- hlds_goal_info, hlds_goal_expr, mode_info, mode_info).
-:- mode modecheck_higher_order_func_call(in, in, in, in, out,
+:- pred modecheck_aditi_builtin(aditi_builtin, list(prog_var), list(mode),
+ determinism, list(prog_var), extra_goals,
+ mode_info, mode_info).
+:- mode modecheck_aditi_builtin(in, in, in, out, out, out,
mode_info_di, mode_info_uo) is det.
%
@@ -79,49 +75,8 @@
:- import_module det_report, unify_proc.
:- import_module map, bool, set, require.
-modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0, Goal)
- -->
- mode_checkpoint(enter, "higher-order call"),
- mode_info_set_call_context(higher_order_call(PredOrFunc)),
- =(ModeInfo0),
-
- { mode_info_get_instmap(ModeInfo0, InstMap0) },
- modecheck_higher_order_call(PredOrFunc, PredVar, Args0,
- Types, Modes, Det, Args, ExtraGoals),
-
- { Call = higher_order_call(PredVar, Args, Types, Modes, Det,
- PredOrFunc) },
- handle_extra_goals(Call, ExtraGoals, GoalInfo0,
- [PredVar | Args0], [PredVar | Args],
- InstMap0, Goal),
- mode_info_unset_call_context,
- mode_checkpoint(exit, "higher-order predicate call").
-
-modecheck_higher_order_func_call(FuncVar, Args0, RetVar, GoalInfo0, Goal) -->
- mode_checkpoint(enter, "higher-order function call"),
- mode_info_set_call_context(higher_order_call(function)),
-
- =(ModeInfo0),
- { mode_info_get_instmap(ModeInfo0, InstMap0) },
-
- { list__append(Args0, [RetVar], Args1) },
- modecheck_higher_order_call(function, FuncVar, Args1,
- Types, Modes, Det, Args, ExtraGoals),
-
- { Call = higher_order_call(FuncVar, Args, Types, Modes, Det,
- function) },
- handle_extra_goals(Call, ExtraGoals, GoalInfo0,
- [FuncVar | Args1], [FuncVar | Args],
- InstMap0, Goal),
-
- mode_info_unset_call_context,
- mode_checkpoint(exit, "higher-order function call").
-
-modecheck_higher_order_call(PredOrFunc, PredVar, Args0, Types, Modes, Det, Args,
- ExtraGoals, ModeInfo0, ModeInfo) :-
-
- mode_info_get_types_of_vars(ModeInfo0, Args0, Types),
-
+modecheck_higher_order_call(PredOrFunc, PredVar, Args0, Modes, Det,
+ Args, ExtraGoals, ModeInfo0, ModeInfo) :-
%
% First, check that `PredVar' has a higher-order pred inst
% (of the appropriate arity)
@@ -139,30 +94,14 @@
Det = Det0,
Modes = Modes0,
- %
- % Check that `Args0' have livenesses which match the
- % expected livenesses.
- %
- get_arg_lives(Modes, ModuleInfo0, ExpectedArgLives),
- modecheck_var_list_is_live(Args0, ExpectedArgLives, 1,
+ modecheck_arg_list(Args0, Args, Modes, ExtraGoals,
ModeInfo0, ModeInfo1),
- %
- % Check that `Args0' have insts which match the expected
- % initial insts, and set their new final insts (introducing
- % extra unifications for implied modes, if necessary).
- %
- mode_list_get_initial_insts(Modes, ModuleInfo0, InitialInsts),
- modecheck_var_has_inst_list(Args0, InitialInsts, 0,
- ModeInfo1, ModeInfo2),
- mode_list_get_final_insts(Modes, ModuleInfo0, FinalInsts),
- modecheck_set_var_inst_list(Args0, InitialInsts, FinalInsts,
- Args, ExtraGoals, ModeInfo2, ModeInfo3),
( determinism_components(Det, _, at_most_zero) ->
instmap__init_unreachable(Instmap),
- mode_info_set_instmap(Instmap, ModeInfo3, ModeInfo)
+ mode_info_set_instmap(Instmap, ModeInfo1, ModeInfo)
;
- ModeInfo = ModeInfo3
+ ModeInfo = ModeInfo1
)
;
% the error occurred in argument 1, i.e. the pred term
@@ -176,6 +115,49 @@
Args = Args0,
ExtraGoals = no_extra_goals
).
+
+modecheck_aditi_builtin(AditiBuiltin, Args0, Modes, Det, Args, ExtraGoals) -->
+ { aditi_builtin_determinism(AditiBuiltin, Det) },
+ modecheck_arg_list(Args0, Args, Modes, ExtraGoals).
+
+:- pred aditi_builtin_determinism(aditi_builtin, determinism).
+:- mode aditi_builtin_determinism(in, out) is det.
+
+aditi_builtin_determinism(aditi_call(_, _, _, _), _) :-
+ error(
+ "modecheck_call__aditi_builtin_determinism: unexpected Aditi call").
+aditi_builtin_determinism(aditi_insert(_), det).
+aditi_builtin_determinism(aditi_delete(_, _), det).
+aditi_builtin_determinism(aditi_bulk_operation(_, _), det).
+aditi_builtin_determinism(aditi_modify(_, _), det).
+
+:- pred modecheck_arg_list(list(prog_var), list(prog_var), list(mode),
+ extra_goals, mode_info, mode_info).
+:- mode modecheck_arg_list(in, out, in, out,
+ mode_info_di, mode_info_uo) is det.
+
+modecheck_arg_list(Args0, Args, Modes, ExtraGoals, ModeInfo0, ModeInfo) :-
+
+ %
+ % Check that `Args0' have livenesses which match the
+ % expected livenesses.
+ %
+ mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ get_arg_lives(Modes, ModuleInfo0, ExpectedArgLives),
+ modecheck_var_list_is_live(Args0, ExpectedArgLives, 1,
+ ModeInfo0, ModeInfo1),
+
+ %
+ % Check that `Args0' have insts which match the expected
+ % initial insts, and set their new final insts (introducing
+ % extra unifications for implied modes, if necessary).
+ %
+ mode_list_get_initial_insts(Modes, ModuleInfo0, InitialInsts),
+ modecheck_var_has_inst_list(Args0, InitialInsts, 0,
+ ModeInfo1, ModeInfo2),
+ mode_list_get_final_insts(Modes, ModuleInfo0, FinalInsts),
+ modecheck_set_var_inst_list(Args0, InitialInsts, FinalInsts,
+ Args, ExtraGoals, ModeInfo2, ModeInfo).
modecheck_call_pred(PredId, ProcId0, ArgVars0, DeterminismKnown,
TheProcId, ArgVars, ExtraGoals, ModeInfo0, ModeInfo) :-
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.37
diff -u -u -r1.37 modecheck_unify.m
--- modecheck_unify.m 1999/05/18 03:08:57 1.37
+++ modecheck_unify.m 1999/05/27 06:10:05
@@ -138,8 +138,12 @@
% with `call(F, A, B, C, X)')
% and then mode-check it.
%
- modecheck_higher_order_func_call(FuncVar, FuncArgVars, X0,
- GoalInfo0, Goal, ModeInfo0, ModeInfo)
+ list__append(FuncArgVars, [X0], AllArgVars),
+ Goal1 = generic_call(
+ higher_order(FuncVar, function, Arity + 1),
+ AllArgVars, [], det),
+ modecheck_goal_expr(Goal1, GoalInfo0, Goal,
+ ModeInfo0, ModeInfo)
;
%
% is the function symbol a user-defined function, rather
@@ -225,12 +229,14 @@
%
% check if variable has a higher-order type
- type_is_higher_order(TypeOfX, PredOrFunc, PredArgTypes),
+ type_is_higher_order(TypeOfX, PredOrFunc, EvalMethod,
+ PredArgTypes),
ConsId0 = cons(PName, _),
% but in case we are redoing mode analysis, make sure
% we don't mess with the address constants for type_info
% fields created by polymorphism.m
- Unification0 \= construct(_, code_addr_const(_, _), _, _),
+ Unification0 \= construct(_, code_addr_const(_, _),
+ _, _, _, _, _),
Unification0 \= deconstruct(_, code_addr_const(_, _), _, _, _)
->
%
@@ -257,7 +263,8 @@
% in get_pred_id_and_proc_id if there are multiple
% matching procedures.
Unification0 = construct(_,
- pred_const(PredId0, ProcId0), _, _)
+ pred_const(PredId0, ProcId0, EvalMethod),
+ _, _, _, _, _)
->
PredId = PredId0,
ProcId = ProcId0
@@ -315,10 +322,11 @@
% construct the lambda expression, and then go ahead
% and modecheck this unification in its new form
%
- Functor0 = lambda_goal(PredOrFunc, ArgVars0, LambdaVars,
- LambdaModes, LambdaDet, LambdaGoal),
- modecheck_unification( X0, Functor0, Unification0, UnifyContext,
- GoalInfo0, Goal, ModeInfo2, ModeInfo)
+ Functor0 = lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
+ ArgVars0, LambdaVars, LambdaModes,
+ LambdaDet, LambdaGoal),
+ modecheck_unification( X0, Functor0, Unification0,
+ UnifyContext, GoalInfo0, Goal, ModeInfo2, ModeInfo)
;
%
% It's not a higher-order pred unification - just
@@ -330,7 +338,8 @@
).
modecheck_unification(X,
- lambda_goal(PredOrFunc, ArgVars, Vars, Modes0, Det, Goal0),
+ lambda_goal(PredOrFunc, EvalMethod, _, ArgVars,
+ Vars, Modes0, Det, Goal0),
Unification0, UnifyContext, _GoalInfo,
unify(X, RHS, Mode, Unification, UnifyContext),
ModeInfo0, ModeInfo) :-
@@ -478,7 +487,8 @@
% Now modecheck the unification of X with the lambda-expression.
%
- RHS0 = lambda_goal(PredOrFunc, ArgVars, Vars, Modes, Det, Goal),
+ RHS0 = lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
+ ArgVars, Vars, Modes, Det, Goal),
modecheck_unify_lambda(X, PredOrFunc, ArgVars, Modes,
Det, RHS0, Unification0, Mode,
RHS, Unification, ModeInfo12, ModeInfo)
@@ -499,8 +509,8 @@
error("modecheck_unification(lambda): very strange var")
),
% return any old garbage
- RHS = lambda_goal(PredOrFunc, ArgVars, Vars,
- Modes0, Det, Goal0),
+ RHS = lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
+ ArgVars, Vars, Modes0, Det, Goal0),
Mode = (free -> free) - (free -> free),
Unification = Unification0
).
@@ -702,7 +712,7 @@
% them with `fail'.
%
(
- Unification = construct(ConstructTarget, _, _, _),
+ Unification = construct(ConstructTarget, _, _, _, _, _, _),
mode_info_var_is_live(ModeInfo, ConstructTarget, dead)
->
Goal = conj([]),
@@ -894,7 +904,7 @@
Unification = complicated_unify(UniMode, CanFail),
mode_info_get_instmap(ModeInfo0, InstMap0),
(
- type_is_higher_order(Type, PredOrFunc, _)
+ type_is_higher_order(Type, PredOrFunc, _, _)
->
% We do not want to report this as an error
% if it occurs in a compiler-generated
@@ -985,13 +995,16 @@
Unification, ModeInfo) :-
% if we are re-doing mode analysis, preserve the existing cons_id
list__length(ArgVars, Arity),
- ( Unification0 = construct(_, ConsId0, _, _) ->
+ ( Unification0 = construct(_, ConsId0, _, _, _, _, AditiInfo0) ->
+ AditiInfo = AditiInfo0,
ConsId = ConsId0
; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
+ AditiInfo = no,
ConsId = ConsId1
;
% the real cons_id will be computed by polymorphism.m;
% we just put in a dummy one for now
+ AditiInfo = no,
ConsId = cons(unqualified("__LambdaGoal__"), Arity)
),
mode_info_get_module_info(ModeInfo0, ModuleInfo),
@@ -1014,11 +1027,12 @@
% converted back to a predicate constant, but
% that doesn't matter since the code will be
% pruned away later by simplify.m.
- ConsId = pred_const(PredId, ProcId),
+ ConsId = pred_const(PredId, ProcId, EvalMethod),
instmap__is_reachable(InstMap)
->
(
- RHS0 = lambda_goal(_, _, _, _, _, Goal),
+ RHS0 = lambda_goal(_, EvalMethod, _,
+ _, _, _, _, Goal),
Goal = call(PredId, ProcId, _, _, _, _) - _
->
module_info_pred_info(ModuleInfo,
@@ -1036,7 +1050,8 @@
;
RHS = RHS0
),
- Unification = construct(X, ConsId, ArgVars, ArgModes),
+ Unification = construct(X, ConsId, ArgVars, ArgModes,
+ no, cell_is_unique, AditiInfo),
ModeInfo = ModeInfo0
;
instmap__is_reachable(InstMap)
@@ -1078,7 +1093,7 @@
mode_info_get_module_info(ModeInfo0, ModuleInfo),
map__lookup(VarTypes, X, TypeOfX),
% if we are re-doing mode analysis, preserve the existing cons_id
- ( Unification0 = construct(_, ConsId0, _, _) ->
+ ( Unification0 = construct(_, ConsId0, _, _, _, _, _) ->
ConsId = ConsId0
; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
ConsId = ConsId1
@@ -1090,7 +1105,8 @@
(
mode_is_output(ModuleInfo, ModeOfX)
->
- Unification = construct(X, ConsId, ArgVars, ArgModes),
+ Unification = construct(X, ConsId, ArgVars, ArgModes,
+ no, cell_is_unique, no),
ModeInfo = ModeInfo0
;
% It's a deconstruction.
@@ -1124,7 +1140,8 @@
CanFail = can_fail,
mode_info_get_instmap(ModeInfo0, InstMap0),
(
- type_is_higher_order(TypeOfX, PredOrFunc, _),
+ type_is_higher_order(TypeOfX, PredOrFunc,
+ _, _),
instmap__is_reachable(InstMap0)
->
set__init(WaitingVars),
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.230
diff -u -u -r1.230 modes.m
--- modes.m 1999/05/18 03:08:59 1.230
+++ modes.m 1999/05/27 06:10:13
@@ -1017,7 +1017,7 @@
mode_info_set_instmap(InstMap0),
mode_checkpoint(exit, "not").
-modecheck_goal_expr(some(Vs, G0), _, some(Vs, G)) -->
+modecheck_goal_expr(some(Vs, CanRemove, G0), _, some(Vs, CanRemove, G)) -->
mode_checkpoint(enter, "some"),
modecheck_goal(G0, G),
mode_checkpoint(exit, "some").
@@ -1025,11 +1025,14 @@
modecheck_goal_expr(call(PredId, ProcId0, Args0, _, Context, PredName),
GoalInfo0, Goal) -->
mode_checkpoint(enter, "call"),
- mode_info_set_call_context(call(PredId)),
=(ModeInfo0),
- { mode_info_get_instmap(ModeInfo0, InstMap0) },
+ { mode_info_get_module_info(ModeInfo0, ModuleInfo0) },
+ { module_info_pred_info(ModuleInfo0, PredId, PredInfo) },
+ { pred_info_get_call_id(PredInfo, CallId) },
+ { mode_info_get_instmap(ModeInfo0, InstMap0) },
{ DeterminismKnown = no },
+ mode_info_set_call_context(call(call(CallId))),
modecheck_call_pred(PredId, ProcId0, Args0, DeterminismKnown,
Mode, Args, ExtraGoals),
@@ -1043,16 +1046,40 @@
mode_info_unset_call_context,
mode_checkpoint(exit, "call").
-modecheck_goal_expr(higher_order_call(PredVar, Args0, _, _, _, PredOrFunc),
+modecheck_goal_expr(generic_call(GenericCall, Args0, Modes0, _),
GoalInfo0, Goal) -->
- modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0,
- Goal).
+ mode_checkpoint(enter, "generic_call"),
+ mode_info_dcg_get_instmap(InstMap0),
+
+ { hlds_goal__generic_call_id(GenericCall, CallId) },
+ mode_info_set_call_context(call(CallId)),
+ (
+ { GenericCall = higher_order(PredVar, PredOrFunc, _) },
+ modecheck_higher_order_call(PredOrFunc, PredVar,
+ Args0, Modes, Det, Args, ExtraGoals),
+ { AllArgs0 = [PredVar | Args0] },
+ { AllArgs = [PredVar | Args] }
+ ;
+ % Class method calls are added by polymorphism.m.
+ % XXX We should probably fill this in so that
+ % rerunning mode analysis works on code with typeclasses.
+ { GenericCall = class_method(_, _, _, _) },
+ { error("modecheck_goal_expr: class_method_call") }
+ ;
+ { GenericCall = aditi_builtin(AditiBuiltin, _) },
+ modecheck_aditi_builtin(AditiBuiltin, Args0, Modes0, Det,
+ Args, ExtraGoals),
+ { Modes = Modes0 },
+ { AllArgs0 = Args0 },
+ { AllArgs = Args }
+ ),
- % XXX This should be fixed one day, in case we decide to re-run
- % modechecking or something like that.
-modecheck_goal_expr(class_method_call(_, _, _, _, _, _),
- _GoalInfo0, _Goal) -->
- { error("modecheck_goal_expr: class method exists at modecheck time") }.
+ { Goal1 = generic_call(GenericCall, Args, Modes, Det) },
+ handle_extra_goals(Goal1, ExtraGoals, GoalInfo0, AllArgs0, AllArgs,
+ InstMap0, Goal),
+
+ mode_info_unset_call_context,
+ mode_checkpoint(exit, "call").
modecheck_goal_expr(unify(A0, B0, _, UnifyInfo0, UnifyContext), GoalInfo0, Goal)
-->
@@ -1082,11 +1109,14 @@
modecheck_goal_expr(pragma_c_code(IsRecursive, PredId, ProcId0, Args0,
ArgNameMap, OrigArgTypes, PragmaCode), GoalInfo, Goal) -->
mode_checkpoint(enter, "pragma_c_code"),
- mode_info_set_call_context(call(PredId)),
-
=(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_instmap(ModeInfo0, InstMap0) },
{ DeterminismKnown = no },
+ mode_info_set_call_context(call(call(CallId))),
modecheck_call_pred(PredId, ProcId0, Args0, DeterminismKnown,
ProcId, Args, ExtraGoals),
@@ -1103,8 +1133,8 @@
unify_rhs_vars(var(Var), [Var]).
unify_rhs_vars(functor(_Functor, Vars), Vars).
-unify_rhs_vars(lambda_goal(_PredOrFunc, LambdaNonLocals, LambdaVars,
- _Modes, _Det, _Goal - GoalInfo), Vars) :-
+unify_rhs_vars(lambda_goal(_PredOrFunc, _EvalMethod, _Fix, LambdaNonLocals,
+ LambdaVars, _Modes, _Det, _Goal - GoalInfo), Vars) :-
goal_info_get_nonlocals(GoalInfo, NonLocals0),
set__delete_list(NonLocals0, LambdaVars, NonLocals1),
set__insert_list(NonLocals1, LambdaNonLocals, NonLocals),
@@ -1946,17 +1976,8 @@
%-----------------------------------------------------------------------------%
mode_context_to_unify_context(unify(UnifyContext, _), _, UnifyContext).
-mode_context_to_unify_context(call(PredId, Arg), ModeInfo,
- unify_context(call(PredCallId, Arg), [])) :-
- mode_info_get_module_info(ModeInfo, ModuleInfo),
- module_info_pred_info(ModuleInfo, PredId, PredInfo),
- pred_info_module(PredInfo, Module),
- pred_info_name(PredInfo, Name),
- pred_info_arity(PredInfo, Arity),
- PredCallId = qualified(Module, Name) / Arity.
-mode_context_to_unify_context(higher_order_call(_PredOrFunc, _Arg), _ModeInfo,
- unify_context(explicit, [])).
- % XXX could do better; it's not really explicit
+mode_context_to_unify_context(call(CallId, Arg), _ModeInfo,
+ unify_context(call(CallId, Arg), [])).
mode_context_to_unify_context(uninitialized, _, _) :-
error("mode_context_to_unify_context: uninitialized context").
@@ -2111,7 +2132,6 @@
check_circular_modes(Module0, Module) -->
{ Module = Module0 }.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.44
diff -u -u -r1.44 module_qual.m
--- module_qual.m 1999/04/23 01:02:52 1.44
+++ module_qual.m 1999/04/29 04:37:52
@@ -601,19 +601,12 @@
qualify_type(term__variable(Var), term__variable(Var), Info, Info) --> [].
qualify_type(Type0, Type, Info0, Info) -->
- { Type0 = term__functor(F, As, _) },
- ( { is_builtin_func_type(F, As, ArgTypes0, RetType0) } ->
- qualify_type_list(ArgTypes0, ArgTypes, Info0, Info1),
- qualify_type(RetType0, RetType, Info1, Info2),
- { term__context_init(Context) },
- { Type = term__functor(term__atom("="),
- [term__functor(term__atom("func"),
- ArgTypes, Context), RetType], Context) }
- ; { type_to_type_id(Type0, TypeId0, Args0) } ->
+ { Type0 = term__functor(_, _, _) },
+ ( { type_to_type_id(Type0, TypeId0, Args0) } ->
( { is_builtin_atomic_type(TypeId0) } ->
{ TypeId = TypeId0 },
{ Info1 = Info0 }
- ; { is_builtin_pred_type(TypeId0) } ->
+ ; { type_id_is_higher_order(TypeId0, _, _) } ->
{ TypeId = TypeId0 },
{ Info1 = Info0 }
;
@@ -622,8 +615,7 @@
type_id, Info0, Info1)
),
qualify_type_list(Args0, Args, Info1, Info2),
- { TypeId = SymName - _ },
- { construct_qualified_term(SymName, Args, Type) }
+ { construct_type(TypeId, Args, Type) }
;
{ mq_info_get_error_context(Info0, ErrorContext) },
report_invalid_type(Type0, ErrorContext),
@@ -1133,26 +1125,6 @@
is_builtin_atomic_type(unqualified("float") - 0).
is_builtin_atomic_type(unqualified("string") - 0).
is_builtin_atomic_type(unqualified("character") - 0).
-
- % is_builtin_pred_type(TypeId)
- % is true iff 'TypeId' is the type_id of a builtin higher-order
- % predicate type.
-
-:- pred is_builtin_pred_type(type_id).
-:- mode is_builtin_pred_type(in) is semidet.
-
-is_builtin_pred_type(unqualified("pred") - _Arity).
-
- % is_builtin_func_type(Functor, Args)
- % is true iff `term__functor(Functor, Args, _)' is a builtin
- % higher-order function type.
-
-:- pred is_builtin_func_type(const, list(type), list(type), type).
-:- mode is_builtin_func_type(in, in, out, out) is semidet.
-
-is_builtin_func_type(term__atom("="),
- [term__functor(term__atom("func"), ArgTypes, _), RetType],
- ArgTypes, RetType).
%-----------------------------------------------------------------------------%
% Access and initialisation predicates.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_debug.m,v
retrieving revision 1.92
diff -u -u -r1.92 opt_debug.m
--- opt_debug.m 1999/05/28 05:26:29 1.92
+++ opt_debug.m 1999/05/29 02:10:51
@@ -773,6 +773,11 @@
opt_debug__dump_code_addr(do_det_aditi_call, "do_det_aditi_call").
opt_debug__dump_code_addr(do_semidet_aditi_call, "do_semidet_aditi_call").
opt_debug__dump_code_addr(do_nondet_aditi_call, "do_nondet_aditi_call").
+opt_debug__dump_code_addr(do_aditi_insert, "do_aditi_insert").
+opt_debug__dump_code_addr(do_aditi_delete, "do_aditi_delete").
+opt_debug__dump_code_addr(do_aditi_bulk_insert, "do_aditi_bulk_insert").
+opt_debug__dump_code_addr(do_aditi_bulk_delete, "do_aditi_bulk_delete").
+opt_debug__dump_code_addr(do_aditi_modify, "do_aditi_modify").
opt_debug__dump_code_addr(do_not_reached, "do_not_reached").
opt_debug__dump_code_addrs([], "").
Index: compiler/opt_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_util.m,v
retrieving revision 1.99
diff -u -u -r1.99 opt_util.m
--- opt_util.m 1999/04/30 06:19:44 1.99
+++ opt_util.m 1999/04/30 06:36:54
@@ -1287,6 +1287,11 @@
opt_util__livevals_addr(do_det_aditi_call, yes).
opt_util__livevals_addr(do_semidet_aditi_call, yes).
opt_util__livevals_addr(do_nondet_aditi_call, yes).
+opt_util__livevals_addr(do_aditi_insert, yes).
+opt_util__livevals_addr(do_aditi_delete, yes).
+opt_util__livevals_addr(do_aditi_bulk_insert, yes).
+opt_util__livevals_addr(do_aditi_bulk_delete, yes).
+opt_util__livevals_addr(do_aditi_modify, yes).
opt_util__livevals_addr(do_not_reached, no).
opt_util__count_temps_instr_list([], R, R, F, F).
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/passes_aux.m,v
retrieving revision 1.31
diff -u -u -r1.31 passes_aux.m
--- passes_aux.m 1999/03/26 11:15:37 1.31
+++ passes_aux.m 1999/04/16 02:38:34
@@ -118,6 +118,11 @@
io__state, io__state).
:- mode process_all_nonimported_nonaditi_procs(task, in, out, di, uo) is det.
+:- pred process_all_nonimported_nonaditi_procs(task, task,
+ module_info, module_info, io__state, io__state).
+:- mode process_all_nonimported_nonaditi_procs(task, out(task),
+ in, out, di, uo) is det.
+
:- pred process_all_nonimported_procs(task, task,
module_info, module_info, io__state, io__state).
:- mode process_all_nonimported_procs(task, out(task), in, out, di, uo) is det.
@@ -169,6 +174,14 @@
\+ hlds_pred__pred_info_is_aditi_relation(PredInfo)
)) },
process_matching_nonimported_procs(Task, NotAditi,
+ ModuleInfo0, ModuleInfo).
+
+process_all_nonimported_nonaditi_procs(Task0, Task,
+ ModuleInfo0, ModuleInfo) -->
+ { NotAditi = lambda([PredInfo::in] is semidet, (
+ \+ hlds_pred__pred_info_is_aditi_relation(PredInfo)
+ )) },
+ process_matching_nonimported_procs(Task0, Task, NotAditi,
ModuleInfo0, ModuleInfo).
process_all_nonimported_procs(Task0, Task, ModuleInfo0, ModuleInfo) -->
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/pd_cost.m,v
retrieving revision 1.4
diff -u -u -r1.4 pd_cost.m
--- pd_cost.m 1998/11/20 04:08:41 1.4
+++ pd_cost.m 1999/05/14 04:53:46
@@ -76,18 +76,10 @@
pd_cost__goal(not(Goal) - _, Cost) :-
pd_cost__goal(Goal, Cost).
-pd_cost__goal(some(_, Goal) - _, Cost) :-
+pd_cost__goal(some(_, _, Goal) - _, Cost) :-
pd_cost__goal(Goal, Cost).
-pd_cost__goal(higher_order_call(_, Args, _, _, _, _) - _, Cost) :-
- list__length(Args, Arity),
- pd_cost__reg_assign(AssignCost),
- Cost0 = AssignCost * Arity // 2,
- pd_cost__stack_flush(Cost1),
- pd_cost__higher_order_call(Cost2),
- Cost is Cost0 + Cost1 + Cost2.
-
-pd_cost__goal(class_method_call(_, _, Args, _, _, _) - _, Cost) :-
+pd_cost__goal(generic_call(_, Args, _, _) - _, Cost) :-
list__length(Args, Arity),
pd_cost__reg_assign(AssignCost),
Cost0 = AssignCost * Arity // 2,
@@ -121,7 +113,7 @@
pd_cost__unify(_, simple_test(_, _), Cost) :-
pd_cost__simple_test(Cost).
-pd_cost__unify(NonLocals, construct(Var, _, Args, _), Cost) :-
+pd_cost__unify(NonLocals, construct(Var, _, Args, _, _, _, _), Cost) :-
( set__member(Var, NonLocals) ->
list__length(Args, Arity),
pd_cost__heap_incr(Cost1),
Index: compiler/pd_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/pd_util.m,v
retrieving revision 1.5
diff -u -u -r1.5 pd_util.m
--- pd_util.m 1999/05/18 03:09:01 1.5
+++ pd_util.m 1999/05/18 03:39:55
@@ -131,7 +131,7 @@
:- import_module pd_cost, hlds_data, instmap, mode_util.
:- import_module unused_args, inst_match, (inst), quantification, mode_util.
:- import_module code_aux, purity, mode_info, unique_modes, term.
-:- import_module type_util, det_util, options.
+:- import_module type_util, det_util, options, goal_util.
:- import_module assoc_list, int, require, set.
pd_util__goal_get_calls(Goal0, CalledPreds) :-
@@ -916,9 +916,9 @@
NewArgs = [NewVar1, NewVar2]
;
OldUnification = construct(OldVar, ConsId,
- OldArgs1, _),
+ OldArgs1, _, _, _, _),
NewUnification = construct(NewVar, ConsId,
- NewArgs1,_ ),
+ NewArgs1, _, _, _, _),
OldArgs = [OldVar | OldArgs1],
NewArgs = [NewVar | NewArgs1]
;
@@ -933,12 +933,20 @@
OldGoal = call(PredId, ProcId, OldArgs, _, _, _) - _,
NewGoal = call(PredId, ProcId, NewArgs, _, _, _) - _
;
- OldGoal = higher_order_call(OldVar, OldArgs1, Types,
- Modes, Det, PredOrFunc) - _,
- NewGoal = higher_order_call(NewVar, NewArgs1, Types,
- Modes, Det, PredOrFunc) - _,
- OldArgs = [OldVar | OldArgs1],
- NewArgs = [NewVar | NewArgs1]
+ % XXX we could do better matching the types and modes
+ % here.
+ OldGoal = generic_call(OldGenericCall, OldArgs1,
+ Modes, Det) - _,
+ NewGoal = generic_call(NewGenericCall, NewArgs1,
+ Modes, Det) - _,
+ functor(OldGenericCall, GenericCallType, _),
+ functor(NewGenericCall, GenericCallType, _),
+ goal_util__generic_call_vars(OldGenericCall,
+ OldArgs0),
+ goal_util__generic_call_vars(NewGenericCall,
+ NewArgs0),
+ list__append(OldArgs0, OldArgs1, OldArgs),
+ list__append(NewArgs0, NewArgs1, NewArgs)
)
->
assoc_list__from_corresponding_lists(OldArgs,
@@ -959,8 +967,8 @@
OldGoal = not(OldSubGoal) - _,
NewGoal = not(NewSubGoal) - _
;
- OldGoal = some(_, OldSubGoal) - _,
- NewGoal = some(_, NewSubGoal) - _
+ OldGoal = some(_, _, OldSubGoal) - _,
+ NewGoal = some(_, _, NewSubGoal) - _
)
->
goal_to_conj_list(OldSubGoal, OldSubGoalList),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.163
diff -u -u -r1.163 polymorphism.m
--- polymorphism.m 1999/04/23 01:02:57 1.163
+++ polymorphism.m 1999/05/27 06:05:59
@@ -912,14 +912,39 @@
% We don't need to add type-infos for higher-order calls,
% since the type-infos are added when the closures are
% constructed, not when they are called.
-polymorphism__process_goal_expr(higher_order_call(A, B, C, D, E, F),
- GoalInfo, higher_order_call(A, B, C, D, E, F) - GoalInfo)
- --> [].
-
- % The same goes for class method calls
-polymorphism__process_goal_expr(class_method_call(A, B, C, D, E, F),
- GoalInfo, class_method_call(A, B, C, D, E, F) - GoalInfo)
- --> [].
+polymorphism__process_goal_expr(GoalExpr0, GoalInfo, Goal) -->
+ { GoalExpr0 = generic_call(GenericCall, Args0, Modes0, Det) },
+
+ %
+ % For aditi_insert calls, we need to add type-infos for
+ % the tuple to insert.
+ %
+ ( { GenericCall = aditi_builtin(aditi_insert(_), _) } ->
+ % Aditi base relations must be monomorphic.
+ { ExistQVars = [] },
+ { term__context_init(Context) },
+
+ =(PolyInfo),
+ { poly_info_get_var_types(PolyInfo, VarTypes) },
+ { map__apply_to_list(Args0, VarTypes, Types) },
+
+ polymorphism__make_type_info_vars(Types, ExistQVars,
+ Context, TypeInfoVars, TypeInfoGoals),
+
+ { list__append(TypeInfoVars, Args0, Args) },
+
+ { in_mode(InMode) },
+ { list__length(TypeInfoVars, NumTypeInfos) },
+ { list__duplicate(NumTypeInfos, InMode, TypeInfoModes) },
+ { list__append(TypeInfoModes, Modes0, Modes) },
+
+ { Call = generic_call(GenericCall, Args, Modes, Det)
+ - GoalInfo },
+ { list__append(TypeInfoGoals, [Call], Goals) },
+ { conj_list_to_goal(Goals, GoalInfo, Goal) }
+ ;
+ { Goal = GoalExpr0 - GoalInfo }
+ ).
polymorphism__process_goal_expr(call(PredId0, ProcId0, ArgVars0,
Builtin, UnifyContext, Name0), GoalInfo, Goal) -->
@@ -1039,7 +1064,7 @@
{ Goal = conj(TheGoals) - GoalInfo }
)
- ; { type_is_higher_order(Type, _, _) } ->
+ ; { type_is_higher_order(Type, _, _, _) } ->
{ SymName = unqualified("builtin_unify_pred") },
{ ArgVars = [XVar, YVar] },
{ module_info_get_predicate_table(ModuleInfo,
@@ -1084,8 +1109,8 @@
{ error("polymorphism: type_to_type_id failed") }
)
;
- { Y = lambda_goal(PredOrFunc, ArgVars, LambdaVars,
- Modes, Det, LambdaGoal0) }
+ { Y = lambda_goal(PredOrFunc, EvalMethod, _, ArgVars,
+ LambdaVars, Modes, Det, LambdaGoal0) }
->
% for lambda expressions, we must recursively traverse the
% lambda goal and then convert the lambda expression
@@ -1097,8 +1122,9 @@
polymorphism__fixup_lambda_quantification(LambdaGoal1,
ArgVars, LambdaVars, ExistQVars,
LambdaGoal, NonLocalTypeInfos),
- polymorphism__process_lambda(PredOrFunc, LambdaVars, Modes,
- Det, ArgVars, NonLocalTypeInfos, LambdaGoal,
+ polymorphism__process_lambda(PredOrFunc, EvalMethod,
+ LambdaVars, Modes, Det, ArgVars,
+ NonLocalTypeInfos, LambdaGoal,
Unification, Y1, Unification1),
{ Goal = unify(XVar, Y1, Mode, Unification1, Context)
- GoalInfo }
@@ -1123,8 +1149,8 @@
polymorphism__process_goal_expr(switch(Var, CanFail, Cases0, SM), GoalInfo,
switch(Var, CanFail, Cases, SM) - GoalInfo) -->
polymorphism__process_case_list(Cases0, Cases).
-polymorphism__process_goal_expr(some(Vars, Goal0), GoalInfo,
- some(Vars, Goal) - GoalInfo) -->
+polymorphism__process_goal_expr(some(Vars, CanRemove, Goal0), GoalInfo,
+ some(Vars, CanRemove, Goal) - GoalInfo) -->
polymorphism__process_goal(Goal0, Goal).
polymorphism__process_goal_expr(if_then_else(Vars, A0, B0, C0, SM), GoalInfo,
if_then_else(Vars, A, B, C, SM) - GoalInfo) -->
@@ -1640,16 +1666,16 @@
%-----------------------------------------------------------------------------%
-:- pred polymorphism__process_lambda(pred_or_func, list(prog_var),
- list(mode), determinism, list(prog_var), set(prog_var),
- hlds_goal, unification, unify_rhs, unification,
+:- pred polymorphism__process_lambda(pred_or_func, lambda_eval_method,
+ list(prog_var), list(mode), determinism, list(prog_var),
+ set(prog_var), hlds_goal, unification, unify_rhs, unification,
poly_info, poly_info).
-:- mode polymorphism__process_lambda(in, in, in, in, in, in, in, in, out, out,
- in, out) is det.
+:- mode polymorphism__process_lambda(in, in, in, in, in, in, in, in, in,
+ out, out, in, out) is det.
-polymorphism__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals,
- NonLocalTypeInfos, LambdaGoal, Unification0, Functor,
- Unification, PolyInfo0, PolyInfo) :-
+polymorphism__process_lambda(PredOrFunc, EvalMethod, Vars, Modes, Det,
+ OrigNonLocals, NonLocalTypeInfos, LambdaGoal, Unification0,
+ Functor, Unification, PolyInfo0, PolyInfo) :-
PolyInfo0 = poly_info(VarSet, VarTypes, TVarSet, TVarMap,
TCVarMap, _Proofs, PredName, ModuleInfo0,
Markers, Owner),
@@ -1665,10 +1691,12 @@
list__filter(polymorphism__constraint_contains_vars(LambdaTypeVars),
AllConstraints, UnivConstraints),
Constraints = constraints(UnivConstraints, []),
- lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
- OrigNonLocals, NonLocalTypeInfos, LambdaGoal, Unification0,
- VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
- Markers, Owner, ModuleInfo0, Functor, Unification, ModuleInfo),
+ lambda__transform_lambda(PredOrFunc, EvalMethod, PredName, Vars, Modes,
+ Det, OrigNonLocals, NonLocalTypeInfos, LambdaGoal,
+ Unification0, VarSet, VarTypes, Constraints, TVarSet, TVarMap,
+ TCVarMap, Markers, Owner, ModuleInfo0, Functor, Unification,
+ ModuleInfo),
+
poly_info_set_module_info(ModuleInfo, PolyInfo0, PolyInfo).
:- pred polymorphism__constraint_contains_vars(list(tvar), class_constraint).
@@ -2022,7 +2050,8 @@
BaseTypeClassInfoTerm = functor(ConsId, []),
% create the construction unification to initialize the variable
- BaseUnification = construct(BaseVar, ConsId, [], []),
+ BaseUnification = construct(BaseVar, ConsId, [], [],
+ no, cell_is_shared, no),
BaseUnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
BaseUnifyContext = unify_context(explicit, []),
@@ -2056,7 +2085,7 @@
list__length(NewArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
Unification = construct(NewVar, NewConsId, NewArgVars,
- UniModes),
+ UniModes, no, cell_is_unique, no),
UnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
@@ -2202,7 +2231,7 @@
),
ExtraGoals = []
;
- type_is_higher_order(Type, PredOrFunc, TypeArgs)
+ type_is_higher_order(Type, PredOrFunc, _, TypeArgs)
->
% This occurs for code where a predicate calls a polymorphic
% predicate with a known higher-order value of the type
@@ -2413,7 +2442,8 @@
polymorphism__init_with_int_constant(CountVar, Num, CountUnifyGoal) :-
CountConsId = int_const(Num),
- CountUnification = construct(CountVar, CountConsId, [], []),
+ CountUnification = construct(CountVar, CountConsId, [], [],
+ no, cell_is_shared, no),
CountTerm = functor(CountConsId, []),
CountInst = bound(unique, [functor(int_const(Num), [])]),
@@ -2526,7 +2556,8 @@
ground(shared, no) - ground(shared, no)),
list__length(ArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
- Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes),
+ Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes,
+ no, cell_is_unique, no),
UnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
@@ -2579,7 +2610,8 @@
VarSet0, VarTypes0, TypeCtorInfoVar, VarSet, VarTypes),
% create the construction unification to initialize the variable
- Unification = construct(TypeCtorInfoVar, ConsId, [], []),
+ Unification = construct(TypeCtorInfoVar, ConsId, [], [],
+ no, cell_is_shared, no),
UnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
@@ -2947,7 +2979,6 @@
map__lookup(VarMap, InstanceConstraint, TypeClassInfoVar),
proc_info_headvars(ProcInfo0, HeadVars0),
- proc_info_vartypes(ProcInfo0, Types0),
proc_info_argmodes(ProcInfo0, Modes0),
proc_info_declared_determinism(ProcInfo0, Detism0),
(
@@ -2969,14 +3000,18 @@
delete_nth(Modes0, N, Modes1)
->
HeadVars = HeadVars1,
- map__apply_to_list(HeadVars1, Types0, Types),
Modes = Modes1
;
error("expand_one_body: typeclass_info var not found")
),
- BodyGoalExpr = class_method_call(TypeClassInfoVar, ProcNum0,
- HeadVars, Types, Modes, Detism),
+ InstanceConstraint = constraint(ClassName, InstanceArgs),
+ list__length(InstanceArgs, InstanceArity),
+ pred_info_get_call_id(PredInfo0, CallId),
+ BodyGoalExpr = generic_call(
+ class_method(TypeClassInfoVar, ProcNum0,
+ class_id(ClassName, InstanceArity), CallId),
+ HeadVars, Modes, Detism),
% Make the goal info for the call.
set__list_to_set(HeadVars0, NonLocals),
--------------------------------------------------------------------------
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