[m-dev.] for review: Aditi updates [2]
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Apr 12 18:25:51 AEST 2000
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.35
diff -u -u -r1.35 modecheck_call.m
--- compiler/modecheck_call.m 2000/01/13 06:16:32 1.35
+++ compiler/modecheck_call.m 2000/03/17 03:11:43
@@ -120,10 +120,10 @@
Args0, Modes, Det, Args, ExtraGoals) -->
{ aditi_builtin_determinism(AditiBuiltin, Det) },
- % `aditi_insert' goals have type_info arguments for each
- % of the arguments of the tuple to insert added to the
- % start of the argument list by polymorphism.m.
- ( { AditiBuiltin = aditi_insert(_) } ->
+ % `aditi_insert' and `aditi_delete' goals have type_info
+ % arguments for each of the arguments of the tuple to
+ % insert added to the start of the argument list by polymorphism.m.
+ ( { AditiBuiltin = aditi_tuple_insert_delete(_, _) } ->
{ CallId = _ - _/Arity },
{ ArgOffset = -Arity }
;
@@ -140,10 +140,8 @@
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).
+aditi_builtin_determinism(aditi_tuple_insert_delete(_, _), det).
+aditi_builtin_determinism(aditi_insert_delete_modify(_, _, _), det).
:- pred modecheck_arg_list(int, list(mode), extra_goals,
list(prog_var), list(prog_var), mode_info, mode_info).
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.101
diff -u -u -r1.101 opt_debug.m
--- compiler/opt_debug.m 2000/04/02 08:09:22 1.101
+++ compiler/opt_debug.m 2000/04/03 04:58:58
@@ -847,7 +847,7 @@
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_aditi_bulk_modify, "do_aditi_bulk_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/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.106
diff -u -u -r1.106 opt_util.m
--- compiler/opt_util.m 2000/03/20 05:26:35 1.106
+++ compiler/opt_util.m 2000/03/23 02:40:49
@@ -1411,7 +1411,7 @@
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_aditi_bulk_modify, yes).
opt_util__livevals_addr(do_not_reached, no).
opt_util__count_temps_instr_list([], R, R, F, F).
@@ -2067,7 +2067,8 @@
do_aditi_bulk_insert).
opt_util__replace_labels_code_addr(do_aditi_bulk_delete, _,
do_aditi_bulk_delete).
-opt_util__replace_labels_code_addr(do_aditi_modify, _, do_aditi_modify).
+opt_util__replace_labels_code_addr(do_aditi_bulk_modify, _,
+ do_aditi_bulk_modify).
opt_util__replace_labels_code_addr(do_not_reached, _, do_not_reached).
:- pred opt_util__replace_labels_label_list(list(label)::in,
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.7
diff -u -u -r1.7 pd_util.m
--- compiler/pd_util.m 1999/10/15 03:45:01 1.7
+++ compiler/pd_util.m 2000/03/17 03:49:57
@@ -1009,13 +1009,11 @@
% The other fields are all implied by the pred_proc_id.
match_aditi_builtin(aditi_call(PredProcId, _, _, _),
aditi_call(PredProcId, _, _, _)).
-match_aditi_builtin(aditi_insert(PredId), aditi_insert(PredId)).
+match_aditi_builtin(aditi_tuple_insert_delete(InsertDelete, PredId),
+ aditi_tuple_insert_delete(InsertDelete, PredId)).
% The syntax used does not change the result of the call.
-match_aditi_builtin(aditi_delete(PredId, _), aditi_delete(PredId, _)).
-match_aditi_builtin(aditi_bulk_operation(Op, PredId),
- aditi_bulk_operation(Op, PredId)).
- % The syntax used does not change the result of the call.
-match_aditi_builtin(aditi_modify(PredId, _), aditi_modify(PredId, _)).
+match_aditi_builtin(aditi_insert_delete_modify(Op, PredId, _),
+ aditi_insert_delete_modify(Op, PredId, _)).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.184
diff -u -u -r1.184 polymorphism.m
--- compiler/polymorphism.m 2000/04/10 07:19:10 1.184
+++ compiler/polymorphism.m 2000/04/11 07:16:06
@@ -869,10 +869,13 @@
{ GoalExpr0 = generic_call(GenericCall, Args0, Modes0, Det) },
%
- % For aditi_insert calls, we need to add type-infos for
- % the tuple to insert.
+ % For `aditi_insert' and `aditi_delete' calls, we need to add
+ % type-infos for the tuple to insert.
%
- ( { GenericCall = aditi_builtin(aditi_insert(_), _) } ->
+ (
+ { GenericCall = aditi_builtin(
+ aditi_tuple_insert_delete(_, _), _) }
+ ->
% Aditi base relations must be monomorphic.
{ term__context_init(Context) },
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.18
diff -u -u -r1.18 post_typecheck.m
--- compiler/post_typecheck.m 2000/01/13 06:16:45 1.18
+++ compiler/post_typecheck.m 2000/04/11 05:20:21
@@ -189,9 +189,6 @@
list__filter(type_is_aditi_state, ArgTypes, AditiStateTypes),
( AditiStateTypes = [], ReportErrs = yes ->
report_no_aditi_state(PredInfo, IOState2, IOState)
- ; AditiStateTypes = [_, _ | _] ->
- report_multiple_aditi_states(PredInfo,
- IOState2, IOState)
;
IOState = IOState2
)
@@ -370,8 +367,8 @@
_, _, _, _) -->
% These are only added by magic.m.
{ error("post_typecheck__finish_aditi_builtin: aditi_call") }.
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo,
- Args, Context, aditi_insert(PredId0), Builtin,
+post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
+ aditi_tuple_insert_delete(InsertDelete, PredId0), Builtin,
PredOrFunc - SymName0/Arity, InsertCallId,
Modes, IO0, IO) :-
% make_hlds.m checks the arity, so this is guaranteed to succeed.
@@ -382,7 +379,7 @@
post_typecheck__resolve_pred_overloading(PredId0, OtherArgs,
CallerPredInfo, ModuleInfo, SymName0, SymName, PredId),
- Builtin = aditi_insert(PredId),
+ Builtin = aditi_tuple_insert_delete(InsertDelete, PredId),
InsertCallId = PredOrFunc - SymName/Arity,
module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
@@ -394,93 +391,106 @@
% The other arguments all have mode `in'.
pred_info_arg_types(RelationPredInfo, ArgTypes),
in_mode(InMode),
- aditi_builtin_modes(InMode, (aditi_top_down),
- ArgTypes, InsertArgModes),
+ unused_mode(AditiStateMode),
+ aditi_builtin_modes(InMode, AditiStateMode, ArgTypes, InsertArgModes),
list__append(InsertArgModes, [aditi_di_mode, aditi_uo_mode], Modes).
post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
- aditi_delete(PredId0, Syntax), aditi_delete(PredId, Syntax),
- PredOrFunc - SymName0/Arity, PredOrFunc - SymName/Arity,
- Modes, IO0, IO) :-
- AdjustArgTypes = (pred(X::in, X::out) is det),
+ Builtin0, Builtin, PredOrFunc - SymName0/Arity,
+ UpdateCallId, Modes, IO0, IO) :-
+ Builtin0 = aditi_insert_delete_modify(InsertDelMod, PredId0, Syntax),
+ UnchangedArgTypes = (pred(X::in, X::out) is det),
+ (
+ InsertDelMod = bulk_insert,
+ AdjustArgTypes = UnchangedArgTypes
+ ;
+ InsertDelMod = delete(_),
+ AdjustArgTypes = UnchangedArgTypes
+ ;
+ InsertDelMod = modify(_),
+ % The argument types of the closure passed to `aditi_modify'
+ % contain two copies of the arguments of the base relation -
+ % one set input and one set output.
+ AdjustArgTypes =
+ (pred(Types0::in, Types::out) is det :-
+ list__length(Types0, Length),
+ HalfLength is Length // 2,
+ ( list__split_list(HalfLength, Types0, Types1, _) ->
+ Types = Types1
+ ;
+ error(
+ "post_typecheck__finish_aditi_builtin: aditi_modify")
+ )
+ )
+ ),
resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
AdjustArgTypes, PredId0, PredId, SymName0, SymName),
+ Builtin = aditi_insert_delete_modify(InsertDelMod, PredId, Syntax),
- Builtin = aditi_delete(PredId, Syntax),
- DeleteCallId = PredOrFunc - SymName/Arity,
+ UpdateCallId = PredOrFunc - SymName/Arity,
module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
check_base_relation(Context, RelationPredInfo,
- Builtin, DeleteCallId, IO0, IO),
+ Builtin, UpdateCallId, IO0, IO),
pred_info_arg_types(RelationPredInfo, ArgTypes),
- in_mode(InMode),
- aditi_builtin_modes(InMode, (aditi_top_down),
- ArgTypes, DeleteArgModes),
- Inst = ground(shared, yes(pred_inst_info(PredOrFunc,
- DeleteArgModes, semidet))),
- Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
-
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
- aditi_bulk_operation(Op, PredId0), Builtin,
- PredOrFunc - SymName0/Arity, BulkOpCallId, Modes, IO0, IO) :-
- AdjustArgTypes = (pred(X::in, X::out) is det),
- resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
- AdjustArgTypes, PredId0, PredId, SymName0, SymName),
-
- Builtin = aditi_bulk_operation(Op, PredId),
- BulkOpCallId = PredOrFunc - SymName/Arity,
+ post_typecheck__insert_delete_modify_closure_info(InsertDelMod,
+ PredOrFunc, ArgTypes, ClosurePredOrFunc,
+ ClosureArgModes, ClosureDetism),
- module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
- check_base_relation(Context, RelationPredInfo,
- Builtin, BulkOpCallId, IO0, IO),
-
- pred_info_arg_types(RelationPredInfo, ArgTypes),
- out_mode(OutMode),
- aditi_builtin_modes(OutMode, (aditi_bottom_up), ArgTypes, OpArgModes),
- Inst = ground(shared, yes(pred_inst_info(PredOrFunc,
- OpArgModes, nondet))),
+ Inst = ground(shared, yes(pred_inst_info(ClosurePredOrFunc,
+ ClosureArgModes, ClosureDetism))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
-
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
- aditi_modify(PredId0, Syntax), Builtin,
- PredOrFunc - SymName0/Arity, ModifyCallId, Modes, IO0, IO) :-
- % The argument types of the closure passed to `aditi_modify'
- % contain two copies of the arguments of the base relation -
- % one set input and one set output.
- AdjustArgTypes =
- (pred(Types0::in, Types::out) is det :-
- list__length(Types0, Length),
- HalfLength is Length // 2,
- ( list__split_list(HalfLength, Types0, Types1, _) ->
- Types = Types1
- ;
- error(
- "post_typecheck__finish_aditi_builtin: aditi_modify")
- )
- ),
- resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
- AdjustArgTypes, PredId0, PredId, SymName0, SymName),
+:- pred post_typecheck__insert_delete_modify_closure_info(
+ aditi_insert_delete_modify, pred_or_func, list(type),
+ pred_or_func, list(mode), determinism).
+:- mode post_typecheck__insert_delete_modify_closure_info(in, in, in,
+ out, out, out) is det.
- Builtin = aditi_modify(PredId, Syntax),
- ModifyCallId = PredOrFunc - SymName/Arity,
+post_typecheck__insert_delete_modify_closure_info(bulk_insert, PredOrFunc,
+ ArgTypes, PredOrFunc, ClosureArgModes, nondet) :-
+ out_mode(OutMode),
+ AditiStateMode = aditi_ui_mode,
+ aditi_builtin_modes(OutMode, AditiStateMode,
+ ArgTypes, ClosureArgModes).
+post_typecheck__insert_delete_modify_closure_info(delete(BulkOrFilter),
+ PredOrFunc, ArgTypes, PredOrFunc, ClosureArgModes, nondet) :-
+ (
+ BulkOrFilter = bulk,
+ out_mode(ArgMode)
+ ;
+ BulkOrFilter = filter,
+ in_mode(ArgMode)
+ ),
+ AditiStateMode = aditi_ui_mode,
+ aditi_builtin_modes(ArgMode, AditiStateMode,
+ ArgTypes, ClosureArgModes).
+post_typecheck__insert_delete_modify_closure_info(modify(BulkOrFilter),
+ _PredOrFunc, ArgTypes, LambdaPredOrFunc,
+ ClosureArgModes, nondet) :-
+ LambdaPredOrFunc = predicate,
+ out_mode(OutMode),
+ in_mode(InMode),
+ unused_mode(UnusedMode),
+ (
+ BulkOrFilter = bulk,
+ DeleteArgMode = OutMode,
+ DeleteAditiStateMode = aditi_ui_mode
+ ;
+ BulkOrFilter = filter,
+ DeleteArgMode = InMode,
+ DeleteAditiStateMode = UnusedMode
+ ),
- module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
- check_base_relation(Context, RelationPredInfo,
- Builtin, ModifyCallId, IO0, IO),
+ aditi_builtin_modes(DeleteArgMode, DeleteAditiStateMode,
+ ArgTypes, DeleteArgModes),
- % Set up the modes of the closure passed to the call to `aditi_modify'.
- pred_info_arg_types(RelationPredInfo, ArgTypes),
- in_mode(InMode),
- out_mode(OutMode),
- aditi_builtin_modes(InMode, (aditi_top_down), ArgTypes, InputArgModes),
- aditi_builtin_modes(OutMode, (aditi_top_down),
- ArgTypes, OutputArgModes),
- list__append(InputArgModes, OutputArgModes, ModifyArgModes),
- Inst = ground(shared,
- yes(pred_inst_info(predicate, ModifyArgModes, semidet))),
- Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
+ InsertArgMode = OutMode,
+ InsertAditiStateMode = UnusedMode,
+ aditi_builtin_modes(InsertArgMode, InsertAditiStateMode,
+ ArgTypes, InsertArgModes),
+ list__append(DeleteArgModes, InsertArgModes, ClosureArgModes).
% Use the type of the closure passed to an `aditi_delete',
% `aditi_bulk_insert', `aditi_bulk_delete' or `aditi_modify'
@@ -502,8 +512,9 @@
pred_info_clauses_info(CallerPredInfo, ClausesInfo),
clauses_info_vartypes(ClausesInfo, VarTypes),
map__lookup(VarTypes, HOArg, HOArgType),
- type_is_higher_order(HOArgType, predicate,
- (aditi_top_down), ArgTypes0)
+ type_is_higher_order(HOArgType,
+ _, EvalMethod, ArgTypes0),
+ EvalMethod \= normal
->
call(AdjustArgTypes, ArgTypes0, ArgTypes),
typecheck__resolve_pred_overloading(ModuleInfo,
@@ -521,30 +532,18 @@
% to an Aditi update.
% The `Mode' passed is the mode of all arguments apart
% from the `aditi__state'.
-:- pred aditi_builtin_modes((mode), lambda_eval_method,
- list(type), list(mode)).
+:- pred aditi_builtin_modes((mode), (mode), list(type), list(mode)).
:- mode aditi_builtin_modes(in, in, in, out) is det.
aditi_builtin_modes(_, _, [], []).
-aditi_builtin_modes(Mode, EvalMethod, [ArgType | ArgTypes],
+aditi_builtin_modes(Mode, AditiStateMode, [ArgType | ArgTypes],
[ArgMode | ArgModes]) :-
( type_is_aditi_state(ArgType) ->
- ( EvalMethod = (aditi_top_down) ->
- % The top-down Aditi closures are not allowed
- % to call database predicates, so their aditi__state
- % arguments must have mode `unused'.
- % The `aditi__state's are passed even though
- % they are not used so that the argument
- % list of the closure matches the argument list
- % of the relation being updated.
- unused_mode(ArgMode)
- ;
- ArgMode = aditi_ui_mode
- )
+ ArgMode = AditiStateMode
;
ArgMode = Mode
),
- aditi_builtin_modes(Mode, EvalMethod, ArgTypes, ArgModes).
+ aditi_builtin_modes(Mode, AditiStateMode, ArgTypes, ArgModes).
% Report an error if a predicate modified by an Aditi builtin
% is not a base relation.
@@ -735,24 +734,6 @@
hlds_out__write_simple_call_id(PredOrFunc,
qualified(Module, Name), Arity),
io__write_string(" without an `aditi:state' argument.\n").
-
-:- pred report_multiple_aditi_states(pred_info, io__state, io__state).
-:- mode report_multiple_aditi_states(in, di, uo) is det.
-
-report_multiple_aditi_states(PredInfo) -->
- io__set_exit_status(1),
- { pred_info_context(PredInfo, Context) },
- prog_out__write_context(Context),
- { pred_info_module(PredInfo, Module) },
- { pred_info_name(PredInfo, Name) },
- { pred_info_arity(PredInfo, Arity) },
- { pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
- io__write_string("Error: `:- pragma aditi' declaration for "),
- hlds_out__write_simple_call_id(PredOrFunc,
- qualified(Module, Name), Arity),
- io__nl,
- prog_out__write_context(Context),
- io__write_string(" with multiple `aditi:state' arguments.\n").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.23
diff -u -u -r1.23 purity.m
--- compiler/purity.m 2000/03/27 05:07:49 1.23
+++ compiler/purity.m 2000/03/31 00:46:07
@@ -536,8 +536,9 @@
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_vartypes(ClausesInfo, VarTypes),
map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
- fix_aditi_state_modes(StateMode, LambdaVarTypes,
- Modes0, Modes)
+ SeenState = no,
+ fix_aditi_state_modes(SeenState, StateMode,
+ LambdaVarTypes, Modes0, Modes)
},
{ GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext) }
;
@@ -655,22 +656,36 @@
% Make sure lambda expressions introduced by the compiler
% have the correct mode for their `aditi__state' arguments.
-:- pred fix_aditi_state_modes((mode), list(type), list(mode), list(mode)).
-:- mode fix_aditi_state_modes(in, in, in, out) is det.
+:- pred fix_aditi_state_modes(bool, (mode), list(type),
+ list(mode), list(mode)).
+:- mode fix_aditi_state_modes(in, in, in, in, out) is det.
-fix_aditi_state_modes(_, [], [], []).
-fix_aditi_state_modes(_, [_|_], [], []) :-
+fix_aditi_state_modes(_, _, [], [], []).
+fix_aditi_state_modes(_, _, [_|_], [], []) :-
error("purity:fix_aditi_state_modes").
-fix_aditi_state_modes(_, [], [_|_], []) :-
+fix_aditi_state_modes(_, _, [], [_|_], []) :-
error("purity:fix_aditi_state_modes").
-fix_aditi_state_modes(AditiStateMode, [Type | Types],
+fix_aditi_state_modes(SeenState0, AditiStateMode, [Type | Types],
[ArgMode0 | Modes0], [ArgMode | Modes]) :-
( type_is_aditi_state(Type) ->
- ArgMode = AditiStateMode
+ (
+ SeenState0 = yes,
+ % The only Aditi builtin which takes a closure
+ % with two `aditi__state' arguments is
+ % `aditi_bulk_modify'.
+ % The second `aditi__state' argument has mode
+ % unused.
+ unused_mode(ArgMode)
+ ;
+ SeenState0 = no,
+ ArgMode = AditiStateMode
+ ),
+ SeenState = yes
;
- ArgMode = ArgMode0
+ ArgMode = ArgMode0,
+ SeenState = SeenState0
),
- fix_aditi_state_modes(AditiStateMode, Types, Modes0, Modes).
+ fix_aditi_state_modes(SeenState, AditiStateMode, Types, Modes0, Modes).
%-----------------------------------------------------------------------------%
% Print error messages
Index: compiler/rl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl.m,v
retrieving revision 1.11
diff -u -u -r1.11 rl.m
--- compiler/rl.m 2000/03/13 05:24:37 1.11
+++ compiler/rl.m 2000/04/10 09:08:44
@@ -593,6 +593,30 @@
:- pred rl__get_entry_proc_name(module_info::in, pred_proc_id::in,
rl_proc_name::out) is det.
+ % rl__get_modify_proc_name(ModuleInfo, BaseRelationPredId, ProcName).
+ %
+ % Get the name of the RL procedure used to apply a modification
+ % to a base relation.
+:- pred rl__get_modify_proc_name(module_info::in,
+ pred_id::in, rl_proc_name::out) is det.
+
+ % rl__get_delete_proc_name(ModuleInfo, BaseRelationPredId, ProcName).
+ %
+ % Get the name of the RL procedure used to apply a deletion
+ % to a base relation.
+:- pred rl__get_delete_proc_name(module_info::in,
+ pred_id::in, rl_proc_name::out) is det.
+
+ % rl__get_c_interface_proc_name(ModuleInfo, PredProcId, ProcName).
+ %
+ % Get the name of the RL procedure used to call an Aditi
+ % procedure from ordinary Mercury code.
+:- pred rl__get_c_interface_proc_name(module_info::in, pred_proc_id::in,
+ string::out) is det.
+
+:- pred rl__get_c_interface_rl_proc_name(module_info::in, pred_proc_id::in,
+ rl_proc_name::out) is det.
+
% Work out the name for a permanent relation.
:- pred rl__permanent_relation_name(module_info::in,
pred_id::in, string::out) is det.
@@ -640,7 +664,7 @@
:- implementation.
:- import_module code_util, code_aux, globals, llds_out, options, prog_out.
-:- import_module prog_util, type_util.
+:- import_module prog_util, type_util, llds.
:- import_module bool, int, require, string.
rl__default_temporary_state(ModuleInfo, TmpState) :-
@@ -1022,15 +1046,72 @@
%-----------------------------------------------------------------------------%
-rl__get_entry_proc_name(ModuleInfo, proc(PredId, ProcId), ProcName) :-
- code_util__make_proc_label(ModuleInfo, PredId, ProcId, Label),
- llds_out__get_proc_label(Label, no, ProcLabel),
+rl__get_entry_proc_name(ModuleInfo, PredProcId, ProcName) :-
+ PredProcId = proc(PredId, _),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
- pred_info_module(PredInfo, PredModule0),
+ pred_info_name(PredInfo, PredName),
+ pred_info_arity(PredInfo, Arity),
+ rl__get_entry_proc_name(ModuleInfo, PredProcId,
+ PredInfo, PredName, Arity, ProcName).
+
+:- pred rl__get_entry_proc_name(module_info::in, pred_proc_id::in,
+ pred_info::in, string::in, arity::in, rl_proc_name::out) is det.
+
+rl__get_entry_proc_name(ModuleInfo, PredProcId, PredInfo, PredName, Arity,
+ ProcName) :-
+ PredProcId = proc(_, ProcId),
+ module_info_name(ModuleInfo, ModuleName),
+ pred_info_import_status(PredInfo, ImportStatus),
+ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+ pred_info_module(PredInfo, PredModule),
pred_info_get_aditi_owner(PredInfo, Owner),
- prog_out__sym_name_to_string(PredModule0, PredModule),
- ProcName = rl_proc_name(Owner, PredModule, ProcLabel, 2).
+ code_util__make_user_proc_label(ModuleName, ImportStatus,
+ PredOrFunc, PredModule, PredName, Arity, ProcId, ProcLabel),
+ llds_out__get_proc_label(ProcLabel, no, ProcLabelStr),
+ prog_out__sym_name_to_string(PredModule, PredModuleStr),
+ ProcName = rl_proc_name(Owner, PredModuleStr, ProcLabelStr, 2).
+
+rl__get_modify_proc_name(ModuleInfo, PredId, ProcName) :-
+ rl__get_update_proc_name(ModuleInfo, PredId,
+ "Aditi_Modify_Proc_For_", ProcName).
+
+rl__get_delete_proc_name(ModuleInfo, PredId, ProcName) :-
+ rl__get_update_proc_name(ModuleInfo, PredId,
+ "Aditi_Delete_Proc_For_", ProcName).
+
+:- pred rl__get_update_proc_name(module_info::in,
+ pred_id::in, string::in, rl_proc_name::out) is det.
+
+rl__get_update_proc_name(ModuleInfo, PredId, ProcNamePrefix, ProcName) :-
+ hlds_pred__initial_proc_id(ProcId),
+ rl__get_entry_proc_name(ModuleInfo, proc(PredId, ProcId), ProcName0),
+ ProcName0 = rl_proc_name(Owner, Module, Name0, Arity),
+ string__append(ProcNamePrefix, Name0, Name),
+ ProcName = rl_proc_name(Owner, Module, Name, Arity).
+rl__get_c_interface_proc_name(ModuleInfo, PredProcId, PredName) :-
+ PredProcId = proc(PredId, ProcId),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_name(PredInfo, PredName0),
+ proc_id_to_int(ProcId, ProcInt),
+ string__int_to_string(ProcInt, ProcStr),
+ string__append_list(["Aditi_C_Interface_Proc_For_Mode_", ProcStr,
+ "_Of_", PredName0], PredName).
+
+rl__get_c_interface_rl_proc_name(ModuleInfo, PredProcId, ProcName) :-
+ rl__get_c_interface_proc_name(ModuleInfo, PredProcId, PredName),
+ PredProcId = proc(PredId, _),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_arg_types(PredInfo, ArgTypes),
+ list__filter(type_is_aditi_state, ArgTypes, AditiStates),
+ list__length(AditiStates, NumAditiStates),
+ list__length(ArgTypes, OrigArity),
+
+ % The plus one is for the input closure argument.
+ InterfaceArity = OrigArity - NumAditiStates + 1,
+ rl__get_entry_proc_name(ModuleInfo, PredProcId, PredInfo,
+ PredName, InterfaceArity, ProcName).
+
rl__permanent_relation_name(ModuleInfo, PredId, ProcName) :-
rl__get_permanent_relation_info(ModuleInfo, PredId, Owner,
Module, _, _, Name, _),
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.14
diff -u -u -r1.14 rl_exprn.m
--- compiler/rl_exprn.m 2000/03/15 08:30:54 1.14
+++ compiler/rl_exprn.m 2000/04/10 08:00:29
@@ -71,15 +71,13 @@
sort_spec::in, list(type)::in, sort_spec::in, list(type)::in,
list(bytecode)::out) is det.
- % rl_exprn__generate_key_range(ModuleInfo, KeyRange, ExprnCode,
- % NumParams, LowerBoundSchema, UpperBoundSchema,
- % MaxTermDepth, ExprnVarTypes).
+ % rl_exprn__generate_equijoin_exprn(ModuleInfo, Attrs,
+ % Schema, Code)
%
- % Generate an expression to produce the upper and lower
- % bounds for a B-tree access.
-:- pred rl_exprn__generate_key_range(module_info::in, key_range::in,
- list(bytecode)::out, int::out, list(type)::out, list(type)::out,
- int::out, list(type)::out) is det.
+ % Generate an expression to compare the join attributes in
+ % an equi-join.
+:- pred rl_exprn__generate_equijoin_exprn(module_info::in, list(int)::in,
+ list(type)::in, list(bytecode)::out) is det.
% rl_exprn__generate_hash_function(ModuleInfo, HashAttrs,
% InputSchema, ExprnCode).
@@ -89,6 +87,22 @@
:- pred rl_exprn__generate_hash_function(module_info::in, list(int)::in,
list(type)::in, list(bytecode)::out) is det.
+ % rl_exprn__generate_key_range(ModuleInfo, KeyRange, ExprnCode,
+ % NumParams, LowerBoundSchema, UpperBoundSchema,
+ % MaxTermDepth, ExprnVarTypes).
+ %
+ % Generate an expression to produce the upper and lower
+ % bounds for a B-tree access.
+:- pred rl_exprn__generate_key_range(module_info::in, key_range::in,
+ list(bytecode)::out, int::out, list(type)::out, list(type)::out,
+ int::out, list(type)::out) is det.
+
+ % Generate an expression to produce either the tuple
+ % to insert or the tuple to delete for a modification
+ % query.
+:- pred rl_exprn__generate_modify_project_exprn(module_info::in,
+ tuple_num::in, list(type)::in, list(bytecode)::out) is det.
+
% rl_exprn__generate(ModuleInfo, Goal, ExprnCode, NumParams,
% ExprnMode, ExprnVarTypes).
%
@@ -205,6 +219,41 @@
Code = tree(Code0, CompareAttr).
%-----------------------------------------------------------------------------%
+
+rl_exprn__generate_equijoin_exprn(_, Attrs0, Schema, Code) :-
+ list__map(rl_exprn__adjust_arg_number, Attrs0, Attrs),
+ rl_exprn__generate_equijoin_instrs(Attrs, Schema,
+ empty, TestCode),
+ ExprnCode =
+ tree(node([rl_PROC_expr_frag(2)]),
+ tree(TestCode,
+ node([rl_PROC_expr_end])
+ )),
+
+ tree__flatten(ExprnCode, Instrs0),
+ list__condense(Instrs0, Code).
+
+:- pred rl_exprn__generate_equijoin_instrs(list(int)::in, list(type)::in,
+ byte_tree::in, byte_tree::out) is det.
+
+rl_exprn__generate_equijoin_instrs([], _, Code, Code).
+rl_exprn__generate_equijoin_instrs([Attr | Attrs], Schema, Code0, Code) :-
+ list__index0_det(Schema, Attr, AttrType),
+ rl_exprn__type_to_aditi_type(AttrType, AType),
+ rl_exprn__test_bytecode(AType, TestBytecode),
+ rl_exprn__get_input_field_code(one, AType, Attr, FieldCode1),
+ rl_exprn__get_input_field_code(two, AType, Attr, FieldCode2),
+ Code1 =
+ tree(Code0,
+ node([
+ FieldCode1,
+ FieldCode2,
+ TestBytecode,
+ rl_EXP_fail_if_false
+ ])
+ ),
+ rl_exprn__generate_equijoin_instrs(Attrs, Schema, Code1, Code).
+
%-----------------------------------------------------------------------------%
rl_exprn__generate_hash_function(_ModuleInfo, Attrs0, Schema, Code) :-
@@ -480,6 +529,43 @@
%-----------------------------------------------------------------------------%
+rl_exprn__generate_modify_project_exprn(_ModuleInfo, TupleNum, Types, Codes) :-
+ list__length(Types, NumAttrs),
+ rl_exprn__generate_modify_project_exprn_2(Types,
+ NumAttrs, TupleNum, 0, empty, ProjectCode),
+ CodeTree =
+ tree(node([rl_PROC_expr_frag(3)]),
+ tree(ProjectCode,
+ node([rl_PROC_expr_end])
+ )),
+ tree__flatten(CodeTree, CodeList),
+ list__condense(CodeList, Codes).
+
+:- pred rl_exprn__generate_modify_project_exprn_2(list(type)::in, int::in,
+ tuple_num::in, int::in, byte_tree::in, byte_tree::out) is det.
+
+rl_exprn__generate_modify_project_exprn_2([], _, _, _, Code, Code).
+rl_exprn__generate_modify_project_exprn_2([Type | Types],
+ NumAttrs, TupleNum, Attr, Code0, Code) :-
+ rl_exprn__type_to_aditi_type(Type, AType),
+ (
+ TupleNum = one,
+ InputAttr = Attr
+ ;
+ TupleNum = two,
+ InputAttr = Attr + NumAttrs
+ ),
+ rl_exprn__get_input_field_code(one, AType, InputAttr, InputFieldCode),
+ rl_exprn__set_output_field_code(one, AType, Attr, OutputFieldCode),
+ Code1 =
+ tree(Code0,
+ node([InputFieldCode, OutputFieldCode])
+ ),
+ rl_exprn__generate_modify_project_exprn_2(Types,
+ NumAttrs, TupleNum, Attr + 1, Code1, Code).
+
+%-----------------------------------------------------------------------------%
+
rl_exprn__generate(ModuleInfo, RLGoal, Code, NumParams, Mode, Decls) :-
RLGoal = rl_goal(_, VarSet, VarTypes, InstMap,
Inputs, MaybeOutputs, Goals, _),
@@ -1118,19 +1204,8 @@
rl_exprn__generate_push(Var2Loc, Type, PushCode2),
rl_exprn_info_get_next_label_id(Label),
{ rl_exprn__type_to_aditi_type(Type, AditiType) },
- {
- AditiType = int,
- EqInstr = rl_EXP_int_eq
- ;
- AditiType = float,
- EqInstr = rl_EXP_flt_eq
- ;
- AditiType = string,
- EqInstr = rl_EXP_str_eq
- ;
- AditiType = term(_),
- EqInstr = rl_EXP_term_eq
- },
+
+ { rl_exprn__test_bytecode(AditiType, EqInstr) },
{ Code =
tree(PushCode1,
tree(PushCode2,
@@ -1139,6 +1214,13 @@
tree(Fail,
node([rl_PROC_label(Label)])
))))) }.
+
+:- pred rl_exprn__test_bytecode(aditi_type::in, bytecode::out) is det.
+
+rl_exprn__test_bytecode(int, rl_EXP_int_eq).
+rl_exprn__test_bytecode(float, rl_EXP_flt_eq).
+rl_exprn__test_bytecode(string, rl_EXP_str_eq).
+rl_exprn__test_bytecode(term(_), rl_EXP_term_eq).
:- pred rl_exprn__functor_test(prog_var::in, cons_id::in, byte_tree::in,
byte_tree::out, rl_exprn_info::in, rl_exprn_info::out) is det.
Index: compiler/rl_out.pp
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_out.pp,v
retrieving revision 1.12
diff -u -u -r1.12 rl_out.pp
--- compiler/rl_out.pp 2000/03/13 05:24:39 1.12
+++ compiler/rl_out.pp 2000/04/11 11:39:27
@@ -150,6 +150,12 @@
map__lookup(Relations, Arg, ArgInfo),
ArgInfo = relation_info(_, ArgSchema, _, _)
), Args, ArgSchemas),
+ rl_out__get_proc_schema(ModuleInfo, ArgSchemas, SchemaString).
+
+:- pred rl_out__get_proc_schema(module_info::in, list(list(type))::in,
+ string::out) is det.
+
+rl_out__get_proc_schema(ModuleInfo, ArgSchemas, SchemaString) :-
rl__schemas_to_strings(ModuleInfo, ArgSchemas,
TypeDecls, ArgSchemaStrings),
list__map_foldl(
@@ -163,7 +169,7 @@
ArgSchemaString, ") "],
ArgSchemaDecl)
), ArgSchemaStrings, ArgSchemaDeclList, 1, _),
- rl_out__get_proc_schema_2(1, Args, "", SchemaString0),
+ rl_out__get_proc_schema_2(1, ArgSchemaDeclList, "", SchemaString0),
list__condense([[TypeDecls | ArgSchemaDeclList], ["("],
[SchemaString0, ")"]], SchemaStrings),
string__append_list(SchemaStrings, SchemaString).
@@ -202,23 +208,27 @@
{ list__foldl(rl_out__generate_proc_bytecode, Procs,
RLInfo0, RLInfo1) },
+ { module_info_predids(ModuleInfo, PredIds) },
+ { list__foldl(rl_out__generate_update_procs, PredIds,
+ RLInfo1, RLInfo2) },
+
globals__io_lookup_string_option(aditi_user, Owner),
{ rl_out_info_assign_const(string(Owner), OwnerIndex,
- RLInfo1, RLInfo2) },
+ RLInfo2, RLInfo3) },
{ prog_out__sym_name_to_string(ModuleName0, ModuleName) },
module_name_to_file_name(ModuleName0, ".m", no, SourceFileName),
module_name_to_file_name(ModuleName0, ".int", no, IntFileName),
{ rl_out_info_assign_const(string(ModuleName), ModuleIndex,
- RLInfo2, RLInfo3) },
- { rl_out_info_assign_const(string(IntFileName), IntIndex,
RLInfo3, RLInfo4) },
+ { rl_out_info_assign_const(string(IntFileName), IntIndex,
+ RLInfo4, RLInfo5) },
{ rl_out_info_assign_const(string(SourceFileName),
- SourceIndex, RLInfo4, RLInfo5) },
- { rl_out_info_get_procs(RLProcs, RLInfo5, RLInfo6) },
- { rl_out_info_get_consts(Consts, RLInfo6, RLInfo7) },
+ SourceIndex, RLInfo5, RLInfo6) },
+ { rl_out_info_get_procs(RLProcs, RLInfo6, RLInfo7) },
+ { rl_out_info_get_consts(Consts, RLInfo7, RLInfo8) },
{ rl_out_info_get_permanent_relations(PermRelsSet,
- RLInfo7, RLInfo8) },
- { rl_out_info_get_relation_variables(RelVars, RLInfo8, _) },
+ RLInfo8, RLInfo9) },
+ { rl_out_info_get_relation_variables(RelVars, RLInfo9, _) },
{ map__to_assoc_list(Consts, ConstsAL) },
{ assoc_list__reverse_members(ConstsAL, ConstsLA0) },
@@ -331,6 +341,267 @@
#endif
#if INCLUDE_ADITI_OUTPUT
+
+ % For each base relation defined in this module, generate
+ % a procedure to be used by aditi_bulk_modify to update
+ % the relation.
+ %
+ % In the procedure below, UpdateRel is the relation returned
+ % by the closure passed to aditi_bulk_modify. Each tuple returned
+ % by that closure contains two sets of arguments -- the tuple
+ % to delete, and the tuple to insert.
+ %
+ % DummyOutput is not actually used -- it is there just so
+ % that the procedure matches the usual convention for calling
+ % Aditi procedures from Mercury.
+ %
+ % ModifyProcFor__p_3(UpdateRel, DummyOutput)
+ % {
+ % delete(p/3, project(UpdateRel, FirstTuple);
+ % insert(p/3, project(UpdateRel, SecondTuple),
+ % init(DummyOutput).
+ % }
+:- pred rl_out__generate_update_procs(pred_id::in, rl_out_info::in,
+ rl_out_info::out) is det.
+
+rl_out__generate_update_procs(PredId) -->
+ rl_out_info_get_module_info(ModuleInfo),
+ { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+ { module_info_name(ModuleInfo, ModuleName) },
+ { pred_info_module(PredInfo, PredModule) },
+ (
+ { ModuleName = PredModule },
+ { hlds_pred__pred_info_is_base_relation(PredInfo) }
+ ->
+ rl_out__generate_update_proc(delete, PredId, PredInfo),
+ rl_out__generate_update_proc(modify, PredId, PredInfo)
+ ;
+ []
+ ).
+
+:- type delete_or_modify
+ ---> delete
+ ; modify
+ .
+
+:- pred rl_out__generate_update_proc(delete_or_modify::in, pred_id::in,
+ pred_info::in, rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__generate_update_proc(DeleteOrModify, PredId, PredInfo) -->
+ { map__init(Relations) },
+ rl_out_info_init_proc(Relations),
+
+ { pred_info_arg_types(PredInfo, ArgTypes) },
+ { pred_info_get_indexes(PredInfo, Indexes) },
+
+ rl_out__schema_to_string(ArgTypes, PermSchemaOffset),
+
+ rl_out_info_add_relation_variable(PermSchemaOffset,
+ PermanentAddr),
+ rl_out__collect_permanent_relation(PredId,
+ PermanentAddr, OpenPermanentCode, UnsetPermanentCode),
+
+ {
+ DeleteOrModify = delete,
+ InputRelTypes = ArgTypes
+ ;
+ DeleteOrModify = modify,
+ list__append(ArgTypes, ArgTypes, InputRelTypes)
+ },
+
+ rl_out__schema_to_string(InputRelTypes, InputRelSchemaOffset),
+ rl_out_info_add_relation_variable(InputRelSchemaOffset,
+ InputRelAddr),
+
+ rl_out__schema_to_string([], NullSchemaOffset),
+ rl_out_info_add_relation_variable(NullSchemaOffset,
+ DummyOutputAddr),
+
+ rl_out_info_get_module_info(ModuleInfo),
+
+ { LockSpec = 0 }, % default lock spec
+ (
+ { DeleteOrModify = delete },
+ { rl__get_delete_proc_name(ModuleInfo, PredId, ProcName) },
+ { DeleteInputStream =
+ node([
+ rl_PROC_stream,
+ rl_PROC_var(InputRelAddr, LockSpec),
+ rl_PROC_stream_end
+ ]) },
+ { InsertCode = empty }
+ ;
+ { DeleteOrModify = modify },
+ { rl__get_modify_proc_name(ModuleInfo, PredId, ProcName) },
+ rl_out__generate_modify_project_exprn(ArgTypes,
+ PermSchemaOffset, one, DeleteProjectExpr),
+ rl_out__generate_modify_project_exprn(ArgTypes,
+ PermSchemaOffset, two, InsertProjectExpr),
+
+ %
+ % Project the input relation onto
+ % the first half of its attributes,
+ % deleting the result from the base
+ % relation.
+ %
+
+ { DeleteInputStream =
+ node([
+ rl_PROC_stream,
+
+ rl_PROC_project_tee,
+ rl_PROC_stream,
+ rl_PROC_var(InputRelAddr, LockSpec),
+ rl_PROC_stream_end,
+ rl_PROC_expr(DeleteProjectExpr),
+ rl_PROC_var_list_nil,
+ rl_PROC_expr_list_nil,
+
+ rl_PROC_stream_end
+ ]) },
+
+ { InsertCode =
+ node([
+ %
+ % Project the input relation onto
+ % the second half of its attributes,
+ % inserting the result into the base
+ % relation.
+ %
+ rl_PROC_materialise(1),
+ rl_PROC_stream,
+
+ rl_PROC_project_tee,
+ rl_PROC_stream,
+ rl_PROC_var(InputRelAddr, LockSpec),
+ rl_PROC_stream_end,
+ rl_PROC_expr(InsertProjectExpr),
+ rl_PROC_var_list_nil,
+ rl_PROC_expr_list_nil,
+
+ rl_PROC_stream_end,
+
+ rl_PROC_var_list_cons(PermanentAddr, LockSpec),
+ rl_PROC_var_list_nil
+ ]) }
+ ),
+
+ rl_out__generate_delete_code(PermanentAddr, Indexes, ArgTypes,
+ PermSchemaOffset, DeleteInputStream, DeleteCode),
+
+ { Codes = tree(
+ %
+ % Open the permanent relation.
+ %
+ node([OpenPermanentCode]),
+
+ %
+ % Do the deletion.
+ %
+ tree(DeleteCode,
+
+ %
+ % Do the insertion for an `aditi_bulk_modify' goal.
+ %
+ tree(InsertCode,
+
+ node([
+ %
+ % Clean up.
+ %
+ UnsetPermanentCode,
+ rl_PROC_unsetrel(InputRelAddr),
+
+ %
+ % Create the dummy output variable.
+ %
+ rl_PROC_createtemprel(DummyOutputAddr,
+ NullSchemaOffset),
+
+ rl_PROC_ret
+ ])
+ ))) },
+ { tree__flatten(Codes, CodeList) },
+ { list__condense(CodeList, Code) },
+
+ { ArgSchemas = [InputRelTypes, []] },
+ { rl_out__get_proc_schema(ModuleInfo, ArgSchemas, ProcSchemaString) },
+ rl_out_info_assign_const(string(ProcSchemaString),
+ ProcSchemaConst),
+
+ { Args = [InputRelAddr, DummyOutputAddr] },
+ rl_out__package_proc(ProcName, Args, Code, ProcSchemaConst).
+
+
+:- pred rl_out__generate_delete_code(int::in, list(index_spec)::in,
+ list(type)::in, int::in, byte_tree::in, byte_tree::out,
+ rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__generate_delete_code(PermanentAddr, _Indexes, ArgTypes, SchemaOffset,
+ DeleteInputStream, DeleteCode) -->
+ (
+ { ArgTypes = [] },
+ { CondCode =
+ tree(node([rl_PROC_empty]),
+ DeleteInputStream
+ ) },
+ { ThenCode = empty },
+
+ % We use clear here because otherwise the relation manager
+ % may complain about deleting a tuple from an empty relation.
+ { ElseCode = node([rl_PROC_clear(PermanentAddr)]) },
+ rl_out__generate_ite(CondCode, ThenCode, ElseCode, DeleteCode)
+ ;
+ { ArgTypes = [_ | _] },
+
+ %
+ % The tuples to delete must come from the relation to
+ % delete from -- Aditi does the deletion by tuple-id,
+ % not tuple contents. To get the correct tuples, we must
+ % do a sem-join of the tuples to delete against the relation
+ % to delete from.
+ %
+ % Note that the indexed semi-join won't work because it returns
+ % tuples from the non-indexed relation, which are no good for
+ % deleting from the indexed relation.
+ %
+ % XXX For a permanent relation with a unique B-tree index
+ % on all attributes, we may be able to use a sort-merge
+ % semi-join to collect the tuples to delete.
+ %
+ { list__length(ArgTypes, Arity) },
+ { list__foldl2(
+ (pred(_::in, L0::in, L::out, N0::in, N::out) is det :-
+ L = [N0 | L0],
+ N = N0 - 1
+ ),
+ ArgTypes, [], Attrs, Arity, _) },
+ rl_out__do_generate_hash_exprn(ArgTypes, SchemaOffset,
+ Attrs, HashExprn),
+ rl_out__do_generate_equijoin_exprn(ArgTypes, Attrs, JoinCond),
+ { LockSpec = 0 }, % default lock spec
+ { DeleteCode =
+ tree(node([
+ rl_PROC_delete(PermanentAddr),
+ rl_PROC_stream,
+ rl_PROC_semijoin_hj,
+ rl_PROC_stream,
+ rl_PROC_var(PermanentAddr, LockSpec),
+ rl_PROC_stream_end
+ ]),
+ tree(DeleteInputStream,
+ node([
+ % Both relations can use the same
+ % hash expression.
+ rl_PROC_expr(HashExprn),
+ rl_PROC_expr(HashExprn),
+ rl_PROC_expr(JoinCond),
+
+ rl_PROC_stream_end
+ ])
+ )) }
+ ).
+
:- pred rl_out__generate_proc_bytecode(rl_proc::in,
rl_out_info::in, rl_out_info::out) is det.
@@ -338,10 +609,8 @@
{ Proc = rl_proc(Name, Inputs, Outputs, MemoedRels,
Relations, RLInstrs, _) },
- { Name = rl_proc_name(Owner, Module, ProcName, _) },
-
{ list__append(Inputs, Outputs, Args) },
- rl_out_info_init_proc(Relations, Args),
+ rl_out_info_init_proc(Relations),
rl_out__generate_instr_list(RLInstrs, RLInstrCodeTree0),
{ set__to_sorted_list(MemoedRels, MemoedList) },
@@ -353,6 +622,7 @@
% If one memoed relation is dropped, all must be
% dropped for correctness. We could possibly be a
% little smarter about this.
+ { Name = rl_proc_name(Owner, _, _, _) },
rl_out__collect_memoed_relations(Owner, Name, MemoedList, 0,
CollectCode, NameCode),
rl_out__get_rel_var_list(MemoedList, RelVarCodes),
@@ -361,10 +631,8 @@
rl_out_info_get_relation_addrs(Addrs),
{ map__to_assoc_list(Addrs, AddrsAL) },
- rl_out__collect_permanent_relations(AddrsAL, [], PermRelCodes),
-
- rl_out_info_get_proc_expressions(Exprns),
- { list__length(Exprns, NumExprns) },
+ rl_out__collect_permanent_relations(AddrsAL, [],
+ PermRelCodes, [], PermUnsetCodes),
rl_out__resolve_proc_addresses(RLInstrCodeTree0, RLInstrCodeTree1),
@@ -374,22 +642,37 @@
tree(RLInstrCodeTree1,
tree(node(NameCode),
tree(GroupCode,
+ tree(node(PermUnsetCodes),
node([rl_PROC_ret])
- ))))) },
+ )))))) },
{ tree__flatten(RLInstrCodeTree, CodeLists) },
{ list__condense(CodeLists, Codes) },
+ list__map_foldl(rl_out_info_get_relation_addr, Args, ArgLocs),
+ rl_out__generate_proc_schema(Args, ProcSchemaConst),
+
+ rl_out__package_proc(Name, ArgLocs, Codes, ProcSchemaConst).
+
+:- pred rl_out__package_proc(rl_proc_name::in, list(int)::in,
+ list(bytecode)::in, int::in,
+ rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__package_proc(Name, ArgLocs, Codes, ProcSchemaConst) -->
+
+ { Name = rl_proc_name(Owner, Module, ProcName, _) },
+
+ rl_out_info_get_proc_expressions(Exprns),
+ { list__length(Exprns, NumExprns) },
+
rl_out_info_assign_const(string(Owner), OwnerConst),
rl_out_info_assign_const(string(Module), ModuleConst),
rl_out_info_assign_const(string(ProcName), NameConst),
{ rl_out__instr_code_size(node(Codes), CodeLength) },
- { list__length(Args, NumArgs) },
- list__map_foldl(rl_out_info_get_relation_addr, Args, ArgLocs),
- rl_out__generate_proc_schema(Args, SchemaConst),
+ { list__length(ArgLocs, NumArgs) },
- { RLProc = procedure(OwnerConst, ModuleConst, NameConst, SchemaConst,
- NumArgs, ArgLocs, NumExprns, Exprns,
+ { RLProc = procedure(OwnerConst, ModuleConst, NameConst,
+ ProcSchemaConst, NumArgs, ArgLocs, NumExprns, Exprns,
CodeLength, Codes) },
rl_out_info_add_proc(RLProc).
@@ -460,46 +743,57 @@
% Put pointers to all the permanent relations
% used by the procedure into variables.
:- pred rl_out__collect_permanent_relations(assoc_list(relation_id, int)::in,
- list(bytecode)::in, list(bytecode)::out,
- rl_out_info::in, rl_out_info::out) is det.
+ list(bytecode)::in, list(bytecode)::out, list(bytecode)::in,
+ list(bytecode)::out, rl_out_info::in, rl_out_info::out) is det.
-rl_out__collect_permanent_relations([], Codes, Codes) --> [].
+rl_out__collect_permanent_relations([], Codes, Codes,
+ UnsetCodes, UnsetCodes) --> [].
rl_out__collect_permanent_relations([RelationId - Addr | Rels],
- Codes0, Codes) -->
+ Codes0, Codes, UnsetCodes0, UnsetCodes) -->
rl_out_info_get_relations(Relations),
{ map__lookup(Relations, RelationId, RelInfo) },
{ RelInfo = relation_info(RelType, _Schema, _Index, _) },
(
{ RelType = permanent(proc(PredId, _)) }
->
- rl_out_info_get_module_info(ModuleInfo),
-
- { rl__get_permanent_relation_info(ModuleInfo, PredId,
- Owner, PredModule, _, _, RelName, SchemaString) },
-
- rl_out_info_assign_const(string(Owner), OwnerConst),
- rl_out_info_assign_const(string(PredModule), PredModuleConst),
- rl_out_info_assign_const(string(SchemaString), SchemaOffset),
- rl_out_info_assign_const(string(RelName), RelNameConst),
-
- rl_out_info_get_permanent_relations(PermRels0),
- { set__insert(PermRels0,
- relation(OwnerConst, PredModuleConst,
- RelNameConst, SchemaOffset),
- PermRels) },
- rl_out_info_set_permanent_relations(PermRels),
-
- { string__format("%s/%s/%s",
- [s(Owner), s(PredModule), s(RelName)], Name) },
- rl_out_info_assign_const(string(Name), RelNameOffset),
- { SetCode = rl_PROC_openpermrel(Addr, RelNameOffset,
- SchemaOffset) },
+ rl_out__collect_permanent_relation(PredId, Addr,
+ SetCode, UnsetCode),
+ { UnsetCodes1 = [UnsetCode | UnsetCodes0] },
{ Codes1 = [SetCode | Codes0] }
;
+ { UnsetCodes1 = UnsetCodes0 },
{ Codes1 = Codes0 }
),
- rl_out__collect_permanent_relations(Rels, Codes1, Codes).
+ rl_out__collect_permanent_relations(Rels, Codes1, Codes,
+ UnsetCodes1, UnsetCodes).
+
+:- pred rl_out__collect_permanent_relation(pred_id::in, int::in,
+ bytecode::out, bytecode::out,
+ rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__collect_permanent_relation(PredId, Addr, SetCode, UnsetCode) -->
+ rl_out_info_get_module_info(ModuleInfo),
+ { rl__get_permanent_relation_info(ModuleInfo, PredId,
+ Owner, PredModule, _, _, RelName, SchemaString) },
+ rl_out_info_assign_const(string(Owner), OwnerConst),
+ rl_out_info_assign_const(string(PredModule), PredModuleConst),
+ rl_out_info_assign_const(string(SchemaString), SchemaOffset),
+ rl_out_info_assign_const(string(RelName), RelNameConst),
+
+ rl_out_info_get_permanent_relations(PermRels0),
+ { set__insert(PermRels0,
+ relation(OwnerConst, PredModuleConst,
+ RelNameConst, SchemaOffset),
+ PermRels) },
+ rl_out_info_set_permanent_relations(PermRels),
+
+ { string__format("%s/%s/%s",
+ [s(Owner), s(PredModule), s(RelName)], Name) },
+ rl_out_info_assign_const(string(Name), RelNameOffset),
+ { SetCode = rl_PROC_openpermrel(Addr, RelNameOffset, SchemaOffset) },
+ { UnsetCode = rl_PROC_unsetrel(Addr) }.
+
%-----------------------------------------------------------------------------%
:- pred rl_out__get_rel_var_list(list(relation_id)::in, byte_tree::out,
@@ -1980,9 +2274,18 @@
rl_out_info::in, rl_out_info::out) is det.
rl_out__generate_hash_exprn(Input, Attrs, ExprnNum) -->
- rl_out_info_get_hash_exprns(HashExprns0),
rl_out_info_get_relation_schema(Input, InputSchema),
rl_out__schema_to_string(InputSchema, InputSchemaOffset),
+ rl_out__do_generate_hash_exprn(InputSchema,
+ InputSchemaOffset, Attrs, ExprnNum).
+
+:- pred rl_out__do_generate_hash_exprn(list(type)::in, int::in,
+ list(int)::in, int::out,
+ rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__do_generate_hash_exprn(InputSchema, InputSchemaOffset,
+ Attrs, ExprnNum) -->
+ rl_out_info_get_hash_exprns(HashExprns0),
( { map__search(HashExprns0, Attrs - InputSchemaOffset, ExprnNum0) } ->
{ ExprnNum = ExprnNum0 }
;
@@ -2003,6 +2306,50 @@
rl_out_info_set_hash_exprns(HashExprns)
).
+ % This is only used by the code to generate the modification
+ % and deletion procedures for base relations, so avoiding
+ % generating multiple copies of one of these is pointless --
+ % only one will ever be generated for each procedure.
+:- pred rl_out__do_generate_equijoin_exprn(list(type)::in, list(int)::in,
+ int::out, rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__do_generate_equijoin_exprn(InputSchema, Attrs, ExprnNum) -->
+ rl_out_info_get_module_info(ModuleInfo),
+ { rl_exprn__generate_equijoin_exprn(ModuleInfo,
+ Attrs, InputSchema, ExprnCode) },
+
+ % Nothing is built on the stack, so this will be enough.
+ { StackSize = 10 },
+ { NumParams = 2 },
+ { Decls = [] },
+ rl_out__schema_to_string([], EmptySchemaOffset),
+ rl_out__package_exprn(ExprnCode, NumParams, test,
+ EmptySchemaOffset, EmptySchemaOffset, StackSize,
+ Decls, ExprnNum).
+
+ % This is only used by the code to generate the modification
+ % procedures for base relations, so avoiding generating multiple
+ % copies of one of these is pointless -- only one will ever be
+ % generated for each procedure.
+:- pred rl_out__generate_modify_project_exprn(list(type)::in, int::in,
+ tuple_num::in, int::out,
+ rl_out_info::in, rl_out_info::out) is det.
+
+rl_out__generate_modify_project_exprn(Schema, SchemaOffset,
+ TupleNum, ExprnNum) -->
+ rl_out_info_get_module_info(ModuleInfo),
+ { rl_exprn__generate_modify_project_exprn(ModuleInfo,
+ TupleNum, Schema, Code) },
+
+ % Nothing is built on the stack, so this will be enough.
+ { StackSize = 10 },
+ { NumParams = 1 },
+ { ExprnMode = generate },
+ { Decls = [] },
+ rl_out__schema_to_string([], EmptySchemaOffset),
+ rl_out__package_exprn(Code, NumParams, ExprnMode, SchemaOffset,
+ EmptySchemaOffset, StackSize, Decls, ExprnNum).
+
:- pred rl_out__package_exprn(list(bytecode)::in, int::in, exprn_mode::in,
int::in, int::in, int::in, list(type)::in, int::out,
rl_out_info::in, rl_out_info::out) is det.
@@ -2123,9 +2470,9 @@
FirstExprn, TmpVars).
:- pred rl_out_info_init_proc(map(relation_id, relation_info)::in,
- list(relation_id)::in, rl_out_info::in, rl_out_info::out) is det.
+ rl_out_info::in, rl_out_info::out) is det.
-rl_out_info_init_proc(Relations, _Args) -->
+rl_out_info_init_proc(Relations) -->
^ relations := Relations,
{ map__init(Labels) },
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.273
diff -u -u -r1.273 typecheck.m
--- compiler/typecheck.m 2000/03/14 11:21:29 1.273
+++ compiler/typecheck.m 2000/04/11 05:13:00
@@ -1153,56 +1153,59 @@
typecheck_aditi_builtin_2(_, _, aditi_call(_, _, _, _), _) -->
% There are only added by magic.m.
{ error("typecheck_aditi_builtin: unexpected aditi_call") }.
-typecheck_aditi_builtin_2(CallId, Args, aditi_insert(_),
- aditi_insert(PredId)) -->
- % The tuple to insert has the same argument types
- % as the relation being inserted into.
+typecheck_aditi_builtin_2(CallId, Args,
+ aditi_tuple_insert_delete(InsertDelete, _),
+ aditi_tuple_insert_delete(InsertDelete, PredId)) -->
+ % The tuple to insert or delete has the same argument types
+ % as the relation being inserted into or deleted from.
typecheck_call_pred(CallId, Args, PredId).
-typecheck_aditi_builtin_2(CallId, Args, aditi_delete(_, Syntax),
- aditi_delete(PredId, Syntax)) -->
- typecheck_aditi_delete_or_bulk_operation_closure(CallId,
- (aditi_top_down), Args, PredId).
-typecheck_aditi_builtin_2(CallId, Args, aditi_bulk_operation(BulkOp, _),
- aditi_bulk_operation(BulkOp, PredId)) -->
- typecheck_aditi_delete_or_bulk_operation_closure(CallId,
- (aditi_bottom_up), Args, PredId).
-typecheck_aditi_builtin_2(CallId, Args, aditi_modify(_, Syntax),
- aditi_modify(PredId, Syntax)) -->
+typecheck_aditi_builtin_2(CallId, Args,
+ aditi_insert_delete_modify(InsertDelMod, _, Syntax),
+ aditi_insert_delete_modify(InsertDelMod, PredId, Syntax)) -->
+ { aditi_insert_del_mod_eval_method(InsertDelMod, EvalMethod) },
+
+ { CallId = PredOrFunc - _ },
+ { InsertDeleteAdjustArgTypes =
+ lambda([RelationArgTypes::in, UpdateArgTypes::out] is det, (
+ construct_higher_order_type(PredOrFunc,
+ EvalMethod, RelationArgTypes, ClosureType),
+ UpdateArgTypes = [ClosureType]
+ )) },
+
% `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 =
+ % corresponding to those of the base relation, one set for
+ % the tuple to delete, and one for the tuple to insert.
+ { ModifyAdjustArgTypes =
lambda([RelationArgTypes::in, AditiModifyTypes::out] is det, (
list__append(RelationArgTypes, RelationArgTypes,
ClosureArgTypes),
- construct_higher_order_pred_type((aditi_top_down),
+ construct_higher_order_pred_type(EvalMethod,
ClosureArgTypes, ClosureType),
AditiModifyTypes = [ClosureType]
)) },
- typecheck_aditi_builtin_closure(CallId, Args, AdjustArgTypes, PredId).
-
- % Typecheck the closure passed to an `aditi_delete',
- % `aditi_bulk_insert' or `aditi_bulk_delete' which
- % determines which tuples are inserted or deleted.
- % The argument types of the closure are the same as the
- % argument types of the base relation being updated.
-:- pred typecheck_aditi_delete_or_bulk_operation_closure(simple_call_id,
- lambda_eval_method, list(prog_var), pred_id,
- typecheck_info, typecheck_info).
-:- mode typecheck_aditi_delete_or_bulk_operation_closure(in, in, in, out,
- typecheck_info_di, typecheck_info_uo) is det.
-typecheck_aditi_delete_or_bulk_operation_closure(CallId,
- EvalMethod, Args, PredId) -->
- { CallId = PredOrFunc - _ },
- { AdjustArgTypes =
- lambda([RelationArgTypes::in, UpdateArgTypes::out] is det, (
- construct_higher_order_type(PredOrFunc,
- EvalMethod, RelationArgTypes, ClosureType),
- UpdateArgTypes = [ClosureType]
- )) },
+ {
+ InsertDelMod = bulk_insert,
+ AdjustArgTypes = InsertDeleteAdjustArgTypes
+ ;
+ InsertDelMod = delete(_),
+ AdjustArgTypes = InsertDeleteAdjustArgTypes
+ ;
+ InsertDelMod = modify(_),
+ AdjustArgTypes = ModifyAdjustArgTypes
+ },
typecheck_aditi_builtin_closure(CallId, Args, AdjustArgTypes, PredId).
+:- pred aditi_insert_del_mod_eval_method(aditi_insert_delete_modify,
+ lambda_eval_method).
+:- mode aditi_insert_del_mod_eval_method(in, out) is det.
+
+aditi_insert_del_mod_eval_method(bulk_insert, (aditi_bottom_up)).
+aditi_insert_del_mod_eval_method(delete(filter), (aditi_top_down)).
+aditi_insert_del_mod_eval_method(delete(bulk), (aditi_bottom_up)).
+aditi_insert_del_mod_eval_method(modify(filter), (aditi_top_down)).
+aditi_insert_del_mod_eval_method(modify(bulk), (aditi_bottom_up)).
+
% Check that there is only one argument (other than the `aditi__state'
% arguments) passed to an `aditi_delete', `aditi_bulk_insert',
% `aditi_bulk_delete' or `aditi_modify', then typecheck that argument.
@@ -1243,10 +1246,9 @@
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.
+aditi_builtin_first_state_arg(aditi_tuple_insert_delete(_, _),
+ _ - _/Arity) = Arity + 1.
+aditi_builtin_first_state_arg(aditi_insert_delete_modify(_, _, _), _) = 2.
%-----------------------------------------------------------------------------%
@@ -5701,11 +5703,12 @@
language_builtin("some", 2).
language_builtin("aditi_insert", 3).
language_builtin("aditi_delete", 3).
-language_builtin("aditi_delete", 4).
+language_builtin("aditi_bulk_insert", 3).
language_builtin("aditi_bulk_insert", 4).
+language_builtin("aditi_bulk_delete", 3).
language_builtin("aditi_bulk_delete", 4).
-language_builtin("aditi_modify", 3).
-language_builtin("aditi_modify", 4).
+language_builtin("aditi_bulk_modify", 3).
+language_builtin("aditi_bulk_modify", 4).
:- pred write_call_context(prog_context, call_id, int, unify_context,
io__state, io__state).
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.105
diff -u -u -r1.105 unify_gen.m
--- compiler/unify_gen.m 2000/03/10 13:37:55 1.105
+++ compiler/unify_gen.m 2000/03/31 00:39:02
@@ -41,6 +41,7 @@
:- 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 rl.
:- import_module term, bool, string, int, list, map, require, std_util.
@@ -509,27 +510,42 @@
)
;
{ Code = empty },
+
+ code_info__make_entry_label(ModuleInfo,
+ PredId, ProcId, no, CodeAddr),
+ { code_util__extract_proc_label_from_code_addr(CodeAddr,
+ ProcLabel) },
(
- { EvalMethod = normal }
+ { EvalMethod = normal },
+ { AddrConst = const(code_addr_const(CodeAddr)) }
;
{ EvalMethod = (aditi_bottom_up) },
- % XXX The closure_layout code needs to be changed
- % to handle these.
- { error(
- "Sorry, not implemented: `aditi_bottom_up' closures") }
+ { rl__get_c_interface_rl_proc_name(ModuleInfo,
+ proc(PredId, ProcId), RLProcName) },
+ { rl__proc_name_to_string(RLProcName, RLProcNameStr) },
+ list__map_foldl(code_info__variable_type,
+ Args, InputTypes),
+ { rl__schema_to_string(ModuleInfo,
+ InputTypes, InputSchemaStr) },
+ { AditiCallArgs = [
+ yes(const(string_const(RLProcNameStr))),
+ yes(const(string_const(InputSchemaStr)))
+ ] },
+ code_info__get_next_cell_number(AditiCallCellNo),
+ { Reuse = no },
+ { AddrConst = create(0, AditiCallArgs, uniform(no),
+ must_be_static, AditiCallCellNo,
+ "aditi_call_info", Reuse) }
;
{ EvalMethod = (aditi_top_down) },
- % XXX The closure_layout code needs to be changed
- % to handle these.
+ % XXX Need to work out how to encode the procedure
+ % name. The update goals which take aditi_top_down
+ % closures aren't implemented on the Aditi side anyway.
{ error(
"Sorry, not implemented: `aditi_top_down' closures") }
),
{ continuation_info__generate_closure_layout(
ModuleInfo, PredId, ProcId, ClosureInfo) },
- code_info__make_entry_label(ModuleInfo, PredId, ProcId, no,
- CodeAddr),
- { code_util__extract_proc_label_from_code_addr(CodeAddr,
- ProcLabel) },
code_info__get_cell_count(CNum0),
{ stack_layout__construct_closure_layout(ProcLabel,
ClosureInfo, ClosureLayoutMaybeRvals,
@@ -545,7 +561,7 @@
{ unify_gen__generate_pred_args(Args, ArgInfo, PredArgs) },
{ Vector = [
yes(ClosureLayout),
- yes(const(code_addr_const(CodeAddr))),
+ yes(AddrConst),
yes(const(int_const(NumArgs)))
| PredArgs
] },
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.60
diff -u -u -r1.60 unique_modes.m
--- compiler/unique_modes.m 1999/11/19 13:22:14 1.60
+++ compiler/unique_modes.m 2000/03/17 04:11:10
@@ -446,11 +446,14 @@
GenericCall = class_method(_, _, _, _),
ArgOffset = 0
;
- % `aditi_insert' goals have type_info arguments for each
- % of the arguments of the tuple to insert added to the
- % start of the argument list by polymorphism.m.
+ % `aditi_insert' and `aditi_delete' goals have type_info
+ % arguments for each of the arguments of the tuple to insert
+ % added to the start of the argument list by polymorphism.m.
GenericCall = aditi_builtin(Builtin, UpdatedCallId),
- ( Builtin = aditi_insert(_), UpdatedCallId = _ - _/Arity ->
+ (
+ Builtin = aditi_tuple_insert_delete(_, _),
+ UpdatedCallId = _ - _/Arity
+ ->
ArgOffset = -Arity
;
ArgOffset = 0
--------------------------------------------------------------------------
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