[m-dev.] for review: Aditi updates[5]
Simon Taylor
stayl at cs.mu.OZ.AU
Sat Jun 5 14:46:54 AEST 1999
Index: compiler/typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.258
diff -u -u -r1.258 typecheck.m
--- typecheck.m 1999/03/26 11:15:45 1.258
+++ typecheck.m 1999/06/02 23:36:59
@@ -132,7 +132,13 @@
:- pred typecheck__resolve_pred_overloading(module_info, list(prog_var),
map(prog_var, type), tvarset, sym_name, sym_name, pred_id).
:- mode typecheck__resolve_pred_overloading(in, in, in, in,
- in, out, out) is det.
+ in, out, out) is det.
+
+:- pred typecheck__resolve_pred_overloading_2(module_info,
+ pred(module_info, list(pred_id), list(pred_id)),
+ list(type), tvarset, sym_name, sym_name, pred_id).
+:- mode typecheck__resolve_pred_overloading_2(in, pred(in, in, out) is det,
+ in, in, in, out, out) is det.
% Find a predicate or function from the list of pred_ids
% which matches the given name and argument types.
@@ -154,6 +160,14 @@
:- mode typecheck__reduce_context_by_rule_application(in, in, in, in, in, out,
in, out, in, out) is det.
+ % report_error_num_args(IsFirst, Context, CallId, CorrectArities).
+ % Report an error for a call with the wrong number of arguments.
+ % `IsFirst' should be `yes' if there are no previous lines in the
+ % error message.
+:- pred report_error_num_args(bool, term__context, simple_call_id,
+ list(int), io__state, io__state).
+:- mode report_error_num_args(in, in, in, in, di, uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -749,7 +763,7 @@
typecheck_info_set_context(Context),
% typecheck the clause - first the head unification, and
% then the body
- typecheck_var_has_type_list(HeadVars, ArgTypes, 0),
+ typecheck_var_has_type_list(HeadVars, ArgTypes, 1),
typecheck_goal(Body0, Body),
checkpoint("end of clause"),
{ Clause = clause(Modes, Body, Context) },
@@ -902,21 +916,34 @@
typecheck_goal_2(not(A0), not(A)) -->
checkpoint("not"),
typecheck_goal(A0, A).
-typecheck_goal_2(some(Vs, G0), some(Vs, G)) -->
+typecheck_goal_2(some(Vs, C, G0), some(Vs, C, G)) -->
checkpoint("some"),
typecheck_goal(G0, G),
ensure_vars_have_a_type(Vs).
typecheck_goal_2(call(_, Mode, Args, Builtin, Context, Name),
call(PredId, Mode, Args, Builtin, Context, Name)) -->
checkpoint("call"),
- typecheck_call_pred(Name, Args, PredId).
-typecheck_goal_2(higher_order_call(PredVar, Args, C, D, E, F),
- higher_order_call(PredVar, Args, C, D, E, F)) -->
- checkpoint("higher-order call"),
- typecheck_higher_order_call(PredVar, Args).
-typecheck_goal_2(class_method_call(A, B, C, D, E, F),
- class_method_call(A, B, C, D, E, F)) -->
- { error("class_method_calls should be introduced after typechecking") }.
+ { list__length(Args, Arity) },
+ typecheck_info_set_called_predid(call(predicate - Name/Arity)),
+ typecheck_call_pred(predicate - Name/Arity, Args, PredId).
+typecheck_goal_2(generic_call(GenericCall0, Args, C, D),
+ generic_call(GenericCall, Args, C, D)) -->
+ { hlds_goal__generic_call_id(GenericCall0, CallId) },
+ typecheck_info_set_called_predid(CallId),
+ (
+ { GenericCall0 = higher_order(PredVar, _, _) },
+ { GenericCall = GenericCall0 },
+ checkpoint("higher-order call"),
+ typecheck_higher_order_call(PredVar, Args)
+ ;
+ { GenericCall0 = class_method(_, _, _, _) },
+ { error("typecheck_goal_2: unexpected class method call") }
+ ;
+ { GenericCall0 = aditi_builtin(AditiBuiltin0, PredCallId) },
+ typecheck_aditi_builtin(PredCallId,
+ AditiBuiltin0, AditiBuiltin, Args),
+ { GenericCall = aditi_builtin(AditiBuiltin, PredCallId) }
+ ).
typecheck_goal_2(unify(A, B0, Mode, Info, UnifyContext),
unify(A, B, Mode, Info, UnifyContext)) -->
checkpoint("unify"),
@@ -984,10 +1011,8 @@
typecheck_higher_order_call(PredVar, Args) -->
{ list__length(Args, Arity) },
- { higher_order_pred_type(Arity, TypeVarSet, PredVarType, ArgTypes) },
- { Arity1 is Arity + 1 },
- { PredCallId = unqualified("call")/Arity1 },
- typecheck_info_set_called_predid(PredCallId),
+ { higher_order_pred_type(Arity, normal,
+ TypeVarSet, PredVarType, ArgTypes) },
% The class context is empty because higher-order predicates
% are always monomorphic. Similarly for ExistQVars.
{ ClassContext = constraints([], []) },
@@ -995,78 +1020,210 @@
typecheck_var_has_polymorphic_type_list([PredVar|Args], TypeVarSet,
ExistQVars, [PredVarType|ArgTypes], ClassContext).
-:- pred higher_order_pred_type(int, tvarset, type, list(type)).
-:- mode higher_order_pred_type(in, out, out, out) is det.
+:- pred higher_order_pred_type(int, lambda_eval_method,
+ tvarset, type, list(type)).
+:- mode higher_order_pred_type(in, in, out, out, out) is det.
- % higher_order_pred_type(N, TypeVarSet, PredType, ArgTypes):
+ % higher_order_pred_type(N, EvalMethod,
+ % TypeVarSet, PredType, ArgTypes):
% Given an arity N, let TypeVarSet = {T1, T2, ..., TN},
- % PredType = `pred(T1, T2, ..., TN)', and
+ % PredType = `EvalMethod pred(T1, T2, ..., TN)', and
% ArgTypes = [T1, T2, ..., TN].
-higher_order_pred_type(Arity, TypeVarSet, PredType, ArgTypes) :-
+higher_order_pred_type(Arity, EvalMethod, TypeVarSet, PredType, ArgTypes) :-
varset__init(TypeVarSet0),
varset__new_vars(TypeVarSet0, Arity, ArgTypeVars, TypeVarSet),
term__var_list_to_term_list(ArgTypeVars, ArgTypes),
- term__context_init(Context),
- PredType = term__functor(
- term__atom("pred"), ArgTypes, Context).
+ construct_higher_order_type(predicate, EvalMethod, ArgTypes, PredType).
-:- pred higher_order_func_type(int, tvarset, type, list(type), type).
-:- mode higher_order_func_type(in, out, out, out, out) is det.
+:- pred higher_order_func_type(int, lambda_eval_method,
+ tvarset, type, list(type), type).
+:- mode higher_order_func_type(in, in, out, out, out, out) is det.
- % higher_order_func_type(N, TypeVarSet, FuncType, ArgTypes, RetType):
+ % higher_order_func_type(N, EvalMethod, TypeVarSet,
+ % FuncType, ArgTypes, RetType):
% Given an arity N, let TypeVarSet = {T0, T1, T2, ..., TN},
- % FuncType = `func(T1, T2, ..., TN) = T0',
+ % FuncType = `EvalMethod func(T1, T2, ..., TN) = T0',
% ArgTypes = [T1, T2, ..., TN], and
% RetType = T0.
-higher_order_func_type(Arity, TypeVarSet, FuncType, ArgTypes, RetType) :-
+higher_order_func_type(Arity, EvalMethod, TypeVarSet,
+ FuncType, ArgTypes, RetType) :-
varset__init(TypeVarSet0),
varset__new_vars(TypeVarSet0, Arity, ArgTypeVars, TypeVarSet1),
varset__new_var(TypeVarSet1, RetTypeVar, TypeVarSet),
term__var_list_to_term_list(ArgTypeVars, ArgTypes),
RetType = term__variable(RetTypeVar),
- term__context_init(Context),
- FuncType = term__functor(term__atom("="),
- [term__functor(
- term__atom("func"), ArgTypes, Context),
- RetType],
- Context).
+ construct_higher_order_func_type(EvalMethod,
+ ArgTypes, RetType, FuncType).
%-----------------------------------------------------------------------------%
-:- pred typecheck_call_pred(sym_name, list(prog_var), pred_id, typecheck_info,
- typecheck_info).
+:- pred typecheck_aditi_builtin(simple_call_id, aditi_builtin, aditi_builtin,
+ list(prog_var), typecheck_info, typecheck_info).
+:- mode typecheck_aditi_builtin(in, in, out, in, typecheck_info_di,
+ typecheck_info_uo) is det.
+
+typecheck_aditi_builtin(CallId, Builtin0, Builtin, Args) -->
+ { get_state_args_det(Args, OtherArgs, State0, State) },
+ typecheck_aditi_builtin_2(CallId, Builtin0, Builtin, OtherArgs),
+ check_aditi_state_args(aditi_builtin_first_state_arg(Builtin0, CallId),
+ State0, State).
+
+:- pred typecheck_aditi_builtin_2(simple_call_id, aditi_builtin, aditi_builtin,
+ list(prog_var), typecheck_info, typecheck_info).
+:- mode typecheck_aditi_builtin_2(in, in, out, in,
+ typecheck_info_di, typecheck_info_uo) is det.
+
+typecheck_aditi_builtin_2(_, aditi_call(_, _, _, _), _, _) -->
+ { error("typecheck_aditi_builtin: unexpected aditi_call") }.
+typecheck_aditi_builtin_2(CallId, aditi_insert(_),
+ aditi_insert(PredId), Args) -->
+ % The first `aditi__state' argument is always argument 2.
+ typecheck_call_pred(CallId, Args, PredId).
+typecheck_aditi_builtin_2(CallId, aditi_delete(_, Syntax),
+ aditi_delete(PredId, Syntax), Args) -->
+ { CallId = PredOrFunc - _ },
+ typecheck_aditi_builtin_higher_order_arg(CallId, PredOrFunc,
+ (aditi_top_down), Args, PredId).
+typecheck_aditi_builtin_2(CallId, aditi_bulk_operation(BulkOp, _),
+ aditi_bulk_operation(BulkOp, PredId), Args) -->
+ { CallId = PredOrFunc - _ },
+ typecheck_aditi_builtin_higher_order_arg(CallId, PredOrFunc,
+ (aditi_bottom_up), Args, PredId).
+typecheck_aditi_builtin_2(CallId, aditi_modify(_, Syntax),
+ aditi_modify(PredId, Syntax), Args) -->
+ % `aditi_modify' takes a closure which takes two sets of arguments
+ % corresponding to those of the base relation - one set input
+ % and one set output.
+ { AdjustArgTypes =
+ lambda([ArgTypes0::in, ArgTypes::out] is det, (
+ list__append(ArgTypes0, ArgTypes0, ArgTypes1),
+ construct_higher_order_pred_type((aditi_top_down),
+ ArgTypes1, HOType),
+ ArgTypes = [HOType]
+ )) },
+ typecheck_aditi_builtin_higher_order_arg_2(CallId,
+ Args, AdjustArgTypes, PredId).
+
+:- func aditi_builtin_first_state_arg(aditi_builtin, simple_call_id) = int.
+
+aditi_builtin_first_state_arg(aditi_call(_, _, _, _), _) = _ :-
+ error("aditi_builtin_first_state_arg: unexpected_aditi_call").
+aditi_builtin_first_state_arg(aditi_insert(_), _ - _/Arity) = Arity + 1.
+aditi_builtin_first_state_arg(aditi_delete(_, _), _) = 2.
+aditi_builtin_first_state_arg(aditi_bulk_operation(_, _), _) = 2.
+aditi_builtin_first_state_arg(aditi_modify(_, _), _) = 2.
+
+:- pred typecheck_aditi_builtin_higher_order_arg(simple_call_id, pred_or_func,
+ lambda_eval_method, list(prog_var), pred_id,
+ typecheck_info, typecheck_info).
+:- mode typecheck_aditi_builtin_higher_order_arg(in, in, in, in, out,
+ typecheck_info_di, typecheck_info_uo) is det.
+
+typecheck_aditi_builtin_higher_order_arg(CallId, PredOrFunc,
+ EvalMethod, Args, PredId) -->
+ { AdjustArgTypes =
+ lambda([ArgTypes0::in, ArgTypes::out] is det, (
+ construct_higher_order_type(PredOrFunc,
+ EvalMethod, ArgTypes0, HOType),
+ ArgTypes = [HOType]
+ )) },
+ typecheck_aditi_builtin_higher_order_arg_2(CallId,
+ Args, AdjustArgTypes, PredId).
+
+:- pred typecheck_aditi_builtin_higher_order_arg_2(simple_call_id,
+ list(prog_var), adjust_arg_types, pred_id,
+ typecheck_info, typecheck_info).
+:- mode typecheck_aditi_builtin_higher_order_arg_2(in,
+ in, in(adjust_arg_types), out,
+ typecheck_info_di, typecheck_info_uo) is det.
+
+typecheck_aditi_builtin_higher_order_arg_2(CallId,
+ OtherArgs, AdjustArgTypes, PredId) -->
+ ( { OtherArgs = [HOArg] } ->
+ { FilterPredIds =
+ lambda([Module::in, PredIds0::in, PredIds::out] is det, (
+ list__filter(hlds_pred__is_base_relation(Module),
+ PredIds0, PredIds)
+ )) },
+ typecheck_call_pred_2(CallId, [HOArg],
+ FilterPredIds, AdjustArgTypes, PredId)
+ ;
+ { error(
+ "typecheck_aditi_builtin: incorrect arity for aditi_delete") }
+ ).
+
+:- pred check_aditi_state_args(int, prog_var, prog_var,
+ typecheck_info, typecheck_info).
+:- mode check_aditi_state_args(in, in, in,
+ typecheck_info_di, typecheck_info_uo) is det.
+
+check_aditi_state_args(FirstStateIndex, AditiState0, AditiState) -->
+ { construct_type(qualified(unqualified("aditi"), "state") - 0,
+ [], StateType) },
+ typecheck_var_has_type_list([AditiState0, AditiState],
+ [StateType, StateType], FirstStateIndex).
+
+%-----------------------------------------------------------------------------%
+
+:- pred typecheck_call_pred(simple_call_id, list(prog_var), pred_id,
+ typecheck_info, typecheck_info).
:- mode typecheck_call_pred(in, in, out, typecheck_info_di,
typecheck_info_uo) is det.
-typecheck_call_pred(PredName, Args, PredId, TypeCheckInfo0, TypeCheckInfo) :-
- list__length(Args, Arity),
- PredCallId = PredName/Arity,
- typecheck_info_set_called_predid(PredCallId, TypeCheckInfo0,
- TypeCheckInfo1),
+typecheck_call_pred(CallId, Args, PredId, TypeCheckInfo0, TypeCheckInfo) :-
+ FilterPredIds = lambda([_::in, X::in, X::out] is det, true),
+ AdjustArgTypes = lambda([X::in, X::out] is det, true),
+ typecheck_call_pred_2(CallId, Args, FilterPredIds,
+ AdjustArgTypes, PredId, TypeCheckInfo0, TypeCheckInfo).
+
+ % The higher-order argument here performs a transformation on
+ % the argument types of the called predicate. It is used to
+ % convert the argument types of the base relation for an Aditi
+ % update builtin to the type of the higher-order argument of
+ % the update predicate. For an ordinary predicate call,
+ % the types are not transformed.
+:- type adjust_arg_types == pred(list(type), list(type)).
+:- inst adjust_arg_types = (pred(in, out) is det).
+
+ % Filter out pred_ids which could not be used in the call's context.
+ % This is used to remove predicates which aren't base relations
+ % when typechecking an Aditi update.
+:- type filter_pred_ids == pred(module_info, list(pred_id), list(pred_id)).
+:- inst filter_pred_ids = (pred(in, in, out) is det).
+
+:- pred typecheck_call_pred_2(simple_call_id, list(prog_var),
+ filter_pred_ids, adjust_arg_types, pred_id,
+ typecheck_info, typecheck_info).
+:- mode typecheck_call_pred_2(in, in,
+ in(filter_pred_ids), in(adjust_arg_types), out,
+ typecheck_info_di, typecheck_info_uo) is det.
+typecheck_call_pred_2(CallId, Args, FilterPredIds, AdjustArgTypes,
+ PredId, TypeCheckInfo1, TypeCheckInfo) :-
typecheck_info_get_type_assign_set(TypeCheckInfo1, OrigTypeAssignSet),
% look up the called predicate's arg types
typecheck_info_get_module_info(TypeCheckInfo1, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
(
- predicate_table_search_pred_sym_arity(PredicateTable,
- PredName, Arity, PredIdList)
+ CallId = PorF - SymName/Arity,
+ predicate_table_search_pf_sym_arity(PredicateTable,
+ PorF, SymName, Arity, PredIdList0),
+ call(FilterPredIds, ModuleInfo, PredIdList0, PredIdList)
->
% handle the case of a non-overloaded predicate specially
% (so that we can optimize the case of a non-overloaded,
% non-polymorphic predicate)
( PredIdList = [PredId0] ->
PredId = PredId0,
- typecheck_call_pred_id(PredId, Args,
+ typecheck_call_pred_id_2(PredId, Args, AdjustArgTypes,
TypeCheckInfo1, TypeCheckInfo2)
;
- typecheck_info_get_pred_import_status(TypeCheckInfo1,
- CallingStatus),
typecheck_call_overloaded_pred(PredIdList, Args,
- CallingStatus, TypeCheckInfo1, TypeCheckInfo2),
+ AdjustArgTypes, TypeCheckInfo1,
+ TypeCheckInfo2),
%
% In general, we can't figure out which
@@ -1092,8 +1249,7 @@
;
invalid_pred_id(PredId),
- report_pred_call_error(TypeCheckInfo1, ModuleInfo,
- PredicateTable, PredCallId, TypeCheckInfo)
+ report_pred_call_error(CallId, TypeCheckInfo1, TypeCheckInfo)
).
:- pred typecheck_call_pred_id(pred_id, list(prog_var),
@@ -1102,12 +1258,24 @@
typecheck_info_uo) is det.
typecheck_call_pred_id(PredId, Args, TypeCheckInfo0, TypeCheckInfo) :-
+ AdjustArgTypes = lambda([X::in, X::out] is det, true),
+ typecheck_call_pred_id_2(PredId, Args, AdjustArgTypes,
+ TypeCheckInfo0, TypeCheckInfo).
+
+:- pred typecheck_call_pred_id_2(pred_id, list(prog_var), adjust_arg_types,
+ typecheck_info, typecheck_info).
+:- mode typecheck_call_pred_id_2(in, in, in(adjust_arg_types),
+ typecheck_info_di, typecheck_info_uo) is det.
+
+typecheck_call_pred_id_2(PredId, Args, AdjustArgTypes,
+ TypeCheckInfo0, TypeCheckInfo) :-
typecheck_info_get_module_info(TypeCheckInfo0, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
predicate_table_get_preds(PredicateTable, Preds),
map__lookup(Preds, PredId, PredInfo),
pred_info_arg_types(PredInfo, PredTypeVarSet, PredExistQVars,
- PredArgTypes),
+ PredArgTypes0),
+ AdjustArgTypes(PredArgTypes0, PredArgTypes),
pred_info_get_class_context(PredInfo, PredClassContext),
%
% rename apart the type variables in
@@ -1119,7 +1287,7 @@
%
( varset__is_empty(PredTypeVarSet) ->
typecheck_var_has_type_list(Args,
- PredArgTypes, 0, TypeCheckInfo0,
+ PredArgTypes, 1, TypeCheckInfo0,
TypeCheckInfo),
(
% sanity check
@@ -1135,18 +1303,18 @@
PredClassContext, TypeCheckInfo0, TypeCheckInfo)
).
-:- pred report_pred_call_error(typecheck_info, module_info, predicate_table,
- pred_call_id, typecheck_info).
-:- mode report_pred_call_error(typecheck_info_di, in, in,
- in, typecheck_info_uo) is det.
-
-report_pred_call_error(TypeCheckInfo1, _ModuleInfo, PredicateTable,
- PredCallId, TypeCheckInfo) :-
- PredCallId = PredName/_Arity,
+:- pred report_pred_call_error(simple_call_id, typecheck_info, typecheck_info).
+:- mode report_pred_call_error(in, typecheck_info_di,
+ typecheck_info_uo) is det.
+
+report_pred_call_error(PredCallId, TypeCheckInfo1, TypeCheckInfo) :-
+ PredCallId = PredOrFunc0 - SymName/_Arity,
+ typecheck_info_get_module_info(TypeCheckInfo1, ModuleInfo),
+ module_info_get_predicate_table(ModuleInfo, PredicateTable),
typecheck_info_get_io_state(TypeCheckInfo1, IOState0),
(
- predicate_table_search_pred_sym(PredicateTable,
- PredName, OtherIds),
+ predicate_table_search_pf_sym(PredicateTable,
+ PredOrFunc0, SymName, OtherIds),
predicate_table_get_preds(PredicateTable, Preds),
OtherIds \= []
->
@@ -1154,12 +1322,15 @@
report_error_pred_num_args(TypeCheckInfo1, PredCallId,
Arities, IOState0, IOState)
;
- predicate_table_search_func_sym(PredicateTable,
- PredName, OtherIds),
+ ( PredOrFunc0 = predicate, PredOrFunc = function
+ ; PredOrFunc0 = function, PredOrFunc = predicate
+ ),
+ predicate_table_search_pf_sym(PredicateTable,
+ PredOrFunc, SymName, OtherIds),
OtherIds \= []
->
- report_error_func_instead_of_pred(TypeCheckInfo1, PredCallId,
- IOState0, IOState)
+ report_error_func_instead_of_pred(TypeCheckInfo1, PredOrFunc,
+ PredCallId, IOState0, IOState)
;
report_error_undef_pred(TypeCheckInfo1, PredCallId,
IOState0, IOState)
@@ -1177,11 +1348,11 @@
typecheck_find_arities(Preds, PredIds, Arities).
:- pred typecheck_call_overloaded_pred(list(pred_id), list(prog_var),
- import_status, typecheck_info, typecheck_info).
-:- mode typecheck_call_overloaded_pred(in, in, in,
- typecheck_info_di, typecheck_info_uo) is det.
+ adjust_arg_types, typecheck_info, typecheck_info).
+:- mode typecheck_call_overloaded_pred(in, in, in(adjust_arg_types),
+ typecheck_info_di, typecheck_info_uo) is det.
-typecheck_call_overloaded_pred(PredIdList, Args, CallingPredStatus,
+typecheck_call_overloaded_pred(PredIdList, Args, AdjustArgTypes,
TypeCheckInfo0, TypeCheckInfo) :-
%
% let the new arg_type_assign_set be the cross-product
@@ -1193,56 +1364,66 @@
module_info_get_predicate_table(ModuleInfo, PredicateTable),
predicate_table_get_preds(PredicateTable, Preds),
typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
- get_overloaded_pred_arg_types(PredIdList, Preds, CallingPredStatus,
+ get_overloaded_pred_arg_types(PredIdList, Preds, AdjustArgTypes,
TypeAssignSet0, [], ArgsTypeAssignSet),
%
% then unify the types of the call arguments with the
% called predicates' arg types
%
- typecheck_var_has_arg_type_list(Args, 0, ArgsTypeAssignSet,
+ typecheck_var_has_arg_type_list(Args, 1, ArgsTypeAssignSet,
TypeCheckInfo0, TypeCheckInfo).
-:- pred get_overloaded_pred_arg_types(list(pred_id), pred_table, import_status,
- type_assign_set, args_type_assign_set, args_type_assign_set).
-:- mode get_overloaded_pred_arg_types(in, in, in, in, in, out) is det.
-
-get_overloaded_pred_arg_types([], _Preds, _CallingPredStatus,
- _TypeAssignSet0, ArgsTypeAssignSet, ArgsTypeAssignSet).
-get_overloaded_pred_arg_types([PredId | PredIds], Preds, CallingPredStatus,
+:- pred get_overloaded_pred_arg_types(list(pred_id), pred_table,
+ adjust_arg_types, type_assign_set,
+ args_type_assign_set, args_type_assign_set).
+:- mode get_overloaded_pred_arg_types(in, in, in(adjust_arg_types),
+ in, in, out) is det.
+
+get_overloaded_pred_arg_types([], _Preds, _AdjustArgTypes, _TypeAssignSet0,
+ ArgsTypeAssignSet, ArgsTypeAssignSet).
+get_overloaded_pred_arg_types([PredId | PredIds], Preds, AdjustArgTypes,
TypeAssignSet0, ArgsTypeAssignSet0, ArgsTypeAssignSet) :-
map__lookup(Preds, PredId, PredInfo),
pred_info_arg_types(PredInfo, PredTypeVarSet, PredExistQVars,
- PredArgTypes),
+ PredArgTypes0),
+ call(AdjustArgTypes, PredArgTypes0, PredArgTypes),
pred_info_get_class_context(PredInfo, PredClassContext),
rename_apart(TypeAssignSet0, PredTypeVarSet, PredExistQVars,
PredArgTypes, PredClassContext,
ArgsTypeAssignSet0, ArgsTypeAssignSet1),
- get_overloaded_pred_arg_types(PredIds, Preds, CallingPredStatus,
+ get_overloaded_pred_arg_types(PredIds, Preds, AdjustArgTypes,
TypeAssignSet0, ArgsTypeAssignSet1, ArgsTypeAssignSet).
%-----------------------------------------------------------------------------%
- % Note: calls to preds declared in .opt files should always be
+ % Note: calls to preds declared in `.opt' files should always be
% module qualified, so they should not be considered
% when resolving overloading.
typecheck__resolve_pred_overloading(ModuleInfo, Args, VarTypes, TVarSet,
PredName0, PredName, PredId) :-
+ map__apply_to_list(Args, VarTypes, ArgTypes),
+ FilterPredIds = lambda([_::in, X::in, X::out] is det, true),
+ typecheck__resolve_pred_overloading_2(ModuleInfo, FilterPredIds,
+ ArgTypes, TVarSet, PredName0, PredName, PredId).
+
+typecheck__resolve_pred_overloading_2(ModuleInfo, FilterPredIds,
+ ArgTypes, TVarSet, PredName0, PredName, PredId) :-
module_info_get_predicate_table(ModuleInfo, PredTable),
(
predicate_table_search_pred_sym(PredTable, PredName0,
PredIds0)
->
- PredIds = PredIds0
+ call(FilterPredIds, ModuleInfo, PredIds0, PredIds)
;
PredIds = []
),
+
%
% Check if there any of the candidate pred_ids
% have argument/return types which subsume the actual
% argument/return types of this function call
%
- map__apply_to_list(Args, VarTypes, ArgTypes),
(
typecheck__find_matching_pred_id(PredIds, ModuleInfo,
TVarSet, ArgTypes, PredId1, PredName1)
@@ -1360,7 +1541,7 @@
rename_apart(TypeAssignSet0, PredTypeVarSet, PredExistQVars,
PredArgTypes, PredClassConstraints,
[], ArgsTypeAssignSet),
- typecheck_var_has_arg_type_list(Args, 0, ArgsTypeAssignSet,
+ typecheck_var_has_arg_type_list(Args, 1, ArgsTypeAssignSet,
TypeCheckInfo0, TypeCheckInfo).
:- pred rename_apart(type_assign_set, tvarset, existq_tvars, list(type),
@@ -1430,9 +1611,9 @@
TypeCheckInfo).
typecheck_var_has_arg_type_list([Var|Vars], ArgNum, ArgTypeAssignSet0) -->
- { ArgNum1 is ArgNum + 1 },
- typecheck_info_set_arg_num(ArgNum1),
+ typecheck_info_set_arg_num(ArgNum),
typecheck_var_has_arg_type(Var, ArgTypeAssignSet0, ArgTypeAssignSet1),
+ { ArgNum1 is ArgNum + 1 },
typecheck_var_has_arg_type_list(Vars, ArgNum1, ArgTypeAssignSet1).
:- pred convert_args_type_assign_set(args_type_assign_set, type_assign_set).
@@ -1574,9 +1755,9 @@
{ error("typecheck_var_has_type_list: length mismatch") }.
typecheck_var_has_type_list([], [], _) --> [].
typecheck_var_has_type_list([Var|Vars], [Type|Types], ArgNum) -->
- { ArgNum1 is ArgNum + 1 },
- typecheck_info_set_arg_num(ArgNum1),
+ typecheck_info_set_arg_num(ArgNum),
typecheck_var_has_type(Var, Type),
+ { ArgNum1 is ArgNum + 1 },
typecheck_var_has_type_list(Vars, Types, ArgNum1).
:- pred typecheck_var_has_type(prog_var, type, typecheck_info, typecheck_info).
@@ -1858,9 +2039,11 @@
typecheck_unify_var_functor(X, F, As),
perform_context_reduction(OrigTypeAssignSet).
typecheck_unification(X,
- lambda_goal(PredOrFunc, NonLocals, Vars, Modes, Det, Goal0),
- lambda_goal(PredOrFunc, NonLocals, Vars, Modes, Det, Goal)) -->
- typecheck_lambda_var_has_type(PredOrFunc, X, Vars),
+ lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals, Vars,
+ Modes, Det, Goal0),
+ lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals, Vars,
+ Modes, Det, Goal)) -->
+ typecheck_lambda_var_has_type(PredOrFunc, EvalMethod, X, Vars),
typecheck_goal(Goal0, Goal).
:- pred typecheck_unify_var_var(prog_var, prog_var,
@@ -2300,58 +2483,47 @@
% checks that `Var' has type `pred(T1, T2, ...)' where
% T1, T2, ... are the types of the `ArgVars'.
-:- pred typecheck_lambda_var_has_type(pred_or_func, prog_var, list(prog_var),
- typecheck_info, typecheck_info).
-:- mode typecheck_lambda_var_has_type(in, in, in, typecheck_info_di,
- typecheck_info_uo) is det.
+:- pred typecheck_lambda_var_has_type(pred_or_func, lambda_eval_method,
+ prog_var, list(prog_var), typecheck_info, typecheck_info).
+:- mode typecheck_lambda_var_has_type(in, in, in, in, typecheck_info_di,
+ typecheck_info_uo) is det.
-typecheck_lambda_var_has_type(PredOrFunc, Var, ArgVars, TypeCheckInfo0,
- TypeCheckInfo) :-
+typecheck_lambda_var_has_type(PredOrFunc, EvalMethod, Var,
+ ArgVars, TypeCheckInfo0, TypeCheckInfo) :-
typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
typecheck_lambda_var_has_type_2(TypeAssignSet0,
- PredOrFunc, Var, ArgVars, [], TypeAssignSet),
+ PredOrFunc, EvalMethod, Var, ArgVars, [], TypeAssignSet),
(
TypeAssignSet = [],
TypeAssignSet0 \= []
->
typecheck_info_get_io_state(TypeCheckInfo0, IOState0),
- report_error_lambda_var(TypeCheckInfo0, PredOrFunc, Var,
- ArgVars, TypeAssignSet0, IOState0, IOState),
+ report_error_lambda_var(TypeCheckInfo0, PredOrFunc, EvalMethod,
+ Var, ArgVars, TypeAssignSet0, IOState0, IOState),
typecheck_info_set_io_state(TypeCheckInfo0, IOState,
- TypeCheckInfo1),
+ TypeCheckInfo1),
typecheck_info_set_found_error(TypeCheckInfo1, yes,
- TypeCheckInfo)
+ TypeCheckInfo)
;
typecheck_info_set_type_assign_set(TypeCheckInfo0,
- TypeAssignSet, TypeCheckInfo)
+ TypeAssignSet, TypeCheckInfo)
).
:- pred typecheck_lambda_var_has_type_2(type_assign_set,
- pred_or_func, prog_var, list(prog_var),
- type_assign_set, type_assign_set).
-:- mode typecheck_lambda_var_has_type_2(in, in, in, in, in, out) is det.
+ pred_or_func, lambda_eval_method, prog_var, list(prog_var),
+ type_assign_set, type_assign_set).
+:- mode typecheck_lambda_var_has_type_2(in, in, in, in, in, in, out) is det.
-typecheck_lambda_var_has_type_2([], _, _, _) --> [].
+typecheck_lambda_var_has_type_2([], _, _, _, _) --> [].
typecheck_lambda_var_has_type_2([TypeAssign0 | TypeAssignSet0],
- PredOrFunc, Var, ArgVars) -->
+ PredOrFunc, EvalMethod, Var, ArgVars) -->
{ type_assign_get_types_of_vars(ArgVars, TypeAssign0, ArgVarTypes,
TypeAssign1) },
- { term__context_init(Context) },
- {
- PredOrFunc = predicate,
- LambdaType = term__functor(term__atom("pred"), ArgVarTypes,
- Context)
- ;
- PredOrFunc = function,
- pred_args_to_func_args(ArgVarTypes, FuncArgTypes, RetType),
- LambdaType = term__functor(term__atom("="),
- [term__functor(term__atom("func"),
- FuncArgTypes, Context),
- RetType], Context)
- },
+ { construct_higher_order_type(PredOrFunc,
+ EvalMethod, ArgVarTypes, LambdaType) },
type_assign_var_has_type(TypeAssign1, Var, LambdaType),
typecheck_lambda_var_has_type_2(TypeAssignSet0,
- PredOrFunc, Var, ArgVars).
+ PredOrFunc, EvalMethod, Var, ArgVars).
:- pred type_assign_get_types_of_vars(list(prog_var), type_assign, list(type),
type_assign).
@@ -2485,13 +2657,29 @@
list__split_list(FuncArity, CompleteArgTypes,
ArgTypes, PredTypeParams)
->
- term__context_init("<builtin>", 0, Context),
- PredType = term__functor(term__atom("pred"),
- PredTypeParams, Context),
+ construct_higher_order_pred_type(normal,
+ PredTypeParams, PredType),
ConsInfo = cons_type_info(PredTypeVarSet,
PredExistQVars,
PredType, ArgTypes, ClassContext),
- L = [ConsInfo | L0]
+ L1 = [ConsInfo | L0],
+
+ % If the predicate has an Aditi marker,
+ % we also add the `aditi pred(...)' type,
+ % which is used for inputs to the Aditi bulk update
+ % operations and also to Aditi aggregates.
+ pred_info_get_markers(PredInfo, Markers),
+ ( check_marker(Markers, aditi) ->
+ construct_higher_order_pred_type(
+ (aditi_bottom_up), PredTypeParams,
+ PredType2),
+ ConsInfo2 = cons_type_info(PredTypeVarSet,
+ PredExistQVars, PredType2,
+ ArgTypes, ClassContext),
+ L = [ConsInfo2 | L1]
+ ;
+ L = L1
+ )
;
error("make_pred_cons_info: split_list failed")
)
@@ -2505,29 +2693,22 @@
(
list__split_list(FuncArity, CompleteArgTypes,
FuncArgTypes, FuncTypeParams),
- list__length(FuncTypeParams, NumParams0),
- NumParams1 is NumParams0 - 1,
- list__split_list(NumParams1, FuncTypeParams,
- FuncArgTypeParams, [FuncReturnTypeParam])
+ pred_args_to_func_args(FuncTypeParams,
+ FuncArgTypeParams, FuncReturnTypeParam)
->
( FuncArgTypeParams = [] ->
FuncType = FuncReturnTypeParam
;
- term__context_init("<builtin>", 0,
- Context),
- FuncType = term__functor(term__atom("="), [
- term__functor(term__atom("func"),
- FuncArgTypeParams,
- Context),
- FuncReturnTypeParam
- ], Context)
+ construct_higher_order_func_type(normal,
+ FuncArgTypeParams, FuncReturnTypeParam,
+ FuncType)
),
ConsInfo = cons_type_info(PredTypeVarSet,
PredExistQVars,
FuncType, FuncArgTypes, ClassContext),
L = [ConsInfo | L0]
;
- error("make_pred_cons_info: split_list or remove_suffix failed")
+ error("make_pred_cons_info: split_list failed")
)
;
L = L0
@@ -2547,7 +2728,8 @@
( ApplyName = "apply" ; ApplyName = "" ),
Arity >= 1,
Arity1 is Arity - 1,
- higher_order_func_type(Arity1, TypeVarSet, FuncType, ArgTypes, RetType),
+ higher_order_func_type(Arity1, normal, TypeVarSet,
+ FuncType, ArgTypes, RetType),
ExistQVars = [],
Constraints = constraints([], []),
ConsTypeInfos = [cons_type_info(TypeVarSet, ExistQVars, RetType,
@@ -2564,7 +2746,7 @@
module_info, % The global symbol tables
- pred_call_id, % The pred_call_id of the pred
+ call_id, % The call_id of the pred
% being called (if any)
int, % The argument number within
@@ -2651,7 +2833,7 @@
typecheck_info_init(IOState0, ModuleInfo, PredId, TypeVarSet, VarSet,
VarTypes, HeadTypeParams, Constraints, Status, TypeCheckInfo) :-
- CallPredId = unqualified("") / 0,
+ CallPredId = call(predicate - unqualified("") / 0),
term__context_init(Context),
map__init(TypeBindings),
map__init(Proofs),
@@ -2733,7 +2915,7 @@
%-----------------------------------------------------------------------------%
-:- pred typecheck_info_get_called_predid(typecheck_info, pred_call_id).
+:- pred typecheck_info_get_called_predid(typecheck_info, call_id).
:- mode typecheck_info_get_called_predid(in, out) is det.
typecheck_info_get_called_predid(TypeCheckInfo, PredId) :-
@@ -2741,7 +2923,7 @@
%-----------------------------------------------------------------------------%
-:- pred typecheck_info_set_called_predid(pred_call_id, typecheck_info,
+:- pred typecheck_info_set_called_predid(call_id, typecheck_info,
typecheck_info).
:- mode typecheck_info_set_called_predid(in, typecheck_info_di,
typecheck_info_uo) is det.
@@ -3976,12 +4158,13 @@
write_type_assign_set_msg(TypeAssignSet, VarSet).
-:- pred report_error_lambda_var(typecheck_info, pred_or_func, prog_var,
- list(prog_var), type_assign_set, io__state, io__state).
-:- mode report_error_lambda_var(typecheck_info_no_io, in, in, in, in, di, uo)
- is det.
+:- pred report_error_lambda_var(typecheck_info, pred_or_func,
+ lambda_eval_method, prog_var, list(prog_var), type_assign_set,
+ io__state, io__state).
+:- mode report_error_lambda_var(typecheck_info_no_io,
+ in, in, in, in, in, di, uo) is det.
-report_error_lambda_var(TypeCheckInfo, PredOrFunc, Var, ArgVars,
+report_error_lambda_var(TypeCheckInfo, PredOrFunc, EvalMethod, Var, ArgVars,
TypeAssignSet) -->
{ typecheck_info_get_context(TypeCheckInfo, Context) },
@@ -3996,15 +4179,25 @@
write_argument_name(VarSet, Var),
io__write_string("\n"),
prog_out__write_context(Context),
+
+ { EvalMethod = normal, EvalStr = ""
+ ; EvalMethod = (aditi_bottom_up), EvalStr = "aditi_bottom_up "
+ ; EvalMethod = (aditi_top_down), EvalStr = "aditi_top_down "
+ },
+
(
{ PredOrFunc = predicate },
- io__write_string(" and `pred("),
+ io__write_string(" and `"),
+ io__write_string(EvalStr),
+ io__write_string("pred("),
mercury_output_vars(ArgVars, VarSet, no),
io__write_string(") :- ...':\n")
;
{ PredOrFunc = function },
{ pred_args_to_func_args(ArgVars, FuncArgs, RetVar) },
- io__write_string(" and `func("),
+ io__write_string(" and `"),
+ io__write_string(EvalStr),
+ io__write_string("func("),
mercury_output_vars(FuncArgs, VarSet, no),
io__write_string(") = "),
mercury_output_var(RetVar, VarSet, no),
@@ -4655,11 +4848,11 @@
%-----------------------------------------------------------------------------%
-:- pred report_error_undef_pred(typecheck_info, pred_call_id,
+:- pred report_error_undef_pred(typecheck_info, simple_call_id,
io__state, io__state).
:- mode report_error_undef_pred(typecheck_info_no_io, in, di, uo) is det.
-report_error_undef_pred(TypeCheckInfo, PredCallId) -->
+report_error_undef_pred(TypeCheckInfo, PredOrFunc - PredCallId) -->
{ PredCallId = PredName/Arity },
{ typecheck_info_get_context(TypeCheckInfo, Context) },
write_typecheck_info_context(TypeCheckInfo),
@@ -4730,9 +4923,8 @@
io__write_string(
" argument of `some' should be a list of variables.\n")
;
- io__write_string(" error: undefined predicate `"),
- hlds_out__write_pred_call_id(PredCallId),
- io__write_string("'"),
+ io__write_string(" error: undefined "),
+ hlds_out__write_simple_call_id(PredOrFunc - PredCallId),
( { PredName = qualified(ModQual, _) } ->
maybe_report_missing_import(TypeCheckInfo, ModQual)
;
@@ -4767,18 +4959,25 @@
io__write_string(".\n")
).
-:- pred report_error_func_instead_of_pred(typecheck_info, pred_call_id,
- io__state, io__state).
-:- mode report_error_func_instead_of_pred(typecheck_info_no_io, in, di, uo)
- is det.
+:- pred report_error_func_instead_of_pred(typecheck_info, pred_or_func,
+ simple_call_id, io__state, io__state).
+:- mode report_error_func_instead_of_pred(typecheck_info_no_io, in, in,
+ di, uo) is det.
-report_error_func_instead_of_pred(TypeCheckInfo, PredCallId) -->
+report_error_func_instead_of_pred(TypeCheckInfo, PredOrFunc, PredCallId) -->
report_error_undef_pred(TypeCheckInfo, PredCallId),
{ typecheck_info_get_context(TypeCheckInfo, Context) },
prog_out__write_context(Context),
- io__write_string(" (There is a *function* with that name, however.\n"),
- prog_out__write_context(Context),
- io__write_string(" Perhaps you forgot to add ` = ...'?)\n").
+ io__write_string(" (There is a *"),
+ hlds_out__write_pred_or_func(PredOrFunc),
+ io__write_string("* with that name, however."),
+ ( { PredOrFunc = function } ->
+ io__nl,
+ prog_out__write_context(Context),
+ io__write_string(" Perhaps you forgot to add ` = ...'?)\n")
+ ;
+ io__write_string(")\n")
+ ).
:- pred report_error_apply_instead_of_pred(typecheck_info, io__state,
io__state).
@@ -4820,21 +5019,49 @@
[]
).
-:- pred report_error_pred_num_args(typecheck_info, pred_call_id, list(int),
- io__state, io__state).
-:- mode report_error_pred_num_args(typecheck_info_no_io, in, in, di, uo) is det.
+:- pred report_error_pred_num_args(typecheck_info, simple_call_id,
+ list(int), io__state, io__state).
+:- mode report_error_pred_num_args(typecheck_info_no_io, in,
+ in, di, uo) is det.
+
+report_error_pred_num_args(TypeCheckInfo, CallId, Arities0) -->
+ write_context_and_pred_id(TypeCheckInfo),
+ { typecheck_info_get_context(TypeCheckInfo, Context) },
+ report_error_num_args(no, Context, CallId, Arities0).
+
+report_error_num_args(First, Context, CallId, Arities0) -->
+ prog_out__write_context(Context),
+ (
+ { First = yes },
+ io__write_string("Error: ")
+ ;
+ { First = no },
+ io__write_string(" error: ")
+ ),
+ io__write_string("wrong number of arguments ("),
+
+ % Adjust arities for functions.
+ { CallId = PredOrFunc - SymName/Arity0 },
+ {
+ PredOrFunc = predicate,
+ Arity = Arity0,
+ Arities = Arities0
+ ;
+ PredOrFunc = function,
+ Arity = Arity0 - 1,
+ list__map((pred(OtherArity::in, OtherArity - 1::out) is det),
+ Arities0, Arities)
+ },
-report_error_pred_num_args(TypeCheckInfo, Name / Arity, Arities) -->
- write_typecheck_info_context(TypeCheckInfo),
- io__write_string(" error: wrong number of arguments ("),
io__write_int(Arity),
io__write_string("; should be "),
report_error_right_num_args(Arities),
io__write_string(")\n"),
- { typecheck_info_get_context(TypeCheckInfo, Context) },
prog_out__write_context(Context),
- io__write_string(" in call to pred `"),
- prog_out__write_sym_name(Name),
+ io__write_string(" in call to "),
+ hlds_out__write_pred_or_func(PredOrFunc),
+ io__write_string(" `"),
+ prog_out__write_sym_name(SymName),
io__write_string("'.\n").
:- pred report_error_right_num_args(list(int), io__state, io__state).
@@ -5004,20 +5231,18 @@
language_builtin("all", 2).
language_builtin("some", 2).
-:- pred write_call_context(prog_context, pred_call_id, int, unify_context,
+:- pred write_call_context(prog_context, call_id, int, unify_context,
io__state, io__state).
:- mode write_call_context(in, in, in, in, di, uo) is det.
-write_call_context(Context, PredCallId, ArgNum, UnifyContext) -->
+write_call_context(Context, CallId, ArgNum, UnifyContext) -->
( { ArgNum = 0 } ->
hlds_out__write_unify_context(UnifyContext, Context)
;
prog_out__write_context(Context),
- io__write_string(" in argument "),
- io__write_int(ArgNum),
- io__write_string(" of call to pred `"),
- hlds_out__write_pred_call_id(PredCallId),
- io__write_string("':\n")
+ io__write_string(" in "),
+ hlds_out__write_call_arg_id(CallId, ArgNum),
+ io__write_string(":\n")
).
%-----------------------------------------------------------------------------%
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_gen.m,v
retrieving revision 1.98
diff -u -u -r1.98 unify_gen.m
--- unify_gen.m 1999/06/01 09:44:16 1.98
+++ unify_gen.m 1999/06/02 01:35:36
@@ -39,8 +39,8 @@
:- import_module hlds_module, hlds_pred, prog_data, prog_out, code_util.
:- import_module mode_util, type_util, code_aux, hlds_out, tree, arg_info.
-:- import_module globals, options, continuation_info, stack_layout.
-:- import_module term, bool, string, int, list, map, require, std_util.
+:- import_module globals, options, continuation_info, stack_layout, rl.
+:- import_module bool, string, int, list, map, require, std_util, term.
:- type uni_val ---> ref(prog_var)
; lval(lval).
@@ -57,9 +57,9 @@
{ Uni = assign(Left, Right) },
unify_gen__generate_assignment(Left, Right, Code)
;
- { Uni = construct(Var, ConsId, Args, Modes) },
+ { Uni = construct(Var, ConsId, Args, Modes, _, _, AditiInfo) },
unify_gen__generate_construction(Var, ConsId,
- Args, Modes, Code)
+ Args, Modes, AditiInfo, Code)
;
{ Uni = deconstruct(Var, ConsId, Args, Modes, _Det) },
( { CodeModel = model_det } ->
@@ -218,7 +218,7 @@
TestRval = binop(float_eq, Rval, const(float_const(Float))).
unify_gen__generate_tag_rval_2(int_constant(Int), Rval, TestRval) :-
TestRval = binop(eq, Rval, const(int_const(Int))).
-unify_gen__generate_tag_rval_2(pred_closure_tag(_, _), _Rval, _TestRval) :-
+unify_gen__generate_tag_rval_2(pred_closure_tag(_, _, _), _Rval, _TestRval) :-
% This should never happen, since the error will be detected
% during mode checking.
error("Attempted higher-order unification").
@@ -258,33 +258,35 @@
% instantiate the arguments of that term.
:- pred unify_gen__generate_construction(prog_var, cons_id,
- list(prog_var), list(uni_mode), code_tree,
- code_info, code_info).
-:- mode unify_gen__generate_construction(in, in, in, in, out, in, out) is det.
+ list(prog_var), list(uni_mode), maybe(rl_exprn_id),
+ code_tree, code_info, code_info).
+:- mode unify_gen__generate_construction(in, in, in, in,
+ in, out, in, out) is det.
-unify_gen__generate_construction(Var, Cons, Args, Modes, Code) -->
+unify_gen__generate_construction(Var, Cons, Args, Modes, AditiInfo, Code) -->
code_info__cons_id_to_tag(Var, Cons, Tag),
- unify_gen__generate_construction_2(Tag, Var, Args, Modes, Code).
+ unify_gen__generate_construction_2(Tag, Var, Args,
+ Modes, AditiInfo, Code).
:- pred unify_gen__generate_construction_2(cons_tag, prog_var,
- list(prog_var), list(uni_mode), code_tree,
- code_info, code_info).
-:- mode unify_gen__generate_construction_2(in, in, in, in, out,
+ list(prog_var), list(uni_mode), maybe(rl_exprn_id),
+ code_tree, code_info, code_info).
+:- mode unify_gen__generate_construction_2(in, in, in, in, in, out,
in, out) is det.
unify_gen__generate_construction_2(string_constant(String),
- Var, _Args, _Modes, Code) -->
+ Var, _Args, _Modes, _, Code) -->
{ Code = empty },
code_info__cache_expression(Var, const(string_const(String))).
unify_gen__generate_construction_2(int_constant(Int),
- Var, _Args, _Modes, Code) -->
+ Var, _Args, _Modes, _, Code) -->
{ Code = empty },
code_info__cache_expression(Var, const(int_const(Int))).
unify_gen__generate_construction_2(float_constant(Float),
- Var, _Args, _Modes, Code) -->
+ Var, _Args, _Modes, _, Code) -->
{ Code = empty },
code_info__cache_expression(Var, const(float_const(Float))).
-unify_gen__generate_construction_2(no_tag, Var, Args, Modes, Code) -->
+unify_gen__generate_construction_2(no_tag, Var, Args, Modes, _, Code) -->
( { Args = [Arg], Modes = [Mode] } ->
code_info__variable_type(Arg, Type),
unify_gen__generate_sub_unify(ref(Var), ref(Arg),
@@ -294,7 +296,7 @@
"unify_gen__generate_construction_2: no_tag: arity != 1") }
).
unify_gen__generate_construction_2(unshared_tag(UnsharedTag),
- Var, Args, Modes, Code) -->
+ Var, Args, Modes, _, Code) -->
code_info__get_module_info(ModuleInfo),
code_info__get_next_cell_number(CellNo),
unify_gen__var_types(Args, ArgTypes),
@@ -309,7 +311,7 @@
CellNo, VarTypeMsg) },
code_info__cache_expression(Var, Expr).
unify_gen__generate_construction_2(shared_remote_tag(Bits0, Num0),
- Var, Args, Modes, Code) -->
+ Var, Args, Modes, _, Code) -->
code_info__get_module_info(ModuleInfo),
code_info__get_next_cell_number(CellNo),
unify_gen__var_types(Args, ArgTypes),
@@ -326,12 +328,12 @@
CellNo, VarTypeMsg) },
code_info__cache_expression(Var, Expr).
unify_gen__generate_construction_2(shared_local_tag(Bits1, Num1),
- Var, _Args, _Modes, Code) -->
+ Var, _Args, _Modes, _, Code) -->
{ Code = empty },
code_info__cache_expression(Var,
mkword(Bits1, unop(mkbody, const(int_const(Num1))))).
unify_gen__generate_construction_2(type_ctor_info_constant(ModuleName,
- TypeName, TypeArity), Var, Args, _Modes, Code) -->
+ TypeName, TypeArity), Var, Args, _Modes, _, Code) -->
( { Args = [] } ->
[]
;
@@ -341,7 +343,7 @@
code_info__cache_expression(Var, const(data_addr_const(data_addr(
ModuleName, type_ctor(info, TypeName, TypeArity))))).
unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
- ClassId, Instance), Var, Args, _Modes, Code) -->
+ ClassId, Instance), Var, Args, _Modes, _, Code) -->
( { Args = [] } ->
[]
;
@@ -351,7 +353,7 @@
code_info__cache_expression(Var, const(data_addr_const(data_addr(
ModuleName, base_typeclass_info(ClassId, Instance))))).
unify_gen__generate_construction_2(tabling_pointer_constant(PredId, ProcId),
- Var, Args, _Modes, Code) -->
+ Var, Args, _Modes, _, Code) -->
( { Args = [] } ->
[]
;
@@ -364,7 +366,7 @@
{ DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)) },
code_info__cache_expression(Var, const(data_addr_const(DataAddr))).
unify_gen__generate_construction_2(code_addr_constant(PredId, ProcId),
- Var, Args, _Modes, Code) -->
+ Var, Args, _Modes, _, Code) -->
( { Args = [] } ->
[]
;
@@ -374,8 +376,9 @@
code_info__get_module_info(ModuleInfo),
code_info__make_entry_label(ModuleInfo, PredId, ProcId, no, CodeAddr),
code_info__cache_expression(Var, const(code_addr_const(CodeAddr))).
-unify_gen__generate_construction_2(pred_closure_tag(PredId, ProcId),
- Var, Args, _Modes, Code) -->
+unify_gen__generate_construction_2(
+ pred_closure_tag(PredId, ProcId, EvalMethod),
+ Var, Args, _Modes, _AditiInfo, Code) -->
% This code constructs or extends a closure.
% The structure of closures is defined in runtime/mercury_ho_call.h.
@@ -413,10 +416,11 @@
{ proc_info_interface_code_model(ProcInfo, CodeModel) },
{ proc_info_headvars(ProcInfo, ProcHeadVars) },
(
+ { EvalMethod = normal },
{ Args = [CallPred | CallArgs] },
{ ProcHeadVars = [ProcPred | ProcArgs] },
- { ProcInfoGoal = higher_order_call(ProcPred, ProcArgs, _, _,
- CallDeterminism, _) - _GoalInfo },
+ { ProcInfoGoal = generic_call(higher_order(ProcPred, _, _),
+ ProcArgs, _, CallDeterminism) - _GoalInfo },
{ determinism_to_code_model(CallDeterminism, CallCodeModel) },
% Check that the code models are compatible.
% Note that det is not compatible with semidet,
@@ -504,6 +508,21 @@
CodeAddr),
{ code_util__extract_proc_label_from_code_addr(CodeAddr,
ProcLabel) },
+ (
+ { EvalMethod = normal }
+ ;
+ { EvalMethod = (aditi_bottom_up) },
+ % XXX The closure_layout code needs to be changed
+ % to handle these.
+ { error(
+ "Sorry, not implemented: `aditi_bottom_up' closures") }
+ ;
+ { EvalMethod = (aditi_top_down) },
+ % XXX The closure_layout code needs to be changed
+ % to handle these.
+ { error(
+ "Sorry, not implemented: `aditi_top_down' closures") }
+ ),
{ module_info_globals(ModuleInfo, Globals) },
{ globals__lookup_bool_option(Globals, typeinfo_liveness,
TypeInfoLiveness) },
@@ -677,7 +696,7 @@
{ Tag = float_constant(_Float) },
{ Code = empty }
;
- { Tag = pred_closure_tag(_, _) },
+ { Tag = pred_closure_tag(_, _, _) },
{ Code = empty }
;
{ Tag = code_addr_constant(_, _) },
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.52
diff -u -u -r1.52 unique_modes.m
--- unique_modes.m 1999/05/18 03:09:05 1.52
+++ unique_modes.m 1999/05/18 03:10:09
@@ -372,36 +372,23 @@
mode_info_set_instmap(InstMap0),
mode_checkpoint(exit, "not").
-unique_modes__check_goal_2(some(Vs, G0), _, some(Vs, G)) -->
+unique_modes__check_goal_2(some(Vs, CanRemove, G0), _,
+ some(Vs, CanRemove, G)) -->
mode_checkpoint(enter, "some"),
unique_modes__check_goal(G0, G),
mode_checkpoint(exit, "some").
-unique_modes__check_goal_2(higher_order_call(PredVar, Args, Types, Modes, Det,
- PredOrFunc), _GoalInfo0, Goal) -->
- mode_checkpoint(enter, "higher-order call"),
- mode_info_set_call_context(higher_order_call(PredOrFunc)),
- { determinism_components(Det, _, at_most_zero) ->
- NeverSucceeds = yes
- ;
- NeverSucceeds = no
- },
- { determinism_to_code_model(Det, CodeModel) },
- unique_modes__check_call_modes(Args, Modes, CodeModel, NeverSucceeds),
- { Goal = higher_order_call(PredVar, Args, Types, Modes, Det,
- PredOrFunc) },
- mode_info_unset_call_context,
- mode_checkpoint(exit, "higher-order call").
-
-unique_modes__check_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
- Det), _GoalInfo0, Goal) -->
- mode_checkpoint(enter, "class method call"),
- % Setting the context to `higher_order_call(...)' is a little
- % white lie. However, since there can't really be a unique
+unique_modes__check_goal_2(generic_call(GenericCall, Args, Modes, Det),
+ _GoalInfo0, Goal) -->
+ { hlds_goal__generic_call_id(GenericCall, CallId) },
+ mode_checkpoint(enter, "generic_call"),
+ % Setting the context to `higher_order_call(...)' for
+ % class method calls is a little white lie.
+ % However, since there can't really be a unique
% mode error in a class_method_call, this lie will never be
% used. There can't be an error because the class_method_call
% is introduced by the compiler as the body of a class method.
- mode_info_set_call_context(higher_order_call(predicate)),
+ mode_info_set_call_context(call(CallId)),
{ determinism_components(Det, _, at_most_zero) ->
NeverSucceeds = yes
;
@@ -409,14 +396,18 @@
},
{ determinism_to_code_model(Det, CodeModel) },
unique_modes__check_call_modes(Args, Modes, CodeModel, NeverSucceeds),
- { Goal = class_method_call(TCVar, Num, Args, Types, Modes, Det) },
+ { Goal = generic_call(GenericCall, Args, Modes, Det) },
mode_info_unset_call_context,
- mode_checkpoint(exit, "class method call").
+ mode_checkpoint(exit, "generic_call").
unique_modes__check_goal_2(call(PredId, ProcId0, Args, Builtin, CallContext,
PredName), _GoalInfo0, Goal) -->
mode_checkpoint(enter, "call"),
- mode_info_set_call_context(call(PredId)),
+ =(ModeInfo),
+ { mode_info_get_module_info(ModeInfo, ModuleInfo) },
+ { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+ { pred_info_get_call_id(PredInfo, CallId) },
+ mode_info_set_call_context(call(call(CallId))),
unique_modes__check_call(PredId, ProcId0, Args, ProcId),
{ Goal = call(PredId, ProcId, Args, Builtin, CallContext, PredName) },
mode_info_unset_call_context,
@@ -453,7 +444,11 @@
Args, ArgNameMap, OrigArgTypes, PragmaCode),
_GoalInfo, Goal) -->
mode_checkpoint(enter, "pragma_c_code"),
- mode_info_set_call_context(call(PredId)),
+ =(ModeInfo),
+ { mode_info_get_module_info(ModeInfo, ModuleInfo) },
+ { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+ { pred_info_get_call_id(PredInfo, CallId) },
+ mode_info_set_call_context(call(call(CallId))),
unique_modes__check_call(PredId, ProcId0, Args, ProcId),
{ Goal = pragma_c_code(IsRecursive, PredId, ProcId, Args,
ArgNameMap, OrigArgTypes, PragmaCode) },
Index: compiler/unused_args.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unused_args.m,v
retrieving revision 1.56
diff -u -u -r1.56 unused_args.m
--- unused_args.m 1998/12/06 23:46:01 1.56
+++ unused_args.m 1999/05/14 04:55:49
@@ -55,7 +55,7 @@
:- import_module hlds_pred, hlds_goal, hlds_data, hlds_out, type_util, instmap.
:- import_module code_util, globals, make_hlds, mercury_to_mercury, mode_util.
:- import_module options, prog_data, prog_out, quantification, special_pred.
-:- import_module passes_aux, inst_match, modules, polymorphism.
+:- import_module passes_aux, inst_match, modules, polymorphism, goal_util.
:- import_module assoc_list, bool, char, int, list, map, require.
:- import_module set, std_util, string.
@@ -448,17 +448,15 @@
traverse_goal(ModuleInfo, Goal, UseInf0, UseInf).
% handle quantification
-traverse_goal(ModuleInfo, some(_, Goal - _), UseInf0, UseInf) :-
+traverse_goal(ModuleInfo, some(_, _, Goal - _), UseInf0, UseInf) :-
traverse_goal(ModuleInfo, Goal, UseInf0, UseInf).
% we assume that higher-order predicate calls use all variables involved
-traverse_goal(_, higher_order_call(PredVar,Args,_,_,_,_), UseInf0, UseInf) :-
- set_list_vars_used(UseInf0, [PredVar|Args], UseInf).
-
-% we assume that class method calls use all variables involved
-traverse_goal(_, class_method_call(PredVar,_,Args,_,_,_), UseInf0, UseInf) :-
- set_list_vars_used(UseInf0, [PredVar|Args], UseInf).
+traverse_goal(_, generic_call(GenericCall,Args,_,_), UseInf0, UseInf) :-
+ goal_util__generic_call_vars(GenericCall, CallArgs),
+ set_list_vars_used(UseInf0, CallArgs, UseInf1),
+ set_list_vars_used(UseInf1, Args, UseInf).
% handle pragma c_code(...) -
% only those arguments which have C names can be used in the C code.
@@ -505,7 +503,7 @@
UseInf = UseInf2
).
-traverse_goal(_, unify(Var1, _, _, construct(_, _, Args, _), _),
+traverse_goal(_, unify(Var1, _, _, construct(_, _, Args, _, _, _, _), _),
UseInf0, UseInf) :-
( local_var_is_used(UseInf0, Var1) ->
set_list_vars_used(UseInf0, Args, UseInf)
@@ -1244,8 +1242,8 @@
bool__or_list([Changed1, Changed2, Changed3], Changed).
fixup_goal_expr(ModuleInfo, UnusedVars, ProcCallInfo, Changed,
- some(Vars, SubGoal0) - GoalInfo,
- some(Vars, SubGoal) - GoalInfo) :-
+ some(Vars, CanRemove, SubGoal0) - GoalInfo,
+ some(Vars, CanRemove, SubGoal) - GoalInfo) :-
fixup_goal(ModuleInfo, UnusedVars, ProcCallInfo,
Changed, SubGoal0, SubGoal).
@@ -1284,11 +1282,7 @@
fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
- GoalExpr = higher_order_call(_, _, _, _, _, _).
-
-fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
- GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
- GoalExpr = class_method_call(_, _, _, _, _, _).
+ GoalExpr = generic_call(_, _, _, _).
fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
@@ -1377,13 +1371,12 @@
\+ list__member(Var1, UnusedVars).
% LVar unused => we don't need the unification
-fixup_unify(_, UnusedVars, no, construct(LVar, ConsId, ArgVars, ArgModes),
- construct(LVar, ConsId, ArgVars, ArgModes)) :-
+fixup_unify(_, UnusedVars, no, Unify, Unify) :-
+ Unify = construct(LVar, _, _, _, _, _, _),
\+ list__member(LVar, UnusedVars).
-fixup_unify(ModuleInfo, UnusedVars, Changed,
- deconstruct(LVar, ConsId, ArgVars, ArgModes, CanFail),
- deconstruct(LVar, ConsId, ArgVars, ArgModes, CanFail)) :-
+fixup_unify(ModuleInfo, UnusedVars, Changed, Unify, Unify) :-
+ Unify = deconstruct(LVar, _, ArgVars, ArgModes, CanFail),
\+ list__member(LVar, UnusedVars),
(
% are any of the args unused, if so we need to
--------------------------------------------------------------------------
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