[m-dev.] Opium-M [3/5]
Erwan Jahier
Erwan.Jahier at irisa.fr
Tue Oct 26 23:46:50 AEST 1999
Index: extras/opium_m/source/exec_control_M.op
===================================================================
RCS file: exec_control_M.op
diff -N exec_control_M.op
--- /dev/null Wed May 28 10:49:58 1997
+++ exec_control_M.op Tue Oct 26 23:26:36 1999
@@ -0,0 +1,609 @@
+%--------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Author : Erwan Jahier <jahier at irisa.fr>
+%
+% Opium-M built-ins, primitives and commands related to the control
+% of the execution (part of scenario opium_kernel-M.op). All predicates
+% of this file are written to be run on an unix-like architecture.
+
+
+%--------------------------------------------------------------------------%
+opium_primitive(
+ name : init_opium_session,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ implementation : init_opium_session_Op,
+ message :
+"Initializes Opium-M."
+ ).
+
+
+% :- pred init_opium_session_Op is det.
+init_opium_session_Op :-
+ load_opium_m_rc,
+ setval(state_of_opium, not_running),
+ setval(a_program_has_been_run, no).
+
+
+load_opium_m_rc :-
+ (
+ getenv('PWD', Cwd),
+ append_strings(Cwd, "/.opium-m-rc", CurrentOpiumRc),
+ exists(CurrentOpiumRc)
+ ->
+ % If a `.opium-m-rc' exists in the current directory, load it.
+ ( get_file_info(CurrentOpiumRc, size, 0) ->
+ true
+ ;
+ % Only print thet message if .opium-m-rc is not empty
+ compile(CurrentOpiumRc)
+ )
+ ;
+ % If no `.opium-m-rc' exists in the current directory, look
+ % in the home directory if such a file is available to load it.
+
+ getenv('HOME', Dir),
+ append_strings(Dir, "/.opium-m-rc", HomeOpiumRc),
+ (
+ exists(HomeOpiumRc)
+ ->
+ ( get_file_info(HomeOpiumRc, size, 0) ->
+ true
+ ;
+ % Only print thet message if .opium-m-rc is not empty
+ compile(HomeOpiumRc)
+ )
+ ;
+ true
+ )
+ ).
+
+%--------------------------------------------------------------------------%
+opium_command(
+ name : re_init_opium,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : re_init_opium_Op,
+ parameters : [],
+ message :
+'Re-initializes Opium-M. This command migth be useful if Opium-M is broken.\
+'
+ ).
+
+re_init_opium_Op :-
+ init_opium_session_Op.
+
+
+%--------------------------------------------------------------------------%
+opium_abort :-
+ end_connection,
+ abort.
+
+%--------------------------------------------------------------------------%
+opium_command(
+ name : run,
+ arg_list : [ProgramCall],
+ arg_type_list : [is_mercury_program_call],
+ abbrev : _,
+ interface : button,
+ command_type : opium,
+ implementation : run_Op,
+ parameters : [],
+ message :
+'Executes a Mercury program from Opium-M. \n\
+\n\
+Example: \
+run(hello) will run the Mercury program hello under the control of Opium-M .\
+run(\"./cat filename\") will run \
+the Mercury program \"cat\" that takes \"filename\" as argument.\
+'
+ ).
+
+% :- pred run_Op(atom).
+% :- mode run_Op(in) is det.
+ % run_Op(PathCallArgs) run the program ProgramName within Opium-M.
+run_Op(PathCallArgs0) :-
+ ( string(PathCallArgs0) ->
+ PathCallArgs = PathCallArgs0
+ ;
+ % Convert the input of run/1 to a string if necessary
+ term_string(PathCallArgs0, PathCallArgs)
+ ),
+ decompose_path_call_and_args(PathCallArgs, Path, Call, Args),
+ run(Path, Call, Args).
+
+% :- pred run(string, atom).
+% :- mode run(in, in) is det.
+run(ProgramPathStr, ProgramCallStr, ListArgsStr) :-
+ (
+ % we store the argument of run/3 in order to restart easily
+ % the execution of the program with rerun/0 command.
+ setval(re_run_program,
+ run(ProgramPathStr, ProgramCallStr, ListArgsStr)),
+
+ term_string(ProgramCall, ProgramCallStr),
+ start_connection(ProgramCall, SocketAddress),
+
+ term_string(SocketAddress, SocketAddressStr),
+ get_parameter(socket_domain, [SocketDomain]),
+
+ run_program(ProgramPathStr, ProgramCallStr, ListArgsStr,
+ SocketAddressStr, SocketDomain, " local "),
+
+ accept(sock, _, newsock),
+
+ % state_of_opium = running | not_running | eot (| bot)
+ setval(state_of_opium, running),
+
+ read_message_from_socket(hello),
+ send_message_to_socket(hello_reply),
+ read_message_from_socket(start),
+ setval(a_program_has_been_run, yes),
+ print_event
+ ->
+ true
+ ;
+ write(stderr, "error in run/1"),
+ end_connection
+ ).
+
+
+
+%------------------------------------------------------------------------------%
+opium_primitive(
+ name : decompose_path_call_and_args,
+ arg_list : [PathCallArgs, Path, Call, Args],
+ arg_type_list : [is_atom_or_string, string, string, string],
+ abbrev : _,
+ implementation : decompose_path_call_and_args_Op,
+ message :
+"Split a Mercury program call into its path, call and arguments list."
+ ).
+
+
+decompose_path_call_and_args_Op(PathCallArgs, Path, Call, Args) :-
+ (
+ % For calls of the form : `run("path/call arg1 arg2 ...")'
+ decompose_path_call_and_args1(PathCallArgs, Path, Call, Args),
+ !
+ ;
+ % For calls of the form : `run("path/call(arg1, arg2, ...)")'.
+ % Note that with this syntax, it won't work if path contains
+ % `..' because of the precedence of the `..'.
+ % I keep the possibility of calling Mercury programs that
+ % way for backward compability reasons.
+ decompose_path_call_and_args2(PathCallArgs, Path, Call, Args)
+ ).
+
+decompose_path_call_and_args1(PathCallArgs, PathStr, CallStr, ArgsStr) :-
+ % PathCallArgs is of the form : "path/call arg1 arg2 ..."
+ % or 'path/call arg1 arg2 ...'.
+ split_string(PathCallArgs, ListString),
+ ListString = [PathCall | ListArgs],
+ pathname(PathCall, PathStr0, CallStr),
+ ( PathStr0 = "" ->
+ PathStr = "./"
+ ;
+ PathStr = PathStr0
+ ),
+ % make sure the call is not of the form `cat(arg)'.
+ term_string(Call, CallStr),
+ Call =.. List,
+ length(List, 1),
+ string_list_to_string(ListArgs, ArgsStr).
+
+decompose_path_call_and_args2(PathCallArgs, PathStr, CallStr, ArgsStr) :-
+ % PathCallArgs is of the form : "path/foo(arg1, arg2, ...)"
+ % or 'path/foo(arg1, arg2, ...)'.
+ pathname(PathCallArgs, PathStr0, CallArgsStr),
+ ( PathStr0 = "" ->
+ PathStr = "./"
+ ;
+ PathStr = PathStr0
+ ),
+ term_string(CallArgs, CallArgsStr),
+ CallArgs =.. [Call | ArgList],
+ term_string(Call, CallStr),
+ maplist(atom_string, ArgList, ArgListStr),
+ string_list_to_string(ArgListStr, ArgsStr).
+
+string_list_to_string([], " ").
+string_list_to_string([String1|StringList], String) :-
+ string_list_to_string(StringList, String2),
+ concat_string([ " ", String1, String2], String).
+
+
+% :- pred run_program(string, string, string, string, string).
+% :- mode run_program(in, in, in, in, in) is det.
+ % run the mercury program in an other process
+run_program(ProgramPathStr, PathCallStr, ListArgsStr,
+ SocketAddressStr, SocketDomain, RemoteMachine) :-
+ (
+ getenv('MERCURY_OPIUM_DIR', Dir),
+ window_command(WindowsStr),
+ concat_string([
+ Dir, "/scripts/exec_mercury_program ",
+ SocketAddressStr, " ", SocketDomain, " ",
+ RemoteMachine, " ",
+ WindowsStr, " ",
+ " ", ProgramPathStr,
+ PathCallStr, "", ListArgsStr," &"],Command),
+ opium_write_debug("Command ="),
+ opium_write_debug(Command ),
+ sh(Command),
+ !
+ ;
+ write(stderr, "eclipse.pl: error in opium_run_program/2")
+ ).
+
+% :- pred list_args_to_string(list(atom), list(string)).
+% :- mode list_args_to_string(in, out) is det.
+list_args_to_string(ListArgs, ArgsStr) :-
+ maplist(arg_to_str, ListArgs, ListArgsStr),
+ list_string_to_string(ListArgsStr, ArgsStr).
+
+% :- pred arg_to_str(atom, string).
+% :- mode arg_to_str(in, out) is det.
+arg_to_str(Argument, String) :-
+ term_string(Argument, String1),
+ append_strings(" ", String1, String).
+
+% :- pred list_string_to_string(list(string), string).
+% :- mode list_string_to_string(in, out) is det.
+list_string_to_string([Str | ListStr], String) :-
+ list_string_to_string(ListStr, Str2),
+ append_strings(Str, Str2, String).
+
+list_string_to_string([], "").
+
+
+%------------------------------------------------------------------------------%
+opium_type(
+ name : is_mercury_program_call,
+ implementation : is_mercury_program_call_Op,
+ message :
+"Type which succeeds for terms or strings of the form: \
+`path/programcall arg1 arg2 ...' or `path/programcall(arg1, arg2, ...)'. \
+It is intended to check the argument of run/1.\n\
+\n\
+Examples: `run(foo)', `run(\"foo\")', `run(\"./cat file\")', \
+`run(./cat(file))', `run(\"../dir/cat file1 file2\")', \
+`run(\"../dir/cat(file1,file2)\")'.\
+"
+ ).
+
+is_mercury_program_call_Op(ProgramCall0) :-
+ ( string(ProgramCall0) ->
+ ProgramCall = ProgramCall0,
+ !
+ ;
+ term_string(ProgramCall0, ProgramCall)
+ ),
+ % Checks program calls of the form "path/call arg1 arg2 ..."
+ split_string(ProgramCall, ListString),
+ ListString = [PathCall | _],
+ pathname(PathCall, _, CallStr),
+ term_string(Call, CallStr),
+ Call =.. List,
+ length(List, 1).
+
+is_mercury_program_call_Op(ProgramCall0) :-
+ ( string(ProgramCall0) ->
+ ProgramCall = ProgramCall0
+ ;
+ term_string(ProgramCall0, ProgramCall)
+ ),
+ % Checks program calls of the form "path/call(arg1,arg2,...)"
+ pathname(ProgramCall, _, CallArgsStr),
+ term_string(CallArgs, CallArgsStr),
+ CallArgs =.. [Call | ArgList],
+ maplist(atom_string, ArgList, _).
+
+
+% split_string(String, List) :- split_string(String, " ", " ", List).
+% We redefine it here because split_string/4 is not part of Eclipse3.5.2
+split_string(String, List) :-
+ string_list(String, L),
+ split_string2(L, [], LL),
+ maplist(list_string, LL, List).
+
+split_string2([], Acc, [Acc]) :-
+ !.
+split_string2([32|Xs], Acc, LL) :-
+ !,
+ split_string2(Xs, [], LL0),
+ (
+ Acc = [], !,
+ LL = LL0
+ ;
+ LL = [Acc|LL0]
+ ).
+split_string2([X|Xs], Acc, LL) :-
+ !,
+ append(Acc, [X], NewAcc),
+ split_string2(Xs, NewAcc, LL).
+
+list_string(L, S) :-
+ string_list(S, L).
+
+%------------------------------------------------------------------------------%
+% opium_command(
+% name : run_remote,
+% arg_list : [MachineName, ProgramCall],
+% arg_type_list : [string, is_atom_or_string],
+% abbrev : _,
+% interface : button,
+% command_type : opium,
+% implementation : run_remote_Op,
+% parameters : [],
+% message :
+% 'Executes a Mercury program from Opium-M on a remote machine. \n\
+% \n\
+% Example: run_remote(\"cripure.irisa.fr\",\"~mercury/sample/hello\") will \
+% run the mercury program \"hello\" on the machine cripure.\
+% '
+% ).
+
+% XXX Not yet working... But that is not that useful...
+run_remote_Op(MachineName, ProgramCall) :-
+ pathname(ProgramCall, Path, Name),
+ run_remote(MachineName, Path, Name).
+
+run_remote(MachineName, ProgramPathStr, ProgramCallStr) :-
+ (
+ % we store the argument of run/2 in order to restart easily
+ % the execution of the program with rerun/0 command.
+ setval(re_run_program,
+ run_remote(MachineName, ProgramPathStr, ProgramCallStr)),
+
+ term_string(ProgramCall, ProgramCallStr),
+
+ ProgramCall =.. [ProgramName | ListArgs],
+ start_connection(ProgramName, SocketAddress),
+
+ term_string(ProgramName, ProgramNameStr),
+ term_string(SocketAddress, SocketAddressStr),
+ list_args_to_string(ListArgs, ListArgsStr),
+ set_parameter(socket_domain, [inet]),
+
+ % Run the program "ProgramName" in an other window
+
+ run_program(ProgramPathStr, ProgramNameStr, ListArgsStr,
+ SocketAddressStr, " inet ", MachineName),
+
+ accept(sock, _, newsock),
+
+ % state_of_opium = running | not_running | eot (| bot)
+ setval(state_of_opium, running),
+
+ read_message_from_socket(hello),
+ send_message_to_socket(hello_reply),
+ read_message_from_socket(start)
+ ->
+ true
+ ;
+ write(stderr, "error in run/1"),
+ end_connection
+ ).
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : abort_trace,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : a,
+ interface : menu,
+ command_type : opium,
+ implementation : abort_trace_Op,
+ parameters : [],
+ message :
+'Aborts the current execution in the traced session.\
+'
+ ).
+
+%:- pred abort_trace.
+%:- mode abort_trace is det.
+abort_trace_Op :-
+ send_message_to_socket(abort_prog),
+ end_connection.
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : no_trace,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : o,
+ interface : hidden,
+ command_type : opium,
+ implementation : no_trace_Op,
+ parameters : [],
+ message :
+'Continues execution until it reaches the end of the \
+current execution without printing any further trace information.\
+'
+ ).
+
+%:- pred no_trace.
+%:- mode no_trace is det.
+no_trace_Op :-
+ send_message_to_socket(no_trace),
+ read_message_from_socket(forward_move_match_not_found),
+ ec.
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : rerun,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : r,
+ interface : button,
+ command_type : opium,
+ implementation : rerun_Op,
+ parameters : [],
+ message :
+'Runs again the last executed program.\
+').
+
+% XX if the connection with the debuggee process ended with a crash,
+% this command may not work properly because the global variable state_of_opium
+% would be set to running instead of not running. I should intercept the CTRL-C
+% to fix that.
+
+%:- pred rerun.
+%:- mode rerun is det.
+rerun_Op :-
+ getval(a_program_has_been_run, yes),
+ getval(re_run_program, ReStartCommand),
+ getval(state_of_opium, State),
+ write(ReStartCommand),nl,
+ (
+ State = eot
+ ->
+ ec
+ ;
+ State = running
+ ->
+ abort_trace
+ ;
+ % State = not_running
+ true
+ ),
+ ReStartCommand,
+ !.
+
+rerun_Op :-
+ write("No program have ever been run ; "),
+ write("you can't use rerun/0 command.\n"),
+ write("You need to invoque the command run/1 at least once to be "),
+ write("able to use rerun/0.\n"),
+ fail.
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : goto,
+ arg_list : [Chrono],
+ arg_type_list : [integer],
+ abbrev : _,
+ interface : menu,
+ command_type : trace,
+ implementation : goto_Op,
+ parameters : [],
+ message :
+'Moves forwards the trace pointer to the event with chronological \
+event number Chrono. If the current event number is larger than Chrono, \
+it fails.\
+').
+
+%:- pred goto(integer).
+%:- mode goto(in) is semidet.
+goto_Op(Chrono) :-
+ current(chrono = C),
+ ( (C < Chrono) ->
+ fget_np(chrono = Chrono)
+ ;
+ write(user, "You can not move forward to event number number "),
+ write(user, Chrono),
+ write(user, " because current_event is "),
+ write(user, C),
+ write(user, "\n"),
+ fail
+ ).
+
+
+%------------------------------------------------------------------------------%
+opium_parameter(
+ name : socket_domain,
+ arg_list : [Domain],
+ arg_type_list : [is_member([unix, inet])],
+ parameter_type : single,
+ default : [unix],
+ commands : [run, rerun],
+ message :
+"Parameter which tells which domain is used by the socket communication \
+betwenn the two processes.\
+"
+ ).
+
+%------------------------------------------------------------------------------%
+opium_parameter(
+ name : window_command,
+ arg_list : [String],
+ arg_type_list : [string],
+ parameter_type : single,
+ default : [""],
+ commands : [run, rerun],
+ message :
+"Parameter which specifies the command used to fork a new window to execute the \
+Mercury program in. By default, no other window is used (\"\"). \
+For example, if one want to execute a Mercury program within a xterm window, \
+one just need to use the command: \
+`set_parameter(window_command, [\"xterm -e \"])'.\
+"
+ ).
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : no_window,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : no_window_Op,
+ parameters : [window_command],
+ message :
+"Set the `window_command' parameter to \"\" (its default value). \
+The Mercury program executes in the same window as Opium-M."
+ ).
+
+no_window_Op :-
+ set_parameter(window_command, [""]).
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : use_xterm,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : use_xterm_Op,
+ parameters : [window_command],
+ message :
+"Set the `window_command' parameter to \"xterm -e \", which make the Mercury \
+executes in a new xterm window; the program's Input/Output will go to that \
+window and the Opium-M's Input/Output will go to the current terminal."
+ ).
+
+use_xterm_Op :-
+ set_parameter(window_command, ["xterm -e "]).
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : use_gdb,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : use_gdb_Op,
+ parameters : [window_command],
+ message :
+"Set the `window_command' parameter to \"xterm -e gdb \". This is to be able to use \
+both gdb and Opium-M. Note that to use gdb, you will need to compile your mercury \
+program with the option `--c-debug'."
+ ).
+
+use_gdb_Op :-
+ set_parameter(window_command, ["xterm -e gdb "]).
+
+
Index: extras/opium_m/source/forward_move_M.op
===================================================================
RCS file: forward_move_M.op
diff -N forward_move_M.op
--- /dev/null Wed May 28 10:49:58 1997
+++ forward_move_M.op Tue Oct 26 23:26:37 1999
@@ -0,0 +1,929 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Author : Erwan Jahier
+% File : forward_move.op
+%
+% This file implements the fget\1 predicate.
+
+
+
+%------------------------------------------------------------------------------%
+% New operator to denotate intervals (ex: 2..9).
+% Also defined in Opium-M.pl
+:- op(350, xfx, ..).
+
+% Also defined in Opium-M.pl and current_slots.op
+:- op(900, xfy, and).
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : fget,
+ arg_list : [AttributeConstraints],
+ arg_type_list : [is_list_or_conj_of_attribute_constraints_fget],
+ abbrev : fg,
+ interface : button,
+ command_type : trace,
+ implementation : fget_Op,
+ parameters : [],
+ message :
+"Moves forwards through the execution until the first event that satisfy the \
+list of constraints specified in AttributeConstraints (*). \
+AttributeConstraints can be either a conjunction of attribute constraints, \
+separated by \"and\" (fget(AC1 and AC2 and ...)) or a list of constraints \
+(fget([AC1, AC2, ...])). \n\
+ \n\
+The different attributes for fget are : \n\
+chrono: \n\
+ chronological event number of the event, \n\
+call: \n\
+ call event number of the event, \n\
+depth: \n\
+ depth in the proof three (number of ancestors - 1) of the event, \n\
+port: \n\
+ type of the event, \n\
+proc_type: \n\
+ tells if the current procedure is a predicate or a function, \n\
+decl_module: \n\
+ module name where the procedure is declared, \n\
+def_module: \n\
+ module name where the procedure is defined, \n\
+name: \n\
+ procedure name, \n\
+arity: \n\
+ procedure arity, \n\
+mode_number: \n\
+ procedure mode number, \n\
+proc: \n\
+ procedure ([proc_type->][decl_module:](name[/arity][-mode_number]) where \
+only the attribute name is mandatory), \n\
+det: \n\
+ procedure determinism, \n\
+goal_path: \n\
+ goal path of the call of the procedure.\n\
+\n\
+(*) An attribute constraint is a term of the form \"AttributeAlias = Term\" \
+where \
+AttributeAlias is an alias of a Mercury event attribute and Term can be: \n\
+an exact value (attribute = ground_term), \n\
+a negated value (attribute = not(ground_term)), \n\
+a list of values (attribute = [ground_term1, ground_term2, ... ]), \n\
+and for integer attributes (chrono, call, depth, arity), \n\
+an interval (attribute = bottom..up). \n\
+Each attribute has a list of possible aliases that you can list with the \
+command list_alias_attributes/0.\n\
+\n\
+Example: the Opium-M goal fget(chrono = [20, 789] and depth = 3..6 and \
+proc = foo/2) \
+will make the execution move forwards until the first event \
+which chronological event number is 20 or 789, depth is 3, 4, 5 or 6, \
+procedure name is foo and arity is not 2. \
+You can also use a list as an argument of fget: \
+fget([chrono=[20, 789], depth = 3..6, proc = foo/2]) will have the \
+same effect as the previous goal.\
+"
+ ).
+
+
+fget_Op(ConjOrList) :-
+ getval(state_of_opium, running),
+ (
+ is_list(ConjOrList),
+ fget_1_list(ConjOrList)
+ ;
+ % Transform the conjuct into a list if necessary
+ conj_to_list(ConjOrList, List),
+ fget_1_list(List)
+ ).
+
+conj_to_list(Attr and TailConj, [Attr | TailList]) :-
+ conj_to_list(TailConj, TailList),
+ !.
+conj_to_list(Attr, List) :-
+ (
+ Attr = -,
+ List = [],
+ % To allow fget(-).
+ !
+ ;
+ List = [Attr]
+ ).
+
+
+% List is a list of attribute constraints (ex: [chrono = 4, pred = [foo, bar]]).
+% From that list, we make the call to fget_ll/13.
+fget_1_list(List) :-
+ fill_slot(chrono, List, Chrono),
+ fill_slot(call, List, Call),
+ fill_slot(depth, List, Depth),
+ fill_slot(port, List, Port),
+ fill_slot(def_module, List, DefModule),
+ ( member(proc = Proc, List) ->
+ fill_slot_proc(Proc, ProcType, DeclModule, Name,
+ Arity, ModeNumber)
+ ;
+
+ fill_slot(proc_type, List, ProcType),
+ fill_slot(decl_module, List, DeclModule),
+ fill_slot(name, List, Name),
+ fill_slot(arity, List, Arity),
+ fill_slot(mode_number, List, ModeNumber)
+ ),
+ fill_slot(det, List, Det),
+ Args = '-', % no forward filtering on arguments yet
+ fill_slot(goal_path, List, GoalPath),
+ fget_ll(Chrono, Call, Depth, Port, ProcType, DeclModule, DefModule,
+ Name, Arity, ModeNumber, Det, Args, GoalPath).
+
+
+fill_slot(SlotName, [Head | Tail], Res) :-
+ Head = (SlotAlias = Value),
+ ( is_alias_for(SlotName, SlotAlias) ->
+ Res = Value
+ ;
+ fill_slot(SlotName, Tail, Res)
+ ).
+fill_slot(SlotName, [], -).
+
+
+fill_slot_proc(Proc, ProcType, DeclModule, Pred, Arity, ModeNumber) :-
+ (
+ Proc = (PT->M:(P/A-MN)),
+ ProcType = PT,
+ DeclModule = M,
+ Pred = P,
+ Arity = A,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = M:(P/A-MN),
+ ProcType = -,
+ DeclModule = M,
+ Pred = P,
+ Arity = A,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = (PT->(P/A-MN)),
+ ProcType = PT,
+ DeclModule = -,
+ Pred = P,
+ Arity = A,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = (PT->M:(P-MN)),
+ ProcType = PT,
+ DeclModule = M,
+ Pred = P,
+ Arity = -,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = (PT->M:(P/A)),
+ ProcType = PT,
+ DeclModule = M,
+ Pred = P,
+ Arity = A,
+ ModeNumber = -,
+ !
+ ;
+ Proc = (P/A-MN),
+ ProcType = -,
+ DeclModule = -,
+ Pred = P,
+ Arity = A,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = M:(P-MN),
+ ProcType = -,
+ DeclModule = M,
+ Pred = P,
+ Arity = -,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = M:(P/A),
+ ProcType = -,
+ DeclModule = M,
+ Pred = P,
+ Arity = A,
+ ModeNumber = -,
+ !
+ ;
+ Proc = (PT->(P-MN)),
+ ProcType = PT,
+ DeclModule = -,
+ Pred = P,
+ Arity = -,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = (PT->(P/A)),
+ ProcType = PT,
+ DeclModule = -,
+ Pred = P,
+ Arity = A,
+ ModeNumber = -,
+ !
+ ;
+ Proc = (PT->M:P),
+ ProcType = PT,
+ DeclModule = M,
+ Pred = P,
+ Arity = -,
+ ModeNumber = -,
+ !
+ ;
+ Proc = (PT->P),
+ ProcType = PT,
+ DeclModule = -,
+ Pred = P,
+ Arity = -,
+ ModeNumber = -,
+ !
+ ;
+ Proc = M:P,
+ ProcType = -,
+ DeclModule = M,
+ Pred = P,
+ Arity = -,
+ ModeNumber = -,
+ !
+ ;
+ Proc = P/A,
+ ProcType = -,
+ DeclModule = -,
+ Pred = P,
+ Arity = A,
+ ModeNumber = -,
+ !
+ ;
+ Proc = P-MN,
+ ProcType = -,
+ DeclModule = -,
+ Pred = P,
+ Arity = -,
+ ModeNumber = MN,
+ !
+ ;
+ Proc = P,
+ ProcType = -,
+ DeclModule = -,
+ Pred = P,
+ Arity = -,
+ ModeNumber = -
+ ).
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : det_fget,
+ arg_list : [List],
+ arg_type_list : [is_list_or_conj_of_attribute_constraints_fget],
+ abbrev : _,
+ interface : menu,
+ command_type : trace,
+ implementation : det_fget_Op,
+ parameters : [],
+ message :
+"It is the deterministic version of fget/1.\
+"
+ ).
+
+det_fget_Op(List) :-
+ fget_Op(List),
+ !.
+
+%------------------------------------------------------------------------------%
+opium_type(
+ name : is_list_or_conj_of_attribute_constraints_fget,
+ implementation : is_list_or_conj_of_attribute_constraints_fget_Op,
+ message :
+"Type which succeeds for list or conjunctions of terms of the form: \
+\"AttributeAlias = Term\", where AttributeAlias is an alias \
+of a Mercury event attribute and Term is a variable, \
+an exact value, a negated value, a list of values, or an interval \
+(Bottom..Up). \
+Example:\n\
+fget(chrono=[20, 789] and depth=3..6 and name=foo and arity=not(2)), \
+which can also be typed fget([chrono=[20, 789], depth=3..6, name=foo, \
+arity=not(2)])\
+"
+ ).
+
+is_list_or_conj_of_attribute_constraints_fget_Op(ListOrConj) :-
+ (
+ is_list(ListOrConj),
+ is_list_of_attribute_constraints(ListOrConj),
+ !
+ ;
+ is_conj_of_attribute_constraints(ListOrConj)
+ ).
+
+is_list_of_attribute_constraints([]).
+is_list_of_attribute_constraints([H | T]) :-
+ H = (Alias = AttributeConstraints),
+ is_alias_for(Attribute, Alias),
+ is_a_fget_attribute_constraint(Attribute, AttributeConstraints),
+ is_list_of_attribute_constraints(T).
+
+is_conj_of_attribute_constraints(Alias = AttributeConstraints and Tail) :-
+ is_alias_for(Attribute, Alias),
+ is_a_fget_attribute_constraint(Attribute, AttributeConstraints),
+ is_conj_of_attribute_constraints(Tail).
+is_conj_of_attribute_constraints(Alias = AttributeConstraints) :-
+ is_alias_for(Attribute, Alias),
+ is_a_fget_attribute_constraint(Attribute, AttributeConstraints).
+is_conj_of_attribute_constraints(-).
+
+
+is_a_fget_attribute_constraint(Attribute, AttributeConstraints) :-
+ (
+ member(Attribute, [chrono, call, depth, arity, mode_number]),
+ is_integer_attribute(AttributeConstraints),
+ !
+ ;
+ member(Attribute, [decl_module, def_module, name]),
+ is_atom_attribute(AttributeConstraints),
+ !
+ ;
+ Attribute = proc_type,
+ is_proc_type_attribute(AttributeConstraints),
+ !
+ ;
+ Attribute = proc,
+ is_proc(AttributeConstraints),
+ !
+ ;
+ Attribute = goal_path,
+ is_goal_path_attribute(AttributeConstraints),
+ !
+ ;
+ Attribute = port,
+ is_port_attribute(AttributeConstraints),
+ !
+ ;
+ Attribute = det,
+ is_det_marker_attribute(AttributeConstraints)
+ ).
+
+
+%------------------------------------------------------------------------------%
+% opium_command(
+% name : fget,
+% arg_list : [Chrono, Call, Depth, Port, Module, Predicate, Arity,
+% ModeNumber, Deter, LiveArgs, GoalPath],
+% arg_type_list : [is_integer_attribute, is_integer_attribute,
+% is_integer_attribute, is_port_attribute,
+% is_atom_attribute, is_atom_attribute,
+% is_integer_attribute, is_integer_attribute,
+% is_det_marker_attribute, is_arg_attribute,
+% is_string_attribute],
+% abbrev : fg,
+% interface : menu,
+% command_type : trace,
+% implementation : fget_ll,
+% parameters : [],
+% message :
+% "Moves forwards through the execution until the first \
+% event which matches the specified attribute values or the end of the \
+% trace execution is encountered and print a trace event. This command is \
+% backtrackable \
+% \n\
+% \n\
+% If an argument (corresponding to an attribute) is:\n\
+% \n\
+% 1) '-' or a variable: \n\
+% Pre-filtering does not take this attribute into account.\n\
+% 2) An exact value: \n\
+% Pre-filtering will check that the retrieved value of the current\n\
+% event unifies with the required value.\n\
+% 3) a negated value (not(v) or \\+(v)):\n\
+% Pre-filtering will check that the retrieved value of the current\n\
+% event does not unify with the required value.\n\
+% 4) A list of possible values ([v1, v2, ...]):\n\
+% Pre-filtering will check that the retrieved value of the current \n\
+% event unifies with one of the element of the list.\n\
+% \n\
+% For integer attributes (e.g. chrono, call, depth, arity, mode_number \n\
+% and line_number, we can also specify:\n\
+% \n\
+% *) An interval ('Bottom..Up'):\n\
+% Pre-filtering will check that the retrieved value of the current \n\
+% event unifies with one of the element of the interval.\n\
+% "
+% ).
+
+fget_ll(Chrono, Call, Depth, Port, PredOrFunc, DeclModule, DefModule, Pred,
+ Arity, ModeNumber, Det, Arg, GoalPath) :-
+ (
+ ( not(Port == '-') ->
+ convert_mercury_port_opium_port(MercuryPort, Port)
+ ;
+ MercuryPort = '-'
+ ),
+ ( not(Det == '-') ->
+ convert_integer_determinism(IntDet, Det)
+ ;
+ IntDet = '-'
+ ),
+ ( not(GoalPath == '-') ->
+ convert_goal_path_string_list(GoalPathList, GoalPath)
+ ;
+ GoalPathList = '-'
+ ),
+
+ build_request_forward(Chrono, Call, Depth, MercuryPort, PredOrFunc,
+ DeclModule, DefModule, Pred, Arity, ModeNumber,
+ IntDet, Arg, GoalPathList, Request),
+
+ send_message_to_socket(Request),
+ read_message_from_socket(Response),
+
+ (
+ Response = forward_move_match_found
+ ->
+ true
+ ;
+ % [EOT] Maybe the response should rather be eot to be homogeneous with
+ % the response done to a current_slots query when eot is reached.
+ Response = forward_move_match_not_found
+ ->
+ write("last event is reached\n"),
+ setval(state_of_opium, eot),
+ % we should not end the connection anymore here when [EOT] is fix
+ end_connection,
+ fail
+ ;
+ Response = error(ErrorMessage)
+ ->
+ write(stderr, "Error in fget_ll/13 (forward_move.op)\n"),
+ write(stderr, " An error occured in the Mercury process: "),
+ write(stderr, ErrorMessage),
+ opium_abort
+ ;
+ write(stderr, "Error in fget_ll/13 (forward_move.op)\n"),
+ write(stderr, "The Mercury process sends: "),
+ write(stderr, Response),
+ write(stderr, "\n"),
+ opium_abort
+ )
+ ;
+ % to make fget backtrackable.
+ ( getval(state_of_opium, running) ->
+ fget_ll(Chrono, Call, Depth, Port, PredOrFunc, DeclModule,
+ DefModule, Pred, Arity, ModeNumber, Det, Arg, GoalPath)
+ ;
+ fail, !
+ )
+ ).
+
+
+%------------------------------------------------------------------------------%
+% :- pred convert_goal_path_string_list(string, list(T)).
+% :- mode convert_goal_path_string_list(out, in) is semidet.
+% The Mercury process sends a string whereas we want to manipulate the goal
+% path as a list. This predicate makes the conversion.
+convert_goal_path_string_list(String, List) :-
+ (
+ is_list_of_lists(List),
+ convert_goal_path_string_list_list(String, List),
+ !
+ ;
+ is_negated_value(List, NegList),
+ convert_goal_path_string_list_exact(NegString, NegList),
+ String = not(NegString),
+ !
+ ;
+ is_exact_value(List),
+ convert_goal_path_string_list_exact(String, List),
+ !
+ ;
+ List == '-',
+ String = '-',
+ !
+ ;
+ % Should never occurs.
+ write(stderr, "Software error in Opium-M.\n"),
+ write(stderr, "--> convert_integer_determinism_/2\n"),
+ opium_abort
+ ).
+
+% :- pred convert_goal_path_string_list_list(list(integer), list(determinism)).
+% :- mode convert_goal_path_string_list_list(out, in) is semidet.
+convert_goal_path_string_list_list([X | XTail], [Y | YTail]) :-
+ convert_goal_path_string_list_exact(X, Y),
+ convert_goal_path_string_list_list(XTail, YTail).
+convert_goal_path_string_list_list([], []).
+
+%:- pred convert_goal_path_string_list_exact(string, list(T)).
+%:- mode convert_goal_path_string_list_exact(out, in) is det.
+convert_goal_path_string_list_exact(String, [X|Xs]) :-
+ atom_string(X, Str),
+ append_strings(Str, ";",Str1),
+ convert_goal_path_string_list_exact(Str2, Xs),
+ append_strings(Str1, Str2, String).
+convert_goal_path_string_list_exact("", []).
+
+
+%------------------------------------------------------------------------------%
+% :- pred convert_integer_determinism(integer, determinism).
+% :- mode convert_integer_determinism(out, in) is semidet.
+convert_integer_determinism(IntDet, Det) :-
+ (
+ Det = '-',
+ IntDet = '-',
+ !
+ ;
+ is_list(Det),
+ convert_integer_determinism_list(IntDet, Det),
+ !
+ ;
+ is_negated_value(Det, NegDet),
+ convert_integer_determinism_exact(NegIntDet, NegDet),
+ IntDet = not(NegIntDet),
+ !
+ ;
+ is_exact_value(Det),
+ convert_integer_determinism_exact(IntDet, Det),
+ !
+ ;
+ % Should never occurs.
+ write(stderr, "Software error in Opium-M.\n"),
+ write(stderr, "--> convert_integer_determinism_/2\n"),
+ opium_abort
+ ).
+
+% :- pred convert_integer_determinism_list(list(integer), list(determinism)).
+% :- mode convert_integer_determinism_list(out, in) is semidet.
+% The mercury process sends an integer coding the determinism. This predicate
+% makes the conversion.
+convert_integer_determinism_list([IntDet | IntDetTail], [Det | DetTail]) :-
+ convert_integer_determinism_exact(IntDet, Det),
+ convert_integer_determinism_list(IntDetTail, DetTail).
+convert_integer_determinism_list([], []).
+
+
+% See runtime/mercury_stack_layout.h and compiler/stack_layout.m.
+%:- pred convert_integer_determinism_exact(integer, atom).
+%:- mode convert_integer_determinism_exact(out, in) is semidet.
+%:- mode convert_integer_determinism_exact(in, out) is semidet.
+convert_integer_determinism_exact(-, -) :-
+ !.
+convert_integer_determinism_exact(0, OpiumAtt) :-
+ (OpiumAtt = failure ; OpiumAtt = 'FAIL'),
+ !.
+convert_integer_determinism_exact(2, OpiumAtt) :-
+ (OpiumAtt = semidet ; OpiumAtt = 'SEMI'),
+ !.
+convert_integer_determinism_exact(3, OpiumAtt) :-
+ (OpiumAtt = nondet ; OpiumAtt = 'NON'),
+ !.
+convert_integer_determinism_exact(4, OpiumAtt) :-
+ (OpiumAtt = erroneous ; OpiumAtt = 'ERR'),
+ !.
+convert_integer_determinism_exact(6, OpiumAtt) :-
+ (OpiumAtt = det ; OpiumAtt = 'DET'),
+ !.
+convert_integer_determinism_exact(7, OpiumAtt) :-
+ (OpiumAtt = multidet ; OpiumAtt = 'MUL'),
+ !.
+convert_integer_determinism_exact(10, OpiumAtt) :-
+ (OpiumAtt = cc_nondet ; OpiumAtt = 'CCNON'),
+ !.
+convert_integer_determinism_exact(14, OpiumAtt) :-
+ (OpiumAtt = cc_multidet ; OpiumAtt = 'CCMUL'),
+ !.
+
+
+%------------------------------------------------------------------------------%
+%:- pred convert_mercury_port_opium_port(mercury_port, opium_port).
+%:- mode convert_mercury_port_opium_port(out, in) is det.
+convert_mercury_port_opium_port(Mport, Oport) :-
+ (
+ Oport = '-',
+ Mport = '-',
+ !
+ ;
+ is_list(Oport),
+ convert_mercury_port_opium_port_list(Mport, Oport),
+ !
+ ;
+ is_negated_value(Oport, NegOport),
+ convert_mercury_port_opium_port(NegMport, NegOport),
+ Mport = not(NegMport),
+ !
+ ;
+ is_exact_value(Oport),
+ convert_mercury_port_opium_port_exact(Mport, Oport),
+ !
+ ;
+ write(stderr, "Software error in Opium-M !\n"),
+ write(stderr, "--> convert_mercury_port_opium_port/2 \n"),
+ opium_abort
+ ).
+
+%:- pred convert_mercury_port_opium_port_list(list(mercury_port),
+% list(opium_port)).
+%:- mode convert_mercury_port_opium_port_list(out, in) is semidet.
+convert_mercury_port_opium_port_list([], []).
+convert_mercury_port_opium_port_list([Mport | MportTail],
+ [Oport | OportTail]) :-
+ convert_mercury_port_opium_port_exact(Mport, Oport),
+ convert_mercury_port_opium_port_list(MportTail, OportTail).
+
+%:- pred convert_mercury_port_opium_port_exact(trace_port_type, atom).
+%:- mode convert_mercury_port_opium_port_exact(in, out) is semidet.
+%:- mode convert_mercury_port_opium_port_exact(out, in) is semidet.
+convert_mercury_port_opium_port_exact(-, -) :-
+ !.
+convert_mercury_port_opium_port_exact(call, Ocall) :-
+ (Ocall = call ; Ocall = 'CALL'),
+ !.
+convert_mercury_port_opium_port_exact(exit, Oexit) :-
+ (Oexit = exit ; Oexit = 'EXIT'),
+ !.
+convert_mercury_port_opium_port_exact(redo, Oredo) :-
+ (Oredo = redo ; Oredo = 'REDO'),
+ !.
+convert_mercury_port_opium_port_exact(fail, Ofail) :-
+ (Ofail = fail ; Ofail = 'FAIL'),
+ !.
+convert_mercury_port_opium_port_exact(ite_cond, Ocond) :-
+ (Ocond = cond ; Ocond = 'COND'),
+ !.
+convert_mercury_port_opium_port_exact(ite_then, Othen) :-
+ (Othen = then ; Othen = 'THEN'),
+ !.
+convert_mercury_port_opium_port_exact(ite_else, Oelse) :-
+ (Oelse = else ; Oelse = 'ELSE'),
+ !.
+convert_mercury_port_opium_port_exact(neg_enter, Oneg_enter) :-
+ (Oneg_enter = neg_enter ; Oneg_enter = 'NEGE'),
+ !.
+convert_mercury_port_opium_port_exact(neg_success, Oneg_success) :-
+ (Oneg_success = neg_success ; Oneg_success = 'NEGS'),
+ !.
+convert_mercury_port_opium_port_exact(neg_failure, Oneg_failure) :-
+ (Oneg_failure = neg_failure ; Oneg_failure = 'NEGF'),
+ !.
+convert_mercury_port_opium_port_exact(disj, Odisj) :-
+ (Odisj = disj ; Odisj = 'DISJ'),
+ !.
+convert_mercury_port_opium_port_exact(switch, Oswitch) :-
+ (Oswitch = switch ; Oswitch = 'SWITCH' ; Oswitch = 'SWTC'),
+ !.
+convert_mercury_port_opium_port_exact(nondet_pragma_first, Ofirst) :-
+ (Ofirst = first ; Ofirst = 'FIRST' ; Ofirst = 'FRST'),
+ !.
+convert_mercury_port_opium_port_exact(nondet_pragma_later, Olater) :-
+ (Olater = later ; Olater = 'LATER' ; Olater = 'LATR'),
+ !.
+convert_mercury_port_opium_port_exact(exception, Oexception) :-
+ (Oexception = exception ; Oexception = 'EXCEPTION' ;
+ Oexception = 'EXCP'),
+ !.
+
+
+%------------------------------------------------------------------------------%
+% :- pred build_request_forward(atom, ..., atom, request_type)
+% :- mode build_request_forward(in, ..., in, out) is semidet.
+build_request_forward(Chrono, Call, Depth, Port, PredOrFunc, DeclModule,
+ DefModule, Name, Arity, ModeNumber, Determinism, Arg, GoalPath,
+ Request) :-
+
+ attribute_to_match(Chrono, ChronoMatch),
+ attribute_to_match(Call, CallMatch),
+ attribute_to_match(Depth, DepthMatch),
+ attribute_to_match(Port, PortMatch),
+ attribute_to_match(PredOrFunc, PredOrFuncMatch),
+ attribute_to_match_str(DeclModule, DeclModuleMatch),
+ attribute_to_match_str(DefModule, DefModuleMatch),
+ attribute_to_match_str(Name, NameMatch),
+ attribute_to_match(Arity, ArityMatch),
+ attribute_to_match(ModeNumber, ModeNumberMatch),
+ attribute_to_match(Determinism, DeterminismMatch),
+ % attribute_to_match(Arg, ArgMatch),
+ ArgMatch = nop, % XXX we currently don't handle arguments
+ % filtering
+ attribute_to_match_gp(GoalPath, GoalPathMatch),
+
+ Request = forward_move(
+ ChronoMatch,
+ CallMatch,
+ DepthMatch,
+ PortMatch,
+ match_user_pred(PredOrFuncMatch, DeclModuleMatch),
+ DefModuleMatch,
+ NameMatch,
+ ArityMatch,
+ ModeNumberMatch,
+ DeterminismMatch,
+ ArgMatch,
+ GoalPathMatch).
+
+
+% :- pred attribute_to_match(attribute, attribute_match_type).
+% :- mode attribute_to_match(in, out) is (semi)det.
+attribute_to_match(Attribute, AttributeMatch) :-
+ (
+ Attribute = '-',
+ AttributeMatch = nop,
+ !
+ ;
+ is_list(Attribute),
+ AttributeMatch = list(Attribute),
+ !
+ ;
+ is_negated_value(Attribute, AttributeNeg),
+ AttributeMatch = neg(AttributeNeg),
+ !
+ ;
+ is_interval(Attribute, L, H),
+ AttributeMatch = interval(L, H),
+ !
+ ;
+ is_exact_value(Attribute),
+ AttributeMatch = exact(Attribute),
+ !
+ ;
+ write(stderr, "Software error in Opium-M !\n"),
+ write(stderr, "--> attribute_to_match/2 \n"),
+ opium_abort
+ ).
+
+
+% :- pred is_list_of_lists(attribute).
+% :- mode is_list_of_lists(in) is semidet.
+is_list_of_lists([X|Xs]) :-
+ is_list(X),
+ is_list_of_lists(Xs).
+
+is_list_of_lists([]).
+
+
+% :- pred is_negated_value(attribute, attribute).
+% :- mode is_negated_value(in, out) is semidet.
+is_negated_value(Attribute, AttributeNeg) :-
+ Attribute = not(AttributeNeg)
+ ;
+ Attribute = (\+ AttributeNeg).
+
+
+% :- pred is_interval(attribute, integer, integer).
+% :- mode is_interval(in, out, out) is semidet.
+is_interval(Attribute, Bottom, Up) :-
+ not(free(Attribute)),
+ Attribute = Bottom .. Up,
+ not(free(Bottom)),
+ not(free(Up)).
+
+
+% :- pred is_exact_value(attribute).
+% :- mode is_exact_value(in) is semidet.
+is_exact_value(Attribute) :-
+ Attribute = ValueAttribute,
+ not(nonground(ValueAttribute)).
+
+
+% :- pred attribute_to_match_str(attribute, attribute_match_type).
+% :- mode attribute_to_match_str(in, out) is (semi)det.
+ % For string attributes (name, decl_module, def_module), we need to
+ % convert atoms (foo) into _quoted_ string ('"foo"') before
+ % sending it to Mercury.
+attribute_to_match_str(Attribute, AttributeMatch) :-
+ (
+ Attribute = '-'
+ ->
+ AttributeMatch = nop
+ ;
+ is_list(Attribute)
+ ->
+ maplist(atom_string, Attribute, AttrStr),
+ maplist(quote_string, AttrStr, AttrStrQuoted),
+ AttributeMatch = list(AttrStrQuoted)
+ ;
+ is_negated_value(Attribute, AttributeNeg)
+ ->
+ atom_string(AttributeNeg, AttrNegStr),
+ quote_string(AttrNegStr, AttrNegStrQuoted),
+ AttributeMatch = neg(AttrNegStrQuoted)
+ ;
+ is_exact_value(Attribute)
+ ->
+ atom_string(Attribute, AttrStr),
+ quote_string(AttrStr, AttrStrQuoted),
+ AttributeMatch = exact(AttrStrQuoted)
+ ;
+ write(stderr, "error in forward_move/attribute_to_match_str\n"),
+ opium_abort
+ ).
+
+
+%:- pred quote_string(string, atom).
+%:- mode quote_string(in, out) is det.
+quote_string(String, StringQuoted):-
+ concat_string(["\"", String, "\""], String2),
+ atom_string(StringQuoted, String2).
+
+
+% X Duplicated code: attribute_to_match, attribute_to_match_str and
+% attribute_to_match_gp are nearly the same.
+% :- pred attribute_to_match_gp(attribute, attribute_match_type).
+% :- mode attribute_to_match_gp(in, out) is (semi)det.
+attribute_to_match_gp(Attribute, AttributeMatch) :-
+ (
+ Attribute = '-',
+ AttributeMatch = nop,
+ !
+ ;
+ is_list(Attribute),
+ maplist(quote_string, Attribute, AttrQuoted),
+ AttributeMatch = list(AttrQuoted),
+ !
+ ;
+ is_negated_value(Attribute, AttributeNeg),
+ quote_string(AttributeNeg , AttrNegQuoted),
+ AttributeMatch = neg(AttrNegQuoted),
+ !
+ ;
+ is_exact_value(Attribute),
+ quote_string(Attribute, AttrQuoted),
+ AttributeMatch = exact(AttrQuoted),
+ !
+ ;
+ write(stderr, "Software error in Opium-M !\n"),
+ write(stderr, "--> attribute_to_match_gp/2 \n"),
+ opium_abort
+ ).
+
+det_fget_Op(Chrono, Call, Depth, Port, PredOrFunc, DeclModule, DefModule,
+ Pred, Arity, ModeNumber, Deter, LiveArgs, GoalPath) :-
+ fget_ll(Chrono, Call, Depth, Port, PredOrFunc, DeclModule, DefModule,
+ Pred, Arity, ModeNumber, Deter, LiveArgs, GoalPath),
+ !.
+
+%------------------------------------------------------------------------------%
+% "fget/8 is the same as fget/11 except that the decl_module, predicate name,
+% arity and mode number attributes are replaced by a procedure attribute.
+%
+% Useless ?
+%
+% :- pred fget_Op(attribute, ..., attribute).
+% :- mode fget_Op(?, ...,?) is nondet.
+fget_8(Chrono, Call, Depth, Port, PredOrFunc, DefModule, '-', Det, Arg,
+ GoalPath) :-
+ fget_ll(Chrono, Call, Depth, Port, PredOrFunc, '-', DefModule, '-',
+ '-', '-', Det, Arg, GoalPath).
+
+fget_8(Chrono, Call, Depth, Port, PredOrFunc, DefModule,
+ DeclModule:Pred/Arity-ModeNumber, Det, Arg, GoalPath) :-
+ fget_ll(Chrono, Call, Depth, Port, PredOrFunc, DeclModule,
+ DefModule, Pred, Arity, ModeNumber, Det, Arg, GoalPath).
+
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : retry,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : button,
+ command_type : trace,
+ implementation : retry_Op,
+ parameters : [],
+ message :
+"Restarts execution at the call port of the current goal.\
+\n\
+The command will fail unless the values of all the input arguments are \
+available at the current port. (The compiler will keep the values of the input \
+arguments of traced procedures as long as possible, but it cannot keep them \
+beyond the point where they are destructively updated.) \n\
+\n\
+The debugger can perform a retry only from an exit or fail port; only at these \
+ports does the debugger have enough information to figure out how to reset the \
+stacks. If the debugger is not at such a port when a retry command is given, \
+the debugger will continue forward execution until it reaches an exit or fail \
+port of the call to be retried before it performs the retry. This may require \
+a noticeable amount of time. \
+"
+ ).
+
+retry_Op :-
+ getval(state_of_opium, running),
+ send_message_to_socket(retry),
+ read_message_from_socket(Message),
+ (
+ Message = ok
+ ;
+ Message = error(ErrorMessage),
+ write(ErrorMessage),
+ nl,
+ fail
+ ),
+ !.
+
Index: extras/opium_m/source/help.op
===================================================================
RCS file: help.op
diff -N help.op
--- /dev/null Wed May 28 10:49:58 1997
+++ help.op Tue Oct 26 23:26:39 1999
@@ -0,0 +1,861 @@
+/*
+ * $Header: help.op,v 1.43 93/07/22 17:04:57 mireille Exp $
+ * 1990 Copyright ECRC GmbH
+ */
+
+
+/*
+ * HELP Scenario
+ *
+ * In the case of a Window User Interface much of the help is given
+ * implicitely by the menus and buttons, only man and manual are still
+ * required.
+ *
+ */
+opium_scenario(
+ name : help,
+ files : [help],
+ scenarios : [],
+ message :
+"Scenario which provides the user with on-line help. There is also the \n\
+facility to get a printed version of the Opium manual."
+ ).
+
+
+/*
+ * OPIUM-HELP
+ */
+opium_command(
+ name : opium_help,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : hidden,
+ command_type : opium,
+ implementation : help_Op,
+ parameters : [],
+ message :
+"Command which shows the help commands."
+ ).
+
+:- tool(show_all/2).
+
+help_Op :-
+ opium_write(help,
+ "\nThere are the following help commands for Opium-M: \n"),
+ show_all(commands, help),
+
+ % I copied this message here because I found no way to extend the
+ % help/0 command by using its previous definition.
+ opium_write(help, "\nAnd here is the help message for ECLiPSe: \n\n"),
+ opium_write(help,
+ " After the prompt [<module>]: ECLiPSe waits for a goal.\n"),
+ opium_write(help,
+ " To type in clauses, call [user] or compile(user), and then\n"),
+ opium_write(help,
+ " enter the clauses ended by ^D (EOF).\n\n"),
+ opium_write(help,
+ " Call help(Pred/Arity) or help(Pred) or help(String)\n"),
+ opium_write(help,
+ " to get help on a specific built-in predicate.\n\n"),
+ opium_write(help,
+ " Call demo (in xeclipse) to invoke the demo programs.\n\n"),
+ opium_write(help,
+ " This message can be modified by setting the handler for event 231.\n").
+
+
+/* if a user types "help" he will see opium_help and not the sepia help
+ * opium_help is explicitly defined here, only so that the error handler
+ * does not complain that it does not exist. The actual command is generated
+ * automatically and overwrites this.
+*/
+opium_help :- help_Op.
+
+:- set_error_handler(231, opium_help/0).
+
+/*
+ * SHOW-ALL (Type)
+ */
+opium_command(
+ name : show_all,
+ arg_list : [ObjectType],
+ arg_type_list : [is_member([modules, scenarios, commands, primitives,
+ procedures, parameters, types, demos])],
+ abbrev : _,
+ interface : button,
+ command_type : opium,
+ implementation : show_all_Op,
+ parameters : [],
+ message :
+"Command which shows all the Opium objects of a certain type, together \n\
+with their arguments and their abbreviations if these exist."
+ ).
+
+show_all_Op(modules) :-
+ opium_nl(help),
+ opium_module(M),
+ opium_printf(help, "%w\n", [M]),
+ fail.
+show_all_Op(modules) :-
+ opium_nl(help),
+ !.
+show_all_Op(scenarios) :-
+ opium_nl(help),
+ opium_scenario_in_module((name:S,_,_,_,_,_), Mod),
+ opium_printf(help, "%w \tin %w\n", [S, Mod]),
+ fail.
+show_all_Op(scenarios) :-
+ opium_nl(help),
+ !.
+show_all_Op(Type) :- % for command, procedure, parameter, primitive, type, demo
+ opium_scenario_in_module((name:Scenario,_,_,_,_,_), Module),
+ show_all_in_module_int(Type, Scenario, Module, scenario, Scenario),
+ fail.
+show_all_Op(_) :-
+ opium_nl(help).
+
+
+/*
+ * SHOW-ALL(Type, Scenario)
+ */
+opium_command(
+ name : show_all,
+ arg_list : [ObjectType, Scenario],
+ arg_type_list : [is_member([commands, procedures, primitives,
+ parameters, types, demos]), is_opium_scenario],
+ abbrev : _,
+ interface : menu,
+ command_type : tool,
+ implementation : show_all_Op,
+ parameters : [],
+ message :
+"Command which shows all the Opium objects of a certain type related to \n\
+Scenario if Scenario is visible in the current module."
+ ).
+
+show_all_Op(Type, Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_,_,_,_), Module),
+ !,
+ show_all_in_module_Op(Type, Scenario, Module).
+show_all_Op(Type, Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_,options:[_,_,global],_,_), Mod),
+ Mod \== Module,
+ show_all_in_module_Op(Type, Scenario, Mod).
+show_all_Op(Type, Scenario, Module).
+
+
+/*
+ * SHOW-ALL-IN-MODULE(Scenario, Module)
+ */
+opium_command(
+ name : show_all_in_module,
+ arg_list : [ObjectType, Scenario, Module],
+ arg_type_list : [is_member([commands, procedures, primitives,
+ parameters, types, demos]),
+ is_opium_scenario, is_opium_module],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : show_all_in_module_Op,
+ parameters : [],
+ message :
+"Command which shows all the Opium objects of a certain type related to \n\
+Scenario loaded in a given module."
+ ).
+
+show_all_in_module_Op(Type, Scenario, Module) :-
+ one_object_exists_in_module(Type, Scenario, Module),
+ !,
+ show_all_in_module_int(Type, Scenario, Module, scenario, Scenario),
+ opium_nl(help).
+show_all_in_module_Op(_, _, _).
+
+show_all_in_module_int(Type, Scenario, Module, Header, Value) :-
+ one_object_exists_in_module(Type, Scenario, Module),
+ !,
+ opium_nl(help),
+ print_header(tty, Header, Value, Module),
+ actually_list_all(Type, Scenario, Module).
+show_all_in_module_int(_, _, _, _, _).
+
+actually_list_all(Type, Scenario, Module) :-
+ get_help_info(Type, Name, ArgList, ArgType, Abbrev, Scenario, Module, Message, DefaultValue, ObjType),
+ opium_write(help, " "),
+ print_syntax(tty, Name, ArgList, Abbrev, Type),
+ fail.
+actually_list_all(_, _, _).
+
+
+
+/*
+ * SHOW-ABBREVIATIONS
+ */
+opium_command(
+ name : show_abbreviations,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : abbrevs,
+ interface : menu,
+ command_type : opium,
+ implementation : show_abbreviations_Op,
+ parameters : [],
+ message :
+"Command which shows all the abbreviations of Opium commands and primitives."
+ ).
+
+show_abbreviations_Op :-
+ opium_scenario_in_module((name:Scenario, _, _, _, _, _), Module),
+ one_object_exists_in_module(abbreviations, Scenario, Module),
+ opium_nl(help),
+ print_header(tty, scenario, Scenario, Module),
+ list_abbrevs(Scenario, Module),
+ fail.
+show_abbreviations_Op :-
+ opium_nl(help).
+
+
+/*
+ * SHOW-ABBREVIATIONS(Scenario)
+ */
+opium_command(
+ name : show_abbreviations,
+ arg_list : [Scenario],
+ arg_type_list : [is_opium_scenario],
+ abbrev : abbrevs,
+ interface : menu,
+ command_type : tool,
+ implementation : show_abbreviations_Op,
+ parameters : [],
+ message :
+"Command which shows all the abbreviations of commands and primitives related \n\
+to Scenario if Scenario is visible in the current module."
+ ).
+
+show_abbreviations_Op(Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_,_,_,_), Module),
+ !,
+ show_abbreviations_in_module(Scenario, Module).
+show_abbreviations_Op(Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_,options:[_,_,global],_,_), Mod),
+ !,
+ show_abbreviations_in_module(Scenario, Mod).
+
+
+/*
+ * SHOW-ABBREVIATIONS-IN-MODULE(Scenario, Module)
+ */
+opium_command(
+ name : show_abbreviations_in_module,
+ arg_list : [Scenario, Module],
+ arg_type_list : [is_opium_scenario, is_opium_module],
+ abbrev : abbrevs,
+ interface : menu,
+ command_type : opium,
+ implementation : show_abbreviations_in_module_Op,
+ parameters : [],
+ message :
+"Command which shows all the abbreviations of commands and primitives related \n\
+to Scenario in a given module."
+ ).
+
+show_abbreviations_in_module_Op(Scenario, Module) :-
+ opium_nl(help),
+ print_header(tty, scenario, Scenario, Module),
+ list_abbrevs(Scenario, Module),
+ opium_nl(help).
+
+list_abbrevs(Scenario, Module) :-
+ get_help_info(commands, Name, ArgList, _, Abbrev, Scenario, Module, _, _, _),
+ not(var(Abbrev)),
+ opium_write(help, " "),
+ print_syntax(tty, Name, ArgList, Abbrev, command),
+ fail.
+list_abbrevs(Scenario, Module) :-
+ get_help_info(primitives, Name, ArgList, _, Abbrev, Scenario, Module, _, _, _),
+ not(var(Abbrev)),
+ opium_write(help, " "),
+ print_syntax(tty, Name, ArgList, Abbrev, command),
+ fail.
+list_abbrevs(Scenario, Module).
+
+
+
+/*
+ * MAN
+ */
+opium_command(
+ name : man,
+ arg_list : [Name],
+ arg_type_list : [is_opium_object_or_var],
+ abbrev : _,
+ interface : button,
+ command_type : opium,
+ implementation : man_Op,
+ parameters : [],
+ message :
+"Command which describes a scenario, a command, a primitive, a procedure, a \n\
+parameter, or a type. For a scenario it gives the corresponding commands, \n\
+parameters, primitives, procedures, and types. For the other objects it \n\
+gives the corresponding scenario." ).
+
+man_Op(X) :-
+ man_int(X),
+ fail.
+man_Op(X) :-
+ opium_nl(help).
+
+% To avoid typing brackets when using the man command.
+:- op(1190, fy, man).
+
+/*
+ * man_int/1
+ * print help information on object with name Name
+ */
+man_int(Name) :-
+ opium_scenario_in_module((
+ name : Name,
+ files : F,
+ scenarios : S,
+ options : OptionList,
+ updated : T,
+ message : Message), Module),
+ opium_nl(help),
+ print_header(tty, scenario, Name, Module),
+ print_man(tty, [], [], Message, [], []),
+ opium_printf(help, "current options : %w\n", [OptionList]),
+ show_all_in_module_int(commands, Name, Module, commands, ''),
+ show_all_in_module_int(primitives, Name, Module, primitives, ''),
+ show_all_in_module_int(parameters, Name, Module, parameters, ''),
+ show_all_in_module_int(procedures, Name, Module, procedures, ''),
+ show_all_in_module_int(types, Name, Module, types, ''),
+ show_all_in_module_int(demos, Name, Module, demos, '').
+man_int(Name) :-
+ get_help_info(Type, Name, ArgList, ArgType, Abbrev, Scenario, Module, Message, DefaultValue, ObjType),
+ opium_nl(help),
+ print_syntax(tty, Name, ArgList, Abbrev, Type),
+ print_man(tty, ArgList, ArgType, Message, DefaultValue, ObjType),
+ print_header(tty, scenario, Scenario, Module).
+
+
+/*
+ * MANUAL
+ */
+opium_command(
+ name : manual,
+ arg_list : [File],
+ arg_type_list : [atom],
+ abbrev : _,
+ interface : button,
+ command_type : opium,
+ implementation : manual_Op,
+ parameters : [],
+ message :
+"Command which shows all the scenarios, their commands and the corresponding \n\
+explanations in the file \"File\" (in LaTeX format). It also does some fixes \n\
+in the LaTeX file. The LaTeX file will then be called <File>.tex afterwards. \n\
+In order to get a printable <File>.dvi, use command latex_manual/1."
+ ).
+
+manual_Op(tty) :-
+ opium_write(error, "tty is not a good name for the manual\n"),
+ !,
+ fail.
+manual_Op(File) :-
+ open(File, write, Manual),
+ writeln(Manual, "\\documentstyle[11pt, makeidx]{article}"),
+ writeln(Manual, "\\parindent 0cm"),
+ writeln(Manual, "\\parskip 0.4cm"),
+ writeln(Manual, "\\textwidth 16cm"),
+ writeln(Manual, "\\oddsidemargin 0cm"),
+ writeln(Manual, "\\topmargin 0cm"),
+ writeln(Manual, "\\textheight 23cm"),
+ writeln(Manual, "\\makeindex"),
+ writeln(Manual, "\\begin{document}"),
+ writeln(Manual, "\\title{Opium -- Reference Manual}"),
+ writeln(Manual, "\\author{}"),
+ writeln(Manual, "\\maketitle"),
+ index_type_labels(Manual),
+ manual_int(Manual),
+ writeln(Manual, "\\printindex"),
+ writeln(Manual, "\\tableofcontents"),
+ writeln(Manual, "\\end{document}"),
+ close(Manual),
+ concat_atom([fixmanual, ' ', File, '> /dev/null'], Cmd1),
+ system(Cmd1),
+ concat_atom([File, '.tex'], LatexFile),
+ concat_atom(['rm -f ', LatexFile], Cmd2),
+ system(Cmd2),
+ concat_atom(['mv ', File, ' ', LatexFile], Cmd3),
+ system(Cmd3).
+
+manual_int(Manual) :-
+ opium_scenario_in_module((name: Scenario,_,_,_,_, message:Message), Module),
+ printf(Manual, "\\section{Scenario \"%w\" in module %w}\n", [Scenario, Module]),
+ printf(Manual, "\\index{%w}\n", [Scenario]),
+ index_type(scenarios, IndexType),
+ printf(Manual, "\\index{%w : %w}\n", [IndexType, Scenario]),
+ write(Manual, Message),
+ write(Manual, '\n\n'),
+ man_all(Manual, commands, Scenario, Module),
+ man_all(Manual, primitives, Scenario, Module),
+ man_all(Manual, procedures, Scenario, Module),
+ man_all(Manual, parameters, Scenario, Module),
+ man_all(Manual, types, Scenario, Module),
+ fail.
+manual_int(Manual).
+
+man_all(Manual, Type, Scenario, Module) :-
+ one_object_exists_in_module(Type, Scenario, Module),
+ !,
+ type_name(Type, TypeName),
+ printf(Manual, "\\subsection*{%w}\n", [TypeName]),
+ actually_man_all(Manual, Type, Scenario, Module).
+man_all(Manual, Type, Scenario, Module).
+
+actually_man_all(Manual, Type, Scenario, Module) :-
+ get_help_info(Type, Name, ArgList, ArgType, Abbrev, Scenario, Module, Message, DefaultValue, ObjType),
+ print_syntax(Manual, Name, ArgList, Abbrev, Type),
+ index_type(Type, IndexType),
+ length(ArgList, Arity),
+ printf(Manual, "\\index{%w : %w/%w}", [IndexType, Name, Arity]),
+ printf(Manual, "\\index{%w : %w/%w}", [Scenario, Name, Arity]),
+ printf(Manual, "\\index{%w/%w}\\\\\n", [Name, Arity]),
+ print_man(Manual, ArgList, ArgType, Message, DefaultValue, ObjType),
+ write(Manual, "\n"),
+ fail.
+actually_man_all(_, _, _, _).
+
+/*
+ * So that the lists of objects sorted by types are at the beginning
+ * of the index.
+ */
+index_type_labels(Manual) :-
+ writeln(Manual, "\\index{1Commands}"),
+ writeln(Manual, "\\index{2Parameters}"),
+ writeln(Manual, "\\index{3Primitives}"),
+ writeln(Manual, "\\index{4Procedures}"),
+ writeln(Manual, "\\index{5Scenarios}"),
+ writeln(Manual, "\\index{6Types}\n").
+
+index_type(commands, '1Commands').
+index_type(parameters, '2Parameters').
+index_type(primitives, '3Primitives').
+index_type(procedures, '4Procedures').
+index_type(scenarios, '5Scenarios').
+index_type(types, '6Types').
+
+type_name(commands, 'Commands').
+type_name(parameters, 'Parameters').
+type_name(primitives, 'Primitives').
+type_name(procedures, 'Procedures').
+type_name(scenarios, 'Scenarios').
+type_name(types, 'Types').
+
+/*
+ * LATEX-MANUAL
+ */
+opium_command(
+ name : latex_manual,
+ arg_list : [File],
+ arg_type_list : [atom],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : latex_manual_Op,
+ parameters : [],
+ message :
+"Command which applies the Unix command \"latex ; makeindex ; latex\" to File, \n\
+where File has been generated by command manual/1. File has to be the name \n\
+of the LaTeX file without extension '.tex'."
+ ).
+
+latex_manual_Op(File) :-
+ concat_atom(['latex ', File, '.tex'], Cmd1),
+ concat_atom(['makeindex ', File, '.idx'], Cmd2),
+ system(Cmd1),
+ system(Cmd2),
+ system(Cmd1).
+
+
+/*
+ * -------------------
+ * u t i l i t i e s
+ * -------------------
+ */
+
+one_object_exists_in_module(commands, Scenario, Module) :-
+ opium_command_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ interface : Interface,
+ command_type : CommandType,
+ scenario : Scenario,
+ implementation : P,
+ parameters : ParList,
+ message : Message ), Module),
+ !.
+one_object_exists_in_module(primitives, Scenario, Module) :-
+ opium_primitive_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ scenario : Scenario,
+ implementation : P,
+ message : Message ), Module),
+ !.
+one_object_exists_in_module(procedures, Scenario, Module) :-
+ opium_procedure_in_module((
+ name : Name,
+ arg_list : ArgList,
+ scenario : Scenario,
+ implementation : P,
+ parameters : ParList,
+ message : Message ), Module),
+ !.
+one_object_exists_in_module(parameters, Scenario, Module) :-
+ opium_parameter_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ scenario : Scenario,
+ parameter_type : ParameterType,
+ default : Default,
+ commands : ComList,
+ message : Message ), Module),
+ !.
+one_object_exists_in_module(types, Scenario, Module) :-
+ opium_type_in_module((
+ name : Name,
+ scenario : Scenario,
+ implementation : P,
+ message : Message ), Module),
+ !.
+one_object_exists_in_module(demos, Scenario, Module) :-
+ opium_demo_in_module((
+ name : Name,
+ demo_goal : Goal,
+ condition : Condition,
+ scenario : Scenario,
+ message : Message ), Module),
+ !.
+one_object_exists_in_module(abbreviations, Scenario, Module) :-
+ opium_command_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ interface : Interface,
+ command_type : CommandType,
+ scenario : Scenario,
+ implementation : P,
+ parameters : ParList,
+ message : Message ), Module),
+ not(var(Abbrev)),
+ !.
+one_object_exists_in_module(abbreviations, Scenario, Module) :-
+ opium_primitive_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ scenario : Scenario,
+ implementation : P,
+ message : Message ), Module),
+ not(var(Abbrev)),
+ !.
+
+/*
+ * To get the information needed for the help in a homogeneous way
+ * The execution must be able to backtrack on this predicate to be able to
+ * find all the objects wanted.
+ */
+get_help_info(commands, Name, ArgList, ArgType, Abbrev, Scenario, Module, Message, [], CmdType) :-
+ opium_command_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ interface : Interface,
+ command_type : CmdType,
+ scenario : Scenario,
+ implementation : P,
+ parameters : ParList,
+ message : Message ), Module).
+get_help_info(primitives, Name, ArgList, ArgType, Abbrev, Scenario, Module, Message, [], []) :-
+ opium_primitive_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ scenario : Scenario,
+ implementation : P,
+ message : Message ), Module).
+get_help_info(procedures, Name, ArgList, [], [], Scenario, Module, Message, [], [] ) :-
+ opium_procedure_in_module((
+ name : Name,
+ arg_list : ArgList,
+ scenario : Scenario,
+ implementation : P,
+ parameters : ParList,
+ message : Message), Module).
+get_help_info(types, Name, [], [], [], Scenario, Module, Message, [], [] ) :-
+ opium_type_in_module((
+ name : Name,
+ scenario : Scenario,
+ implementation : P,
+ message : Message), Module).
+get_help_info(demos, Name, _ArgList, Condition, [], Scenario, Module, Message, Goal, demos) :-
+ opium_demo_in_module((
+ name : Name,
+ demo_goal : Goal,
+ condition : Condition,
+ scenario : Scenario,
+ message : Message ), Module).
+get_help_info(parameters, Name, ArgList, ArgType, [], Scenario, Module, Message, DefaultValue, ParType) :-
+ opium_parameter_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ scenario : Scenario,
+ parameter_type : ParType,
+ default : Default,
+ commands : ComList,
+ message : Message ), Module),
+ get_default_value(Default, DefaultValue, Name).
+
+get_default_value(nodefault, nodefault, _) :-
+ !.
+get_default_value(Default, DefaultValue, Name) :-
+ DefaultValue =.. [Name | Default],
+ !.
+
+
+/*
+ * Print basic formats.
+ * All the following predicates are deterministic.
+ * For the "latex" device, "nl" has to be replaced by "\\"
+ */
+
+opium_procedure(
+ name : print_header,
+ arg_list : [Device, Type, Name, Module],
+ implementation : print_header_Op,
+ parameters : [],
+ message :
+ "Procedure which prints (for on-line and paper manuals) the type of \n\
+the object and whether it is global or local. Essentially used for \n\
+scenarios and in many places."
+ ).
+
+print_header_Op(Device, scenario, Name, Module) :-
+ !,
+ print_scenario_header(Device, Name, Module).
+print_header_Op(tty, Type, Name, _) :-
+ !,
+ opium_printf(help, "%w :\n", [Type]).
+print_header_Op(Manual, Type, Name, _) :-
+ printf(Manual, "{\\bf %w :}\n", [Type]).
+
+print_scenario_header(tty, Scenario, Module) :-
+ !,
+ opium_scenario_in_module((name:Scenario,_,_,options:[_,_,GloLoc],_,_), Module),
+ opium_printf(help, "scenario : %w (%w in %w)\n", [Scenario, GloLoc, Module]).
+print_scenario_header(Manual, Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_,options:[_,_,GloLoc],_,_), Module),
+ printf(Manual, "{\\bf scenario : %w (%w in %w}\n", [Scenario, GloLoc, Module]).
+
+
+opium_procedure(
+ name : print_syntax,
+ arg_list : [Device, Name, ArgList, Abbrev, Type],
+ implementation : print_syntax_Op,
+ parameters : [],
+ message :
+ "Procedure which prints (for on-line and paper manuals) the syntax of \n\
+an object, i.e. the list of arguments, and the abbreviation if \n\
+existing."
+ ).
+
+print_syntax_Op(tty, Name, ArgList, Abbrev, Type) :-
+ !,
+ opium_write(help, Name),
+ print_arg_list(tty, ArgList),
+ print_abbrev(tty, Abbrev, ArgList),
+ opium_nl(help).
+print_syntax_Op(Manual, Name, ArgList, Abbrev, Type) :-
+ printf(Manual, "{\\bf %w}", [Name]),
+ print_arg_list(Manual, ArgList),
+ write(Manual, " "),
+ print_abbrev(Manual, Abbrev, ArgList),
+ write(Manual, "\n").
+
+print_arg_list(Device, []):-
+ !.
+print_arg_list(tty, [A | List]) :-
+ !,
+ opium_write(help, "("),
+ opium_write(help, A),
+ print_rest_arg(tty, List),
+ opium_write(help, ")").
+print_arg_list(Manual, [A | List]) :-
+ !,
+ printf(Manual, "(%w", [A]),
+ print_rest_arg(Manual, List),
+ write(Manual, ")").
+print_arg_list(tty, X) :-
+ !,
+ opium_write(help, X).
+print_arg_list(Manual, X) :-
+ write(Manual, X).
+
+print_rest_arg(Device, []):- !.
+print_rest_arg(tty, [A | List]) :-
+ !,
+ opium_printf(help, ", %w", [A]),
+ print_rest_arg(tty, List).
+print_rest_arg(Manual, [A | List]) :-
+ printf(Manual, ", %w", [A]),
+ print_rest_arg(Manual, List).
+
+print_abbrev(Device, Abbrev, _) :-
+ var(Abbrev),
+ !.
+print_abbrev(Device, [], _) :-
+ !.
+print_abbrev(tty, Abbrev, Arg) :-
+ !,
+ opium_printf(help, " {%w}", [Abbrev]).
+print_abbrev(Manual, Abbrev, Arg) :-
+ printf(Manual, "{\\em \\{%w\\}}", [Abbrev]).
+
+
+opium_procedure(
+ name : print_man,
+ arg_list : [Device, ArgList, ArgType, Message, DefaultValue, ObjType],
+ implementation : print_man_Op,
+ parameters : [],
+ message :
+ "Procedure which prints (for on-line and paper manuals) the help \n\
+message of an object, the type of the arguments, the default value if \n\
+a parameter and the type of the object. If you want to customize it \n\
+beware that there is a patch for demos."
+ ).
+
+
+print_man_Op(tty, _, Condition, Message, DemoGoal, demos) :-
+ !,
+ opium_printf(help, "demo_goal: %w\ncondition: %w\n%w\n", [DemoGoal, Condition, Message]).
+print_man_Op(tty, ArgList, ArgType, Message, DefaultValue, ObjType) :-
+ !,
+ opium_printf(help, "%w\n", [Message]),
+ print_arg_type(tty, ArgList, ArgType),
+ print_default_value(tty, DefaultValue),
+ print_object_type(tty, DefaultValue, ObjType).
+print_man_Op(Manual, ArgList, ArgType, Message, DefaultValue, ObjType) :-
+ writeln(Manual, Message),
+ print_arg_type(Manual, ArgList, ArgType),
+ print_default_value(Manual, DefaultValue),
+ print_object_type(Manual, DefaultValue, ObjType).
+
+print_arg_type(_, _, []) :- !.
+print_arg_type(tty, [Arg | AList], [Type | TList]) :-
+ !,
+ opium_printf(help, "%w \t: %w\n", [Arg, Type]),
+ print_arg_type(tty, AList, TList).
+print_arg_type(Manual, [Arg | AList], [Type | TList]) :-
+ printf(Manual, "\\\\{\\em %w : %w}\n", [Arg, Type]),
+ print_arg_type(Manual, AList, TList).
+
+print_default_value(Device, []):- !.
+print_default_value(tty, Default) :-
+ !,
+ opium_printf(help, "default value : %Qw\n", [Default]).
+print_default_value(tty, nodefault):-
+ !,
+ opium_write(help, "default value : none\n").
+print_default_value(Manual, nodefault):-
+ !,
+ write(Manual, "\\\\default value : none\n").
+print_default_value(Manual, Default) :-
+ printf(Manual, "\\\\default value : %Qw\n", [Default]).
+
+print_object_type(Device, _, []):- !.
+print_object_type(tty, [], CmdType) :-
+ /* no default, so it is a command */
+ !,
+ opium_printf(help, "type of command : %w\n", [CmdType]).
+print_object_type(Manual, [], CmdType) :-
+ /* no default, so it is a command */
+ !,
+ printf(Manual, "\\\\type of command : %w\n", [CmdType]).
+print_object_type(tty, _, ParType) :-
+ !,
+ opium_printf(help, "type of parameter : %w\n", [ParType]).
+print_object_type(Manual, _, ParType) :-
+ printf(Manual, "\\\\type of parameter : %w\n", [ParType]).
+
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : apropos,
+ arg_list : [Name],
+ arg_type_list : [atom],
+ abbrev : a,
+ interface : button,
+ command_type : opium,
+ implementation : apropos_Op,
+ parameters : [],
+ message :
+"Command which displays all the commands, primitives, procedures, parameters, \
+or types for which Name is a substring of.\n\
+Example: \n\
+[Opium-M]: apropos man.\n\
+ man\n\
+ manual\n\
+ latex_manual\n\
+ window_command\n\
+ opium_command_in_module\n\
+ print_man\n\
+" ).
+
+apropos_Op(X) :-
+ findall(Result, apropos(X, Result), Found),
+ display_apropos_result(Found),
+ nl.
+
+apropos(X, Result) :-
+ setof(Names, get_help_info(_, Names,_,_,_,_,_,_,_,_), L),
+ maplist(atom_string, L, Lstr),
+ atom_string(X, Xstr),
+ find_in_list(Xstr, Lstr, Result).
+
+% get_help_info(Type, Name, ArgList, ArgType, Abbrev, Scenario, Module, Message,
+% DefaultValue, ObjType)
+
+
+find_in_list(String, [Names|_], Names) :-
+ substring(Names, String, _).
+find_in_list(String, [_|Xs], Result) :-
+ find_in_list(String, Xs, Result).
+
+display_apropos_result([]).
+display_apropos_result([NamesStr|Xs]) :-
+ atom_string(Names, NamesStr),
+ get_help_info(Type, Names,_,_,Abbrev,_,_,_,_,_),
+ (
+ nonvar(Abbrev),
+ ( Type = commands ; Type = primitives),
+ printf(" %s (%w)\n", [Names, Abbrev]),
+ !
+ ;
+ printf(" %s\n", [Names])
+ ),
+ display_apropos_result(Xs).
+
+% To avoid typing brackets when using the apropos command.
+:- op(1190, fy, apropos).
+:- op(1190, fy, a).
Index: extras/opium_m/source/interactive_queries.op
===================================================================
RCS file: interactive_queries.op
diff -N interactive_queries.op
--- /dev/null Wed May 28 10:49:58 1997
+++ interactive_queries.op Tue Oct 26 23:26:39 1999
@@ -0,0 +1,218 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Author : Erwan Jahier
+% File : interactive_queries.op
+%
+
+%------------------------------------------------------------------------------%
+
+opium_scenario(
+ name : interactive_queries,
+ files : [interactive_queries],
+ scenarios : [],
+ message :
+"Scenario that handles interactive queries."
+ ).
+
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : query,
+ arg_list : [ModuleList],
+ arg_type_list : [is_list],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : query_Op,
+ parameters : [],
+ message :
+"The commands query/1, cc_query/1 and io_query/1 allow you to type in queries \
+(goals) interactively in the debugger. When you use one of these commands, the \
+debugger will respond with a query prompt (`?-' or `run <--'), at which you \
+can type in a goal; the debugger will the compile and execute the goal and \
+display the answer(s). You can return from the query prompt to the Opium-M \
+prompt by typing the end-of-file indicator (typically control-D or \
+control-Z), or by typing `quit.'. \n\
+\n\
+The list of module names passed down in the argument of the query specify which \
+modules will be imported. Note that you can also add new modules to the list \
+of imports directly at the query prompt, by using a command of the form \
+`[module]', e.g. `[int]'. You need to import all the modules that \
+define symbols used in your query. Queries can only use symbols that are \
+exported from a module; entities which are declared in a module's \
+implementation section only cannot be used. \n\
+\n\
+The three variants differ in what kind of goals they allow. For goals which \
+perform I/O, you need to use `io_query/1'; this lets you type in the goal \
+using DCG syntax. For goals which don't do I/O, but which have determinism \
+`cc_nondet' or `cc_multi', you need to use `cc_query/1'; this finds only one \
+solution to the specified goal. For all other goals, you can use plain \
+`query/1', which finds all the solutions to the goal. \
+\n\
+For `query/1' and `cc_query/1', the debugger will print out all the variables \
+in the goal using `io__write'. The goal must bind all of its variables to \
+ground terms, otherwise you will get a mode error. \n\
+\n\
+The current implementation works by compiling the queries on-the-fly and then \
+dynamically linking them into the program being debugged. Thus it may take a \
+little while for your query to be executed. Each query will be written to a \
+file named `query.m' in the current directory, so make sure you don't name \
+your source file `query.m'. Note that dynamic linking may not be supported \
+on some systems; if you are using a system for which dynamic linking is not \
+supported, you will get an error message when you try to run these commands."
+ ).
+
+% Most of this documentation is duplicated from the documentation
+% in mercury/doc/user_guide.texi.
+
+query_Op(ModuleList) :-
+ any_query(ModuleList, query).
+
+any_query(ModuleList, QueryType) :-
+ ( not getval(state_of_opium, running) ->
+ write("No program is running, you can't make a query.\n")
+ ;
+ true
+ ),
+ % strings need to quoted before being sent.
+ maplist(quote_string, ModuleList, QuotedList),
+ Message =.. [QueryType, QuotedList],
+ send_message_to_socket(Message),
+ loop_for_queries(QueryType).
+
+
+loop_for_queries(QueryType) :-
+ display_query_prompt(QueryType),
+ read(Term),
+ ( Term = options(String) ->
+ quote_string(String, QuotedString),
+ Term2 = options(QuotedString)
+ ;
+ Term2 = Term
+ ),
+ send_message_to_socket(Term2),
+ nl,
+ read_message_from_socket(Response),
+ get_parameter(debug_opium, OnOff),
+ ( OnOff == on ->
+ printf("response to query = %w\n", [Response])
+ ;
+ true
+ ),
+ (
+ ( Response == iq_eof ; Response == iq_quit ),
+ write("End of the interactive queries session.\n"),
+ !
+ ;
+ Response = iq_imported(ImportedMod),
+ write("The currently imported modules are "),
+ print(ImportedMod),
+ nl,
+ loop_for_queries(QueryType),
+ !
+ ;
+ Response = iq_error(ErrorMsg),
+ printf("%w\n", ErrorMsg),
+ loop_for_queries(QueryType),
+ !
+ ;
+ Response == iq_ok,
+ nl,
+ loop_for_queries(QueryType),
+ !
+ ;
+ % Should never occur
+ printf("Bad message from interactive_query:query_", []),
+ printf("external/7: %w.\n", Response),
+ fail
+ ).
+
+display_query_prompt(query) :-
+ write("\n?- ").
+
+display_query_prompt(cc_query) :-
+ write("\n?- ").
+
+display_query_prompt(io_query) :-
+ write("\nrun <-- ").
+
+
+quote_string(String, StringQuoted):-
+ concat_string(["\"", String, "\""], String2),
+ atom_string(StringQuoted, String2).
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : cc_query,
+ arg_list : [ModuleList],
+ arg_type_list : [is_list],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : cc_query_Op,
+ parameters : [],
+ message :
+
+"cf query/1."
+ ).
+
+cc_query_Op(ModuleList) :-
+ any_query(ModuleList, cc_query).
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : io_query,
+ arg_list : [ModuleList],
+ arg_type_list : [is_list],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : io_query_Op,
+ parameters : [],
+ message :
+
+"cf query/1."
+ ).
+
+io_query_Op(ModuleList) :-
+ any_query(ModuleList, io_query).
+
+%------------------------------------------------------------------------------%
+opium_command(
+ name : mmc_options,
+ arg_list : [String],
+ arg_type_list : [string],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : mmc_options_Op,
+ parameters : [],
+ message :
+"This command sets the options that will be passed to `mmc' to compile your \
+query when you use one of the query commands: `query/1', `cc_query/2', or \
+`io_query/3'. For example, if a query results in a compile error, it may \
+sometimes be helpful to use mmc_options(\"--verbose-errors\").\
+"
+ ).
+
+
+mmc_options_Op(Options) :-
+ ( not getval(state_of_opium, running) ->
+ write("No program is running, you can't set mmc options.\n")
+ ;
+ true
+ ),
+ quote_string(Options, QuotedOptions),
+ send_message_to_socket(mmc_options(QuotedOptions)),
+ read_message_from_socket(Response),
+ printf("response to query = %w\n", [Response]),
+ (
+ Response == mmc_options_ok,
+ nl
+ ;
+ % Should never occur
+ write("Bad message from the Mercury proccess.\n"),
+ write("mmc_options_ok expected.\n"),
+ fail
+ ).
Index: extras/opium_m/source/interface.op
===================================================================
RCS file: interface.op
diff -N interface.op
--- /dev/null Wed May 28 10:49:58 1997
+++ interface.op Tue Oct 26 23:26:39 1999
@@ -0,0 +1,481 @@
+/*
+ * $Header: interface.op,v 1.22 94/03/29 15:37:23 sepia Exp $
+ * 1990 Copyright ECRC GmbH
+ */
+
+
+/*
+ * This file contains the entry points for the windowing user
+ * interface. It can be loaded without the other files of the
+ * scenario and the tty interface should still work.
+ * The predicates simply check whether the interface status is tty or
+ * pce and then call the appropriate dedicated predicates which for
+ * the pce ones are defined elsewhere.
+ */
+
+
+/*
+ * INTERFACE scenario
+ * It has to be compiled in 'Opium-M' module.
+ */
+
+opium_scenario(
+ name : interface,
+ files : [interface, wui_objects, wui_sepia],
+ scenarios : [help],
+ message :
+ "Scenario which enables both a tty and a window-based user interface. \n\
+By default the interface is tty. To start the window-based interface \n\
+use \"pce_interface/1\", to get the tty interface back use \n\
+\"tty_interface\"."
+ ).
+
+
+
+% /*
+% * INTERFACE-STATUS/1
+% */
+% opium_procedure(
+% name : interface_status,
+% arg_list : [Status],
+% implementation : interface_status_Op,
+% parameters : [],
+% message :
+% "Procedure which tells what the interface status currently is (either \n\
+% tty or pce). Useful for scenario with sophisticated display."
+% ).
+
+% :- make_local_array(interface_status).
+% :- setval(interface_status, tty).
+
+% interface_status_Op(X) :-
+% getval(interface_status, X).
+
+
+% /*
+% * PCE-INTERFACE/1
+% */
+% opium_command(
+% name : pce_interface,
+% arg_list : [WindowSystem],
+% arg_type_list : [is_member([sunview, xview])],
+% abbrev : _,
+% interface : hidden,
+% command_type : opium,
+% implementation : pce_interface_Op,
+% parameters : [],
+% message :
+% "Command which sets (or resets) a window-based user interface built \n\
+% on top of PCE (see KEGI manual). This interface runs both under \n\
+% SunView and XView. It provides a control panel, and output views \n\
+% complementing the usual tty window used by default. The control panel \n\
+% contains a menu with all the loaded scenarios; a menu with all the \n\
+% Opium module; buttons and menus giving access to the objects of the \n\
+% current scenario. The Opium commands and the trace lines are still \n\
+% displayed in the tty window, but help information and source \n\
+% information are directed to specialized output views. NOTE that to \n\
+% select items in menus you have to use the right-hand button of the \n\
+% mouse. Note also that if you write extensions which may run either on \n\
+% tty and pce interface, to output results you should use the opium_write \n\
+% primitives."
+% ).
+
+% pce_interface_Op(WindowSystem) :-
+% not get_flag(extension, kegi_xview),
+% !,
+% error(142, pce_interface(WindowSystem)).
+% pce_interface_Op(WindowSystem) :-
+% ( interface_status(pce)
+% -> true
+% ; reset_pce_interface(WindowSystem)).
+
+% reset_pce_interface(WindowSystem) :-
+% call(init_running("PCE"), kegi),
+% ( WindowSystem == sunview
+% -> call(start_pce(pce), kegi)
+% ; WindowSystem == xview,
+% call(start_pce(xpce), kegi)),
+% pce_quiet, % no warning, nothing written on pce.log
+% setval(interface_status, pce), % has to be set before make_interface_list
+% make_interface_list(O),
+% init_opium_interface,
+% open_interface_sepia_communication,
+% wui_error_handlers.
+% reset_pce_interface(WindowSystem) :-
+% reset_tty_interface,
+% !,
+% fail.
+
+
+% /*
+% * TTY-INTERFACE/0
+% */
+% opium_command(
+% name : tty_interface,
+% arg_list : [],
+% arg_type_list : [],
+% abbrev : _,
+% interface : button,
+% command_type : opium,
+% implementation : tty_interface_Op,
+% parameters : [],
+% message :
+% "Command which sets (or resets) a tty like interface for Opium. In \n\
+% the tty interface input and output related to the Opium process are \n\
+% done via a tty-like window. Input is only entered with the keyboard."
+% ).
+
+% tty_interface_Op :-
+% ( interface_status(tty)
+% -> true
+% ; reset_tty_interface).
+
+% /*
+% *
+% */
+% reset_tty_interface :-
+% setval(interface_status, tty),
+% tty_error_handlers,
+% (close_pce -> true ; true),
+% set_flag(enable_interrupts, on), % Kegi does not always leave this in a proper state
+% (close_interface_sepia_communication-> true; true).
+
+
+% /*
+% * -------------------------------
+% * Hooks for the wui-interface
+% * -------------------------------
+% */
+
+% /*
+% *
+% */
+% update_opium_module_menu(X):-
+% ( interface_status(pce)
+% -> pce_update_opium_module_menu(X)
+% ; true).
+
+% /*
+% * This doesn't do anything yet in either interface XXX
+% */
+% update_tracing_command_interface(OnOff).
+
+
+% /*
+% * This should open the opium tty window in any case ?? XXX
+% */
+
+% opium_command(
+% name : show_interface,
+% arg_list : [OnOff],
+% arg_type_list : [is_member([on, off])],
+% abbrev : show_int,
+% interface : button,
+% command_type : opium,
+% implementation : show_interface_Op,
+% parameters : [],
+% message :
+% "Commands which hides the windowing user interface items (off) or \n\
+% makes them visible. The windowing user interface is still present."
+% ).
+
+% show_interface_Op(on):-
+% ( interface_status(pce)
+% -> pce_show_interface(on)
+% ; true).
+% show_interface_Op(off) :-
+% ( interface_status(pce)
+% -> pce_show_interface(off)
+% ; true).
+
+% /*
+% *
+% */
+% init_interface :-
+% ( interface_status(pce)
+% -> pce_init_interface
+% ; true).
+
+% /*
+% *
+% */
+% make_interface_list(X,Y,Z) :-
+% ( interface_status(pce)
+% -> wui_make_interface_list(X,Y,Z)
+% ; true).
+
+
+
+% /*
+% * EXECUTE_DEMO_GOAL
+% */
+% opium_procedure(
+% name : execute_demo_goal,
+% arg_list : [Goal],
+% implementation : execute_demo_goal_Op,
+% parameters : [],
+% message :
+% "This procedure executes a goal for demos, according to the current \n\
+% interface_status."
+% ).
+
+% /* wui_execute_demo_goal doesn't need the Module info as it is simply
+% * echoing input in the sepia session.
+% */
+% execute_demo_goal_Op(Goal) :-
+% ( interface_status(tty)
+% -> opium_nl(help),
+% get_flag(toplevel_module, Module),
+% call(Goal, Module)
+% ; wui_execute_demo_goal(Goal)
+% ).
+
+
+
+% /*
+% * INIT-DEMO-SERIES/0
+% */
+% opium_procedure(
+% name : init_demo_series,
+% arg_list : [],
+% implementation : init_demo_series_Op,
+% parameters : [],
+% message :
+% "Procedure which initializes the interface and aborts the currently \n\
+% traced execution if there exists one. This should be used in the \n\
+% \"condition\" of a the first demo of a series (currently those ending \n\
+% with \"_0\")."
+% ).
+
+% init_demo_series_Op :-
+% (traced_execution_running -> abort_trace ; true),
+% system(clear), % for trace and control window
+% opium_clear(source, pce),
+% opium_clear(help, pce).
+
+
+
+% /*
+% * READ-INPUT
+% */
+% opium_procedure(
+% name : read_input,
+% arg_list : [Input],
+% implementation : read_input_Op,
+% parameters : [],
+% message :
+% "Procedure which reads an input from within the current input stream \n\
+% of opium."
+% ).
+
+% /* read in both cases from the input stream
+% */
+% read_input_Op(X) :-
+% read(input, X).
+
+
+interface_status(tty).
+
+/*
+ * -------------------------------
+ * Write predicates
+ *
+ * As there are many different possible output streams in the pce interface,
+ * "write" has to be extended
+ * -------------------------------
+ */
+
+/*
+ * Initially all the opium output streams are just writing on the
+ * standard output.
+ */
+:- set_stream(trace, output).
+:- set_stream(source, output).
+:- set_stream(help, output).
+
+
+/*
+ * OPIUM-WRITE/2
+ */
+opium_procedure(
+ name : opium_write,
+ arg_list : [ViewOrStream, Message],
+ implementation : opium_write_Op,
+ parameters : [],
+ message :
+ "Procedure which writes Message into either a View or a Standard \n\
+Sepia stream, according to the interface status. View is one of \n\
+[trace, help, source, error]."
+ ).
+
+opium_write_Op(View, X) :-
+ interface_status(Status),
+ opium_write_do(View, X, Status).
+
+
+/*
+ * OPIUM-WRITE/3
+ */
+opium_procedure(
+ name : opium_write,
+ arg_list : [ViewOrStream, Message, Status],
+ implementation : opium_write_Op,
+ parameters : [],
+ message :
+ "Procedure which writes Message into either a View or a Standard \n\
+Sepia stream, if the interface status is Status. View is one of \n\
+[trace, help, source, error]."
+ ).
+
+opium_write_Op(View, X, Status) :-
+ ( interface_status(Status)
+ -> opium_write_do(View, X, Status)
+ ; true).
+
+opium_write_do(error, X, tty) :-
+ !,
+ write(error, "*** Opium : "),
+ write(error, X),
+ flush(error).
+opium_write_do(Stream, X, tty) :-
+ !,
+ write(Stream, X), %standard sepia's write
+ flush(Stream).
+% opium_write_do(View, X, pce) :-
+% !,
+% pce_opium_write(View, X).
+
+
+/*
+ * OPIUM-CLEAR/1
+ */
+opium_procedure(
+ name : opium_clear,
+ arg_list : [View],
+ implementation : opium_clear_Op,
+ parameters : [],
+ message :
+"Procedure which clears the View according to the interface status. \n\
+View is one of [trace, help, source, error]." ).
+
+opium_clear_Op(View) :-
+ interface_status(Status),
+ opium_clear_do(View, Status).
+
+
+/*
+ * OPIUM-CLEAR/2
+ */
+opium_procedure(
+ name : opium_clear,
+ arg_list : [View, Status],
+ implementation : opium_clear_Op,
+ parameters : [],
+ message :
+"Procedure which clears the View if the interface status is Status. \n\
+View is one of [trace, help, source, error]."
+ ).
+
+opium_clear_Op(View, Status):-
+ ( interface_status(Status)
+ -> opium_clear_do(View, Status)
+ ; true).
+
+opium_clear_do(View, tty):-
+ !.
+% opium_clear_do(View, pce) :-
+% pce_opium_clear(View).
+
+
+
+/*
+ * OPIUM-NL/1
+ */
+opium_procedure(
+ name : opium_nl,
+ arg_list : [ViewOrStream],
+ implementation : opium_nl_Op,
+ parameters : [],
+ message :
+ "Procedure which prints a new line on a View or a Sepia stream, \n\
+according to the interface status. View is one of [trace, help, \n\
+source, error]."
+ ).
+
+opium_nl_Op(View) :-
+ interface_status(Status),
+ opium_nl_do(View, Status).
+
+
+/*
+ * OPIUM-NL/2
+ */
+opium_procedure(
+ name : opium_nl,
+ arg_list : [ViewOrStream, Status],
+ implementation : opium_nl_Op,
+ parameters : [],
+ message :
+ "Procedure which prints a new line on a View or a Sepia stream if the \n\
+interface status is Status. View is one of [trace, help, source, \n\
+error]."
+ ).
+
+opium_nl_Op(View, Status) :-
+ ( interface_status(Status)
+ -> opium_nl_do(View, Status)
+ ; true).
+
+opium_nl_do(error, tty) :-
+ !,
+ nl(error).
+opium_nl_do(Stream, tty) :-
+ !,
+ nl(Stream).
+% opium_nl_do(View,pce) :-
+% !,
+% pce_opium_nl(View).
+
+
+/*
+ * OPIUM-PRINTF/3
+ */
+opium_procedure(
+ name : opium_printf,
+ arg_list : [ViewOrStream, FormatString, ArgList],
+ implementation : opium_printf_Op,
+ parameters : [],
+ message :
+ "Procedure which printfs the arguments in ArgList on a View or a Sepia \n\
+stream, according to the interface status. View is one of [trace, \n\
+help, source, error]."
+ ).
+
+opium_printf_Op(View, Format, ArgList) :-
+ interface_status(Status),
+ opium_printf_do(View, Format, ArgList, Status).
+
+
+/*
+ * OPIUM-PRINTF/4
+ */
+opium_procedure(
+ name : opium_printf,
+ arg_list : [View, FormatString, ArgList, Status],
+ implementation : opium_printf_Op,
+ parameters : [],
+ message :
+"Procedure which printfs the arguments in ArgList on a View or a Sepia \n\
+stream if the interface status is Status. View is one of [trace, help, \n\
+source, error]."
+ ).
+
+opium_printf_Op(View, Format, ArgList, Status) :-
+ ( interface_status(Status)
+ -> opium_printf_do(View, Format, ArgList, Status)
+ ; true).
+
+opium_printf_do(View, Format, ArgList, Status) :-
+ sprintf(M, Format, ArgList),
+ opium_write_do(View, M, Status).
+
--
R1.
--------------------------------------------------------------------------
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