[m-dev.] Opium-M [4/5]
Erwan Jahier
Erwan.Jahier at irisa.fr
Tue Oct 26 23:47:14 AEST 1999
Index: extras/opium_m/source/listing.m
===================================================================
RCS file: listing.m
diff -N listing.m
--- /dev/null Wed May 28 10:49:58 1997
+++ listing.m Tue Oct 26 23:26:40 1999
@@ -0,0 +1,580 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Auteur : Erwan Jahier <jahier at irisa.fr>
+%
+%
+% This module defines the program listing which takes a mercury module
+% and a predicate name, a function name or a type name and outputs the
+% corresponding source code or hlds code in the file listing_output.
+% It is intended to be used within the Mercury debuggers.
+%
+% Usage: listing <module_name> <pred_name>[.hlds_dump.*] [<arity>]
+% If arity is not typed in, listing will display all the predicates
+% pred_name/n. If the ".hlds_dump.*" extension is typed in, it will
+% display the hlds code of the file <pred_name>.hlds_dump.*.
+%
+
+:- module listing.
+
+:- interface.
+
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module string, int, list, term, term_io, varset, std_util, require.
+
+:- type pair_of_lines
+ ---> pair_of_lines(int, int).
+
+
+:- type type_of_file
+ ---> hlds % if it is a hlds file.
+ ; source. % if is is a source Mercury file.
+
+%------------------------------------------------------------------------------%
+main -->
+ io__command_line_arguments(Args),
+ (
+ { Args = [ModuleNameStr, ProcNameStr, ProcArStr] },
+ { string__to_int(ProcArStr, ProcAr) },
+ { string__right(ModuleNameStr, 19, EndName) }
+ ->
+ (
+ { EndName = ".hlds_dump.99-final" }
+ ->
+ open_file_and_start(ModuleNameStr,
+ ProcNameStr, yes(ProcAr), hlds)
+ ;
+ { string__append(ModuleNameStr, ".m", FileName) },
+ open_file_and_start(FileName,
+ ProcNameStr, yes(ProcAr), source )
+ )
+ ;
+ { Args = [ModuleNameStr, ProcNameStr] },
+ { string__right(ModuleNameStr, 19, EndName) }
+ ->
+ (
+ { EndName = ".hlds_dump.99-final"}
+ ->
+ open_file_and_start(ModuleNameStr,
+ ProcNameStr, no, hlds)
+ ;
+ { string__append(ModuleNameStr, ".m", FileName) },
+ open_file_and_start(FileName,
+ ProcNameStr, no, source)
+ )
+ ;
+ io__write_string(" Usage: listing <module_name>[.hlds_dump.*] "),
+ io__write_string("<pred_name> [<arity>]"),
+ nl
+ ).
+
+
+:- pred open_file_and_start(string, string, maybe(int), type_of_file,
+ io__state, io__state).
+:- mode open_file_and_start(in, in, in, in, di, uo) is det.
+ % First we read the file and collect a list of pair_of_lines(Begin, End)
+ % where Begin (resp End) is the line number of the beginning (resp the
+ % end) of a part of the file where the requested predicate is defined.
+ % Then we re-read the file and print those lines.
+open_file_and_start(ModuleNameStr, ProcNameStr, ProcAr, FileType) -->
+ ( { FileType = hlds } ->
+ % hlds files may contain the character "$" which provokes a syntax
+ % error. So we remove all the occurrences of $ before collecting the
+ % interesting lines.
+ { append(ModuleNameStr, "copy", ModuleNameStr2) },
+ remove_bad_characters(ModuleNameStr, ModuleNameStr2)
+ ;
+ { ModuleNameStr2 = ModuleNameStr }
+ ),
+ io__see(ModuleNameStr2, Result1),
+ (
+ { Result1 = error(CodedMessage1) },
+ { io__error_message(CodedMessage1, Message1) },
+ io__write(Message1)
+ ;
+ { Result1 = ok},
+ collect_interesting_lines(ProcNameStr, ProcAr, FileType,
+ List_pair_of_lines),
+ nl,
+ io__seen,
+ ( { FileType = hlds } ->
+ { append("rm -f ", ModuleNameStr2, Command) },
+ io__call_system(Command, _)
+ ;
+ { true }
+ ),
+ io__see(ModuleNameStr, Result2),
+ io__tell("listing_output", Result3),
+ (
+ { Result2 = error(CodedMessage2) },
+ { Result3 = ok },
+ { io__error_message(CodedMessage2, Message2) },
+ io__write(Message2)
+ ;
+ { Result2 = ok },
+ { Result3 = error(CodedMessage3) },
+ { io__error_message(CodedMessage3, Message3) },
+ io__write(Message3)
+ ;
+ { Result2 = error(CodedMessage2) },
+ { Result3 = error(CodedMessage3) },
+ { io__error_message(CodedMessage3, Message3) },
+ { io__error_message(CodedMessage2, Message2) },
+ io__write(Message2),
+ io__write(Message3)
+ ;
+ { Result2 = ok },
+ { Result3 = ok },
+ display_source_code(List_pair_of_lines, 1),
+ nl,
+ io__seen,
+ io__told
+ )
+ ).
+
+
+:- pred remove_bad_characters(string, string, io__state, io__state).
+:- mode remove_bad_characters(in, in, di, uo) is det.
+remove_bad_characters(ModuleNameStr, ModuleNameStr2) -->
+ { append_list(["cat ", ModuleNameStr, "| sed s/\\$//g > ",
+ ModuleNameStr2], Call) },
+ io__call_system(Call, _Result).
+
+
+:- pred collect_interesting_lines(string, maybe(int), type_of_file,
+ list(pair_of_lines), io__state, io__state).
+:- mode collect_interesting_lines(in, in, in, out, di, uo) is det.
+
+collect_interesting_lines(ProcNameStr, ProcAr, FileType, ListOut) -->
+ term_io__read_term(Result),
+ get_line_number(LN),
+ (
+ { Result = eof },
+ { ListOut = [] }
+ ;
+ { Result = error(String, _) },
+ io__write(String),
+ { ListOut = [] }
+ ;
+ { Result = term(_Varset, Term) },
+ (
+ { is_a_function_declaration(Term, ProcAr,
+ LineNumberStart, ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_predicate_and_mode_declaration(Term, ProcAr,
+ LineNumberStart, ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_function_and_mode_declaration(Term, ProcAr,
+ LineNumberStart, ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_predicate_declaration(Term, ProcAr,
+ LineNumberStart, ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_predicate_mode_declaration(Term, ProcAr,
+ LineNumberStart, ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_function_mode_declaration(Term, ProcAr,
+ LineNumberStart, ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_pragma_c_code_declaration(Term, ProcAr,
+ LineNumberStart, ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_type_declaration(Term, ProcAr, LineNumberStart,
+ ProcTerm) },
+ { ProcTerm = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_predicate(Term, ProcAr, FileType, LineNumberStart,
+ Functor) },
+ { Functor = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { is_a_function(Term, ProcAr, FileType, LineNumberStart,
+ Functor) },
+ { Functor = ProcNameStr }
+ ->
+ { List1 = [pair_of_lines(LineNumberStart, LN)] }
+ ;
+ { List1 = [] }
+ ),
+ collect_interesting_lines(ProcNameStr, ProcAr, FileType, List2),
+ { append(List1, List2, ListOut) }
+ ).
+
+%------------------------------------------------------------------------------%
+:- pred is_a_predicate_declaration(term, maybe(int), int, string).
+:- mode is_a_predicate_declaration(in, in, out, out) is semidet.
+ % :- pred test(term, string).
+is_a_predicate_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("pred"), [T2 | _], _),
+ T2 = term__functor(term__atom(ProcTerm), ListArg, _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+
+:- pred is_a_predicate_mode_declaration(term, maybe(int), int, string).
+:- mode is_a_predicate_mode_declaration(in, in, out, out) is semidet.
+ % :- mode test(in, out) is det.
+is_a_predicate_mode_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("mode"), [T2 | _], _),
+ T2 = term__functor(term__atom("is") , [T3 | _], _),
+ T3 = term__functor(term__atom(ProcTerm) , ListArg, _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+
+%------------------------------------------------------------------------------%
+:- pred is_a_function_declaration(term, maybe(int), int, string).
+:- mode is_a_function_declaration(in, in, out, out) is semidet.
+ % :- func test(string) = int.
+is_a_function_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("func"), [T2 | _], _),
+ T2 = term__functor(term__atom("="), [T3 | _], _),
+ T3 = term__functor(term__atom(ProcTerm),ListArg , _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+
+:- pred is_a_function_mode_declaration(term, maybe(int), int, string).
+:- mode is_a_function_mode_declaration(in, in, out, out) is semidet.
+ % :- mode test(out) = in det .
+is_a_function_mode_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("mode"), [T2 | _], _),
+ T2 = term__functor(term__atom("is"), [T3 | _], _),
+ T3 = term__functor(term__atom("="), [T4 | _], _),
+ T4 = term__functor(term__atom(ProcTerm) , ListArg, _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+
+%------------------------------------------------------------------------------%
+:- pred is_a_predicate_and_mode_declaration(term, maybe(int), int, string).
+:- mode is_a_predicate_and_mode_declaration(in, in, out, out) is semidet.
+is_a_predicate_and_mode_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ %:- pred test(term::in, string::out) is det.
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("pred"), [T2 | _], _),
+ T2 = term__functor(term__atom("is"), [T3 | _], _),
+ T3 = term__functor(term__atom(ProcTerm), ListArg, _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+:- pred is_a_function_and_mode_declaration(term, maybe(int), int, string).
+:- mode is_a_function_and_mode_declaration(in, in, out, out) is semidet.
+ % :- func test(string::in) = int::out is det.
+is_a_function_and_mode_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("::"), [T2 | _], _),
+ T2 = term__functor(term__atom("func"), [T3 | _], _),
+ T3 = term__functor(term__atom("=") , [T4 | _], _),
+ T4 = term__functor(term__atom(ProcTerm), ListArg, _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+
+%------------------------------------------------------------------------------%
+:- pred is_a_pragma_c_code_declaration(term, maybe(int), int, string).
+:- mode is_a_pragma_c_code_declaration(in, in, out, out) is semidet.
+ % :- pragma c_code(test(S1::in, S2::in, S3::in), [...]
+is_a_pragma_c_code_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("pragma"), [T2 | _], _),
+ T2 = term__functor(term__atom("c_code"), [T3 | _], _),
+ T3 = term__functor(term__atom(ProcTerm) , ListArg, _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+
+%------------------------------------------------------------------------------%
+:- pred is_a_type_declaration(term, maybe(int), int, string).
+:- mode is_a_type_declaration(in, in, out, out) is semidet.
+ % :- type maybe(T) ---> no ; yes(T)
+is_a_type_declaration(Term, ProcAr, LineNumber, ProcTerm) :-
+ Term = term__functor(term__atom(":-"), [T1 | _],
+ context(_, LineNumber)),
+ T1 = term__functor(term__atom("type"), [T2 | _], _),
+ T2 = term__functor(term__atom("--->"), [T3, _], _),
+ T3 = term__functor(term__atom(ProcTerm) , ListArg, _),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ L = Arity
+ ;
+ ProcAr = no
+ ).
+
+
+%------------------------------------------------------------------------------%
+:- pred is_a_predicate(term, maybe(int), type_of_file, int, string).
+:- mode is_a_predicate(in, in, in, out, out) is semidet.
+
+is_a_predicate(Term, ProcAr, hlds, LineNumber, Functor) :-
+ Term = functor(atom(":-"), L1, context(_, LineNumber)),
+ L1 = [functor(atom(":"), [_, T1 | _], _) | _],
+ T1 = functor(atom(String2), ListArg, _),
+ Functor = String2,
+ Functor \= "=",
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, Arity)
+ ;
+ ProcAr = no
+ ).
+
+is_a_predicate(Term, ProcAr, source, LineNumber, Functor) :-
+ Term = functor(atom(String1), T1, context(_, LineNumber1)),
+ (
+ ( String1 = ":-"
+ ; String1 = "-->")
+ ->
+ % The term is a clause with a body.
+ T1 = [Head | _],
+ Head = functor(atom(String2), ListArg,
+ context(_, LineNumber)),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ ( String1 = ":-" ->
+ L = Arity
+ ;
+ % String1 = "-->"
+ LL is L + 2,
+ LL = Arity
+ )
+ ;
+ ProcAr = no
+ ),
+ % We need to check if the term Term is not a declaration:
+ % (From language reference manual, "Declarations" section)
+ not( list__member(String2, [
+ "type", "pred", "func", "inst", "mode",
+ "typeclass", "typeclass", "instance", "pragma",
+ "module", "interface", "implementation",
+ "import_module", "use_module", "include_module",
+ "end_module"] )),
+ Functor = String2,
+ Functor \= "=" % It is the case if the proc correspond
+ % to a function.
+ ;
+ % The term is a clause without body.
+ Functor = String1,
+ LineNumber = LineNumber1,
+ Functor \= "=", % It is the case if the proc correspond
+ % to a function.
+ (
+ ProcAr = yes(Arity),
+ list__length(T1, L),
+ L = Arity
+ ;
+ ProcAr = no
+ )
+ ).
+
+%------------------------------------------------------------------------------%
+:- pred is_a_function(term, maybe(int), type_of_file, int, string).
+:- mode is_a_function(in, in, in, out, out) is semidet.
+is_a_function(Term, ProcAr, hlds, LineNumber, Functor) :-
+ Term = functor(atom(":-"), L1, context(_, LineNumber)),
+ L1 = [functor(atom("="),
+ [functor(atom(":"),[_, T1 | _], _) | _], _) | _],
+ T1 = functor(atom(String2), ListArg, _),
+ Functor = String2,
+ Functor \= "=",
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, Arity - 1)
+ ;
+ ProcAr = no
+ ).
+
+is_a_function(Term, ProcAr, source, LineNumber, Functor) :-
+ Term = functor(atom(String1), T1, _),
+ (
+ ( String1 = ":-"
+ ; String1 = "-->")
+ ->
+ % The term is a clause with a body.
+ T1 = [Head | _],
+ Head = functor(atom("="), T2, _),
+ T2 = [Head2 | _],
+ Head2 = functor(atom(String2), ListArg, context(_, LineNumber)),
+ (
+ ProcAr = yes(Arity),
+ list__length(ListArg, L),
+ ( String1 = ":-" ->
+ LL is L + 1,
+ LL = Arity
+ ;
+ % String1 = "-->"
+ LL is L + 3,
+ LL = Arity
+ )
+ ;
+ ProcAr = no
+ ),
+ % We need to check if the term Term is not a declaration:
+ % (From language reference manual, "Declarations" section)
+ not( list__member(String2, [
+ "type", "pred", "func", "inst", "mode",
+ "typeclass", "typeclass", "instance", "pragma",
+ "module", "interface", "implementation",
+ "import_module", "use_module", "include_module",
+ "end_module"] )),
+ % List taken from the language reference manual,
+ % "Declarations" section.
+ Functor = String2
+ ;
+ % The term is a clause without body.
+ T1 = [Head | _],
+ Head = functor(atom(String2), _, context(_, LineNumber)),
+ Functor = String2,
+ (
+ ProcAr = yes(Arity),
+ list__length(T1, L),
+ L = Arity
+ ;
+ ProcAr = no
+ )
+ ).
+
+%--------------------------------------------------------------------------%
+:- pred display_source_code(list(pair_of_lines), int, io__state, io__state).
+:- mode display_source_code(in, in, di, uo) is det.
+display_source_code([], _, Io, Io).
+display_source_code([pair_of_lines(L1, L2) | Tail], CurrentLine) -->
+ { N is L1 - CurrentLine },
+ skip_n_lines(N),
+ { M is L2 - L1 + 1 },
+ read_and_print_n_lines(M),
+ display_source_code(Tail, L2 + 1).
+
+
+:- pred skip_n_lines(int, io__state, io__state).
+:- mode skip_n_lines(in, di, uo) is det.
+skip_n_lines(N) -->
+ (
+ { N = 0 }
+ ->
+ []
+ ;
+ io__read_line_as_string(Result),
+ (
+ { Result = ok(_) },
+ skip_n_lines(N - 1)
+ ;
+ % Should never occur
+ { Result = eof },
+ write_string("error in listing.m: end of file "),
+ write_string("should not be reached"), nl
+ ;
+ % Should never occur
+ { Result = error(CodedMessage) },
+ { io__error_message(CodedMessage, Message) },
+ write(Message)
+ )
+ ).
+
+
+:- pred read_and_print_n_lines(int, io__state, io__state).
+:- mode read_and_print_n_lines(in, di, uo) is det.
+read_and_print_n_lines(N) -->
+ (
+ { N = 0 }
+ ->
+ []
+ ;
+ io__read_line_as_string(Result),
+ (
+ { Result = ok(LineStr) },
+ write_string(LineStr),
+ read_and_print_n_lines(N - 1)
+ ;
+ % Should never occur
+ { Result = eof },
+ write_string("error in listing.m: end of file"),
+ write_string("should not be reached"), nl
+ ;
+ % Should never occur
+ { Result = error(CodedMessage) },
+ { io__error_message(CodedMessage, Message) },
+ write(Message)
+ )
+ ).
+
+
+:- end_module listing.
+%------------------------------------------------------------------------------%
+
Index: extras/opium_m/source/load_Opium-M.pl
===================================================================
RCS file: load_Opium-M.pl
diff -N load_Opium-M.pl
--- /dev/null Wed May 28 10:49:58 1997
+++ load_Opium-M.pl Tue Oct 26 23:26:40 1999
@@ -0,0 +1,50 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Author : Erwan Jahier <jahier at irisa.fr>
+%
+% This is the first file to be loaded when Opium-M is run.
+% It is called from the Opium-M script.
+
+
+%------------------------------------------------------------------------------%
+% re-definition of opium_answer/2
+% defined in ~/sepia/workdir/sepia/pl/boot_bips.pl
+
+opium_answer(_, yes).
+opium_answer(_, no) :-
+ write(toplevel_output, 'no.\n').
+opium_answer(_, no_answer) :-
+ write(toplevel_output, 'no (more) solution.\n').
+opium_answer(_, last_yes).
+opium_answer(_, last_answer) :-
+ write(toplevel_output, '\n').
+opium_answer(_, more_answers) :-
+ write(toplevel_output, ' More? (;) '),
+ flush(toplevel_output),
+ tyi(toplevel_input, C),
+ ( C == 59 ->
+ write(toplevel_output, '\n'),
+ flush(toplevel_output),
+ fail
+ ;
+ write(toplevel_output, '\n'),
+ flush(toplevel_output)
+ ).
+
+:- set_error_handler(156, opium_answer/2).
+
+
+%------------------------------------------------------------------------------%
+% Load Opium-M.
+:- getenv('MERCURY_OPIUM_DIR', Dir),
+ append_strings(Dir, "/source/load_scenario-M.pl", MakeFile),
+ compile(MakeFile).
+
+% Initialise the Opium-M session
+:- init_opium_session.
+
+:- set_flag(toplevel_module, 'Opium-M').
+
+%------------------------------------------------------------------------------%
+
Index: extras/opium_m/source/load_Opium-M_without_banner.pl
===================================================================
RCS file: load_Opium-M_without_banner.pl
diff -N load_Opium-M_without_banner.pl
--- /dev/null Wed May 28 10:49:58 1997
+++ load_Opium-M_without_banner.pl Tue Oct 26 23:26:40 1999
@@ -0,0 +1,10 @@
+:- compile("./load_Opium-M.pl").
+
+
+% Remove the Eclipse banner (for non-regression test)
+
+opium_banner(_, _Sepiabanner) :-
+ write(toplevel_output, ""),
+ flush(toplevel_output).
+
+:- set_error_handler(164, opium_banner/2).
Index: extras/opium_m/source/load_scenario-M.pl
===================================================================
RCS file: load_scenario-M.pl
diff -N load_scenario-M.pl
--- /dev/null Wed May 28 10:49:58 1997
+++ load_scenario-M.pl Tue Oct 26 23:26:40 1999
@@ -0,0 +1,110 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Authors : Erwan Jahier <jahier at irisa.fr>,
+% Mireille Ducassé <ducasse at irisa.fr>
+%
+% This file loads the Opium-M files. It is loaded from the load_Opium-M.pl.
+
+
+:- module('Opium-M').
+
+
+/*
+** Caution : the order of compilation is relevant!
+** At least for the scenario handler.
+*/
+
+:-
+ getenv('MERCURY_OPIUM_DIR', OpiumDir),
+ append_strings(OpiumDir, "/source/opiumfiles/", OpiumfilesStr),
+ append_strings(OpiumDir, "/source/", SourceStr),
+
+ % compile the *.op files
+ append_strings(SourceStr, "util.pl", Util),
+ compile(Util, 'Opium-M'),
+
+ append_strings(OpiumfilesStr, "autoload.load", AutoloadLoad),
+ append_strings(OpiumfilesStr, "scenario.load", ScenarioLoad),
+ append_strings(OpiumfilesStr, "scenario_handler.load", ScenarioHLoad),
+ append_strings(OpiumfilesStr, "parameter.load", ParameterLoad),
+ append_strings(OpiumfilesStr, "translate.load", TranslateLoad),
+ append_strings(OpiumfilesStr, "error.load", ErrorLoad),
+ append_strings(OpiumfilesStr, "types.load", TypesLoad),
+ append_strings(OpiumfilesStr, "make.load", MakeLoad),
+ append_strings(OpiumfilesStr, "help.load", HelpLoad),
+ append_strings(OpiumfilesStr, "opium_kernel_M.load", OpiumLoad),
+ append_strings(OpiumfilesStr, "coprocess_M.load", CoprocessLoad),
+ append_strings(OpiumfilesStr, "exec_control_M.load", ExecLoad),
+ append_strings(OpiumfilesStr, "current_arg_M.load", Current_argLoad),
+ append_strings(OpiumfilesStr, "current_slots_M.load", Current_slotsLoad),
+ append_strings(OpiumfilesStr, "event_attributes_M.load", EventLoad),
+ append_strings(OpiumfilesStr, "forward_move_M.load", ForwardLoad),
+ append_strings(OpiumfilesStr, "display_M.load", DisplayLoad),
+ append_strings(OpiumfilesStr, "browse.load", BrowseLoad),
+ append_strings(OpiumfilesStr, "interactive_queries.load", IQLoad),
+ append_strings(OpiumfilesStr, "source_M.load", SourceLoad),
+ append_strings(OpiumfilesStr, "step_by_step_M.load", StepLoad),
+
+ append_strings(SourceStr, "autoload.op", AutoloadOp),
+ append_strings(SourceStr, "interface.op", InterfaceOp),
+ append_strings(SourceStr, "error.op", ErrorOp),
+ append_strings(SourceStr, "help.op", HelpOp),
+ append_strings(SourceStr, "make.op", Makeop),
+ append_strings(SourceStr, "scenario.op", ScenarioOp),
+ append_strings(SourceStr, "scenario_handler.op", ScenarioHOp),
+ append_strings(SourceStr, "types.op", TypesOp),
+ append_strings(SourceStr, "translate.op", TranslateOp),
+ append_strings(SourceStr, "parameter.op", ParameterOp),
+ append_strings(SourceStr, "opium_kernel_M.op", OpiumOp),
+ append_strings(SourceStr, "coprocess_M.op", CoprocessOp),
+ append_strings(SourceStr, "exec_control_M.op", ExecOp),
+ append_strings(SourceStr, "current_arg_M.op", Current_argOp),
+ append_strings(SourceStr, "current_slots_M.op", Current_slotsOp),
+ append_strings(SourceStr, "event_attributes_M.op", EventOp),
+ append_strings(SourceStr, "forward_move_M.op", ForwardOp),
+ append_strings(SourceStr, "browse.op", BrowseOp),
+ append_strings(SourceStr, "interactive_queries.op", IQOp),
+ append_strings(SourceStr, "display_M.op", DisplayOp),
+ append_strings(SourceStr, "source_M.op", SourceOp),
+ append_strings(SourceStr, "step_by_step_M.op", StepOp),
+
+ compile([ScenarioHOp, ErrorOp, Makeop, ParameterOp, ScenarioOp,
+ AutoloadOp, TranslateOp, TypesOp]),
+
+ assert(current_options([active, _, global])),
+ setval(already_global, no), %% XXX [md] pas completement satisfaisant
+
+ compile([ScenarioHLoad, ErrorLoad, MakeLoad, ParameterLoad, ScenarioLoad,
+ AutoloadLoad, TranslateLoad, TypesLoad]),
+ initialize_parameters(single, scenario_handler, 'Opium-M'),
+ initialize_parameters(multiple, scenario_handler, 'Opium-M'),
+
+ compile(InterfaceOp),
+
+ compile([HelpOp, HelpLoad]),
+ initialize_parameters(single, help, 'Opium-M'),
+ initialize_parameters(multiple, help, 'Opium-M'),
+
+ compile([OpiumOp, ForwardOp, Current_slotsOp, Current_argOp,
+ EventOp, ExecOp, CoprocessOp, BrowseOp, IQOp]),
+ compile([OpiumLoad, ForwardLoad, Current_slotsLoad, Current_argLoad,
+ EventLoad, ExecLoad, CoprocessLoad, BrowseLoad, IQLoad]),
+ initialize_parameters(single, 'opium_kernel_M', 'Opium-M'),
+ initialize_parameters(multiple, 'opium_kernel_M', 'Opium-M'),
+
+ compile([DisplayOp, DisplayLoad]),
+ initialize_parameters(single, 'display_M' , 'Opium-M'),
+ initialize_parameters(multiple, 'display_M', 'Opium-M'),
+
+ compile([StepOp, StepLoad]),
+ initialize_parameters(single, 'step_by_step_M', 'Opium-M'),
+ initialize_parameters(multiple, 'step_by_step_M', 'Opium-M'),
+
+ compile([SourceOp, SourceLoad]),
+ initialize_parameters(single, 'source_M', 'Opium-M'),
+ initialize_parameters(multiple, 'source_M', 'Opium-M'),
+
+ setval(already_global, yes). %% XXX [md] pas completement satisfaisant
+
+
Index: extras/opium_m/source/make.op
===================================================================
RCS file: make.op
diff -N make.op
--- /dev/null Wed May 28 10:49:58 1997
+++ make.op Tue Oct 26 23:26:41 1999
@@ -0,0 +1,803 @@
+/*
+ * $Header: make.op,v 1.65 93/03/30 19:09:56 mireille Exp $
+ * 1990 Copyright ECRC GmbH
+ */
+
+/*
+ * commands used to "make" Opium scenarios
+ * (part of scenario scenario)
+ */
+
+:- (is_predicate(current_options/1) ->
+ /* make.op is loaded 2nd time */
+ true
+ ;
+ (dynamic current_options/1),
+ (export current_options/1)
+ ).
+
+/*
+ * MAKE/1
+ */
+opium_command(
+ name : make,
+ arg_list : [Scenario],
+ arg_type_list : [atom],
+ abbrev : _,
+ interface : button,
+ command_type : tool,
+ implementation : make_scenario_Op,
+ parameters : [],
+ message :
+ "Command which loads a single scenario as active, traceable, and \n\
+local into the current module. The declaration of a scenario must be \n\
+done in a file named <scenario>.op. Only those files of the scenario \n\
+are loaded which are not up-to-date. The scenario source files must be \n\
+in the current directory. The object files will be put in a directory \n\
+called \"opiumfiles\"."
+ ).
+
+
+/*
+ * MAKE/2
+ */
+opium_command(
+ name : make,
+ arg_list : [Scenario, Module],
+ arg_type_list : [atom, atom],
+ abbrev : _,
+ interface : button,
+ command_type : opium,
+ implementation : make_scenario_Op,
+ parameters : [],
+ message :
+ "Command which loads a single scenario as active, traceable, and \n\
+local into the given module. The declaration of a scenario must be \n\
+done in a file named <scenario>.op. Only those files of the scenario \n\
+are loaded which are not up-to-date. The scenario source files must be \n\
+in the current directory. The object files will be put in a directory \n\
+called \"opiumfiles\"."
+ ).
+
+make_scenario_Op(Scenario, Mod) :-
+ make_scenario_Op(Scenario, Mod, [active, traceable, local]).
+
+/*
+ * MAKE/3
+ */
+opium_command(
+ name : make,
+ arg_list : [Scenario, Module, OptionList],
+ arg_type_list : [atom, atom, is_option_list],
+ abbrev : _,
+ interface : button,
+ command_type : opium,
+ implementation : make_scenario_Op,
+ parameters : [],
+ message :
+ "Command which loads a single scenario into a given module. The \n\
+options are active/inactive, traceable/untraceable, and global/local; \n\
+they have to be given in this order. The declaration of a scenario \n\
+must be done in a file named <scenario>.op. Only those files of the \n\
+scenario are loaded which are not up-to-date. The scenario source \n\
+files must be in the current directory. The object files will be put \n\
+in a directory called \"opiumfiles\"."
+ ).
+
+make_scenario_Op(Scenario, Mod, OptionList) :-
+ is_absolute_pathname(Scenario),
+ !,
+ atom_string(Scenario, ScenarioS),
+ get_dir_and_file(ScenarioS, SrcDirS, ScenarioNameS),
+ atom_string(SrcDir, SrcDirS),
+ getcwd(WDS),
+ append_strings(WDS, "opiumfiles/", ObjDirS),
+ atom_string(ObjDir, ObjDirS),
+ make_scenario_Op(SName, Mod, OptionList, SrcDir, ObjDir).
+make_scenario_Op(S, Mod, OptionList) :-
+ getenv('MERCURY_OPIUM_DIR', OpiumDir),
+ append_strings(OpiumDir, "/source/", ODS),
+ append_strings(ODS, "/opiumfiles/", ObjDirS),
+ atom_string(OD, ODS),
+ atom_string(ObjDir, ObjDirS),
+ make_scenario_Op(S, Mod, OptionList, OD, ObjDir).
+
+/*
+ * is_absolute_pathname/1
+ * (still the same implementation as in MU-Prolog, could
+ * be implemented better in Sepia)
+ */
+is_absolute_pathname(P) :-
+ atom(P),
+ name(P, L),
+ L = [47 | _]. % 47 = '/'
+
+get_dir_and_file(PathName, Dir, File) :-
+ lastpos("/", PathName, P),
+ string_length(PathName, PL),
+ DL is P,
+ substring(PathName, 1, DL, Dir),
+ FL is PL - DL,
+ FP is P + 1,
+ substring(PathName, FP, FL, File).
+
+lastpos(Sub, String, Pos) :-
+ lastpos(Sub, String, 0, Pos).
+
+lastpos(Sub, String, AccPos, LastPos) :-
+ substring(String, Sub, Pos),
+ !,
+ string_length(String, L),
+ NewL is L - Pos,
+ P is Pos + 1,
+ NewPos is AccPos + Pos,
+ substring(String, P, NewL, NewString),
+ lastpos(Sub, NewString, NewPos, LastPos).
+lastpos(Sub, String, Pos, Pos).
+
+
+/*
+ * IS-OPTION-LIST
+ */
+opium_type(
+ name : is_option_list,
+ implementation : is_option_list_Op,
+ message :
+"Type which succeeds for a list of options for a scenario: \n\
+[active/inactive, traceable/untraceable, global/local]."
+ ).
+
+is_option_list_Op([A, T, G]) :-
+ atom(A),
+ member(A, [active, inactive]),
+ atom(T),
+ member(T, [traceable, untraceable]),
+ atom(G),
+ member(G, [global, local]).
+
+/*
+ * IS-ABSOLUTE-DIR
+ */
+opium_type(
+ name : is_absolute_dir,
+ implementation : is_absolute_dir_Op,
+ message :
+"Type which succeeds for an atom starting with \"/\" and ending with \"/\"."
+ ).
+
+is_absolute_dir_Op(D) :-
+ atom(D),
+ name(D, L),
+ L = [47 | _], % 47 = '/'
+ last_element(L, 47).
+
+last_element([X], X) :-
+ !.
+last_element([X|Xs], Z) :-
+ last_element(Xs, Z).
+
+
+/*
+ * MAKE/5
+ */
+opium_command(
+ name : make,
+ arg_list : [Scenario, Module, OptionList, SrcDir, ObjDir],
+ arg_type_list : [atom, atom, is_option_list, is_absolute_dir,
+ is_absolute_dir],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : make_scenario_Op,
+ parameters : [],
+ message :
+ "Command which loads a single scenario into a given module. The \n\
+source files are taken from SrcDir, the object files are taken from, \n\
+resp. written to, ObjDir. The options are active/inactive, \n\
+traceable/untraceable, and global/local; they have to be given in this \n\
+order. Only those files of the scenario are loaded which are not \n\
+up-to-date."
+ ).
+
+make_scenario_Op(Scenario, Mod, [_, _, global], SrcDir, ObjDir) :-
+ opium_scenario_in_module((name:Scenario, _,_, options:[_,_,global], _,_), Mod1),
+ Mod \== Mod1,
+ !,
+ printf(error, "scenario %w is already global in module %w\n", [Scenario, Mod1]).
+make_scenario_Op(Scenario, Mod, [A, T, GloLoc], SrcDir, ObjDir) :-
+ printf(output, "\nmaking scenario %w (%w)\n", [Scenario, GloLoc]),
+ set_dbgcomp_flag(T),
+ file_suffixe_flag(SrcSuff, _, _),
+ concat_atom([SrcDir, Scenario, SrcSuff], BaseFile),
+ provide_opium_module(Mod),
+ set_error_handler(95, gloloc_error_handler/3),
+ get_scenario_declaration(Scenario, BaseFile, Mod, FileList, NeededS),
+ make_scenario_int(Scenario, Mod, [A, T, GloLoc], FileList, NeededS, SrcDir, ObjDir),
+ reset_error_handler(95),
+ set_dbgcomp_flag(traceable),
+ !.
+make_scenario_Op(Scenario, Mod, OptionList, SrcDir, ObjDir) :-
+ reset_error_handler(95),
+ set_dbgcomp_flag(traceable),
+ printf(error, "scenario %w could not be made\n", [Scenario]).
+
+/*
+ * first check whether scenario is declared in base file,
+ * then continue to make scenario
+ */
+get_scenario_declaration(Scenario, BaseFile, Module, FL, N) :-
+ open(BaseFile, read, S),
+ repeat,
+ read(S, X),
+ ( X = end_of_file,
+ !,
+ printf(error, "scenario %w should be declared in file %w\n", [Scenario, BaseFile]),
+ close(S),
+ fail
+ ;
+ X = opium_scenario(name:Scenario, files:FL, scenarios:N, M),
+ !,
+ call(compile_term(opium_scenario(name:Scenario, files:FL, scenarios:N, M)), Module),
+ close(S)
+ ).
+
+make_scenario_int(Scenario, Mod, [inactive, T, GL], FileList, NeededS, SrcDir, ObjDir) :-
+ !,
+ provide_directory(ObjDir),
+ call(assert(autoload_scenario(Scenario, [inactive, T, GL], SrcDir, ObjDir)), Mod),
+ update_time(Scenario, Mod, FileList, [inactive, T, GL], SrcDir, Time),
+ assert(current_options([inactive, T, GL])),
+ update(Scenario, Mod, [inactive, T, GL], FileList, Time, SrcDir, ObjDir),
+ retract_all(current_options(_)),
+ set_update_time_and_options(Scenario, Mod, [inactive, T, GL], ObjDir).
+make_scenario_int(Scenario, Mod, [A, T, GL], FileList, NeededS, SrcDir, ObjDir) :-
+ provide_directory(ObjDir),
+ update_time(Scenario, Mod, FileList, [A,T, GL], SrcDir, Time),
+ assert(current_options([A, T, GL])),
+ update(Scenario, Mod, [A, T, GL], FileList, Time, SrcDir, ObjDir),
+ retract_all(current_options(_)),
+% [R1] Not available for Opium-M.
+% make_interface_list(Scenario, GL, Mod), % for windowing user-interface
+ (opium_level(0) ->
+ /* we are booting Opium, so c parameters cannot be set */
+ initialize_parameters(single, Scenario, Mod),
+ initialize_parameters(multiple, Scenario, Mod)
+ ;
+ set_default_parameters_in_module(Scenario, Mod)
+ ),
+ set_update_time_and_options(Scenario, Mod, [A, T, GL], ObjDir),
+ make_needed_scenarios(NeededS, Mod).
+
+update_time(Scenario, Mod, FileList, OptionList, SrcDir, Time) :-
+ absolute_pathnames(SrcDir, FileList, AbsFileList),
+ opium_scenario_in_module((
+ name : Scenario,
+ files : AbsFileList,
+ scenarios : S,
+ options : OptionList,
+ updated : Time,
+ M), Mod),
+ /* scenario with same options and same files already present */
+ !.
+update_time(Scenario, Mod, FileList, OptionList, SrcDir, 0).
+
+set_update_time_and_options(S, Mod, OptL, ObjDir) :-
+ call(retract(opium_scenario(name:S, F, N, options:_, updated:_, M)), Mod),
+ !,
+ current_time(T, ObjDir),
+ call(assert(opium_scenario(name:S, F, N, options:OptL, updated:T, M)), Mod).
+
+/* to overcome the problem that system time on client and file server
+ * are usually not the same
+ */
+current_time(T, ObjDir) :-
+ concat_atom([ObjDir, '.opium'], F),
+ open(F, write, X),
+ write(X, opium), % to modify the file
+ close(X),
+ modify_time(F, T).
+
+/*
+ * make_needed_scenarios
+ * make other scenarios which are required to run the actual one
+ */
+make_needed_scenarios([], Mod) :-
+ !.
+make_needed_scenarios([NeededS | NS], Mod) :-
+ make_needed_scenarios_i(NeededS, Mod),
+ make_needed_scenarios(NS, Mod).
+
+make_needed_scenarios_i(NeededScenario, Mod) :-
+ call(opium_scenario(name:NeededScenario, F, N, O, U, M), Mod),
+ !.
+make_needed_scenarios_i(NeededScenario, Mod) :-
+ opium_scenario_in_module((name:NeededScenario, _,_, options:[active,_,global], _,_), Mod1),
+ Mod \== Mod1,
+ /* scenario already globally present in another module */
+ !.
+make_needed_scenarios_i(NeededScenario, Mod) :-
+ printf(output, "scenario %w needed but not present\n", [NeededScenario]),
+ make(NeededScenario, Mod).
+
+/*
+ * update all the files related to the scenario
+ */
+update(Scenario, Mod, OptL, [], UpdateT, SrcDir, ObjDir).
+update(Scenario, Mod, OptL, [File|Fs], UpdateT, SrcDir, ObjDir) :-
+ update_file(Scenario, Mod, OptL, File, UpdateT, SrcDir, ObjDir),
+ update(Scenario, Mod, OptL, Fs, UpdateT, SrcDir, ObjDir).
+
+update_file(Scenario, Mod, OptL, File, UpdateTime, SrcDir, ObjDir) :-
+ file_suffixe_flag(SrcSuff, LoadSuff, AutoLoadSuff),
+ concat_atom([SrcDir, File, SrcSuff], SrcF),
+ concat_atom([ObjDir, File, LoadSuff], LoadF),
+ concat_atom([ObjDir, File, AutoLoadSuff], AutoLoadF),
+ update_i(Scenario, Mod, OptL, UpdateTime, SrcF, LoadF, AutoLoadF, SrcDir).
+
+update_i(Scenario, Mod, OptionList, UpdateTime, SrcF, LoadF, AutoLoadF, SrcDir) :-
+ modify_time(SrcF, ModifTime),
+ modify_time(LoadF, TranslateTime),
+ ModifTime >= TranslateTime,
+ !,
+ translate_file(Scenario, SrcF, LoadF, AutoLoadF, SrcDir, Mod),
+ load_file_if_needed(Scenario, Mod, OptionList, SrcF, LoadF, AutoLoadF, TranslateTime).
+update_i(Scenario, Mod, OptionList, UpdateTime, SrcF, LoadF, AutoLoadF, SrcDir) :-
+ modify_time(LoadF, TranslateTime),
+ % R1 XXX Bug here: UpdateTime in not instanciated.
+ % To turn around that bug, I have simply commented it out, which is ok
+ % since removing that test can only cause files to be loaded
+ % whereas it was not neccessary. It would certainly be necessary
+ % to look at it more carefully to fix that bug in a proper way.
+ % The best way to fix that kind of bugs is certainly to rewrite
+ % everything in Mercury ;-)
+% TranslateTime >= UpdateTime,
+ !,
+ load_file_if_needed(Scenario, Mod, OptionList, SrcF, LoadF, AutoLoadF, TranslateTime).
+update_i(Scenario, Mod, OptionList, UpdateTime, SrcF, LoadF, AutoLoadF, ScrDir) :-
+ printf(output, "%w is up-to-date\n", [SrcF]).
+
+/*
+ * load_file_if_needed/7
+ * If the scenario shall be made "inactive", the autoload file is compiled.
+ * Otherwise it is checked whether the load file has to be compiled.
+ */
+load_file_if_needed(Scenario, Mod, [inactive, _, _], SrcF, LoadF, AutoLoadF, TranslateTime) :-
+ !,
+ compile(AutoLoadF, Mod),
+ update_file_name(Scenario, Mod, SrcF).
+load_file_if_needed(Scenario, Mod, [active, Traceable, GloLoc], SrcF, LoadF, AutoLoadF, TranslateTime) :-
+ file_to_be_loaded(Scenario, Mod, SrcF, LoadF, Traceable, GloLoc, TranslateTime),
+ !,
+ call(current_options(O), 'Opium-M'),
+ printf(output, "loading %w\n", [SrcF]),
+ compile(SrcF, Mod),
+ compile(LoadF, Mod),
+ update_file_name(Scenario, Mod, SrcF),
+ printf(output, "%w is loaded\n", [SrcF]).
+load_file_if_needed(Scenario, Mod, OptionL, SrcF, LoadF, AutoLoadF, TranslateTime).
+
+/*
+ * file_to_be_loaded/7
+ * The file does not have to be loaded if the most recent version
+ * is already loaded in another scenario in the same module.
+ */
+file_to_be_loaded(Scenario, Mod, SrcFile, LoadF, Traceable, GloLoc, TTime) :-
+ call(opium_scenario(name:S, files:Files, N, O, updated:UpdateTime, M), Mod),
+ S \== Scenario,
+ O = options : [active, Traceable, GloLoc],
+ member(SrcFile, Files),
+ % XXX make/5 crashes because this is uninstanciated.
+ % Removing it seems to make things work. It is ok to do
+ % that since the only problem it can cause is that the message
+ % "%w is up-to-date\n" migth be printed when it is not the case...
+% UpdateTime > TTime,
+ !,
+ printf(output, "%w is up-to-date\n", [SrcFile]),
+ fail.
+file_to_be_loaded(Scenario, Mod, SrcFile, LoadF, Traceable, GloLoc, TTime) :-
+ opium_scenario_in_module((name:S, files:Files, N, O, updated:UpdateTime, M), Mod1),
+ Mod \== Mod1,
+ O = options : [active, Traceable, global],
+ member(SrcFile, Files),
+ !,
+ /* load file again, but take care that opium_objects are
+ * already declared global in another module */
+ setval(already_global, yes).
+file_to_be_loaded(Scenario, Mod, SrcFile, LoadF, Traceable, GloLoc, TTime) :-
+ setval(already_global, no).
+
+/*
+ * update_file_name/3
+ * In the scenario, the files contained in the filelist have to
+ * be the names of the files actually loaded.
+ */
+update_file_name(Scenario, Mod, SrcF) :-
+ call(retract(opium_scenario(name:Scenario, files:FileL, N, O, U, M)), Mod),
+ !,
+ update_filelist(FileL, SrcF, NewFileL),
+ call(assert(opium_scenario(name:Scenario, files:NewFileL, N, O, U, M)), Mod).
+
+update_filelist([], _, []).
+update_filelist([OldF|OldFs], SrcF, [SrcF|OldFs]) :-
+ atom_string(OldF, OldFS),
+ get_dir_and_file(OldFS, _, FileName),
+ atom_string(SrcF, SrcFS),
+ get_dir_and_file(SrcFS, _, FileName),
+ !.
+update_filelist([OldF|OldFs], SrcF, [OldF|NewFs]) :-
+ update_filelist(OldFs, SrcF, NewFs).
+
+
+/*
+ * make scenario traceable/untraceable
+ */
+set_dbgcomp_flag(traceable) :-
+ set_flag(debug_compile, on),
+ set_flag(variable_names, on).
+set_dbgcomp_flag(untraceable) :-
+ set_flag(debug_compile, off),
+ set_flag(variable_names, on).
+
+
+/*
+ * suffixes of Opium files
+ */
+file_suffixe_flag('.op', '.load', '.autoload').
+
+
+/*
+ * provide_directory(+Dir)
+ */
+provide_directory(Dir) :-
+ /* ending '/' has to be removed first */
+ atom_string(Dir, DirS),
+ string_length(DirS, L),
+ L0 is L - 1,
+ substring(DirS, 1, L0, PathS),
+ atom_string(Path, PathS),
+ provide_dir(Path).
+
+provide_dir(Dir) :-
+ exists(Dir),
+ !.
+provide_dir(Dir) :-
+ concat_atom([mkdir, ' ', Dir], SystemCmd),
+ sh(SystemCmd).
+
+
+/*
+ * absolute_pathnames(+SrcDir, +FileList, -AbsFileList)
+ * change the names of the files related to a scenario
+ * to their absolute pathnames
+ */
+absolute_pathnames(ScrDir, [], []) :-
+ !.
+absolute_pathnames(SrcDir, [File | Fs], [AbsFile | AbsFs]) :-
+ concat_atom([SrcDir, File, '.op'], AbsFile),
+ absolute_pathnames(SrcDir, Fs, AbsFs).
+
+
+/*
+ * The following is a hook which allows to redefine some global
+ * system predicates (spy/1, nospy/1, traceable/1, listing/1, etc):
+ * instead of being global, they are exported, and then they have
+ * to be imported by every opium module
+ */
+
+gloloc_error_handler(95, global Pred, _) :-
+ redefined_system_pred(Pred),
+ !,
+ export Pred.
+gloloc_error_handler(95, Goal, Module) :-
+ error(default(95), Goal, Module).
+
+redefined_system_pred((traceable)/1).
+redefined_system_pred((untraceable)/1).
+redefined_system_pred((skipped)/1).
+redefined_system_pred((unskipped)/1).
+redefined_system_pred((spy)/1).
+redefined_system_pred((nospy)/1).
+redefined_system_pred(no_trace/0).
+redefined_system_pred((listing)/1).
+redefined_system_pred((ls)/1).
+
+
+/*
+ * MODIFY-TIME
+ */
+opium_procedure(
+ name : modify_time,
+ arg_list : [File, Time],
+ implementation : modify_time_Op,
+ parameters : [],
+ message :
+"Procedure which returns the Time when File has been modified. If the file \n\
+does not exist, it returns 0."
+ ).
+
+modify_time_Op(File, Time) :-
+ get_file_info(File, mtime, Time),
+ !.
+modify_time_Op(File, 0).
+
+
+
+/* -------------------------
+ * load opium declarations
+ * -------------------------
+ */
+
+:- global load_decl/1.
+:- tool(load_decl/1, load_decl_body/2).
+
+load_decl_body(Clause, Module) :-
+ add_gloloc_directive(Clause, Module),
+ add_declaration(Clause, Module),
+ !.
+load_decl_body(Clause, Module).
+
+add_gloloc_directive(Clause, Module) :-
+ call(current_options([_,_,GloLoc]), 'Opium-M'),
+ add_gloloc_directive(Clause, Module, GloLoc).
+
+add_gloloc_directive(_, _, global) :-
+ getval(already_global, yes),
+ !,
+ fail.
+add_gloloc_directive(opium_command(name:Name, arg_list:ArgList, _, abbrev:Abbrev, _,_,_,_,_,_), Module, GloLoc) :-
+ length(ArgList, Arity),
+ declare_pred(Name/Arity, Module, GloLoc),
+ (var(Abbrev) ->
+ true
+ ;
+ declare_pred(Abbrev/Arity, Module, GloLoc)
+ ).
+add_gloloc_directive(opium_primitive(name:Name, arg_list:ArgList, _, abbrev:Abbrev ,_,_,_), Module, GloLoc) :-
+ length(ArgList, Arity),
+ declare_pred(Name/Arity, Module, GloLoc),
+ (var(Abbrev) ->
+ true
+ ;
+ declare_pred(Abbrev/Arity, Module, GloLoc)
+ ).
+add_gloloc_directive(opium_procedure(name:Name, arg_list:ArgList, _,_,_,_), Module, GloLoc) :-
+ length(ArgList, Arity),
+ declare_pred(Name/Arity, Module, GloLoc).
+add_gloloc_directive(opium_parameter(name:Name, arg_list:ArgList, _,_,_,_,_,_), Module, GloLoc).
+add_gloloc_directive(opium_type(name:Name, _,_,_), Module, GloLoc) :-
+ declare_pred(Name/1, Module, GloLoc).
+add_gloloc_directive(opium_demo(name:Name,_,_,_,_), Module, GloLoc) :-
+ declare_pred(Name/0, Module, GloLoc).
+add_gloloc_directive(opium_scenario(_,_,_,_,_,_), _, _).
+
+declare_pred(Name/Arity, Module, global) :-
+ !,
+ call(global Name/Arity, Module).
+declare_pred(Name/Arity, Module, local) :-
+ call(get_flag(Name/Arity, visibility, local), Module),
+ !.
+declare_pred(Name/Arity, Module, local) :-
+ call(local Name/Arity, Module).
+
+add_declaration(Clause, Module) :-
+ equivalent_clause_exists(Clause, Clause1, Module),
+ call(retract(Clause1), Module),
+ call(assert(Clause), Module),
+ !.
+add_declaration(Clause, Module) :-
+ call(assert(Clause), Module).
+
+
+/*
+ * equivalent_clause_exists(NewClause, ExistingClause) :- ExistingClause,
+ * with the following parameters equal:
+ * scenarios: name
+ * commands, procedures, primitives, parameters: name, arity, scenario
+ * types: name, scenario
+ * demos: name, scenario
+ */
+equivalent_clause_exists(
+ opium_scenario(Name, _, _, _, _, _),
+ opium_scenario(Name, Files, Scenarios, OptionList, Updated, Message),
+ Module
+) :-
+ call(opium_scenario(Name, Files, Scenarios, OptionList, Updated, Message), Module).
+equivalent_clause_exists(
+ opium_command( name : Name,
+ arg_list : ArgList1,
+ arg_type_list : _,
+ abbrev : _,
+ interface : _,
+ command_type : _,
+ scenario : Scenario,
+ implementation : _,
+ parameters : _,
+ message : _),
+ opium_command( name : Name,
+ arg_list : ArgList2,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ interface : Interface,
+ command_type : CommandType,
+ scenario : Scenario,
+ implementation : Implementation,
+ parameters : Parameter,
+ message : Message),
+ Module
+) :-
+ call(opium_command( name : Name,
+ arg_list : ArgList2,
+ arg_type_list : ArgType,
+ abbrev : Abbrev,
+ interface : Interface,
+ command_type : CommandType,
+ scenario : Scenario,
+ implementation : Implementation,
+ parameters : Parameter,
+ message : Message), Module),
+ length(ArgList1, L),
+ length(ArgList2, L),
+ !.
+equivalent_clause_exists(
+ opium_primitive(name : Name,
+ arg_list : ArgList1,
+ arg_type_list : _,
+ abbrev : _,
+ scenario : Scenario,
+ implementation : _,
+ message : _),
+ opium_primitive(name : Name,
+ arg_list : ArgList2,
+ arg_type_list : ArgType,
+ abbrev : _,
+ scenario : Scenario,
+ implementation : Implementation,
+ message : Message),
+ Module
+) :-
+ call(opium_primitive( name : Name,
+ arg_list : ArgList2,
+ arg_type_list : ArgType,
+ abbrev : _,
+ scenario : Scenario,
+ implementation : Implementation,
+ message : Message), Module),
+ length(ArgList1, L),
+ length(ArgList2, L),
+ !.
+equivalent_clause_exists(
+ opium_procedure(name : Name,
+ arg_list : ArgList1,
+ scenario : Scenario,
+ implementation : _,
+ parameters : _,
+ message : _),
+ opium_procedure(name : Name,
+ arg_list : ArgList2,
+ scenario : Scenario,
+ implementation : Procedure,
+ parameters : ParameterList,
+ message : Message),
+ Module
+) :-
+ call(opium_procedure( name : Name,
+ arg_list : ArgList2,
+ scenario : Scenario,
+ implementation : Procedure,
+ parameters : ParameterList,
+ message : Message), Module),
+ length(ArgList1, L),
+ length(ArgList2, L),
+ !.
+equivalent_clause_exists(
+ opium_parameter(name : Name,
+ arg_list : ArgList1,
+ arg_type_list : _,
+ scenario : Scenario,
+ parameter_type : _,
+ default : _,
+ commands : _,
+ message : _),
+ opium_parameter(name : Name,
+ arg_list : ArgList2,
+ arg_type_list : ArgType,
+ scenario : Scenario,
+ parameter_type : ParameterType,
+ default : DefaultArg,
+ commands : CommandList,
+ message : Message),
+ Module
+) :-
+ call(opium_parameter( name : Name,
+ arg_list : ArgList2,
+ arg_type_list : ArgType,
+ scenario : Scenario,
+ parameter_type : ParameterType,
+ default : DefaultArg,
+ commands : CommandList,
+ message : Message), Module),
+ length(ArgList1, L),
+ length(ArgList2, L),
+ !.
+equivalent_clause_exists(
+ opium_type( name : Name,
+ scenario : Scenario,
+ implementation : _,
+ message : _),
+ opium_type( name : Name,
+ scenario : Scenario,
+ implementation : Procedure,
+ message : Message),
+ Module
+) :-
+ call(opium_type(name : Name,
+ scenario : Scenario,
+ implementation : Procedure,
+ message : Message), Module).
+equivalent_clause_exists(
+ opium_demo( name : Name,
+ demo_goal : _,
+ condition : _,
+ scenario : Scenario,
+ message : _),
+ opium_demo( name : Name,
+ demo_goal : Goal,
+ condition : Condition,
+ scenario : Scenario,
+ message : Message),
+ Module
+) :-
+ call(opium_demo(name : Name,
+ demo_goal : Goal,
+ condition : Condition,
+ scenario : Scenario,
+ message : Message), Module).
+
+
+/*
+ * module handling
+ */
+provide_opium_module(sepia_kernel) :-
+ /* sepia_kernel cannot be an opium module */
+ !,
+ fail.
+provide_opium_module(kegi) :-
+ /* kegi cannot be an opium module */
+ !,
+ fail.
+provide_opium_module(Mod) :-
+ is_opium_module(Mod),
+ !.
+
+% [R1] Removed because update_opium_module_menu is not available in Opium-M
+% provide_opium_module(Mod) :-
+% update_opium_module_menu(Mod), % for wui interface
+% printf(output, "creating opium module %w\n", [Mod]),
+% (current_module(Mod) ->
+% true
+% ;
+% create_module(Mod)
+% ),
+% get_opium_file("opium_module", File),
+% compile(File, Mod).
+
+/*
+ * initialize_parameters(Type, Scenario, Mod)
+ * sets default values for parameters of Type is Scenario in Mod
+ * (needed because parameters of type 'C' cannot be set at boot time)
+ */
+initialize_parameters(Type, Scenario, Mod) :-
+ opium_parameter_in_module((
+ name : Parameter,
+ arg_list : ArgList,
+ arg_type_list : _,
+ scenario : Scenario,
+ parameter_type : Type,
+ default : DefaultVal,
+ commands : _,
+ message : _), Mod),
+ set_default_value(Type, Parameter, ArgList, DefaultVal, Mod),
+ fail.
+initialize_parameters(Type, Scenario, Mod).
+
+
Index: extras/opium_m/source/make_scenario-M.pl
===================================================================
RCS file: make_scenario-M.pl
diff -N make_scenario-M.pl
--- /dev/null Wed May 28 10:49:58 1997
+++ make_scenario-M.pl Tue Oct 26 23:26:41 1999
@@ -0,0 +1,55 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Authors : Erwan Jahier <jahier at irisa.fr>,
+% Mireille Ducassé <ducasse at irisa.fr>
+%
+% This file builds the Opium-M files. It is loaded from the INSTALL-OPIUM-M
+% script.
+
+:- module('Opium-M').
+
+:-
+ getenv('MERCURY_OPIUM_DIR', OpiumDir),
+ append_strings(OpiumDir, "/source/", SourceStr),
+ atom_string(Source, SourceStr),
+
+ append_strings(SourceStr, "util.pl", Util),
+ compile(Util, 'Opium-M'),
+
+ append_strings(OpiumDir, "/source/error.op", Error),
+ append_strings(OpiumDir, "/source/scenario_handler.op",
+ Scenario_handler),
+ append_strings(OpiumDir, "/source/make.op", Make),
+ append_strings(OpiumDir, "/source/scenario.op", Scenario),
+ append_strings(OpiumDir, "/source/translate.op", Translate),
+ append_strings(OpiumDir, "/source/types.op", Types),
+ append_strings(OpiumDir, "/source/parameter.op", Parameter),
+ append_strings(OpiumDir, "/source/autoload.op", Autoload),
+ append_strings(OpiumDir, "/source/interface.op", Interface),
+ compile(Scenario_handler, 'Opium-M'),
+ compile(Error, 'Opium-M'),
+ compile(Make, 'Opium-M'),
+ compile(Parameter, 'Opium-M'),
+ compile(Scenario, 'Opium-M'),
+ compile(Autoload, 'Opium-M'),
+ compile(Translate, 'Opium-M'),
+ compile(Types, 'Opium-M'),
+ compile(Interface, 'Opium-M'),
+
+ build_obj_dir(OD),
+ make(scenario_handler, 'Opium-M', [active, traceable, global], Source, OD),
+ make('opium_kernel_M', 'Opium-M', [active, traceable, global], Source, OD),
+ make('source_M', 'Opium-M', [active, traceable, global], Source, OD),
+ make('display_M', 'Opium-M', [active, traceable, global], Source, OD),
+ make('step_by_step_M', 'Opium-M', [active, traceable, global], Source, OD),
+ make(help, 'Opium-M', [active, traceable, global], Source, OD),
+
+ halt.
+
+
+
+
+
+
+
Index: extras/opium_m/source/opium_kernel_M.op
===================================================================
RCS file: opium_kernel_M.op
diff -N opium_kernel_M.op
--- /dev/null Wed May 28 10:49:58 1997
+++ opium_kernel_M.op Tue Oct 26 23:26:41 1999
@@ -0,0 +1,25 @@
+%--------------------------------------------------------------------------%
+% Copyright (C) 1999 IRISA/INRIA.
+%
+% Author : Erwan Jahier <jahier at irisa.fr>
+%
+
+opium_scenario(
+ name : opium_kernel_M,
+ files : [ opium_kernel_M,
+ forward_move_M,
+ current_slots_M,
+ current_arg_M,
+ event_attributes_M,
+ exec_control_M,
+ coprocess_M,
+ interactive_queries,
+ browse],
+ scenarios : [],
+ message :
+"Scenario opium_kernel_M contains all the basic mechanisms of Opium-M \
+which are needed to debug Mercury programs. \n\
+"
+ ).
+
+
Index: extras/opium_m/source/opium_module.sd
===================================================================
RCS file: opium_module.sd
diff -N opium_module.sd
Binary files /dev/null and opium_module.sd differ
Index: extras/opium_m/source/parameter.op
===================================================================
RCS file: parameter.op
diff -N parameter.op
--- /dev/null Wed May 28 10:49:58 1997
+++ parameter.op Tue Oct 26 23:26:42 1999
@@ -0,0 +1,580 @@
+/*
+ * $Header: parameter.op,v 1.23 91/03/22 10:19:47 mireille Exp $
+ * 1990 Copyright ECRC GmbH
+ */
+
+
+/*
+ * GET-PARAMETER
+ */
+opium_command(
+ name : get_parameter,
+ arg_list : [Parameter, ValueList],
+ arg_type_list : [is_opium_parameter, is_list_or_var],
+ abbrev : _,
+ interface : menu,
+ command_type : tool,
+ implementation : get_parameter_Op,
+ parameters : [],
+ message :
+"Command which gets the value of the parameter visible in the current module."
+ ).
+
+get_parameter_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((name:Parameter, _,_,_,_,_,_,_), Module),
+ !,
+ get_parameter_in_module(Parameter, ValueList, Module).
+get_parameter_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((name:Parameter,_,_, scenario:Scenario, _,_,_,_), Mod),
+ opium_scenario_in_module((name:Scenario,_,_, options:[_,_,global],_,_), Mod),
+ get_parameter_in_module(Parameter, ValueList, Mod).
+
+
+/*
+ * GET-PARAMETER-IN-MODULE
+ */
+opium_command(
+ name : get_parameter_in_module,
+ arg_list : [Parameter, ValueList, Module],
+ arg_type_list : [is_opium_parameter, is_list_or_var, is_opium_module],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : get_parameter_in_module_Op,
+ parameters : [],
+ message :
+"Command which gets the value of the parameter in a given module."
+ ).
+
+get_parameter_in_module_Op(Parameter, VarList, Module) :-
+ opium_parameter_in_module((name:Parameter, arg_list:ArgList, _,_, parameter_type:ParType, _,_,_), Module),
+ get_parameter_value(ParType, Parameter, ArgList, VarList, Module).
+
+% XXX remote_once is not available in Opium-M
+% get_parameter_value(c, Parameter, _, [Value], _) :-
+% !,
+% remote_once(getval(Parameter, Value), sepia_kernel).
+
+get_parameter_value(ParType, Parameter, ArgList, VarList, Module) :-
+ length(ArgList, L),
+ length(VarList, L),
+ Val =.. [Parameter | VarList],
+ call(Val, Module).
+
+
+/*
+ * SET-PARAMETER
+ */
+opium_command(
+ name : set_parameter,
+ arg_list : [Parameter, ValueList],
+ arg_type_list : [is_opium_parameter, is_list],
+ abbrev : _,
+ interface : menu,
+ command_type : tool,
+ implementation : set_parameter_Op,
+ parameters : [],
+ message :
+"Command which sets the value of the parameter visible in the current module. \n\
+It automatically prompts the user for the values using the types given \n\
+in the declaration of the parameter."
+ ).
+
+set_parameter_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((name:Parameter, _,_,_,_,_,_,_), Module),
+ !,
+ set_parameter_in_module(Parameter, ValueList, Module).
+set_parameter_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((name:Parameter,_,_, scenario:Scenario, _,_,_,_), Mod),
+ opium_scenario_in_module((name:Scenario,_,_, options:[_, _, global],_,_), Mod),
+ set_parameter_in_module(Parameter, ValueList, Mod).
+
+
+
+/*
+ * SET-PARAMETER-IN-MODULE
+ */
+opium_command(
+ name : set_parameter_in_module,
+ arg_list : [Parameter, ValueList, Module],
+ arg_type_list : [is_opium_parameter, is_list, is_opium_module],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : set_parameter_in_module_Op,
+ parameters : [],
+ message :
+"Command which sets the value of the parameter in a given module. It \n\
+automatically prompts the user for the values using the types given \n\
+in the declaration of the parameter."
+ ).
+
+set_parameter_in_module_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((
+ name: Parameter,
+ arg_list: ArgList,
+ arg_type_list: ArgType,
+ scenario: _,
+ parameter_type: ParType,
+ default: DefaultArg,
+ commands: _,
+ message: _), Module),
+ check_arg_type(ValueList, ArgList, ArgType, NewValueList, Module),
+ set_parameter_value(ParType, Parameter, ArgList, NewValueList, Module).
+
+% XXX remote_once is not available in Opium-M
+% set_parameter_value(c, Parameter, _, [NewVal], _) :-
+% remote_once(setval(Parameter, NewVal), sepia_kernel).
+set_parameter_value(single, Parameter, ArgList, NewValueList, Module) :-
+ length(ArgList, L),
+ length(VarList, L),
+ G =.. [Parameter | VarList],
+ call(retract_all(G), Module),
+ NewVal =.. [Parameter | NewValueList],
+ call(assert(NewVal), Module).
+set_parameter_value(multiple, Parameter, ArgList, NewValueList, Module) :-
+ NewVal =.. [Parameter | NewValueList],
+ call(assert(NewVal), Module).
+
+
+/*
+ * SET-PARAMETER
+ *
+ * interactive (will ask for value)
+ */
+opium_command(
+ name : set_parameter,
+ arg_list : [Parameter],
+ arg_type_list : [is_opium_parameter],
+ abbrev : _,
+ interface : hidden,
+ command_type : tool,
+ implementation : set_parameter_Op,
+ parameters : [],
+ message :
+"Interactive command which helps to set the value of the parameter which \n\
+is visible in the current module. It automatically checks the type of the \n\
+values according to the type given in the declaration of the parameter."
+ ).
+
+set_parameter_Op(Parameter, Module) :-
+ set_parameter_Op(Parameter, [], Module).
+
+
+
+/*
+ * SET-PARAMETER-IN-MODULE
+ *
+ * interactive (will ask for value)
+ */
+opium_command(
+ name : set_parameter_in_module,
+ arg_list : [Parameter, Module],
+ arg_type_list : [is_opium_parameter, is_opium_module],
+ abbrev : _,
+ interface : hidden,
+ command_type : opium,
+ implementation : set_parameter_in_module_Op,
+ parameters : [],
+ message :
+"Interactive command which helps to set the value of the parameter in a \n\
+given module. It automatically checks the type of the values according to \n\
+the type given in the declaration of the parameter."
+ ).
+
+set_parameter_in_module_Op(Parameter, Module) :-
+ set_parameter_in_module_Op(Parameter, Module, []).
+
+
+/*
+ * UNSET-PARAMETER
+ */
+opium_command(
+ name : unset_parameter,
+ arg_list : [Parameter, ValueList],
+ arg_type_list : [is_opium_parameter, is_list],
+ abbrev : _,
+ interface : menu,
+ command_type : tool,
+ implementation : unset_parameter_Op,
+ parameters : [],
+ message :
+'Command which unsets a value of a parameter which may have multiple values. \n\
+For a parameter of type "single" or "c" you can use set_parameter.'
+ ).
+
+unset_parameter_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((name:Parameter, _,_,_,_,_,_,_), Module),
+ !,
+ unset_parameter_in_module(Parameter, ValueList, Module).
+unset_parameter_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((name:Parameter,_,_, scenario:Scenario, _,_,_,_), Mod),
+ opium_scenario_in_module((name:Scenario,_,_, options:[_, _, global],_,_), Mod),
+ unset_parameter_in_module(Parameter, ValueList, Mod).
+
+
+/*
+ * UNSET-PARAMETER-IN-MODULE
+ */
+opium_command(
+ name : unset_parameter_in_module,
+ arg_list : [Parameter, ValueList, Module],
+ arg_type_list : [is_opium_parameter, is_list, is_opium_module],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : unset_parameter_in_module_Op,
+ parameters : [],
+ message :
+'Command which unsets the value of a parameter which may have multiple \n\
+values, in a given module. For a parameter of type "single" or "c" you \n\
+can use set_parameter_in_module.'
+ ).
+
+unset_parameter_in_module_Op(Parameter, ValueList, Module) :-
+ opium_parameter_in_module((
+ name: Parameter,
+ arg_list: ArgList,
+ arg_type_list: ArgType,
+ scenario: _,
+ parameter_type: multiple,
+ default: DefaultArg,
+ commands: _,
+ message: _), Module),
+ G =.. [Parameter | ValueList],
+ call(retract_all(G), Module).
+
+
+/*
+ * SET-DEFAULT-PARAMETERS
+ */
+opium_command(
+ name : set_default_parameters,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : set_default_parameters_Op,
+ parameters : [default_parameter],
+ message :
+"Command which sets or resets all the parameters of all the scenarios to \n\
+their default values."
+ ).
+
+set_default_parameters_Op :-
+ opium_scenario_in_module((name:S, _, _, _, _, _), Mod),
+ set_default_parameters_in_module(S, Mod),
+ fail.
+set_default_parameters_Op.
+
+
+/*
+ * SET-DEFAULT-PARAMETERS( Scenario )
+ */
+opium_command(
+ name : set_default_parameters,
+ arg_list : [Scenario],
+ arg_type_list : [is_opium_scenario],
+ abbrev : _,
+ interface : menu,
+ command_type : tool,
+ implementation : set_default_parameters_Op,
+ parameters : [default_parameter],
+ message :
+"Command which sets or resets the parameters of a scenario visible in the \n\
+current module to their default values."
+ ).
+
+set_default_parameters_Op(Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_,_,_,_), Module),
+ !,
+ set_default_parameters_in_module(Scenario, Module).
+set_default_parameters_Op(Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_, options:[_,_,global],_,_), Mod),
+ !,
+ set_default_parameters_in_module(Scenario, Mod).
+
+
+/*
+ * SET-DEFAULT-PARAMETERS-IN-MODULE( Scenario )
+ */
+opium_command(
+ name : set_default_parameters_in_module,
+ arg_list : [Scenario, Module],
+ arg_type_list : [is_opium_scenario, is_opium_module],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : set_default_parameters_in_module_Op,
+ parameters : [default_parameter],
+ message :
+"Command which sets or resets the parameters of a scenario to their default \n\
+values in a given module."
+ ).
+
+set_default_parameters_in_module_Op(Scenario, Module) :-
+ opium_parameter_in_module((
+ name: Parameter,
+ arg_list: ArgList,
+ arg_type_list: ArgType,
+ scenario: Scenario,
+ parameter_type: ParType,
+ default: DefaultVal,
+ commands: CommandList,
+ message: Message), Module),
+ set_default_value(ParType, Parameter, ArgList, DefaultVal, Module),
+ fail.
+set_default_parameters_in_module_Op(Scenario, Module).
+
+% XXX remote_once is not available in Opium-M
+% set_default_value(c, Parameter, _, [DefaultVal], _) :-
+% /* there is always a default value for c parameters */
+% remote_once(setval(Parameter, DefaultVal), sepia_kernel).
+set_default_value(_, Parameter, ArgList, nodefault, Module) :-
+ !,
+ length(ArgList, L),
+ length(VarList, L),
+ G =.. [Parameter | VarList],
+ call(retract_all(G), Module).
+set_default_value(_, Parameter, ArgList, DefaultVal, Module) :-
+ length(ArgList, L),
+ length(VarList, L),
+ G1 =.. [Parameter | VarList],
+ call(retract_all(G1), Module),
+ G2 =.. [Parameter | DefaultVal],
+ call(assert(G2), Module).
+
+
+/*
+ * SET-DEFAULT( Par )
+ */
+opium_command(
+ name : set_default,
+ arg_list : [Parameter],
+ arg_type_list : [is_opium_parameter],
+ abbrev : _,
+ interface : menu,
+ command_type : tool,
+ implementation : set_default_Op,
+ parameters : [],
+ message :
+"Command which sets or resets the default value of Parameter visible in \n\
+the current module."
+ ).
+
+set_default_Op(Parameter, Module) :-
+ opium_parameter_in_module((name:Parameter, _,_,_,_,_,_,_), Module),
+ !,
+ set_default_in_module(Parameter, Module).
+set_default_Op(Parameter, Module) :-
+ opium_parameter_in_module((name:Parameter, _,_, scenario:Scenario, _,_,_,_), Mod),
+ opium_scenario_in_module((name:Scenario, _,_, options:[_,_,global], _,_), Mod),
+ set_default_in_module(Parameter, Mod).
+
+
+/*
+ * SET-DEFAULT-IN-MODULE( Par )
+ */
+opium_command(
+ name : set_default_in_module,
+ arg_list : [Parameter, Module],
+ arg_type_list : [is_opium_parameter, is_opium_module],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : set_default_in_module_Op,
+ parameters : [],
+ message :
+"Command which sets or resets the default value of Parameter in a given module."
+ ).
+
+set_default_in_module_Op(Parameter, Module) :-
+ opium_parameter_in_module((
+ name: Parameter,
+ arg_list: ArgList,
+ arg_type_list: ArgType,
+ scenario: _,
+ parameter_type: ParType,
+ default: DefaultVal,
+ commands: _,
+ message: _), Module),
+ set_default_value(ParType, Parameter, ArgList, DefaultVal, Module).
+
+
+/*
+ * SHOW-PARAMETERS( Scenario )
+ */
+opium_command(
+ name : show_parameters,
+ arg_list : [Scenario],
+ arg_type_list : [is_opium_scenario],
+ abbrev : _,
+ interface : menu,
+ command_type : tool,
+ implementation : show_parameters_Op,
+ parameters : [],
+ message :
+"Command which shows the values of all the parameters related to a \n\
+scenario visible in the current module."
+ ).
+
+show_parameters_Op(Scenario, Module) :-
+ opium_scenario_in_module((name:Scenario,_,_,_,_,_), Module),
+ !,
+ show_parameters_in_module(Scenario, Module).
+show_parameters_Op(Scenario, Mod) :-
+ opium_scenario_in_module((name:Scenario,_,_, options:[_,_,global],_,_), Mod),
+ !,
+ show_parameters_in_module(Scenario, Mod).
+
+
+/*
+ * SHOW-PARAMETERS-IN-MODULE( Scenario )
+ */
+opium_command(
+ name : show_parameters_in_module,
+ arg_list : [Scenario, Module],
+ arg_type_list : [is_opium_scenario, is_opium_module],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : show_parameters_in_module_Op,
+ parameters : [],
+ message :
+"Command which shows the values of all the parameters related to Scenario \n\
+in a given module."
+ ).
+
+show_parameters_in_module_Op(Scenario, Module) :-
+ opium_parameter_in_module((
+ name: Parameter,
+ arg_list: ArgList,
+ arg_type_list: _,
+ scenario: Scenario,
+ parameter_type: ParType,
+ default: _,
+ commands: _,
+ message: _), Module),
+ list_parameter(ParType, Parameter, ArgList, Module),
+ fail.
+show_parameters_in_module_Op(Scenario, Module).
+
+% XXX remote_once is not available in Opium-M
+% list_parameter(c, Parameter, _, _) :-
+% !,
+% remote_once(getval(Parameter, Val), sepia_kernel),
+% G =.. [Parameter | [Val]],
+% opium_printf(help, " %w\n", [G]).
+list_parameter(single, Parameter, ArgList, Module) :-
+ !,
+ length(ArgList, L),
+ length(VarList, L),
+ Goal =.. [Parameter | VarList],
+ call(Goal, Module),
+ opium_printf(help, " %w\n", [Goal]).
+list_parameter(multiple, Parameter, ArgList, Module) :-
+ length(ArgList, L),
+ length(VarList, L),
+ Goal =.. [Parameter | VarList],
+ call(Goal, Module),
+ opium_printf(help, " %w\n", [Goal]),
+ fail.
+list_parameter(multiple, Parameter, ArgList, Module).
+
+
+/*
+ * SHOW-PARAMETERS
+ */
+opium_command(
+ name : show_parameters,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : show_parameters_Op,
+ parameters : [],
+ message :
+"Command which shows the values of all the parameters of all scenarios."
+ ).
+
+show_parameters_Op :-
+ opium_nl(help),
+ opium_scenario_in_module((name:S,_,_,_,_,_), Mod),
+ parameter_exists(S, Mod),
+ opium_printf(help, "Parameters of scenario %w in module %w :\n", [S, Mod]),
+ show_parameters_in_module(S, Mod),
+ opium_nl(help),
+ fail.
+show_parameters_Op.
+
+parameter_exists(Scenario, Module) :-
+ opium_parameter_in_module((
+ name: Parameter,
+ arg_list: ArgList,
+ arg_type_list: _,
+ scenario: Scenario,
+ parameter_type: ParType,
+ default: _,
+ commands: _,
+ message: _), Module),
+ check_parameter_exists(ParType, Parameter, ArgList, Module),
+ !.
+
+check_parameter_exists(c, Parameter, ArgList, Module) :-
+ !.
+check_parameter_exists(ParType, Parameter, ArgList, Module) :-
+ length(ArgList, L),
+ length(VarList, L),
+ Clause =.. [Parameter | VarList],
+ call(Clause, Module),
+ !.
+
+/*
+ * GET-PARAMETER-INFO
+ */
+opium_primitive(
+ name : get_parameter_info,
+ arg_list : [Parameter, Scenario, Module, ArgList, ArgType,
+ Default, CurrentValues],
+ arg_type_list : [is_opium_parameter, is_opium_scenario,
+ is_opium_module, var, var, var, var],
+ abbrev : _,
+ implementation : get_parameter_info_Op,
+ message :
+"Primitive which gives information about parameter Name related to Scenario in \n\
+a given module. CurrentValues is instantiated to the list of all current values."
+ ).
+
+get_parameter_info_Op(Name,Scenario, Module, ArgList, ArgType, Default,
+ CurrentValues) :-
+ opium_parameter_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgType,
+ scenario : Scenario,
+ parameter_type : ParType,
+ default : Default,
+ commands : _,
+ message : _ ), Module),
+ get_current_values(ParType, Name, Module, ArgList, CurrentValues).
+
+% XXX remote_once is not available in Opium-M
+% get_current_values(c, Name, Module, ArgList, [Val]) :-
+% remote_once(getval(Name, Val), sepia_kernel),
+% !.
+get_current_values(single, Name, Module, ArgList, ValList) :-
+ length(ArgList, L),
+ length(ValList, L),
+ Pred =.. [Name | ValList],
+ call(Pred, Module),
+ !.
+get_current_values(multiple, Name, Module, ArgList, CurrentValues) :-
+ length(ArgList, L),
+ length(VarList, L),
+ Pred =.. [Name | VarList],
+ setof(VarList, call(Pred, Module), CurrentValues),
+ !.
+get_current_values(ParType, Name, Module, ArgList, []).
+
Index: extras/opium_m/source/scenario.op
===================================================================
RCS file: scenario.op
diff -N scenario.op
--- /dev/null Wed May 28 10:49:58 1997
+++ scenario.op Tue Oct 26 23:26:42 1999
@@ -0,0 +1,414 @@
+/*
+ * $Header: scenario.op,v 1.27 91/03/22 10:19:53 mireille Exp $
+ * 1990 Copyright ECRC GmbH
+ */
+
+:- dynamic init_scenario/1.
+
+
+/*
+ * INITIALIZATION
+ */
+opium_command(
+ name : initialization,
+ arg_list : [Goals],
+ arg_type_list : [is_term],
+ abbrev : _,
+ interface : hidden,
+ command_type : tool,
+ implementation : initialization_Op,
+ parameters : [],
+ message :
+"When called as a compiled goal in a scenario file, initialization/1 \n\
+asserts a clause which ensures that the goals given as argument of \n\
+initialization/1 will be called whenever a new trace is started.\n\
+NOTE: it has to be ensured that these goals refer to either global \n\
+or exported predicates!"
+ ).
+
+:- dynamic init_scenario/0.
+
+initialization_Op((Goal, Gs), Module) :-
+ !,
+ assert_goal(Goal, Module),
+ initialization_Op(Gs, Module).
+initialization_Op(Goal, Module) :-
+ assert_goal(Goal, Module).
+
+assert_goal(Goal, Module) :-
+ assert_unique((init_scenario :- call(Goal, Module))).
+
+assert_unique((H :- B)) :-
+ clause(H, B),
+ !.
+assert_unique((H :- B)) :-
+ assert((H :- B)),
+ !.
+assert_unique(H) :-
+ clause(H, true),
+ !.
+assert_unique(H) :-
+ assert(H).
+
+
+/*
+ * IS-OPIUM-MODULE
+ */
+opium_type(
+ name : is_opium_module,
+ implementation : is_opium_module_Op,
+ message :
+"Type which succeeds for the name of a module which contains an opium \n\
+scenario, or a module which has been initialized interactively by calling \n\
+an Opium command or primitive."
+ ).
+
+is_opium_module_Op(X) :-
+ var(X),
+ !,
+ fail.
+is_opium_module_Op(M) :-
+ current_module(M),
+ not is_locked(M),
+ call(is_predicate(opium_module/0), M).
+
+
+/*
+ * OPIUM-MODULE
+ */
+opium_primitive(
+ name : opium_module,
+ arg_list : [M],
+ arg_type_list : [is_opium_module_or_var],
+ abbrev : _,
+ implementation : opium_module_Op,
+ message :
+"Primitive which succeeds if its argument is an opium module. It can also \n\
+be used to generate all the opium modules on backtracking."
+ ).
+
+opium_module_Op('Opium-M').
+ /* to get 'Opium-M' as first module always (manual) */
+opium_module_Op(M) :-
+ current_module(M),
+ M \== 'Opium-M',
+ not is_locked(M),
+ call(is_predicate(opium_module/0), M).
+
+
+
+/*
+ * IS-OPIUM-MODULE-OR-VAR
+ */
+opium_type(
+ name : is_opium_module_or_var,
+ implementation : is_opium_module_or_var_Op,
+ message :
+"Type which succeeds if the argument is an opium module or a variable."
+ ).
+
+is_opium_module_or_var_Op(X) :-
+ var(X),
+ !.
+is_opium_module_or_var_Op(X) :-
+ is_opium_module(X).
+
+
+/*
+ * SET_DEFAULT (Type, Name, Scenario, Module)
+ */
+opium_command(
+ name : set_default,
+ arg_list : [ObjectType, Pred, Scenario, Module],
+ arg_type_list : [is_customizable_type_or_var, is_pred_or_var,
+ is_opium_scenario_or_var, is_opium_module_or_var],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : set_default_Op,
+ parameters : [],
+ message :
+ "Commands which sets the object Pred (e.g. next/1) of type ObjectType \n\
+(e.g. command) in Scenario and Module to its default value. If used with \n\
+variables it will set to default the matching objects on backtracking. \n\
+For parameters use set_default/1."
+ ).
+
+set_default_Op(ObjectType, Name/Arity, Scenario, Module) :-
+ build_object(ObjectType, Name/Arity, default, Scenario, Module).
+
+
+/*
+ * REBUILD_OBJECT(ObjectType, ObjectName, Implementation, Scenario, Module)
+ */
+opium_command(
+ name : rebuild_object,
+ arg_list : [ObjectType, Pred, Implementation, Scenario, Module],
+ arg_type_list : [is_customizable_type, is_pred, atom,
+ is_opium_scenario_or_var, is_opium_module_or_var],
+ abbrev : _,
+ interface : menu,
+ command_type : opium,
+ implementation : rebuild_object_Op,
+ parameters : [],
+ message :
+ "Commands which links Pred (e.g. next/1) of ObjectType (e.g. command) in \n\
+Scenario and Module to the given Implementation. Pred must be the \n\
+name of an existing object with same arity. Implementation must be the \n\
+name of a predicate (e.g. mynext). This predicate must have the same \n\
+arity as the object to rebuild (except for tools commands where the \n\
+implementation must be of arity +1). The existence of such a predicate \n\
+is not checked by Opium."
+ ).
+
+rebuild_object_Op(ObjectType, Name/Arity, Impl, Scenario, Module) :-
+ build_object(ObjectType, Name/Arity, Impl, Scenario, Module).
+
+
+/*
+ * build_object/5 (ObjectType, Name/Arity, NewImpl, Scenario, Module)
+ */
+build_object(command, Name/Arity, NewImpl, Scenario, Module) :-
+ opium_command_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgTypeList,
+ abbrev : _Abbrev,
+ interface : _Interface,
+ command_type : ComType,
+ scenario : Scenario,
+ implementation : DefaultImpl,
+ parameters : _Pars,
+ message : _M
+ ), Module),
+ length(ArgList, Arity),
+ ( NewImpl == default -> Impl = DefaultImpl ; Impl = NewImpl),
+ build_pred_command(BuiltPred, ComType, Name, ArgList, ArgTypeList, Impl),
+ recompile_object(BuiltPred, Module).
+
+build_object(primitive, Name/Arity, NewImpl, Scenario, Module) :-
+ opium_primitive_in_module((
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : _ArgTypeList,
+ abbrev : _Abbrev,
+ scenario : Scenario,
+ implementation : DefaultImpl,
+ message : _M
+ ), Module),
+ length(ArgList, Arity),
+ ( NewImpl == default -> Impl = DefaultImpl ; Impl = NewImpl),
+ build_pred_primitive(BuiltPred, Name, ArgList, Impl),
+ recompile_object(BuiltPred, Module).
+
+build_object(procedure, Name/Arity, NewImpl, Scenario, Module) :-
+ opium_procedure_in_module((
+ name : Name,
+ arg_list : ArgList,
+ scenario : Scenario,
+ implementation : DefaultImpl,
+ parameters : _Pars,
+ message : _M
+ ), Module),
+ length(ArgList, Arity),
+ ( NewImpl == default -> Impl = DefaultImpl ; Impl = NewImpl),
+ build_pred_procedure(BuiltPred, Name, ArgList, Impl),
+ recompile_object(BuiltPred, Module).
+
+build_object(type, Name/1, NewImpl, Scenario, Module) :-
+ opium_type_in_module((
+ name : Name,
+ scenario : Scenario,
+ implementation : DefaultImpl,
+ message : _M
+ ), Module),
+ ( NewImpl == default -> Impl = DefaultImpl ; Impl = NewImpl),
+ build_pred_type(BuiltPred, Name, Impl),
+ recompile_object(BuiltPred, Module).
+
+
+
+recompile_object(BuiltPred, Module) :-
+ call(compile_term(BuiltPred), Module).
+
+/*
+ * build_pred_command/5 (BuiltPred, CmdType, Name, ArgList, TypeList, Impl)
+ * Computes the clauses (to be compiled) which links name and implementation
+ * according to the type of the command.
+ */
+build_pred_command(BuiltPred, opium, Name, [], [], Impl) :-
+ !,
+ BuiltPred = (Name :- Impl).
+build_pred_command(BuiltPred, opium, Name, ArgList, TypeList, Impl) :-
+ !,
+ Cmd1 =.. [Name | ArgList],
+ name_variables(ArgList, ArgNameList),
+ BuiltPred = (Cmd1 :-
+ check_arg_type(ArgList, ArgNameList, TypeList, NewList),
+ Cmd2 =.. [Impl | NewList],
+ Cmd2).
+build_pred_command(BuiltPred, trace, Name, [], [], Impl) :-
+ !,
+ concat_atom([Name, '_np'], Name_np),
+ BuiltPred =
+ ([(Name :- Name_np, print_event),
+ (Name_np :- Impl)]).
+build_pred_command(BuiltPred, trace, Name, ArgList, TypeList, Impl) :-
+ Cmd1 =.. [Name | ArgList],
+ concat_atom([Name, '_np'], Name_np),
+ Cmd_np =.. [Name_np | ArgList],
+ ImplGoal =.. [Impl | ArgList],
+ name_variables(ArgList, ArgNameList),
+ BuiltPred =
+ ([(Cmd1 :-
+ check_arg_type(ArgList, ArgNameList, TypeList, NewList),
+ Cmd2 =.. [Name_np | NewList],
+ Cmd2,
+ print_event),
+ (Cmd_np :- ImplGoal)]).
+build_pred_command(BuiltPred, tool, Name, [], [], Impl) :-
+ !,
+ concat_atoms(Name, '_body', BodyName),
+ BodyCmd1 =.. [BodyName | [ActModule]],
+ BodyCmd2 =.. [Impl | [ActModule]],
+ BuiltPred = (BodyCmd1 :- BodyCmd2).
+build_pred_command(BuiltPred, tool, Name, ArgList, TypeList, Impl) :-
+ append(ArgList, [ActModule], BodyArgList),
+ name_variables(BodyArgList, BodyArgNameList),
+ append(TypeList, [is_opium_module], BodyTypeList),
+ concat_atoms(Name, '_body', BodyName),
+ BodyCmd1 =.. [BodyName | BodyArgList],
+ BuiltPred =
+ (BodyCmd1 :-
+ check_arg_type(BodyArgList, BodyArgNameList, BodyTypeList, NewList),
+ BodyCmd2 =.. [Impl | NewList],
+ BodyCmd2).
+
+/*
+ * build_pred_primitive/4
+ */
+build_pred_primitive(BuiltPred, Name, ArgList, Impl) :-
+ Cmd1 =.. [Name | ArgList],
+ Cmd2 =.. [Impl | ArgList],
+ BuiltPred =(Cmd1 :- Cmd2).
+
+/*
+ * build_pred_procedure/4
+ */
+build_pred_procedure(BuiltPred, Name, ArgList, Impl):-
+ Cmd1 =.. [Name | ArgList],
+ Cmd2 =.. [Impl | ArgList],
+ BuiltPred = (Cmd1 :- Cmd2).
+
+/*
+ * build_pred_type/3
+ */
+build_pred_type(BuiltPred, Name, Impl) :-
+ Cmd1 =.. [Name | [X]],
+ Cmd2 =.. [Impl | [X]],
+ BuiltPred = (Cmd1 :- Cmd2).
+
+/*
+ * IMPLEMENTATION_LINK(?ObjectType, ?Pred, ?ObjectImpl, ?Module)
+ */
+
+opium_primitive(
+ name : implementation_link,
+ arg_list : [ObjectType, Pred, DefaultImpl, Module],
+ arg_type_list : [is_customizable_type_or_var, is_pred_or_var, is_atom_or_var,
+ is_opium_module_or_var],
+ abbrev : _,
+ implementation : implementation_link_Op,
+ message :
+ "Primitive which retrieves the link between Pred, an Opium objects \n\
+(e.g. next/0) of ObjectType and its default implementation visible in \n\
+Module. This is useful when you want to customize an object and you \n\
+want to re-use the default implementation. Only commands, primitives, \n\
+procedures and types can be customized. For parameters see \n\
+set_parameter."
+ ).
+
+
+implementation_link_Op(command, ObjectName/Arity, ObjectImpl, Module) :-
+ opium_command_in_module((
+ name : ObjectName,
+ arg_list : ArgList,
+ arg_type_list : _,
+ abbrev : _,
+ interface : _,
+ command_type : _,
+ scenario : _,
+ implementation : ObjectImpl,
+ parameters : _,
+ message : _
+ ), Module),
+ length(ArgList, Arity).
+implementation_link_Op(primitive, ObjectName/Arity, ObjectImpl, Module) :-
+ opium_primitive_in_module((
+ name : ObjectName,
+ arg_list : ArgList,
+ arg_type_list : _,
+ abbrev : _,
+ scenario : _,
+ implementation : ObjectImpl,
+ message : _
+ ), Module),
+ length(ArgList, Arity).
+implementation_link_Op(procedure, ObjectName/Arity, ObjectImpl, Module) :-
+ opium_procedure_in_module((
+ name : ObjectName,
+ arg_list : ArgList,
+ scenario : _,
+ implementation : ObjectImpl,
+ parameters : _,
+ message : _
+ ), Module),
+ length(ArgList, Arity).
+implementation_link_Op(type, ObjectName, ObjectImpl, Module) :-
+ opium_type_in_module((
+ name : ObjectName,
+ scenario : _,
+ implementation : ObjectImpl,
+ message : _
+ ), Module).
+
+
+/*
+ * IS-CUSTOMIZABLE-TYPE-OR-VAR
+ */
+opium_type(
+ name : is_customizable_type_or_var,
+ implementation : is_customizable_type_or_var_Op,
+ message :
+ "Type which succeeds for a type of Opium object which is customizable, \n\
+or a variable. Customizable types are command, primitive, procedure, \n\
+type."
+ ).
+
+is_customizable_type_or_var_Op(X) :-
+ var(X),
+ !.
+is_customizable_type_or_var_Op(X) :-
+ is_customizable_type(X).
+
+
+/*
+ * IS-CUSTOMIZABLE-TYPE
+ */
+opium_type(
+ name : is_customizable_type,
+ implementation : is_customizable_type_Op,
+ message :
+ "Type which succeeds for a type of Opium object which is customizable.\n\
+Customizable types are command, primitive, procedure, type."
+ ).
+
+is_customizable_type_Op(X) :-
+ var(X),
+ !,
+ fail.
+is_customizable_type_Op(command).
+is_customizable_type_Op(primitive).
+is_customizable_type_Op(procedure).
+is_customizable_type_Op(type).
+
Index: extras/opium_m/source/scenario_handler.op
===================================================================
RCS file: scenario_handler.op
diff -N scenario_handler.op
--- /dev/null Wed May 28 10:49:58 1997
+++ scenario_handler.op Tue Oct 26 23:26:43 1999
@@ -0,0 +1,536 @@
+/*
+ * $Header: scenario_handler.op,v 1.4 93/07/30 17:49:10 mireille Exp $
+ * 1990 Copyright ECRC GmbH
+ */
+
+:- tool(get_parameter/2).
+:- tool(set_parameter/2).
+
+
+
+opium_scenario(
+ name : scenario_handler,
+ files : [ scenario_handler,
+ make,
+ parameter,
+ scenario,
+ autoload,
+ error,
+ translate,
+ types],
+ scenarios : [],
+ message :
+ "The scenario handler manages all the Opium objects: scenarios, \n\
+commands, parameters, primitives, types and demos. It also handles an \n\
+error recovery mechanism and the autoload of inactive scenarios."
+ ).
+
+
+% Useless in Opium-M ???
+% /*
+% * DEF-MODULE
+% */
+% opium_primitive(
+% name : def_module,
+% arg_list : [Pred, CallModule, DefModule],
+% arg_type_list : [is_pred, is_atom, is_atom_or_var],
+% abbrev : _,
+% implementation : def_module_Op,
+% message :
+% "Primitives which gives or checks the module where Pred visible in CallModule \n\
+% is defined. The primitive fails if Pred is not defined at all."
+% ).
+
+% def_module_Op(P/A, CallModule, DefModule) :-
+% def_module_ok(P/A, CallModule, DefModule).
+
+% /*
+% * we use a function def_module_c because Sepia's get_flag/3 does
+% * not work if the module is locked
+% */
+% def_module_ok(P/A, CallMod, DefMod) :-
+% exchange_with_prolog_asynchronously(def_module_pk(P/A, CallMod, D),
+% def_module_pk(P/A, CallMod, DefMod)).
+
+
+/*
+ * GET-OPIUM-FILENAME
+ */
+opium_primitive(
+ name : get_opium_filename,
+ arg_list : [File, FileName],
+ arg_type_list : [atom, var],
+ abbrev : _,
+ implementation : get_opium_filename_Op,
+ message :
+"Primitive which gives the full file name including suffix of an Opium \n\
+file. If the file does not exist it fails and gives an error message."
+ ).
+
+get_opium_filename_Op(F, File) :-
+ get_flag(prolog_suffix, Suffixes),
+ get_filename(F, Suffixes, File).
+
+get_filename(F, Suffixes, File) :-
+ (string(F) -> % first convert to a string
+ FS = F
+ ;
+ atom(F) ->
+ atom_string(F, FS)
+ ;
+ opium_printf(error, "%w is not a proper file name\n", [F]),
+ fail
+ ),
+ (substring(FS, "/", 1) -> % absolute path name
+ FullS = FS
+ ;
+ get_flag(cwd, CWD),
+ concat_strings(CWD, FS, FullS)
+ ),
+ (
+ PlFile = FullS
+ ;
+ member(Suff, Suffixes),
+ concat_strings(FullS, Suff, PlFile)
+ ),
+ exists(PlFile),
+ !,
+ atom_string(File, PlFile).
+get_filename(F, Suffixes, File) :-
+ printf(error, "file %w does not exist\n", [F]),
+ fail.
+
+
+% XXX R1 remote_once is not available in Opium-M
+% /*
+% * GET-PROLOG-FILENAME
+% */
+% opium_primitive(
+% name : get_prolog_filename,
+% arg_list : [File, FileName],
+% arg_type_list : [atom, var],
+% abbrev : _,
+% implementation : get_prolog_filename_Op,
+% message :
+% "Primitive which gives the full file name including suffix of a Prolog \n\
+% file. If the file does not exist it fails and gives an error message."
+% ).
+
+% get_prolog_filename_Op(F, File) :-
+% remote_once(get_flag(prolog_suffix, Suffixes), sepia_kernel),
+% get_filename(F, Suffixes, File).
+
+
+
+/*
+ * OPIUM-SCENARIO-IN-MODULE
+ */
+opium_procedure(
+ name : opium_scenario_in_module,
+ arg_list : [Scenario, Module],
+ implementation : opium_scenario_in_module_Op,
+ parameters : [],
+ message :
+"Procedure which succeeds if Scenario is declared in Module."
+ ).
+
+opium_scenario_in_module_Op(S, Module)
+:-
+ (global_op(400,xfy,:) ; global_op(600,xfy,:),fail),
+ S = (
+ name : Name,
+ files : Files,
+ scenarios : Scenarios,
+ options : Options,
+ updated : UTime,
+ message : M
+ ),
+ opium_module(Module),
+ call(opium_scenario(
+ name : Name,
+ files : Files,
+ scenarios : Scenarios,
+ options : Options,
+ updated : UTime,
+ message : M
+ ), Module),
+ global_op(600,xfy,:).
+
+/*
+ * OPIUM-COMMAND-IN-MODULE
+ */
+opium_procedure(
+ name : opium_command_in_module,
+ arg_list : [Command, Module],
+ implementation : opium_command_in_module_Op,
+ parameters : [],
+ message :
+"Procedure which succeeds if Command is declared in Module."
+ ).
+
+opium_command_in_module_Op(C, Module)
+:-
+ (global_op(400,xfy,:) ; global_op(600,xfy,:),fail),
+ C = (
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgTypeList,
+ abbrev : Abbrev,
+ interface : Interface,
+ command_type : ComType,
+ scenario : Scenario,
+ implementation : Impl,
+ parameters : Pars,
+ message : M
+ ),
+ opium_module(Module),
+ call(opium_command(
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgTypeList,
+ abbrev : Abbrev,
+ interface : Interface,
+ command_type : ComType,
+ scenario : Scenario,
+ implementation : Impl,
+ parameters : Pars,
+ message : M
+ ), Module),
+ global_op(600,xfy,:).
+
+/*
+ * OPIUM-PRIMITIVE-IN-MODULE
+ */
+opium_procedure(
+ name : opium_primitive_in_module,
+ arg_list : [Primitive, Module],
+ implementation : opium_primitive_in_module_Op,
+ parameters : [],
+ message :
+"Procedure which succeeds if Primitive is declared in Module."
+ ).
+
+opium_primitive_in_module_Op(P, Module)
+:-
+ (global_op(400,xfy,:) ; global_op(600,xfy,:),fail),
+ P = (
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgTypeList,
+ abbrev : Abbrev,
+ scenario : Scenario,
+ implementation : Impl,
+ message : M
+ ),
+ opium_module(Module),
+ call(opium_primitive(
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgTypeList,
+ abbrev : Abbrev,
+ scenario : Scenario,
+ implementation : Impl,
+ message : M
+ ), Module),
+ global_op(600,xfy,:).
+
+/*
+ * OPIUM-PROCEDURE-IN-MODULE
+ */
+opium_procedure(
+ name : opium_procedure_in_module,
+ arg_list : [Procedure, Module],
+ implementation : opium_procedure_in_module_Op,
+ parameters : [],
+ message :
+"Procedure which succeeds if Procedure is declared in Module."
+ ).
+
+opium_procedure_in_module_Op(Proc, Module)
+:-
+ (global_op(400,xfy,:) ; global_op(600,xfy,:),fail),
+ Proc = (
+ name : Name,
+ arg_list : ArgList,
+ scenario : Scenario,
+ implementation : Impl,
+ parameters : Pars,
+ message : M
+ ),
+ opium_module(Module),
+ call(opium_procedure(
+ name : Name,
+ arg_list : ArgList,
+ scenario : Scenario,
+ implementation : Impl,
+ parameters : Pars,
+ message : M
+ ), Module),
+ global_op(600,xfy,:).
+
+/*
+ * OPIUM-PARAMETER-IN-MODULE
+ */
+opium_procedure(
+ name : opium_parameter_in_module,
+ arg_list : [Parameter, Module],
+ implementation : opium_parameter_in_module_Op,
+ parameters : [],
+ message :
+"Procedure which succeeds if Parameter is declared in Module."
+ ).
+
+opium_parameter_in_module_Op(P, Module)
+:-
+ (global_op(400,xfy,:) ; global_op(600,xfy,:),fail),
+ P = (
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgTypeList,
+ scenario : Scenario,
+ parameter_type : ParameterType,
+ default : Default,
+ commands : Commands,
+ message : M
+ ),
+ opium_module(Module),
+ call(opium_parameter(
+ name : Name,
+ arg_list : ArgList,
+ arg_type_list : ArgTypeList,
+ scenario : Scenario,
+ parameter_type : ParameterType,
+ default : Default,
+ commands : Commands,
+ message : M
+ ), Module),
+ global_op(600,xfy,:).
+
+/*
+ * OPIUM-TYPE-IN-MODULE
+ */
+opium_procedure(
+ name : opium_type_in_module,
+ arg_list : [Type, Module],
+ implementation : opium_type_in_module_Op,
+ parameters : [],
+ message :
+"Procedure which succeeds if Type is declared in Module."
+ ).
+
+opium_type_in_module_Op(Type, Module)
+:-
+ (global_op(400,xfy,:) ; global_op(600,xfy,:),fail),
+ Type = (
+ name : Name,
+ scenario : Scenario,
+ implementation : Impl,
+ message : M
+ ),
+ opium_module(Module),
+ call(opium_type(
+ name : Name,
+ scenario : Scenario,
+ implementation : Impl,
+ message : M
+ ), Module),
+ global_op(600,xfy,:).
+
+
+/*
+ * OPIUM-DEMO-IN-MODULE
+ */
+opium_procedure(
+ name : opium_demo_in_module,
+ arg_list : [Demo, Module],
+ implementation : opium_demo_in_module_Op,
+ parameters : [],
+ message :
+"Procedure which succeeds if Demo is declared in Module."
+ ).
+
+opium_demo_in_module_Op(Demo, Module)
+:-
+ (global_op(400,xfy,:) ; global_op(600,xfy,:),fail),
+ Demo = (
+ name : Name,
+ demo_goal : Goal,
+ condition : Condition,
+ scenario : Scenario,
+ message : M
+ ),
+ opium_module(Module),
+ call(opium_demo(
+ name : Name,
+ demo_goal : Goal,
+ condition : Condition,
+ scenario : Scenario,
+ message : M
+ ), Module),
+ global_op(600,xfy,:).
+
+
+/*
+ * IS-OPIUM-SCENARIO
+ */
+opium_type(
+ name : is_opium_scenario,
+ implementation : is_opium_scenario_Op,
+ message :
+"Type which succeeds for an active opium scenario."
+ ).
+
+is_opium_scenario_Op(S) :-
+ atom(S),
+ opium_scenario_in_module((name: S, _, _, _, _, _), M).
+
+
+/*
+ * IS-OPIUM-SCENARIO
+ */
+opium_type(
+ name : is_opium_scenario_or_var,
+ implementation : is_opium_scenario_or_var_Op,
+ message :
+"Type which succeeds for an active opium scenario or a variable."
+ ).
+
+is_opium_scenario_or_var_Op(S) :-
+ (var(S) ; is_opium_scenario_Op(S)).
+
+/*
+ * IS-OPIUM-PARAMETER
+ */
+opium_type(
+ name : is_opium_parameter,
+ implementation : is_opium_parameter_Op,
+ message :
+"Type which succeeds for a parameter of an opium scenario."
+ ).
+
+is_opium_parameter_Op(Par) :-
+ atom(Par),
+ opium_parameter_in_module((name: Par, _, _, _, _, _, _, _), _).
+
+
+/*
+ * IS-OPIUM-OBJECT-OR-VAR
+ */
+opium_type(
+ name : is_opium_object_or_var,
+ implementation : is_opium_object_or_var_Op,
+ message :
+"Type which succeeds for an object declared in an opium scenario, or a \n\
+variable. An Opium object is a scenario, a command, a primitive, a procedure, \n\
+a parameter, or a type."
+ ).
+
+is_opium_object_or_var_Op(X) :-
+ var(X),
+ !.
+is_opium_object_or_var_Op(X) :-
+ is_opium_scenario(X),
+ !.
+is_opium_object_or_var_Op(X) :-
+ is_opium_command(X),
+ !.
+is_opium_object_or_var_Op(X) :-
+ is_opium_procedure(X),
+ !.
+is_opium_object_or_var_Op(X) :-
+ is_opium_parameter(X),
+ !.
+is_opium_object_or_var_Op(X) :-
+ is_opium_primitive(X),
+ !.
+is_opium_object_or_var_Op(X) :-
+ is_opium_type(X),
+ !.
+is_opium_object_or_var_Op(X) :-
+ is_opium_demo(X),
+ !.
+
+is_opium_command(Cmd) :-
+ opium_command_in_module((name: Cmd, _, _, _, _, _, _, _, _, _), _).
+
+is_opium_procedure(Proc) :-
+ opium_procedure_in_module((name: Proc, _, _, _, _, _), _).
+
+is_opium_primitive(Prim) :-
+ opium_primitive_in_module((name: Prim, _, _, _, _, _, _), _).
+
+is_opium_type(T) :-
+ opium_type_in_module((name: T, _, _, _), _).
+
+is_opium_demo(T) :-
+ opium_demo_in_module((name: T, _, _, _, _), _).
+
+
+
+
+/*
+ * SET-DEFAULT-STATE
+ */
+/*
+ this is too costly and too fuzzy
+
+opium_command(
+ name : set_default_state,
+ arg_list : [],
+ arg_type_list : [],
+ abbrev : _,
+ interface : button,
+ command_type : opium,
+ implementation : set_default_state_Op,
+ parameters : [],
+ message :
+"Command which sets the Opium state to its default value. It sets the \n\
+parameters to their default values, and resets all the predicate flags."
+ ).
+
+set_default_state_Op:-
+ % unset_pred_flag has to be done first before
+ % set_default_parameters erases "flagged_pred"
+ unset_pred_flags,
+ set_default_parameters,
+ !.
+*/
+
+
+/*
+ * decode_port(?PortName, ?PortNumber)
+ * (used in extension.op)
+ * The inside and outside backtracking are redirected to a single
+ * port, because they actually correspond to a single action in
+ * the compiler.
+ * If this list is changed please change also the documentation of
+ * the is_port type.
+ */
+decode_port(call, 1) :- !.
+decode_port(redo, 2) :- !.
+decode_port(next, 3) :- !. % backtracking while still "inside" the box
+decode_port(exit_c, 4) :- !. % exit leaving choice points
+decode_port(fail, 5) :- !.
+decode_port(exit, 6) :- !. % deterministic exit
+decode_port(delay, 7) :- !.
+decode_port(resume, 8) :- !.
+decode_port(unify, 9) :- !.
+decode_port(cut, 10) :- !.
+decode_port(leave, 11) :- !.
+decode_port(next, 12) :- !. % backtracking from "outside" the box
+decode_port(try, 13) :- !. % a choice point is created
+
+decode_port_or_portlist(0, 0) :- !.
+decode_port_or_portlist([], []) :- !.
+decode_port_or_portlist([H | T], [HD | TD]) :-
+ !,
+ decode_port(H, HD),
+ decode_port_or_portlist(T, TD).
+decode_port_or_portlist(P, PD) :-
+ decode_port(P, PD).
+
+
+
+
+
+
--
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