%------------------------------------------------------------------------------% % Copyright (C) 1999-2001 INRIA/INSA de Rennes/IFSIC. % This file may only be copied under the terms of the GNU Library General % Public License - see the file License in the Morphine distribution. % % Author : Erwan Jahier % % This files contains various types declarations concerning the event % attributes. Those types are used both in forward_move.op and % current_slots.op. %------------------------------------------------------------------------------% opium_type( name : is_port, implementation : is_port_Op, message : "Succeeds for a Mercury Port. Mercury ports are call (or 'CALL'), \ exit (or 'EXIT'), fail (or 'FAIL'), redo (or 'REDO'), then (or 'THEN'), \ else (or 'ELSE'), disj (or 'DISJ'), switch (or 'SWITCH' or 'SWTC'), \ first (or 'FIRST' or 'FRST'), later (or 'LATER' or 'LATR'), \ exception (or 'EXCP' or 'EXCEPTION'). \ "). is_port_Op(Port) :- is_list_of_ports_Op([Port]). %------------------------------------------------------------------------------% opium_type( name : is_port_or_var, implementation : is_port_or_var_Op, message : "Succeeds for a Mercury port or a variable (See `is_port/1').\ "). is_port_or_var_Op(X) :- var(X), ! ; is_port(X). %------------------------------------------------------------------------------% opium_type( name : is_list_of_ports, implementation : is_list_of_ports_Op, message : "Succeeds for a sublist of ['CALL', 'EXIT', 'REDO', 'FAIL', 'THEN',\ 'ELSE', 'DISJ', 'SWITCH', 'SWTC', 'FIRST', 'FRST', 'LATER', 'LATR', 'EXCP', \ 'EXCEPTION', \ call, exit, fail, redo, cond, then, else, disj, switch, first, later, exception, \ neg_enter, neg_success, neg_failure].\ "). is_list_of_ports_Op(List) :- list_of_mercury_ports(ListMercPorts), is_sublist(List, ListMercPorts). is_sublist([], _). is_sublist([Term | Tail], L2) :- member(Term, L2), is_sublist(Tail, L2). list_of_mercury_ports([ 'CALL', 'EXIT', 'FAIL', 'REDO', 'THEN', 'ELSE', 'DISJ', 'SWITCH', 'SWTC', 'FIRST', 'FRST', 'LATER', 'LATR', 'EXCP', 'EXCEPTION', call, exit, fail, redo, cond, then, else, disj, switch, first, later, exception, neg_enter, neg_success, neg_failure]). %------------------------------------------------------------------------------% opium_type( name : is_port_attribute, implementation : is_port_attribute_Op, message : "Succeeds for a port, a negated port (not('CALL')), a list of \ ports, '-' or a variable.\ "). is_port_attribute_Op(Attribute) :- Attribute == '-' ; free(Attribute), ! ; is_port(Attribute) ; Attribute = not(AttributeNeg), is_port(AttributeNeg) ; Attribute = \+(AttributeNeg), is_port(AttributeNeg) ; is_list_of_ports(Attribute) . %------------------------------------------------------------------------------% opium_type( name : is_goal_path, implementation : is_goal_path_Op, message : "Succeeds for list of atoms of the form '?','e', 't', '~', 'q', \ 'ci', 'si', 'di' where i is an integer > 0." ). is_goal_path_Op([X|Xs]) :- is_valid_path(X), is_goal_path_Op(Xs). is_goal_path_Op([]). is_valid_path('?'). is_valid_path(e). is_valid_path(t). is_valid_path(q). is_valid_path('~'). is_valid_path(X) :- atom_string(X, Xstr), append_strings("d", IntStr, Xstr), atom_string(Int, IntStr), integer_atom(_, Int). is_valid_path(X) :- atom_string(X, Xstr), append_strings("c", IntStr, Xstr), atom_string(Int, IntStr), integer_atom(_, Int). is_valid_path(X) :- atom_string(X, Xstr), append_strings("s", IntStr, Xstr), atom_string(Int, IntStr), integer_atom(_, Int). %------------------------------------------------------------------------------% opium_type( name : is_goal_path_or_var, implementation : is_goal_path_or_var_Op, message : "Succeeds for a Mercury goal path or a variable (See `is_goal_path/1')."). is_goal_path_or_var_Op(X) :- var(X), ! ; is_goal_path(X). %------------------------------------------------------------------------------% % Should we need a Opium declaration for this one ? % :- pred is_list_of_paths(attribute). % :- mode is_list_of_paths(in) is semidet. is_list_of_goal_paths([X|Xs]) :- is_goal_path(X), is_list_of_goal_paths(Xs). is_list_of_goal_paths([]). %------------------------------------------------------------------------------% opium_type( name : is_goal_path_attribute, implementation : is_goal_path_attribute_Op, message : "Succeeds for a goal path, a negated goal path, a list of goal path, '-' or \ a variable."). is_goal_path_attribute_Op(Attribute) :- Attribute == '-' ; free(Attribute), ! ; is_goal_path(Attribute) ; Attribute = not(AttributeNeg), is_goal_path(AttributeNeg) ; Attribute = \+(AttributeNeg), is_goal_path(AttributeNeg) ; is_list_of_goal_paths(Attribute) . %------------------------------------------------------------------------------% opium_type( name : is_atom_attribute, implementation : is_atom_attribute_Op, message : "Succeeds for an atom, a negated atoms, a list of atom, a variable \ or '-'. It is intended to check `proc_name' `def_module' and \ `decl_module' attributes.\ "). is_atom_attribute_Op(Attribute) :- Attribute == '-' ; free(Attribute), ! ; atom(Attribute), ! ; Attribute = not(AttributeNeg), atom(AttributeNeg), ! ; Attribute = \+(AttributeNeg), atom(AttributeNeg), ! ; is_list_of_atoms(Attribute) . %------------------------------------------------------------------------------% opium_type( name : is_proc_type, implementation : is_proc_type_Op, message : "Succeeds for the atoms `predicate' and `function'."). is_proc_type_Op(X) :- member(X, [predicate, function]). %------------------------------------------------------------------------------% opium_type( name : is_proc_type_attribute, implementation : is_proc_type_attribute_Op, message : "Succeeds for pred or func, not(pred) or not(func), \ a list of atoms pred or func, '-' or a variable."). is_proc_type_attribute_Op(Attribute) :- Attribute == '-' ; free(Attribute), ! ; member(Attribute, [predicate, function]), ! ; Attribute = not(AttributeNeg), member(AttributeNeg, [predicate, function]), ! ; Attribute = \+(AttributeNeg), member(Attribute, [predicate, function]), ! ; subtract(Attribute, [predicate, function], []) . %------------------------------------------------------------------------------% opium_type( name : is_det_marker, implementation : is_det_marker_Op, message : "Succeeds for a Mercury determinism marker. Mercury determinism are \ det (or 'DET'), semidet (or 'SEMI'), nondet (or 'NON'), multidet (or 'MUL'), \ cc_nondet (or 'CCNON'), cc_multidet (or 'CCMUL'), failure (or 'FAIL') and \ erroneous (or 'ERR'). \ "). is_det_marker_Op(Det) :- is_list_of_dets_Op([Det]). %------------------------------------------------------------------------------% opium_type( name : is_det_marker_or_var, implementation : is_det_marker_or_var_Op, message : "Succeeds for a Mercury determinism markers or a variable.\ "). is_det_marker_or_var_Op(X) :- var(X), ! ; is_det_marker(X). %------------------------------------------------------------------------------% opium_type( name : is_list_of_dets, implementation : is_list_of_dets_Op, message : "Succeeds for a sublist of [det, semidet, nondet, multidet,\ cc_nondet, cc_multidet, failure, erroneous, 'DET', 'SEMI', 'NON', 'MUL', \ 'ERR', 'FAIL', 'CCNON', 'CCMUL'] \ (the determinism markers in capital letters are the ones used in mdb, the \ internal Mercury debugger).\ "). is_list_of_dets_Op(List) :- list_of_mercury_dets(ListMercDets), is_sublist(List, ListMercDets). list_of_mercury_dets([det, semidet, nondet, multidet, cc_nondet, cc_multidet, failure, erroneous, 'DET', 'SEMI', 'NON', 'MUL', 'ERR', 'FAIL', 'CCNON', 'CCMUL']). %------------------------------------------------------------------------------% opium_type( name : is_det_marker_attribute, implementation : is_det_marker_attribute_Op, message : "Succeeds for a Mercury determinism marker, a negated determinism \ (not(nondet)), a list of determinism markers, '-' or a variable.\ "). is_det_marker_attribute_Op(Attribute) :- Attribute == '-' ; free(Attribute), ! ; is_det_marker(Attribute), ! ; Attribute = not(AttributeNeg), is_det_marker(AttributeNeg), ! ; Attribute = \+(AttributeNeg), is_det_marker(AttributeNeg), ! ; is_list_of_dets(Attribute) . %------------------------------------------------------------------------------% opium_type( name : is_proc, implementation : is_proc_Op, message : "Succeeds for terms of the form \ `[ProcType+][Module:]ProcName[/Arity][-ModeNum]' where terms betwenn square \ bracquets are optional, `ProcType' has type `is_proc_type_attribute/1', \ `Module' and `ProcName' have type `is_atom_attribute/1', `Arity' and `ModeNum' \ have `type is_integer_attribute/1'."). is_proc_Op(Proc) :- ( Proc = P, is_atom_attribute(P), ! ; Proc = (PT->P), is_proc_type_attribute(PT), is_atom_attribute(P), ! ; Proc = M:P, is_atom_attribute(M), is_atom_attribute(P), ! ; Proc = P/A, is_atom_attribute(P), is_integer_attribute(A), ! ; Proc = P-MN, is_atom_attribute(P), is_integer_attribute(MN), ! ; Proc = (P/A-MN), is_atom_attribute(P), is_integer_attribute(A), is_integer_attribute(MN), ! ; Proc = M:(P-MN), is_atom_attribute(M), is_atom_attribute(P), is_integer_attribute(MN), ! ; Proc = M:(P/A), is_atom_attribute(M), is_atom_attribute(P), is_integer_attribute(A), ! ; Proc = (PT->(P-MN)), is_proc_type_attribute(PT), is_atom_attribute(P), is_integer_attribute(MN), ! ; Proc = (PT->(P/A)), is_proc_type_attribute(PT), is_atom_attribute(P), is_integer_attribute(A), ! ; Proc = (PT->M:P), is_proc_type_attribute(PT), is_atom_attribute(M), is_atom_attribute(P), ! ; Proc = M:(P/A-MN), is_atom_attribute(M), is_atom_attribute(P), is_integer_attribute(A), is_integer_attribute(MN), ! ; Proc = (PT->(P/A-MN)), is_proc_type_attribute(PT), is_atom_attribute(P), is_integer_attribute(A), is_integer_attribute(MN), ! ; Proc = (PT->M:(P-MN)), is_proc_type_attribute(PT), is_atom_attribute(M), is_atom_attribute(P), is_integer_attribute(MN), ! ; Proc = (PT->M:(P/A)), is_proc_type_attribute(PT), is_atom_attribute(M), is_atom_attribute(P), is_integer_attribute(A), ! ; Proc = (PT->M:(P/A-MN)), is_proc_type_attribute(PT), is_atom_attribute(M), is_atom_attribute(P), is_integer_attribute(A), is_integer_attribute(MN) ). is_proc_Op(-) :- !. %------------------------------------------------------------------------------% opium_type( name : is_proc_or_var, implementation : is_proc_or_var_Op, message : "Succeeds for a Mercury procedure or a variable.\ "). is_proc_or_var_Op(X) :- var(X), ! ; is_proc(X). %------------------------------------------------------------------------------% opium_type( name : is_arg_attribute, implementation : is_arg_attribute_Op, message : "For the time being, you can't perform filtering on arguments, i.e., you can \ only have variables or '-' for that attribute.\ "). is_arg_attribute_Op(Attribute) :- free(Attribute) ; Attribute == '-'. %------------------------------------------------------------------------------% opium_type( name : is_integer_attribute, implementation : is_integer_attribute_Op, message : "Succeeds for an integer, a negated integer (not 6), a list of \ integers ([3, 5, 9]), an interval ('3..11'), a variable or '-'.\ " ). is_integer_attribute_Op(Attribute) :- Attribute == '-', ! ; free(Attribute), ! ; integer(Attribute), ! ; Attribute = not(AttributeNeg), integer(AttributeNeg), ! ; Attribute = \+(AttributeNeg), integer(AttributeNeg), ! ; is_list_of_integers(Attribute), ! ; Attribute = Bottom .. Up, integer(Bottom), integer(Up), Bottom =< Up . %:- pred is_list_of_integers(list(integer)). %:- mode is_list_of_integers(in) is semidet. is_list_of_integers([]). is_list_of_integers([X | Xs]) :- integer(X), is_list_of_integers(Xs). %------------------------------------------------------------------------------% opium_type( name : is_string_attribute, implementation : is_string_attribute_Op, message : "Succeeds for a string, a negated string (not \"foo\"), a list of \ strings, a variable or '-'.\ "). is_string_attribute_Op(Attribute) :- Attribute == '-' ; free(Attribute), ! ; string(Attribute) ; Attribute = not(AttributeNeg), string(AttributeNeg) ; Attribute = \+(AttributeNeg), string(AttributeNeg) ; is_list_of_strings(Attribute) . %:- pred is_list_of_strings(list(string)). %:- mode is_list_of_strings(in) is semidet. is_list_of_strings([]). is_list_of_strings([X | Xs]) :- string(X), is_list_of_strings(Xs). %------------------------------------------------------------------------------% opium_command( name : list_attribute_aliases, arg_list : [], arg_type_list : [], abbrev : laa, interface : hidden, command_type : opium, implementation : list_attribute_aliases_op, parameters : [], message : "Lists the available aliases for the different Mercury event attributes \ (`fget/1' and `current/1')."). list_attribute_aliases_op :- findall(X, is_alias_for(chrono, X), Lchrono), findall(X, is_alias_for(call, X), Lcall), findall(X, is_alias_for(depth, X), Ldepth), findall(X, is_alias_for(port, X), Lport), findall(X, is_alias_for(proc_type, X), LPredOrFunc), findall(X, is_alias_for(decl_module, X), Ldeclmodule), findall(X, is_alias_for(def_module, X), Ldefmodule), findall(X, is_alias_for(name, X), Lname), findall(X, is_alias_for(arity, X), Larity), findall(X, is_alias_for(mode_number, X), Lmode_number), findall(X, is_alias_for(proc, X), Lproc), findall(X, is_alias_for(det, X), Ldet), findall(X, is_alias_for(goal_path, X), Lgoal_path), findall(X, is_alias_for(args, X), Largs), findall(X, is_alias_for(arg_names, X), LArgsName), findall(X, is_alias_for(arg_types, X), LArgsType), findall(X, is_alias_for(vars, X), LVars), findall(X, is_alias_for(var_names_and_types, X), Lvar_names_and_types), findall(X, is_alias_for(local_vars, X), Lother), findall(X, is_alias_for(stack, X), Lstack), printf("List of attribute aliases for fget/1 and current/1:\n",[]), printf("%19s: %w\n", [chrono, Lchrono]), printf("%19s: %w\n", [call, Lcall]), printf("%19s: %w\n", [depth, Ldepth]), printf("%19s: %w\n", [port, Lport]), printf("%19s: %w\n", [proc_type, LPredOrFunc]), printf("%19s: %w\n", [def_module, Ldefmodule]), printf("%19s: %w\n", [decl_module, Ldeclmodule]), printf("%19s: %w\n", [name, Lname]), printf("%19s: %w\n", [arity, Larity]), printf("%19s: %w\n", [mode_number, Lmode_number]), printf("%19s: %w\n", [proc, Lproc]), printf("%19s: %w\n", [det, Ldet]), printf("%19s: %w\n", [goal_path, Lgoal_path]), printf("\nList of attribute aliases for current/1 only:\n",[]), printf("%19s: %w\n", [args, Largs]), printf("%19s: %w\n", [arg_names, LArgsName]), printf("%19s: %w\n", [arg_types, LArgsType]), printf("%19s: %w\n", [vars, LVars]), printf("%19s: %w\n", [var_names_and_types, Lvar_names_and_types]), printf("%19s: %w\n", [local_vars, Lother]), printf("%19s: %w\n", [stack, Lstack]). %------------------------------------------------------------------------------% % opium_primitive( % name : is_alias_for, % arg_list : [AttributeName, Alias], % arg_type_list : [atom, atom], % implementation : is_alias_for_Op, % message : % "Succeeds if Alias is an alias for the attribute AttributeName. The aliases \ % for all the attributes can be listed with list_attribute_aliases/0 command. % " % ). % This is used for both fget/1 and current/1 command. is_alias_for(chrono, chrono). is_alias_for(chrono, c). is_alias_for(call, call). is_alias_for(call, ca). is_alias_for(call, cl). is_alias_for(depth, depth). is_alias_for(depth, d). is_alias_for(port, port). is_alias_for(port, p). is_alias_for(proc, procedure). is_alias_for(proc, proc). is_alias_for(name, procedure_name). is_alias_for(name, proc_name). is_alias_for(name, name). is_alias_for(name, n). is_alias_for(proc_type, proc_type). is_alias_for(proc_type, pred_or_func). is_alias_for(proc_type, pof). is_alias_for(decl_module, decl_module). is_alias_for(decl_module, decl_mod). is_alias_for(decl_module, dlm). is_alias_for(def_module, def_module). is_alias_for(def_module, def_mod). is_alias_for(def_module, dfm). is_alias_for(arity, arity). is_alias_for(arity, ar). is_alias_for(mode_number, mode_number). is_alias_for(mode_number, mode_num). is_alias_for(mode_number, mn). is_alias_for(det, determinism). is_alias_for(det, deter). is_alias_for(det, det). is_alias_for(goal_path, goal_path). is_alias_for(goal_path, gp). is_alias_for(line_number, line_number). is_alias_for(line_number, ln). % XXX Those ones are not hanled in fget yet. is_alias_for(args, arguments). is_alias_for(args, args). is_alias_for(args, arg). is_alias_for(args, a). is_alias_for(arg_names, arg_names). is_alias_for(arg_names, an). is_alias_for(arg_types, arg_types). is_alias_for(arg_types, types). is_alias_for(arg_types, type). is_alias_for(arg_types, at). is_alias_for(vars, vars). is_alias_for(var_names_and_types, var_names_and_types). is_alias_for(var_names_and_types, vnt). is_alias_for(local_vars, local_vars). is_alias_for(local_vars, local_var). is_alias_for(local_vars, non_arg_vars). is_alias_for(local_vars, other_live_var). is_alias_for(local_vars, nav). is_alias_for(stack, stack). is_alias_for(stack, stk). is_alias_for(stack, s).