2001-04-09 20:54:03 +01:00
|
|
|
/*************************************************************************
|
|
|
|
* *
|
|
|
|
* YAP Prolog *
|
|
|
|
* *
|
2014-12-14 11:45:42 +00:00
|
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
2001-04-09 20:54:03 +01:00
|
|
|
* *
|
2014-04-09 12:39:29 +01:00
|
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 *
|
2001-04-09 20:54:03 +01:00
|
|
|
* *
|
|
|
|
**************************************************************************
|
|
|
|
* *
|
|
|
|
* File: boot.yap *
|
|
|
|
* Last rev: 8/2/88 *
|
|
|
|
* mods: *
|
|
|
|
* comments: boot file for Prolog *
|
|
|
|
* *
|
|
|
|
*************************************************************************/
|
2003-01-08 16:45:35 +00:00
|
|
|
|
2015-01-04 23:58:23 +00:00
|
|
|
%% @{
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/**
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
@defgroup YAPControl Control Predicates
|
2015-01-04 23:58:23 +00:00
|
|
|
@ingroup builtins
|
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
|
|
|
|
|
|
|
|
2014-07-27 01:14:15 +01:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred :_P_ ; :_Q_ is iso
|
2014-07-27 01:14:15 +01:00
|
|
|
Disjunction of goals (or).
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
p(X) :- q(X); r(X).
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
should be read as "p( _X_) if q( _X_) or r( _X_)".
|
|
|
|
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
*/
|
2014-07-27 01:14:15 +01:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred \+ :_P_ is iso
|
|
|
|
Negation by failure.
|
2014-07-27 01:14:15 +01:00
|
|
|
|
|
|
|
Goal _P_ is not provable. The execution of this predicate fails if
|
|
|
|
and only if the goal _P_ finitely succeeds. It is not a true logical
|
|
|
|
negation, which is impossible in standard Prolog, but
|
|
|
|
"negation-by-failure".
|
|
|
|
|
|
|
|
This predicate might be defined as:
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
~~~~~~~~~~~~
|
2014-07-27 01:14:15 +01:00
|
|
|
\+(P) :- P, !, fail.
|
|
|
|
\+(_).
|
2014-11-02 12:10:32 +00:00
|
|
|
~~~~~~~~~~~~
|
2014-07-27 01:14:15 +01:00
|
|
|
if _P_ did not include "cuts".
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
If _P_ includes cuts, the cuts are defined to be scoped by _P_: they canno cut over the calling prredicate.
|
|
|
|
|
|
|
|
~~~~~~~~~~~~
|
|
|
|
go(P).
|
|
|
|
:- \+ P, !, fail.
|
|
|
|
\+(_).
|
|
|
|
~~~~~~~~~~~~
|
|
|
|
|
2014-07-27 01:14:15 +01:00
|
|
|
*/
|
|
|
|
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred not :_P_
|
2014-07-27 01:14:15 +01:00
|
|
|
|
|
|
|
|
|
|
|
Goal _P_ is not provable. The same as `\+ _P_`.
|
|
|
|
|
|
|
|
This predicate is kept for compatibility with C-Prolog and previous
|
|
|
|
versions of YAP. Uses of not/1 should be replaced by
|
|
|
|
`\+`/1, as YAP does not implement true negation.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-07-27 01:14:15 +01:00
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred :_Condition__ -> :_Action_ is iso
|
2014-07-27 01:14:15 +01:00
|
|
|
|
|
|
|
|
|
|
|
Read as "if-then-else" or "commit". This operator is similar to the
|
|
|
|
conditional operator of imperative languages and can be used alone or
|
|
|
|
with an else part as follows:
|
|
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
+P -> +Q
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
"if P then Q".
|
|
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
+P -> +Q; +R
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
"if P then Q else R".
|
|
|
|
|
|
|
|
These two predicates could be defined respectively in Prolog as:
|
|
|
|
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
(P -> Q) :- P, !, Q.
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
and
|
|
|
|
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
(P -> Q; R) :- P, !, Q.
|
|
|
|
(P -> Q; R) :- R.
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
if there were no "cuts" in _P_, _Q_ and _R_.
|
|
|
|
|
|
|
|
Note that the commit operator works by "cutting" any alternative
|
|
|
|
solutions of _P_.
|
|
|
|
|
|
|
|
Note also that you can use chains of commit operators like:
|
|
|
|
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
P -> Q ; R -> S ; T.
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
Note that `(->)/2` does not affect the scope of cuts in its
|
|
|
|
arguments.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-07-27 01:14:15 +01:00
|
|
|
*/
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred :_Condition_ *-> :_Action_ is iso
|
2014-07-27 01:14:15 +01:00
|
|
|
|
|
|
|
This construct implements the so-called <em>soft-cut</em>. The control is
|
2014-11-02 12:10:32 +00:00
|
|
|
defined as follows:
|
|
|
|
+ If _Condition_ succeeds at least once, the
|
|
|
|
semantics is the same as ( _Condition_, _Action_).
|
|
|
|
|
|
|
|
+ If
|
2014-07-27 01:14:15 +01:00
|
|
|
_Condition_ does not succeed, the semantics is that of (\\+
|
2014-11-02 12:10:32 +00:00
|
|
|
_Condition_, _Else_).
|
|
|
|
|
|
|
|
In other words, if _Condition_
|
2014-07-27 01:14:15 +01:00
|
|
|
succeeds at least once, simply behave as the conjunction of
|
|
|
|
_Condition_ and _Action_, otherwise execute _Else_.
|
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
The construct _A *-> B_, i.e. without an _Else_ branch, is
|
2014-07-27 01:14:15 +01:00
|
|
|
translated as the normal conjunction _A_, _B_.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-07-27 01:14:15 +01:00
|
|
|
*/
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred ! is iso
|
2014-07-27 01:14:15 +01:00
|
|
|
|
|
|
|
|
|
|
|
Read as "cut". Cuts any choices taken in the current procedure.
|
|
|
|
When first found "cut" succeeds as a goal, but if backtracking should
|
|
|
|
later return to it, the parent goal (the one which matches the head of
|
|
|
|
the clause containing the "cut", causing the clause activation) will
|
|
|
|
fail. This is an extra-logical predicate and cannot be explained in
|
|
|
|
terms of the declarative semantics of Prolog.
|
|
|
|
|
|
|
|
example:
|
|
|
|
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
member(X,[X|_]).
|
|
|
|
member(X,[_|L]) :- member(X,L).
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
|
|
|
|
With the above definition
|
|
|
|
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
?- member(X,[1,2,3]).
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
|
|
|
|
will return each element of the list by backtracking. With the following
|
|
|
|
definition:
|
|
|
|
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
member(X,[X|_]) :- !.
|
|
|
|
member(X,[_|L]) :- member(X,L).
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
the same query would return only the first element of the
|
2014-07-27 01:14:15 +01:00
|
|
|
list, since backtracking could not "pass through" the cut.
|
|
|
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
2014-04-09 12:39:29 +01:00
|
|
|
system_module(_init, _SysExps, _Decls) :- !.
|
|
|
|
system_module(M, SysExps, Decls) :-
|
|
|
|
'$current_module'(prolog, M),
|
|
|
|
'$compile'( ('$system_module'(M) :- true), 0, assert_static('$system_module'(M)), M ),
|
|
|
|
'$export_preds'(SysExps, prolog),
|
|
|
|
'$export_preds'(Decls, M).
|
|
|
|
|
|
|
|
'$export_preds'([], _).
|
|
|
|
'$export_preds'([N/A|Decls], M) :-
|
|
|
|
functor(S, N, A),
|
|
|
|
'$sys_export'(S, M),
|
|
|
|
'$export_preds'(Decls, M).
|
|
|
|
|
|
|
|
use_system_module(_init, _SysExps) :- !.
|
|
|
|
use_system_module(M, SysExps) :-
|
|
|
|
'$current_module'(M0, M0),
|
|
|
|
'$import_system'(SysExps, M0, M).
|
|
|
|
|
|
|
|
'$import_system'([], _, _).
|
|
|
|
'$import_system'([N/A|Decls], M0, M) :-
|
|
|
|
functor(S, N, A),
|
|
|
|
'$compile'( (G :- M0:G) ,0, assert_static((M:G :- M0:G)), M ),
|
|
|
|
'$import_system'(Decls, M0, M).
|
|
|
|
|
|
|
|
private(_).
|
|
|
|
|
|
|
|
%
|
|
|
|
% boootstrap predicates.
|
|
|
|
%
|
2014-11-02 12:10:32 +00:00
|
|
|
:- system_module( '$_boot', [
|
2014-04-09 12:39:29 +01:00
|
|
|
bootstrap/1,
|
|
|
|
call/1,
|
|
|
|
catch/3,
|
|
|
|
catch_ball/2,
|
|
|
|
expand_term/2,
|
|
|
|
import_system_module/2,
|
|
|
|
incore/1,
|
|
|
|
(not)/1,
|
|
|
|
repeat/0,
|
|
|
|
throw/1,
|
2014-11-02 12:10:32 +00:00
|
|
|
true/0], ['$$compile'/4,
|
2014-04-09 12:39:29 +01:00
|
|
|
'$call'/4,
|
|
|
|
'$catch'/3,
|
|
|
|
'$check_callable'/2,
|
|
|
|
'$check_head_and_body'/4,
|
|
|
|
'$check_if_reconsulted'/2,
|
|
|
|
'$clear_reconsulting'/0,
|
|
|
|
'$command'/4,
|
|
|
|
'$cut_by'/1,
|
|
|
|
'$disable_debugging'/0,
|
|
|
|
'$do_live'/0,
|
|
|
|
'$enable_debugging'/0,
|
|
|
|
'$find_goal_definition'/4,
|
|
|
|
'$handle_throw'/3,
|
|
|
|
'$head_and_body'/3,
|
|
|
|
'$inform_as_reconsulted'/2,
|
|
|
|
'$init_system'/0,
|
|
|
|
'$init_win_graphics'/0,
|
|
|
|
'$live'/0,
|
|
|
|
'$loop'/2,
|
|
|
|
'$meta_call'/2,
|
|
|
|
'$prompt_alternatives_on'/1,
|
|
|
|
'$run_at_thread_start'/0,
|
|
|
|
'$system_catch'/4,
|
|
|
|
'$undefp'/1,
|
|
|
|
'$version'/0]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_absf', ['$system_library_directories'/2]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_checker', ['$check_term'/5,
|
|
|
|
'$sv_warning'/2]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_consult', ['$csult'/2]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_control', ['$run_atom_goal'/1]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_directives', ['$all_directives'/1,
|
|
|
|
'$exec_directives'/5]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_errors', ['$do_error'/2]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_grammar', ['$translate_rule'/2]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_modules', ['$get_undefined_pred'/4,
|
|
|
|
'$meta_expansion'/6,
|
2014-10-05 23:53:05 +01:00
|
|
|
'$module_expansion'/6]).
|
2014-04-09 12:39:29 +01:00
|
|
|
|
|
|
|
:- use_system_module( '$_preddecls', ['$dynamic'/2]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_preds', ['$assert_static'/5,
|
|
|
|
'$assertz_dynamic'/4,
|
|
|
|
'$init_preds'/0,
|
|
|
|
'$unknown_error'/1,
|
|
|
|
'$unknown_warning'/1]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_qly', ['$init_state'/0]).
|
|
|
|
|
|
|
|
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
|
|
|
|
'$iso_check_goal'/2]).
|
|
|
|
|
|
|
|
|
2011-06-14 09:01:10 +01:00
|
|
|
%
|
|
|
|
%
|
|
|
|
%
|
2014-09-11 20:06:57 +01:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred true is iso
|
|
|
|
Succeed.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
Succeeds once.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
2002-03-08 06:33:16 +00:00
|
|
|
true :- true.
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2009-10-23 16:50:43 +01:00
|
|
|
'$live' :-
|
2001-04-09 20:54:03 +01:00
|
|
|
'$init_system',
|
2002-01-16 22:11:55 +00:00
|
|
|
'$do_live'.
|
|
|
|
|
2012-09-21 11:49:59 +01:00
|
|
|
'$init_prolog' :-
|
|
|
|
'$init_system'.
|
|
|
|
|
2002-01-16 22:11:55 +00:00
|
|
|
'$do_live' :-
|
2015-06-19 01:11:30 +01:00
|
|
|
repeat,
|
|
|
|
'$current_module'(Module),
|
|
|
|
( Module==user ->
|
|
|
|
'$compile_mode'(_,0)
|
|
|
|
;
|
|
|
|
format(user_error,'[~w]~n', [Module])
|
|
|
|
),
|
|
|
|
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
|
2012-09-21 11:49:59 +01:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
'$init_system' :-
|
2013-10-30 14:12:54 +00:00
|
|
|
get_value('$yap_inited', true), !.
|
2012-09-21 11:49:59 +01:00
|
|
|
'$init_system' :-
|
2013-10-30 14:12:54 +00:00
|
|
|
set_value('$yap_inited', true),
|
2012-09-21 11:49:59 +01:00
|
|
|
% do catch as early as possible
|
|
|
|
(
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(halt_after_consult, false),
|
|
|
|
current_prolog_flag(verbose, normal),
|
|
|
|
\+ '$uncaught_throw'
|
2012-09-21 11:49:59 +01:00
|
|
|
->
|
|
|
|
'$version'
|
|
|
|
;
|
|
|
|
true
|
|
|
|
),
|
2012-06-12 14:50:36 +01:00
|
|
|
% '$init_preds', % needs to be done before library_directory
|
|
|
|
% (
|
|
|
|
% retractall(user:library_directory(_)),
|
|
|
|
% '$system_library_directories'(D),
|
|
|
|
% assertz(user:library_directory(D)),
|
|
|
|
% fail
|
|
|
|
% ;
|
|
|
|
% true
|
|
|
|
% ),
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(file_name_variables, OldF),
|
|
|
|
set_prolog_flag(file_name_variables, true),
|
2014-03-16 18:59:54 +00:00
|
|
|
'$init_consult',
|
2015-06-19 01:11:30 +01:00
|
|
|
set_prolog_flag(file_name_variables, OldF),
|
2012-09-21 11:49:59 +01:00
|
|
|
'$init_globals',
|
2015-06-19 01:11:30 +01:00
|
|
|
set_prolog_flag(fileerrors, true),
|
2012-09-21 11:49:59 +01:00
|
|
|
set_value('$gc',on),
|
|
|
|
('$exit_undefp' -> true ; true),
|
|
|
|
prompt1(' ?- '),
|
2015-06-19 01:11:30 +01:00
|
|
|
set_prolog_flag(debug, false),
|
2006-12-13 16:10:26 +00:00
|
|
|
% simple trick to find out if this is we are booting from Prolog.
|
2011-09-09 21:39:15 +01:00
|
|
|
% boot from a saved state
|
2001-04-09 20:54:03 +01:00
|
|
|
(
|
2011-09-09 21:39:15 +01:00
|
|
|
'$undefined'('$init_preds',prolog)
|
2014-12-14 11:45:42 +00:00
|
|
|
->
|
|
|
|
get_value('$consult_on_boot',X),
|
|
|
|
(
|
|
|
|
X \= []
|
2011-09-09 21:39:15 +01:00
|
|
|
->
|
2014-12-14 11:45:42 +00:00
|
|
|
bootstrap(X),
|
|
|
|
module( user ),
|
2015-06-19 01:11:30 +01:00
|
|
|
qsave_program( 'startup.yss')
|
2014-12-14 11:45:42 +00:00
|
|
|
;
|
2011-09-09 21:39:15 +01:00
|
|
|
true
|
2014-12-14 11:45:42 +00:00
|
|
|
)
|
2011-09-09 21:39:15 +01:00
|
|
|
;
|
|
|
|
'$init_state'
|
|
|
|
),
|
2006-12-13 16:10:26 +00:00
|
|
|
'$db_clean_queues'(0),
|
2014-12-14 11:45:42 +00:00
|
|
|
% this must be executed from C-code.
|
2010-12-07 15:06:53 +00:00
|
|
|
% '$startup_saved_state',
|
2011-02-14 19:43:54 +00:00
|
|
|
set_input(user_input),
|
|
|
|
set_output(user_output),
|
2010-01-14 15:58:19 +00:00
|
|
|
'$init_or_threads',
|
2009-04-25 18:54:21 +01:00
|
|
|
'$run_at_thread_start'.
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2010-02-28 09:08:06 +00:00
|
|
|
'$init_globals' :-
|
2015-06-19 01:11:30 +01:00
|
|
|
% set_prolog_flag(break_level, 0),
|
2014-11-02 12:10:32 +00:00
|
|
|
% '$set_read_error_handler'(error), let the user do that
|
2013-10-29 12:43:31 +00:00
|
|
|
nb_setval('$chr_toplevel_show_store',false).
|
2010-02-28 09:08:06 +00:00
|
|
|
|
2007-11-26 23:43:10 +00:00
|
|
|
'$init_consult' :-
|
2013-10-29 12:43:31 +00:00
|
|
|
set_value('$open_expands_filename',true),
|
|
|
|
nb_setval('$assert_all',off),
|
2007-11-26 23:43:10 +00:00
|
|
|
nb_setval('$if_level',0),
|
|
|
|
nb_setval('$endif',off),
|
2013-11-04 01:14:48 +00:00
|
|
|
nb_setval('$initialization_goals',off),
|
2012-07-07 00:49:02 +01:00
|
|
|
nb_setval('$included_file',[]),
|
2012-08-23 21:02:15 +01:00
|
|
|
\+ '$undefined'('$init_preds',prolog),
|
|
|
|
'$init_preds',
|
2012-07-07 00:49:02 +01:00
|
|
|
fail.
|
|
|
|
'$init_consult'.
|
|
|
|
|
2014-03-04 11:58:48 +00:00
|
|
|
'$init_win_graphics' :-
|
|
|
|
'$undefined'(window_title(_,_), system), !.
|
|
|
|
'$init_win_graphics' :-
|
2014-03-06 02:09:48 +00:00
|
|
|
load_files([library(win_menu)], [silent(true),if(not_loaded)]),
|
2014-03-04 11:58:48 +00:00
|
|
|
fail.
|
|
|
|
'$init_win_graphics'.
|
|
|
|
|
2010-01-14 15:58:19 +00:00
|
|
|
'$init_or_threads' :-
|
2011-06-21 15:19:07 +01:00
|
|
|
'$c_yapor_workers'(W), !,
|
2010-01-14 15:58:19 +00:00
|
|
|
'$start_orp_threads'(W).
|
|
|
|
'$init_or_threads'.
|
|
|
|
|
|
|
|
'$start_orp_threads'(1) :- !.
|
|
|
|
'$start_orp_threads'(W) :-
|
2010-04-20 03:59:48 +01:00
|
|
|
thread_create('$c_worker',_,[detached(true)]),
|
2010-01-14 15:58:19 +00:00
|
|
|
W1 is W-1,
|
|
|
|
'$start_orp_threads'(W1).
|
|
|
|
|
2007-11-26 23:43:10 +00:00
|
|
|
|
2007-10-21 09:48:06 +01:00
|
|
|
% Start file for yap
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2007-10-21 09:48:06 +01:00
|
|
|
/* I/O predicates */
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2007-10-21 09:48:06 +01:00
|
|
|
/* meaning of flags for '$write' is
|
2006-01-02 02:16:19 +00:00
|
|
|
1 quote illegal atoms
|
|
|
|
2 ignore operator declarations
|
|
|
|
4 output '$VAR'(N) terms as A, B, C, ...
|
|
|
|
8 use portray(_)
|
2007-10-21 09:48:06 +01:00
|
|
|
*/
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2007-10-21 09:48:06 +01:00
|
|
|
/* main execution loop */
|
2011-07-26 23:32:50 +01:00
|
|
|
'$read_toplevel'(Goal, Bindings) :-
|
2015-06-19 01:11:30 +01:00
|
|
|
fail,
|
2012-12-14 23:30:48 +00:00
|
|
|
'$pred_exists'(read_history(_,_,_,_,_,_), user),
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(readline, true), !,
|
2011-02-23 17:46:50 +00:00
|
|
|
read_history(h, '!h',
|
|
|
|
[trace, end_of_file],
|
2011-05-01 22:43:54 +01:00
|
|
|
Prompt, Goal, Bindings), !,
|
2011-02-23 17:46:50 +00:00
|
|
|
(nonvar(Err) ->
|
|
|
|
print_message(error,Err), fail
|
|
|
|
;
|
|
|
|
true
|
|
|
|
).
|
2011-07-26 23:32:50 +01:00
|
|
|
'$read_toplevel'(Goal, Bindings) :-
|
2011-09-01 05:10:49 +01:00
|
|
|
prompt1('?- '),
|
|
|
|
prompt(_,'|: '),
|
2015-06-19 01:11:30 +01:00
|
|
|
'$system_catch'(read_term(user_input,
|
|
|
|
Goal,
|
|
|
|
[variable_names(Bindings)]),
|
|
|
|
prolog, E, '$handle_toplevel_error'( E) ).
|
|
|
|
|
|
|
|
'$handle_toplevel_error'( syntax_error(_)) :-
|
2014-12-14 11:45:42 +00:00
|
|
|
!,
|
|
|
|
fail.
|
2015-06-19 01:11:30 +01:00
|
|
|
'$handle_toplevel_error'( error(io_error(read,user_input),_)) :-
|
2014-12-14 11:45:42 +00:00
|
|
|
!.
|
2013-02-26 15:32:39 +00:00
|
|
|
'$handle_toplevel_error'(_, E) :-
|
|
|
|
throw(E).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2015-06-19 01:11:30 +01:00
|
|
|
|
|
|
|
/** @pred stream_property( _Stream_, _Prop_)
|
|
|
|
|
|
|
|
*/
|
|
|
|
|
2007-10-21 09:48:06 +01:00
|
|
|
% reset alarms when entering top-level.
|
|
|
|
'$enter_top_level' :-
|
|
|
|
'$alarm'(0, 0, _, _),
|
|
|
|
fail.
|
|
|
|
'$enter_top_level' :-
|
|
|
|
'$clean_up_dead_clauses',
|
|
|
|
fail.
|
|
|
|
'$enter_top_level' :-
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(break_level, BreakLevel),
|
|
|
|
current_prolog_flag(debug, DBON),
|
2007-10-21 09:48:06 +01:00
|
|
|
(
|
2010-03-01 22:32:40 +00:00
|
|
|
'$nb_getval'('$trace', on, fail)
|
2007-10-21 09:48:06 +01:00
|
|
|
->
|
|
|
|
TraceDebug = trace
|
|
|
|
;
|
2008-09-02 03:48:02 +01:00
|
|
|
DBON == true
|
2007-10-21 09:48:06 +01:00
|
|
|
->
|
|
|
|
TraceDebug = debug
|
|
|
|
;
|
|
|
|
true
|
|
|
|
),
|
2008-02-22 15:08:37 +00:00
|
|
|
print_message(informational,prompt(BreakLevel,TraceDebug)),
|
2007-10-21 09:48:06 +01:00
|
|
|
fail.
|
|
|
|
'$enter_top_level' :-
|
|
|
|
get_value('$top_level_goal',GA), GA \= [], !,
|
|
|
|
set_value('$top_level_goal',[]),
|
|
|
|
'$run_atom_goal'(GA),
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(break_level, BreakLevel),
|
2014-12-14 11:45:42 +00:00
|
|
|
(
|
|
|
|
Breaklevel \= 0
|
|
|
|
->
|
|
|
|
true
|
|
|
|
;
|
|
|
|
'$pred_exists'(halt(_), user)
|
|
|
|
->
|
|
|
|
halt(0)
|
|
|
|
;
|
|
|
|
'$halt'(0)
|
|
|
|
).
|
2007-10-21 09:48:06 +01:00
|
|
|
'$enter_top_level' :-
|
2014-02-22 22:48:29 +00:00
|
|
|
flush_output,
|
2007-10-21 09:48:06 +01:00
|
|
|
'$run_toplevel_hooks',
|
2011-07-27 16:49:43 +01:00
|
|
|
prompt1(' ?- '),
|
2011-07-26 23:32:50 +01:00
|
|
|
'$read_toplevel'(Command,Varnames),
|
2007-10-21 09:48:06 +01:00
|
|
|
nb_setval('$spy_gn',1),
|
2011-07-27 16:49:43 +01:00
|
|
|
% stop at spy-points if debugging is on.
|
2007-10-21 09:48:06 +01:00
|
|
|
nb_setval('$debug_run',off),
|
2010-04-08 01:44:08 +01:00
|
|
|
nb_setval('$debug_jump',off),
|
2011-07-26 23:32:50 +01:00
|
|
|
'$command'(Command,Varnames,_Pos,top),
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(break_level, BreakLevel),
|
2014-12-14 11:45:42 +00:00
|
|
|
(
|
|
|
|
BreakLevel \= 0
|
|
|
|
->
|
|
|
|
true
|
|
|
|
;
|
|
|
|
'$pred_exists'(halt(_), user)
|
|
|
|
-> halt(0)
|
|
|
|
;
|
|
|
|
'$halt'(0)
|
|
|
|
).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2006-02-08 17:29:55 +00:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
'$erase_sets' :-
|
2006-01-02 02:16:19 +00:00
|
|
|
eraseall('$'),
|
|
|
|
eraseall('$$set'),
|
2014-11-02 12:10:32 +00:00
|
|
|
eraseall('$$one'),
|
2006-01-02 02:16:19 +00:00
|
|
|
eraseall('$reconsulted'), fail.
|
|
|
|
'$erase_sets' :- \+ recorded('$path',_,_), recorda('$path',"",_).
|
|
|
|
'$erase_sets'.
|
|
|
|
|
2014-12-14 11:45:42 +00:00
|
|
|
'$version' :-
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(version_git,VersionGit),
|
|
|
|
current_prolog_flag(compiled_at,AT),
|
|
|
|
current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ),
|
|
|
|
sub_atom( VersionGit, 0, 8, _, VERSIONGIT ),
|
|
|
|
format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]),
|
|
|
|
fail.
|
|
|
|
'$version'.
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred repeat is iso
|
2014-09-11 20:06:57 +01:00
|
|
|
Succeeds repeatedly.
|
|
|
|
|
|
|
|
In the next example, `repeat` is used as an efficient way to implement
|
|
|
|
a loop. The next example reads all terms in a file:
|
|
|
|
~~~~~~~~~~~~~{.prolog}
|
|
|
|
a :- repeat, read(X), write(X), nl, X=end_of_file, !.
|
|
|
|
~~~~~~~~~~~~~
|
|
|
|
the loop is effectively terminated by the cut-goal, when the test-goal
|
|
|
|
`X=end` succeeds. While the test fails, the goals `read(X)`,
|
|
|
|
`write(X)`, and `nl` are executed repeatedly, because
|
|
|
|
backtracking is caught by the `repeat` goal.
|
|
|
|
|
|
|
|
The built-in `repeat/0` could be defined in Prolog by:
|
|
|
|
|
|
|
|
~~~~~{.prolog}
|
|
|
|
repeat.
|
|
|
|
repeat :- repeat.
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
The predicate between/3 can be used to iterate for a pre-defined
|
|
|
|
number of steps.
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
2006-01-02 02:16:19 +00:00
|
|
|
repeat :- '$repeat'.
|
|
|
|
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat'.
|
|
|
|
'$repeat' :- '$repeat'.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
'$start_corouts' :-
|
2007-10-21 09:48:06 +01:00
|
|
|
eraseall('$corout'),
|
|
|
|
eraseall('$result'),
|
|
|
|
eraseall('$actual'),
|
|
|
|
fail.
|
|
|
|
'$start_corouts' :- recorda('$actual',main,_),
|
|
|
|
recordz('$corout','$corout'(main,main,'$corout'([],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[])),_Ref),
|
|
|
|
recorda('$result',going,_).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2008-10-23 22:17:45 +01:00
|
|
|
'$command'(C,VL,Pos,Con) :-
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(strict_iso, true), !, /* strict_iso on */
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_command'(C,VL,Pos,Con,C).
|
|
|
|
'$command'(C,VL,Pos,Con) :-
|
2014-11-02 12:10:32 +00:00
|
|
|
( (Con = top ; var(C) ; C = [_|_]) ->
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_command'(C,VL,Pos,Con,C), ! ;
|
2008-08-06 11:15:48 +01:00
|
|
|
% do term expansion
|
2007-10-21 09:48:06 +01:00
|
|
|
expand_term(C, EC),
|
2008-08-06 11:15:48 +01:00
|
|
|
% execute a list of commands
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_commands'(EC,VL,Pos,Con,C),
|
2008-08-06 11:15:48 +01:00
|
|
|
% succeed only if the *original* was at end of file.
|
|
|
|
C == end_of_file
|
2007-10-21 09:48:06 +01:00
|
|
|
).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
|
|
|
%
|
|
|
|
% Hack in case expand_term has created a list of commands.
|
|
|
|
%
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_commands'(V,_,_,_,Source) :- var(V), !,
|
2006-01-02 02:16:19 +00:00
|
|
|
'$do_error'(instantiation_error,meta_call(Source)).
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_commands'([],_,_,_,_) :- !.
|
|
|
|
'$execute_commands'([C|Cs],VL,Pos,Con,Source) :- !,
|
2006-01-02 02:16:19 +00:00
|
|
|
(
|
2011-11-10 12:27:36 +00:00
|
|
|
'$system_catch'('$execute_command'(C,VL,Pos,Con,C),prolog,Error,user:'$LoopError'(Error, Con)),
|
2014-11-02 12:10:32 +00:00
|
|
|
fail
|
2006-01-02 02:16:19 +00:00
|
|
|
;
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_commands'(Cs,VL,Pos,Con,Source)
|
2008-08-06 01:56:11 +01:00
|
|
|
).
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_commands'(C,VL,Pos,Con,Source) :-
|
|
|
|
'$execute_command'(C,VL,Pos,Con,Source).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2008-08-12 02:27:23 +01:00
|
|
|
%
|
2006-01-02 02:16:19 +00:00
|
|
|
%
|
|
|
|
%
|
|
|
|
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_command'(C,_,_,top,Source) :- var(C), !,
|
2006-01-02 02:16:19 +00:00
|
|
|
'$do_error'(instantiation_error,meta_call(Source)).
|
2014-12-14 11:45:42 +00:00
|
|
|
'$execute_command'(C,_,_,top,Source) :- number(C), !,
|
2014-10-20 09:20:56 +01:00
|
|
|
'$do_error'(type_error(callable,C),meta_call(Source)).
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_command'(R,_,_,top,Source) :- db_reference(R), !,
|
2014-10-20 09:20:56 +01:00
|
|
|
'$do_error'(type_error(callable,R),meta_call(Source)).
|
2008-10-23 22:17:45 +01:00
|
|
|
'$execute_command'(end_of_file,_,_,_,_) :- !.
|
|
|
|
'$execute_command'(Command,_,_,_,_) :-
|
2010-03-01 22:32:40 +00:00
|
|
|
'$nb_getval'('$if_skip_mode', skip, fail),
|
2007-10-21 09:48:06 +01:00
|
|
|
\+ '$if_directive'(Command),
|
2008-08-06 11:15:48 +01:00
|
|
|
!.
|
2011-03-11 19:49:32 +00:00
|
|
|
'$execute_command'((:-G),VL,Pos,Option,_) :-
|
2014-11-02 12:10:32 +00:00
|
|
|
% !,
|
2010-05-25 16:15:09 +01:00
|
|
|
Option \= top, !,
|
2006-01-02 02:16:19 +00:00
|
|
|
'$current_module'(M),
|
2007-10-10 10:44:28 +01:00
|
|
|
% allow user expansion
|
2007-10-17 00:17:04 +01:00
|
|
|
expand_term((:- G), O),
|
2011-03-11 19:49:32 +00:00
|
|
|
(
|
|
|
|
O = (:- G1)
|
|
|
|
->
|
2012-02-13 09:39:29 +00:00
|
|
|
'$process_directive'(G1, Option, M, VL, Pos)
|
2011-03-11 19:49:32 +00:00
|
|
|
;
|
|
|
|
'$execute_commands'(O,VL,Pos,Option,O)
|
|
|
|
).
|
2014-10-05 23:53:05 +01:00
|
|
|
'$execute_command'((?-G), VL, Pos, Option, Source) :-
|
2010-05-25 16:15:09 +01:00
|
|
|
Option \= top, !,
|
2014-10-05 23:53:05 +01:00
|
|
|
'$execute_command'(G, VL, Pos, top, Source).
|
|
|
|
'$execute_command'(G, VL, Pos, Option, Source) :-
|
|
|
|
'$continue_with_command'(Option, VL, Pos, G, Source).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
|
|
|
%
|
|
|
|
% This command is very different depending on the language mode we are in.
|
|
|
|
%
|
|
|
|
% ISO only wants directives in files
|
|
|
|
% SICStus accepts everything in files
|
|
|
|
% YAP accepts everything everywhere
|
2014-11-02 12:10:32 +00:00
|
|
|
%
|
2012-02-13 09:39:29 +00:00
|
|
|
'$process_directive'(G, top, M, VL, Pos) :-
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(language_mode, yap), !, /* strict_iso on */
|
2012-02-13 09:39:29 +00:00
|
|
|
'$process_directive'(G, consult, M, VL, Pos).
|
|
|
|
'$process_directive'(G, top, _, _, _) :- !,
|
2006-01-02 02:16:19 +00:00
|
|
|
'$do_error'(context_error((:- G),clause),query).
|
|
|
|
%
|
|
|
|
% allow modules
|
|
|
|
%
|
2012-02-13 09:39:29 +00:00
|
|
|
'$process_directive'(M:G, Mode, _, VL, Pos) :- !,
|
|
|
|
'$process_directive'(G, Mode, M, VL, Pos).
|
2006-01-02 02:16:19 +00:00
|
|
|
%
|
|
|
|
% default case
|
|
|
|
%
|
2012-02-13 09:39:29 +00:00
|
|
|
'$process_directive'(Gs, Mode, M, VL, Pos) :-
|
2006-01-02 02:16:19 +00:00
|
|
|
'$all_directives'(Gs), !,
|
2012-02-13 09:39:29 +00:00
|
|
|
'$exec_directives'(Gs, Mode, M, VL, Pos).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
|
|
|
%
|
|
|
|
% ISO does not allow goals (use initialization).
|
|
|
|
%
|
2015-06-19 01:11:30 +01:00
|
|
|
'$process_directive'(D, _, M, VL, Pos) :-
|
|
|
|
current_prolog_flag(language_mode, iso), !, % ISO Prolog mode, go in and do it,
|
2006-01-02 02:16:19 +00:00
|
|
|
'$do_error'(context_error((:- M:D),query),directive).
|
|
|
|
%
|
|
|
|
% but YAP and SICStus does.
|
|
|
|
%
|
2014-10-02 14:34:03 +01:00
|
|
|
'$process_directive'(G, Mode, M, VL, Pos) :-
|
|
|
|
( '$undefined'('$save_directive'(G, Mode, M, VL, Pos),prolog) ->
|
|
|
|
true
|
|
|
|
;
|
|
|
|
'$save_directive'(G, Mode, M, VL, Pos)
|
|
|
|
->
|
|
|
|
true
|
|
|
|
;
|
|
|
|
true
|
|
|
|
),
|
|
|
|
( '$execute'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2014-08-04 15:45:30 +01:00
|
|
|
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !,
|
2010-03-14 09:30:24 +00:00
|
|
|
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
|
2014-08-04 15:45:30 +01:00
|
|
|
'$continue_with_command'(reconsult,V,Pos,G,Source) :-
|
2008-10-23 22:17:45 +01:00
|
|
|
'$go_compile_clause'(G,V,Pos,5,Source),
|
2006-01-02 02:16:19 +00:00
|
|
|
fail.
|
2014-08-04 15:45:30 +01:00
|
|
|
'$continue_with_command'(consult,V,Pos,G,Source) :-
|
2015-06-19 01:11:30 +01:00
|
|
|
'$go_compile_clause'(G,V,Pos,13,Source),
|
2006-01-02 02:16:19 +00:00
|
|
|
fail.
|
2014-08-04 15:45:30 +01:00
|
|
|
'$continue_with_command'(top,V,_,G,_) :-
|
2006-12-13 16:10:26 +00:00
|
|
|
'$query'(G,V).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
|
|
|
%
|
|
|
|
% not 100% compatible with SICStus Prolog, as SICStus Prolog would put
|
|
|
|
% module prefixes all over the place, although unnecessarily so.
|
|
|
|
%
|
2014-10-05 23:53:05 +01:00
|
|
|
% G is the goal to compile
|
2014-12-14 11:45:42 +00:00
|
|
|
% Vs the named variables
|
2014-10-05 23:53:05 +01:00
|
|
|
% Pos the source position
|
|
|
|
% N where to add first or last
|
|
|
|
% Source the original clause
|
|
|
|
'$go_compile_clause'(G,Vs,Pos,N,Source) :-
|
2006-01-02 02:16:19 +00:00
|
|
|
'$current_module'(Mod),
|
2014-10-05 23:53:05 +01:00
|
|
|
'$go_compile_clause'(G,Vs,Pos,N,Mod,Mod,Mod,Source).
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-10-05 23:53:05 +01:00
|
|
|
'$go_compile_clause'(G,_Vs,_Pos,_N,_HM,_BM,_SM,Source) :-
|
2009-11-20 00:32:14 +00:00
|
|
|
var(G), !,
|
2014-11-02 12:10:32 +00:00
|
|
|
'$do_error'(instantiation_error,assert(Source)).
|
2014-10-05 23:53:05 +01:00
|
|
|
'$go_compile_clause'((G:-_),_Vs,_Pos,_N,_HM,_BM,_SM,Source) :-
|
2009-11-20 00:32:14 +00:00
|
|
|
var(G), !,
|
2014-11-02 12:10:32 +00:00
|
|
|
'$do_error'(instantiation_error,assert(Source)).
|
2014-10-05 23:53:05 +01:00
|
|
|
'$go_compile_clause'(M:G,Vs,Pos,N,_,_,SourceMod,Source) :- !,
|
|
|
|
'$go_compile_clause'(G,Vs,Pos,N,M,M,M,Source).
|
|
|
|
'$go_compile_clause'((M:H :- B),Vs,Pos,N,_,BodyMod,SourceMod,Source) :- !,
|
|
|
|
'$go_compile_clause'((H :- B),Vs,Pos,N,M,BodyMod,SourceMod,Source).
|
|
|
|
'$go_compile_clause'(G,Vs,Pos,N,HeadMod,BodyMod,SourceMod,Source) :- !,
|
|
|
|
'$precompile_term'(G, G0, G1, HeadMod, BodyMod, SourceMod),
|
2008-07-23 00:34:50 +01:00
|
|
|
'$$compile'(G1, G0, N, HeadMod).
|
|
|
|
|
2006-01-02 02:16:19 +00:00
|
|
|
|
|
|
|
% process an input clause
|
|
|
|
'$$compile'(G, G0, L, Mod) :-
|
2008-05-15 14:41:48 +01:00
|
|
|
'$head_and_body'(G,H,_),
|
2007-11-08 11:22:05 +00:00
|
|
|
(
|
2015-06-19 01:11:30 +01:00
|
|
|
'$is_dynamic'(H, Mod)
|
2007-11-08 11:22:05 +00:00
|
|
|
->
|
2015-06-19 01:11:30 +01:00
|
|
|
'$assertz_dynamic'(L, G, G0, Mod)
|
2007-11-08 11:22:05 +00:00
|
|
|
;
|
2012-12-07 08:08:32 +00:00
|
|
|
'$nb_getval'('$assert_all',on,fail)
|
2007-11-08 11:22:05 +00:00
|
|
|
->
|
2008-04-01 21:47:57 +01:00
|
|
|
functor(H,N,A),
|
2007-11-08 11:22:05 +00:00
|
|
|
'$dynamic'(N/A,Mod),
|
2015-06-19 01:11:30 +01:00
|
|
|
'$assertz_dynamic'(L, G, G0, Mod)
|
2007-11-08 11:22:05 +00:00
|
|
|
;
|
2008-05-15 14:41:48 +01:00
|
|
|
'$not_imported'(H, Mod),
|
2007-11-08 11:22:05 +00:00
|
|
|
'$compile'(G, L, G0, Mod)
|
|
|
|
).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2012-03-28 14:35:09 +01:00
|
|
|
%
|
|
|
|
% check if current module redefines an imported predicate.
|
|
|
|
% and remove import.
|
|
|
|
%
|
2008-05-15 14:41:48 +01:00
|
|
|
'$not_imported'(H, Mod) :-
|
2012-03-28 14:35:09 +01:00
|
|
|
recorded('$import','$import'(NM,Mod,NH,H,_,_),R),
|
|
|
|
NM \= Mod,
|
2008-05-15 14:41:48 +01:00
|
|
|
functor(NH,N,Ar),
|
2012-03-28 14:35:09 +01:00
|
|
|
print_message(warning,redefine_imported(Mod,NM,N/Ar)),
|
|
|
|
erase(R),
|
|
|
|
fail.
|
2008-05-15 14:41:48 +01:00
|
|
|
'$not_imported'(_, _).
|
|
|
|
|
2009-09-20 16:03:10 +01:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
'$check_if_reconsulted'(N,A) :-
|
|
|
|
once(recorded('$reconsulted',N/A,_)),
|
|
|
|
recorded('$reconsulted',X,_),
|
|
|
|
( X = N/A , !;
|
|
|
|
X = '$', !, fail;
|
|
|
|
fail
|
|
|
|
).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2008-05-15 14:41:48 +01:00
|
|
|
'$inform_as_reconsulted'(N,A) :-
|
2006-01-02 02:16:19 +00:00
|
|
|
recorda('$reconsulted',N/A,_).
|
|
|
|
|
2008-05-15 14:41:48 +01:00
|
|
|
'$clear_reconsulting' :-
|
|
|
|
recorded('$reconsulted',X,Ref),
|
|
|
|
erase(Ref),
|
|
|
|
X == '$', !,
|
|
|
|
( recorded('$reconsulting',_,R) -> erase(R) ).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2010-12-31 05:20:49 +00:00
|
|
|
'$prompt_alternatives_on'(determinism).
|
2010-02-28 00:05:38 +00:00
|
|
|
|
|
|
|
/* Executing a query */
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2008-05-15 14:41:48 +01:00
|
|
|
'$query'(end_of_file,_).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2010-03-27 11:34:10 +00:00
|
|
|
'$query'(G,[]) :-
|
2011-01-06 17:20:29 +00:00
|
|
|
'$prompt_alternatives_on'(OPT),
|
|
|
|
( OPT = groundness ; OPT = determinism), !,
|
2006-01-02 02:16:19 +00:00
|
|
|
'$yes_no'(G,(?-)).
|
2010-03-27 11:34:10 +00:00
|
|
|
'$query'(G,V) :-
|
2006-01-02 02:16:19 +00:00
|
|
|
(
|
2013-02-13 15:06:06 +00:00
|
|
|
'$current_choice_point'(CP),
|
2013-02-08 16:36:45 +00:00
|
|
|
'$current_module'(M),
|
2013-12-13 08:42:57 +00:00
|
|
|
'$user_call'(G, M),
|
2013-02-13 15:06:06 +00:00
|
|
|
'$current_choice_point'(NCP),
|
2012-06-08 13:26:11 +01:00
|
|
|
'$delayed_goals'(G, V, NV, LGs, DCP),
|
2010-03-27 11:34:10 +00:00
|
|
|
'$write_answer'(NV, LGs, Written),
|
2010-02-28 00:05:38 +00:00
|
|
|
'$write_query_answer_true'(Written),
|
|
|
|
(
|
2014-11-02 12:10:32 +00:00
|
|
|
'$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0
|
2013-02-12 18:47:30 +00:00
|
|
|
->
|
|
|
|
format(user_error, '.~n', []),
|
2010-02-28 00:05:38 +00:00
|
|
|
!
|
|
|
|
;
|
2006-12-13 16:10:26 +00:00
|
|
|
'$another',
|
2010-02-28 00:05:38 +00:00
|
|
|
!
|
|
|
|
),
|
2014-11-02 12:10:32 +00:00
|
|
|
fail
|
2006-12-13 16:10:26 +00:00
|
|
|
;
|
2010-02-28 00:05:38 +00:00
|
|
|
'$out_neg_answer'
|
2006-01-02 02:16:19 +00:00
|
|
|
).
|
|
|
|
|
|
|
|
'$yes_no'(G,C) :-
|
|
|
|
'$current_module'(M),
|
|
|
|
'$do_yes_no'(G,M),
|
2012-06-08 13:26:11 +01:00
|
|
|
'$delayed_goals'(G, [], NV, LGs, _),
|
2010-03-27 11:34:10 +00:00
|
|
|
'$write_answer'(NV, LGs, Written),
|
2006-01-02 02:16:19 +00:00
|
|
|
( Written = [] ->
|
2013-02-12 18:47:30 +00:00
|
|
|
!,'$present_answer'(C, true)
|
2013-02-08 16:36:45 +00:00
|
|
|
;
|
2013-02-12 18:47:30 +00:00
|
|
|
'$another', !
|
2006-01-02 02:16:19 +00:00
|
|
|
),
|
|
|
|
fail.
|
|
|
|
'$yes_no'(_,_) :-
|
2008-05-15 19:31:02 +01:00
|
|
|
'$out_neg_answer'.
|
2006-12-13 16:10:26 +00:00
|
|
|
|
|
|
|
'$add_env_and_fail' :- fail.
|
|
|
|
|
2012-06-21 15:41:35 +01:00
|
|
|
%
|
|
|
|
% *-> at this point would require compiler support, which does not exist.
|
|
|
|
%
|
2012-06-08 13:26:11 +01:00
|
|
|
'$delayed_goals'(G, V, NV, LGs, NCP) :-
|
2012-08-08 00:32:45 +01:00
|
|
|
(
|
|
|
|
CP is '$last_choice_pt',
|
2013-02-13 15:06:06 +00:00
|
|
|
'$current_choice_point'(NCP1),
|
2014-12-14 11:45:42 +00:00
|
|
|
'$attributes':delayed_goals(G, V, NV, LGs),
|
2013-02-13 15:06:06 +00:00
|
|
|
'$current_choice_point'(NCP2),
|
2012-12-02 13:18:29 +00:00
|
|
|
'$clean_ifcp'(CP),
|
2012-08-08 00:32:45 +01:00
|
|
|
NCP is NCP2-NCP1
|
|
|
|
;
|
2014-11-02 12:10:32 +00:00
|
|
|
copy_term_nat(V, NV),
|
|
|
|
LGs = [],
|
2014-02-14 22:44:55 +00:00
|
|
|
% term_factorized(V, NV, LGs),
|
2012-08-08 00:32:45 +01:00
|
|
|
NCP = 0
|
2012-06-04 16:29:56 +01:00
|
|
|
).
|
2010-03-27 11:34:10 +00:00
|
|
|
|
2006-12-13 16:10:26 +00:00
|
|
|
'$out_neg_answer' :-
|
2014-11-02 12:10:32 +00:00
|
|
|
( '$undefined'(print_message(_,_),prolog) ->
|
2014-04-06 17:05:17 +01:00
|
|
|
'$present_answer'(user_error,'false.~n')
|
2006-01-02 02:16:19 +00:00
|
|
|
;
|
2013-02-12 18:47:30 +00:00
|
|
|
print_message(help,false)
|
2006-01-02 02:16:19 +00:00
|
|
|
),
|
|
|
|
fail.
|
|
|
|
|
2013-02-08 16:36:45 +00:00
|
|
|
'$do_yes_no'([X|L], M) :-
|
|
|
|
!,
|
|
|
|
'$csult'([X|L], M).
|
2009-05-05 00:10:07 +01:00
|
|
|
'$do_yes_no'(G, M) :-
|
2013-12-13 08:42:57 +00:00
|
|
|
'$user_call'(G, M).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2009-05-05 00:10:07 +01:00
|
|
|
'$write_query_answer_true'([]) :- !,
|
2013-02-12 18:47:30 +00:00
|
|
|
format(user_error,'true',[]).
|
2009-05-05 00:10:07 +01:00
|
|
|
'$write_query_answer_true'(_).
|
2006-01-02 02:16:19 +00:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
%
|
|
|
|
% present_answer has three components. First it flushes the streams,
|
|
|
|
% then it presents the goals, and last it shows any goals frozen on
|
|
|
|
% the arguments.
|
|
|
|
%
|
|
|
|
'$present_answer'(_,_):-
|
2011-02-14 19:28:44 +00:00
|
|
|
flush_output,
|
2001-04-09 20:54:03 +01:00
|
|
|
fail.
|
|
|
|
'$present_answer'((?-), Answ) :-
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(break_level, BL ),
|
2004-07-22 22:32:23 +01:00
|
|
|
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
|
2001-04-09 20:54:03 +01:00
|
|
|
true ),
|
2003-08-27 14:37:10 +01:00
|
|
|
( recorded('$print_options','$toplevel'(Opts),_) ->
|
2001-04-09 20:54:03 +01:00
|
|
|
write_term(user_error,Answ,Opts) ;
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,'~w',[Answ])
|
2001-04-09 20:54:03 +01:00
|
|
|
),
|
2013-02-12 18:47:30 +00:00
|
|
|
format(user_error,'.~n', []).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
'$another' :-
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,' ? ',[]),
|
2008-03-12 15:37:34 +00:00
|
|
|
get0(user_input,C),
|
2010-02-11 18:06:27 +00:00
|
|
|
'$do_another'(C).
|
|
|
|
|
|
|
|
'$do_another'(C) :-
|
2011-02-14 20:47:34 +00:00
|
|
|
( C== 0'; -> skip(user_input,10), %'
|
2013-02-12 18:47:30 +00:00
|
|
|
% '$add_nl_outside_console',
|
2003-02-24 11:01:01 +00:00
|
|
|
fail
|
2002-05-24 06:14:46 +01:00
|
|
|
;
|
2003-02-24 11:01:01 +00:00
|
|
|
C== 10 -> '$add_nl_outside_console',
|
2014-11-02 12:10:32 +00:00
|
|
|
( '$undefined'(print_message(_,_),prolog) ->
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,'yes~n', [])
|
2003-12-01 17:27:42 +00:00
|
|
|
;
|
|
|
|
print_message(help,yes)
|
|
|
|
)
|
2010-02-11 18:06:27 +00:00
|
|
|
;
|
2014-11-02 12:10:32 +00:00
|
|
|
C== 13 ->
|
2010-02-11 18:06:27 +00:00
|
|
|
get0(user_input,NC),
|
2014-11-02 12:10:32 +00:00
|
|
|
'$do_another'(NC)
|
2002-05-24 06:14:46 +01:00
|
|
|
;
|
|
|
|
C== -1 -> halt
|
2001-04-09 20:54:03 +01:00
|
|
|
;
|
2011-02-14 20:47:34 +00:00
|
|
|
skip(user_input,10), '$ask_again_for_another'
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
|
|
|
|
2011-02-14 19:28:44 +00:00
|
|
|
%'$add_nl_outside_console' :-
|
|
|
|
% '$is_same_tty'(user_input, user_error), !.
|
2003-02-24 11:01:01 +00:00
|
|
|
'$add_nl_outside_console' :-
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,'~n',[]).
|
2003-02-24 11:01:01 +00:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
'$ask_again_for_another' :-
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,'Action (\";\" for more choices, <return> for exit)', []),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$another'.
|
|
|
|
|
|
|
|
'$write_answer'(_,_,_) :-
|
2011-02-14 19:28:44 +00:00
|
|
|
flush_output,
|
2001-04-09 20:54:03 +01:00
|
|
|
fail.
|
2005-10-28 18:38:50 +01:00
|
|
|
'$write_answer'(Vs, LBlk, FLAnsw) :-
|
2003-02-24 11:01:01 +00:00
|
|
|
'$purge_dontcares'(Vs,IVs),
|
|
|
|
'$sort'(IVs, NVs),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$prep_answer_var_by_var'(NVs, LAnsw, LBlk),
|
|
|
|
'$name_vars_in_goals'(LAnsw, Vs, NLAnsw),
|
2006-05-24 03:35:39 +01:00
|
|
|
'$write_vars_and_goals'(NLAnsw, first, FLAnsw).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
'$purge_dontcares'([],[]).
|
2014-11-02 12:10:32 +00:00
|
|
|
'$purge_dontcares'([Name=_|Vs],NVs) :-
|
2012-10-09 16:31:43 +01:00
|
|
|
atom_codes(Name, [C|_]), C is "_", !,
|
2001-04-09 20:54:03 +01:00
|
|
|
'$purge_dontcares'(Vs,NVs).
|
|
|
|
'$purge_dontcares'([V|Vs],[V|NVs]) :-
|
|
|
|
'$purge_dontcares'(Vs,NVs).
|
|
|
|
|
|
|
|
|
|
|
|
'$prep_answer_var_by_var'([], L, L).
|
2014-11-02 12:10:32 +00:00
|
|
|
'$prep_answer_var_by_var'([Name=Value|L], LF, L0) :-
|
2001-04-09 20:54:03 +01:00
|
|
|
'$delete_identical_answers'(L, Value, NL, Names),
|
|
|
|
'$prep_answer_var'([Name|Names], Value, LF, LI),
|
|
|
|
'$prep_answer_var_by_var'(NL, LI, L0).
|
|
|
|
|
|
|
|
% fetch all cases that have the same solution.
|
|
|
|
'$delete_identical_answers'([], _, [], []).
|
2012-10-09 16:31:43 +01:00
|
|
|
'$delete_identical_answers'([(Name=Value)|L], Value0, FL, [Name|Names]) :-
|
2001-04-09 20:54:03 +01:00
|
|
|
Value == Value0, !,
|
|
|
|
'$delete_identical_answers'(L, Value0, FL, Names).
|
|
|
|
'$delete_identical_answers'([VV|L], Value0, [VV|FL], Names) :-
|
|
|
|
'$delete_identical_answers'(L, Value0, FL, Names).
|
|
|
|
|
|
|
|
% now create a list of pairs that will look like goals.
|
|
|
|
'$prep_answer_var'(Names, Value, LF, L0) :- var(Value), !,
|
|
|
|
'$prep_answer_unbound_var'(Names, LF, L0).
|
|
|
|
'$prep_answer_var'(Names, Value, [nonvar(Names,Value)|L0], L0).
|
|
|
|
|
|
|
|
% ignore unbound variables
|
|
|
|
'$prep_answer_unbound_var'([_], L, L) :- !.
|
|
|
|
'$prep_answer_unbound_var'(Names, [var(Names)|L0], L0).
|
|
|
|
|
|
|
|
'$gen_name_string'(I,L,[C|L]) :- I < 26, !, C is I+65.
|
|
|
|
'$gen_name_string'(I,L0,LF) :-
|
|
|
|
I1 is I mod 26,
|
|
|
|
I2 is I // 26,
|
|
|
|
C is I1+65,
|
|
|
|
'$gen_name_string'(I2,[C|L0],LF).
|
|
|
|
|
2006-05-24 03:35:39 +01:00
|
|
|
'$write_vars_and_goals'([], _, []).
|
|
|
|
'$write_vars_and_goals'([nl,G1|LG], First, NG) :- !,
|
2005-10-18 18:04:43 +01:00
|
|
|
nl(user_error),
|
2006-05-24 03:35:39 +01:00
|
|
|
'$write_goal_output'(G1, First, NG, Next, IG),
|
|
|
|
'$write_vars_and_goals'(LG, Next, IG).
|
|
|
|
'$write_vars_and_goals'([G1|LG], First, NG) :-
|
|
|
|
'$write_goal_output'(G1, First, NG, Next, IG),
|
|
|
|
'$write_vars_and_goals'(LG, Next, IG).
|
|
|
|
|
2011-02-12 18:42:44 +00:00
|
|
|
'$goal_to_string'(Format, G, String) :-
|
|
|
|
format(codes(String),Format,G).
|
2006-05-24 03:35:39 +01:00
|
|
|
|
2009-09-10 00:00:35 +01:00
|
|
|
'$write_goal_output'(var([V|VL]), First, [var([V|VL])|L], next, L) :- !,
|
2006-05-24 03:35:39 +01:00
|
|
|
( First = first -> true ; format(user_error,',~n',[]) ),
|
2012-10-09 16:31:43 +01:00
|
|
|
format(user_error,'~a',[V]),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$write_output_vars'(VL).
|
2009-09-10 00:00:35 +01:00
|
|
|
'$write_goal_output'(nonvar([V|VL],B), First, [nonvar([V|VL],B)|L], next, L) :- !,
|
2006-05-24 03:35:39 +01:00
|
|
|
( First = first -> true ; format(user_error,',~n',[]) ),
|
2012-10-09 16:31:43 +01:00
|
|
|
format(user_error,'~a',[V]),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$write_output_vars'(VL),
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,' = ', []),
|
2003-08-27 14:37:10 +01:00
|
|
|
( recorded('$print_options','$toplevel'(Opts),_) ->
|
2009-05-22 19:24:27 +01:00
|
|
|
write_term(user_error,B,[priority(699)|Opts]) ;
|
|
|
|
write_term(user_error,B,[priority(699)])
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
2008-03-13 17:16:47 +00:00
|
|
|
'$write_goal_output'(nl, First, NG, First, NG) :- !,
|
|
|
|
format(user_error,'~n',[]).
|
2009-09-10 00:00:35 +01:00
|
|
|
'$write_goal_output'(Format-G, First, NG, Next, IG) :- !,
|
2005-10-18 18:04:43 +01:00
|
|
|
G = [_|_], !,
|
2006-05-24 03:35:39 +01:00
|
|
|
% dump on string first so that we can check whether we actually
|
|
|
|
% had any output from the solver.
|
|
|
|
'$goal_to_string'(Format, G, String),
|
|
|
|
( String == [] ->
|
|
|
|
% we didn't
|
|
|
|
IG = NG, First = Next
|
|
|
|
;
|
|
|
|
% we did
|
|
|
|
( First = first -> true ; format(user_error,',~n',[]) ),
|
|
|
|
format(user_error, '~s', [String]),
|
|
|
|
NG = [G|IG]
|
|
|
|
).
|
2009-09-10 00:00:35 +01:00
|
|
|
'$write_goal_output'(_-G, First, [G|NG], next, NG) :- !,
|
2006-05-24 03:35:39 +01:00
|
|
|
( First = first -> true ; format(user_error,',~n',[]) ),
|
2003-08-27 14:37:10 +01:00
|
|
|
( recorded('$print_options','$toplevel'(Opts),_) ->
|
2001-04-09 20:54:03 +01:00
|
|
|
write_term(user_error,G,Opts) ;
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,'~w',[G])
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
2009-09-10 00:00:35 +01:00
|
|
|
'$write_goal_output'(_M:G, First, [G|NG], next, NG) :- !,
|
|
|
|
( First = first -> true ; format(user_error,',~n',[]) ),
|
|
|
|
( recorded('$print_options','$toplevel'(Opts),_) ->
|
|
|
|
write_term(user_error,G,Opts) ;
|
|
|
|
format(user_error,'~w',[G])
|
|
|
|
).
|
|
|
|
'$write_goal_output'(G, First, [M:G|NG], next, NG) :-
|
|
|
|
'$current_module'(M),
|
2009-04-25 18:54:21 +01:00
|
|
|
( First = first -> true ; format(user_error,',~n',[]) ),
|
|
|
|
( recorded('$print_options','$toplevel'(Opts),_) ->
|
|
|
|
write_term(user_error,G,Opts) ;
|
|
|
|
format(user_error,'~w',[G])
|
|
|
|
).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2010-03-27 11:34:10 +00:00
|
|
|
'$name_vars_in_goals'(G, VL0, G) :-
|
|
|
|
'$name_well_known_vars'(VL0),
|
|
|
|
'$variables_in_term'(G, [], GVL),
|
|
|
|
'$name_vars_in_goals1'(GVL, 0, _).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
'$name_well_known_vars'([]).
|
2012-12-02 13:18:29 +00:00
|
|
|
'$name_well_known_vars'([Name=V|NVL0]) :-
|
2001-04-09 20:54:03 +01:00
|
|
|
var(V), !,
|
|
|
|
V = '$VAR'(Name),
|
|
|
|
'$name_well_known_vars'(NVL0).
|
|
|
|
'$name_well_known_vars'([_|NVL0]) :-
|
|
|
|
'$name_well_known_vars'(NVL0).
|
|
|
|
|
|
|
|
'$name_vars_in_goals1'([], I, I).
|
2011-03-18 19:34:19 +00:00
|
|
|
'$name_vars_in_goals1'(['$VAR'(Name)|NGVL], I0, IF) :-
|
2001-04-09 20:54:03 +01:00
|
|
|
I is I0+1,
|
2011-03-18 19:34:19 +00:00
|
|
|
'$gen_name_string'(I0,[],SName), !,
|
|
|
|
atom_codes(Name, [95|SName]),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$name_vars_in_goals1'(NGVL, I, IF).
|
|
|
|
'$name_vars_in_goals1'([NV|NGVL], I0, IF) :-
|
|
|
|
nonvar(NV),
|
2002-01-02 16:55:24 +00:00
|
|
|
'$name_vars_in_goals1'(NGVL, I0, IF).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
'$write_output_vars'([]).
|
|
|
|
'$write_output_vars'([V|VL]) :-
|
2004-07-22 22:32:23 +01:00
|
|
|
format(user_error,' = ~s',[V]),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$write_output_vars'(VL).
|
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
/** @pred + _P_ is nondet
|
|
|
|
|
|
|
|
The same as `call( _P_)`. This feature has been kept to provide
|
|
|
|
compatibility with C-Prolog. When compiling a goal, YAP
|
|
|
|
generates a `call( _X_)` whenever a variable _X_ is found as
|
|
|
|
a goal.
|
|
|
|
|
|
|
|
~~~~~{.prolog}
|
|
|
|
a(X) :- X.
|
|
|
|
~~~~~
|
|
|
|
is converted to:
|
|
|
|
|
|
|
|
~~~~~{.prolog}
|
|
|
|
a(X) :- call(X).
|
|
|
|
~~~~~
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred call(+ _P_) is iso
|
2014-09-11 20:06:57 +01:00
|
|
|
Meta-call predicate.
|
|
|
|
|
|
|
|
If _P_ is instantiated to an atom or a compound term, the goal `call(
|
|
|
|
_P_)` is executed as if the clause was originally written as _P_
|
|
|
|
instead as call( _P_ ), except that any "cut" occurring in _P_ only
|
|
|
|
cuts alternatives in the execution of _P_.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
2001-04-09 20:54:03 +01:00
|
|
|
call(G) :- '$execute'(G).
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred incore(+ _P_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
The same as call/1.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
2001-04-09 20:54:03 +01:00
|
|
|
incore(G) :- '$execute'(G).
|
|
|
|
|
|
|
|
%
|
|
|
|
% standard meta-call, called if $execute could not do everything.
|
|
|
|
%
|
2001-11-15 00:01:43 +00:00
|
|
|
'$meta_call'(G, M) :-
|
2013-02-13 15:06:06 +00:00
|
|
|
'$current_choice_point'(CP),
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'(G, CP, G, M).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2013-12-13 08:42:57 +00:00
|
|
|
'$user_call'(G, M) :-
|
2014-02-16 12:52:18 +00:00
|
|
|
( '$$save_by'(CP),
|
2013-12-13 08:42:57 +00:00
|
|
|
'$enable_debugging',
|
|
|
|
'$call'(G, CP, M:G, M),
|
|
|
|
'$$save_by'(CP2),
|
2014-02-16 12:52:18 +00:00
|
|
|
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
|
2013-12-13 08:42:57 +00:00
|
|
|
'$disable_debugging'
|
|
|
|
;
|
|
|
|
'$disable_debugging',
|
|
|
|
fail
|
|
|
|
).
|
|
|
|
|
|
|
|
'$enable_debugging' :-
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(debug, false), !.
|
2013-12-13 08:42:57 +00:00
|
|
|
'$enable_debugging' :-
|
|
|
|
'$nb_getval'('$trace', on, fail), !,
|
|
|
|
'$creep'.
|
|
|
|
'$enable_debugging'.
|
|
|
|
|
|
|
|
'$disable_debugging' :-
|
|
|
|
'$stop_creeping'.
|
|
|
|
|
2004-11-22 16:22:14 +00:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred :_P_ , :_Q_ is iso, meta
|
|
|
|
Conjunction of goals (and).
|
|
|
|
|
|
|
|
The conjunction is a fundamental construct of Prolog. Example:
|
|
|
|
|
|
|
|
~~~~~~~
|
|
|
|
p(X) :- q(X), r(X).
|
|
|
|
~~~~~~~
|
|
|
|
|
|
|
|
should be read as `p( _X_) if q( _X_) and r( _X_).
|
|
|
|
|
|
|
|
|
|
|
|
*/
|
2004-11-22 16:22:14 +00:00
|
|
|
','(X,Y) :-
|
2006-12-27 01:32:38 +00:00
|
|
|
yap_hacks:env_choice_point(CP),
|
2004-11-22 16:22:14 +00:00
|
|
|
'$current_module'(M),
|
2004-11-22 16:31:33 +00:00
|
|
|
'$call'(X,CP,(X,Y),M),
|
|
|
|
'$call'(Y,CP,(X,Y),M).
|
2008-02-12 17:03:59 +00:00
|
|
|
';'((X->A),Y) :- !,
|
|
|
|
yap_hacks:env_choice_point(CP),
|
|
|
|
'$current_module'(M),
|
|
|
|
( '$execute'(X)
|
|
|
|
->
|
|
|
|
'$call'(A,CP,(X->A;Y),M)
|
|
|
|
;
|
|
|
|
'$call'(Y,CP,(X->A;Y),M)
|
|
|
|
).
|
|
|
|
';'((X*->A),Y) :- !,
|
|
|
|
yap_hacks:env_choice_point(CP),
|
|
|
|
'$current_module'(M),
|
|
|
|
(
|
2013-02-15 19:40:05 +00:00
|
|
|
yap_hacks:current_choice_point(DCP),
|
2008-02-12 17:03:59 +00:00
|
|
|
'$execute'(X),
|
|
|
|
yap_hacks:cut_at(DCP),
|
|
|
|
'$call'(A,CP,((X*->A),Y),M)
|
|
|
|
;
|
|
|
|
'$call'(Y,CP,((X*->A),Y),M)
|
|
|
|
).
|
2004-11-22 16:22:14 +00:00
|
|
|
';'(X,Y) :-
|
2006-12-27 01:32:38 +00:00
|
|
|
yap_hacks:env_choice_point(CP),
|
2004-11-22 16:22:14 +00:00
|
|
|
'$current_module'(M),
|
2004-11-22 16:31:33 +00:00
|
|
|
( '$call'(X,CP,(X;Y),M) ; '$call'(Y,CP,(X;Y),M) ).
|
2004-11-22 16:22:14 +00:00
|
|
|
'|'(X,Y) :-
|
2006-12-27 01:32:38 +00:00
|
|
|
yap_hacks:env_choice_point(CP),
|
2004-11-22 16:22:14 +00:00
|
|
|
'$current_module'(M),
|
2004-11-22 16:31:33 +00:00
|
|
|
( '$call'(X,CP,(X|Y),M) ; '$call'(Y,CP,(X|Y),M) ).
|
|
|
|
'->'(X,Y) :-
|
2006-12-27 01:32:38 +00:00
|
|
|
yap_hacks:env_choice_point(CP),
|
2004-11-22 16:22:14 +00:00
|
|
|
'$current_module'(M),
|
2006-03-24 16:26:31 +00:00
|
|
|
( '$call'(X,CP,(X->Y),M) -> '$call'(Y,CP,(X->Y),M) ).
|
2008-02-12 17:03:59 +00:00
|
|
|
'*->'(X,Y) :-
|
|
|
|
yap_hacks:env_choice_point(CP),
|
|
|
|
'$current_module'(M),
|
|
|
|
( '$call'(X,CP,(X*->Y),M), '$call'(Y,CP,(X*->Y),M) ).
|
2004-11-22 16:22:14 +00:00
|
|
|
\+(G) :- \+ '$execute'(G).
|
|
|
|
not(G) :- \+ '$execute'(G).
|
|
|
|
|
2006-12-30 03:25:47 +00:00
|
|
|
'$cut_by'(CP) :- '$$cut_by'(CP).
|
2004-11-22 16:22:14 +00:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
%
|
|
|
|
% do it in ISO mode.
|
|
|
|
%
|
2001-11-15 00:01:43 +00:00
|
|
|
'$meta_call'(G,_ISO,M) :-
|
2001-04-09 20:54:03 +01:00
|
|
|
'$iso_check_goal'(G,G),
|
2013-02-13 15:06:06 +00:00
|
|
|
'$current_choice_point'(CP),
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'(G, CP, G, M).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2001-11-15 00:01:43 +00:00
|
|
|
'$meta_call'(G, CP, G0, M) :-
|
|
|
|
'$call'(G, CP, G0, M).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'(G, CP, G0, _, M) :- /* iso version */
|
2001-04-09 20:54:03 +01:00
|
|
|
'$iso_check_goal'(G,G0),
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'(G, CP, G0, M).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2001-10-30 16:42:05 +00:00
|
|
|
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'(M:_,_,G0,_) :- var(M), !,
|
2002-09-09 18:40:12 +01:00
|
|
|
'$do_error'(instantiation_error,call(G0)).
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'(M:G,CP,G0,_) :- !,
|
|
|
|
'$call'(G,CP,G0,M).
|
|
|
|
'$call'((X,Y),CP,G0,M) :- !,
|
2003-05-02 15:37:11 +01:00
|
|
|
'$call'(X,CP,G0,M),
|
|
|
|
'$call'(Y,CP,G0,M).
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'((X->Y),CP,G0,M) :- !,
|
2001-04-09 20:54:03 +01:00
|
|
|
(
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(X,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
->
|
2008-02-12 17:03:59 +00:00
|
|
|
'$call'(Y,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
2008-02-12 17:03:59 +00:00
|
|
|
'$call'((X*->Y),CP,G0,M) :- !,
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(X,CP,G0,M),
|
2008-02-12 17:03:59 +00:00
|
|
|
'$call'(Y,CP,G0,M).
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'((X->Y; Z),CP,G0,M) :- !,
|
2001-04-09 20:54:03 +01:00
|
|
|
(
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(X,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
->
|
2003-05-02 15:37:11 +01:00
|
|
|
'$call'(Y,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
;
|
2003-05-02 15:37:11 +01:00
|
|
|
'$call'(Z,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
2008-02-12 17:03:59 +00:00
|
|
|
'$call'((X*->Y; Z),CP,G0,M) :- !,
|
|
|
|
(
|
2013-02-15 19:40:05 +00:00
|
|
|
'$current_choice_point'(DCP),
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(X,CP,G0,M),
|
2008-02-12 17:03:59 +00:00
|
|
|
yap_hacks:cut_at(DCP),
|
|
|
|
'$call'(Y,CP,G0,M)
|
|
|
|
;
|
|
|
|
'$call'(Z,CP,G0,M)
|
|
|
|
).
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'((A;B),CP,G0,M) :- !,
|
2001-04-09 20:54:03 +01:00
|
|
|
(
|
2003-05-02 15:37:11 +01:00
|
|
|
'$call'(A,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
;
|
2003-05-02 15:37:11 +01:00
|
|
|
'$call'(B,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
2003-01-29 14:47:17 +00:00
|
|
|
'$call'((X->Y| Z),CP,G0,M) :- !,
|
|
|
|
(
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(X,CP,G0,M)
|
2003-01-29 14:47:17 +00:00
|
|
|
->
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(Y,CP,G0,M)
|
2003-01-29 14:47:17 +00:00
|
|
|
;
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(Z,CP,G0,M)
|
2003-01-29 14:47:17 +00:00
|
|
|
).
|
2008-02-12 17:03:59 +00:00
|
|
|
'$call'((X*->Y| Z),CP,G0,M) :- !,
|
|
|
|
(
|
2013-02-15 19:40:05 +00:00
|
|
|
'$current_choice_point'(DCP),
|
2008-08-06 01:56:11 +01:00
|
|
|
'$call'(X,CP,G0,M),
|
2008-02-12 17:03:59 +00:00
|
|
|
yap_hacks:cut_at(DCP),
|
|
|
|
'$call'(Y,CP,G0,M)
|
|
|
|
;
|
|
|
|
'$call'(Z,CP,G0,M)
|
|
|
|
).
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'((A|B),CP, G0,M) :- !,
|
2001-04-09 20:54:03 +01:00
|
|
|
(
|
2003-05-02 15:37:11 +01:00
|
|
|
'$call'(A,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
;
|
2003-05-02 15:37:11 +01:00
|
|
|
'$call'(B,CP,G0,M)
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
2006-11-27 17:42:03 +00:00
|
|
|
'$call'(\+ X, _CP, _G0, M) :- !,
|
2014-10-19 13:09:35 +01:00
|
|
|
\+ ('$current_choice_point'(CP),
|
|
|
|
'$call'(X,CP,G0,M) ).
|
2007-01-24 14:20:04 +00:00
|
|
|
'$call'(not(X), _CP, _G0, M) :- !,
|
2014-10-19 13:09:35 +01:00
|
|
|
\+ ('$current_choice_point'(CP),
|
|
|
|
'$call'(X,CP,G0,M) ).
|
2001-11-15 00:01:43 +00:00
|
|
|
'$call'(!, CP, _,_) :- !,
|
2006-12-30 03:25:47 +00:00
|
|
|
'$$cut_by'(CP).
|
2001-12-11 04:35:31 +00:00
|
|
|
'$call'([A|B], _, _, M) :- !,
|
|
|
|
'$csult'([A|B], M).
|
2004-12-05 05:01:45 +00:00
|
|
|
'$call'(G, CP, G0, CurMod) :-
|
|
|
|
( '$is_expand_goal_or_meta_predicate'(G,CurMod) ->
|
|
|
|
(
|
2012-12-07 08:08:32 +00:00
|
|
|
'$do_goal_expansion'(G, CurMod, NG) ->
|
|
|
|
'$call'(NG, CP, G0,CurMod)
|
2004-12-05 05:01:45 +00:00
|
|
|
;
|
|
|
|
% repeat other code.
|
|
|
|
'$is_metapredicate'(G,CurMod) ->
|
|
|
|
(
|
2008-07-23 00:34:50 +01:00
|
|
|
'$meta_expansion'(G,CurMod,CurMod,CurMod,NG,[]) ->
|
2004-12-05 05:01:45 +00:00
|
|
|
'$execute0'(NG, CurMod)
|
|
|
|
;
|
|
|
|
'$execute0'(G, CurMod)
|
|
|
|
)
|
|
|
|
;
|
|
|
|
'$execute0'(G, CurMod)
|
|
|
|
)
|
2002-11-26 23:00:32 +00:00
|
|
|
;
|
2004-12-05 05:01:45 +00:00
|
|
|
'$execute0'(G, CurMod)
|
2002-11-26 23:00:32 +00:00
|
|
|
).
|
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
'$check_callable'(V,G) :- var(V), !,
|
2006-05-25 17:28:28 +01:00
|
|
|
'$do_error'(instantiation_error,G).
|
2007-01-24 14:20:04 +00:00
|
|
|
'$check_callable'(M:_G1,G) :- var(M), !,
|
2006-05-25 17:28:28 +01:00
|
|
|
'$do_error'(instantiation_error,G).
|
|
|
|
'$check_callable'(_:G1,G) :- !,
|
|
|
|
'$check_callable'(G1,G).
|
2001-04-09 20:54:03 +01:00
|
|
|
'$check_callable'(A,G) :- number(A), !,
|
2014-10-20 09:20:56 +01:00
|
|
|
'$do_error'(type_error(callable,A),G).
|
2001-04-09 20:54:03 +01:00
|
|
|
'$check_callable'(R,G) :- db_reference(R), !,
|
2014-10-20 09:20:56 +01:00
|
|
|
'$do_error'(type_error(callable,R),G).
|
2001-04-09 20:54:03 +01:00
|
|
|
'$check_callable'(_,_).
|
|
|
|
|
|
|
|
|
2005-10-19 02:47:43 +01:00
|
|
|
bootstrap(F) :-
|
2011-02-12 14:14:12 +00:00
|
|
|
% '$open'(F, '$csult', Stream, 0, 0, F),
|
|
|
|
% '$file_name'(Stream,File),
|
|
|
|
open(F, read, Stream),
|
2015-06-19 01:11:30 +01:00
|
|
|
stream_property(Stream, [file_name(File)]),
|
2005-10-19 02:47:43 +01:00
|
|
|
'$start_consult'(consult, File, LC),
|
|
|
|
file_directory_name(File, Dir),
|
2011-05-12 22:26:10 +01:00
|
|
|
working_directory(OldD, Dir),
|
2005-10-28 18:38:50 +01:00
|
|
|
(
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(verbose_load, silent)
|
2005-10-28 18:38:50 +01:00
|
|
|
->
|
|
|
|
true
|
|
|
|
;
|
|
|
|
H0 is heapused, '$cputime'(T0,_),
|
2014-12-14 11:45:42 +00:00
|
|
|
format(user_error, '~*|% consulting ~w...~n', [LC,F])
|
2005-10-28 18:38:50 +01:00
|
|
|
),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$loop'(Stream,consult),
|
2011-05-12 22:26:10 +01:00
|
|
|
working_directory(_, OldD),
|
2014-04-06 17:05:17 +01:00
|
|
|
'$current_module'(_, prolog),
|
2001-04-09 20:54:03 +01:00
|
|
|
'$end_consult',
|
2005-10-28 18:38:50 +01:00
|
|
|
(
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(verbose_load, silent)
|
2005-10-28 18:38:50 +01:00
|
|
|
->
|
|
|
|
true
|
|
|
|
;
|
|
|
|
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
|
|
|
format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T])
|
|
|
|
),
|
2007-02-18 00:26:36 +00:00
|
|
|
!,
|
2011-02-14 22:55:59 +00:00
|
|
|
close(Stream).
|
2007-02-18 00:26:36 +00:00
|
|
|
|
2013-01-15 11:18:09 +00:00
|
|
|
'$loop'(Stream,exo) :-
|
2014-11-02 12:10:32 +00:00
|
|
|
prolog_flag(agc_margin,Old,0),
|
2013-01-15 11:18:09 +00:00
|
|
|
prompt1('| '), prompt(_,'| '),
|
|
|
|
'$current_module'(OldModule),
|
|
|
|
repeat,
|
|
|
|
'$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error,
|
|
|
|
user:'$LoopError'(Error, Status)),
|
2013-01-22 22:21:44 +00:00
|
|
|
prolog_flag(agc_margin,_,Old),
|
2013-01-15 11:18:09 +00:00
|
|
|
!.
|
|
|
|
'$loop'(Stream,db) :-
|
2014-11-02 12:10:32 +00:00
|
|
|
prolog_flag(agc_margin,Old,0),
|
2013-01-15 11:18:09 +00:00
|
|
|
prompt1('| '), prompt(_,'| '),
|
|
|
|
'$current_module'(OldModule),
|
|
|
|
repeat,
|
|
|
|
'$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error,
|
|
|
|
user:'$LoopError'(Error, Status)),
|
2013-01-22 22:21:44 +00:00
|
|
|
prolog_flag(agc_margin,_,Old),
|
2013-01-15 11:18:09 +00:00
|
|
|
!.
|
2001-04-09 20:54:03 +01:00
|
|
|
'$loop'(Stream,Status) :-
|
|
|
|
repeat,
|
2011-02-14 15:19:37 +00:00
|
|
|
prompt1('| '), prompt(_,'| '),
|
2002-04-09 16:12:14 +01:00
|
|
|
'$current_module'(OldModule),
|
2013-11-20 22:30:49 +00:00
|
|
|
'$system_catch'('$enter_command'(Stream,OldModule,Status), OldModule, Error,
|
2003-12-01 17:27:42 +00:00
|
|
|
user:'$LoopError'(Error, Status)),
|
2002-01-22 17:11:36 +00:00
|
|
|
!.
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2013-11-20 22:30:49 +00:00
|
|
|
'$enter_command'(Stream,Mod,Status) :-
|
2015-06-19 01:11:30 +01:00
|
|
|
read_term(Stream, Command, [variable_names(Vars), term_position(Pos), syntax_errors(dec10) ]),
|
2011-06-14 09:01:10 +01:00
|
|
|
'$command'(Command,Vars,Pos,Status).
|
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
'$abort_loop'(Stream) :-
|
2002-09-09 18:40:12 +01:00
|
|
|
'$do_error'(permission_error(input,closed_stream,Stream), loop).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2014-04-06 17:05:17 +01:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
/* General purpose predicates */
|
|
|
|
|
|
|
|
'$head_and_body'((H:-B),H,B) :- !.
|
|
|
|
'$head_and_body'(H,H,true).
|
|
|
|
|
|
|
|
%
|
|
|
|
% split head and body, generate an error if body is unbound.
|
|
|
|
%
|
|
|
|
'$check_head_and_body'((H:-B),H,B,P) :- !,
|
|
|
|
'$check_head'(H,P).
|
|
|
|
'$check_head_and_body'(H,H,true,P) :-
|
|
|
|
'$check_head'(H,P).
|
|
|
|
|
|
|
|
'$check_head'(H,P) :- var(H), !,
|
2002-09-09 18:40:12 +01:00
|
|
|
'$do_error'(instantiation_error,P).
|
2001-04-09 20:54:03 +01:00
|
|
|
'$check_head'(H,P) :- number(H), !,
|
2014-10-20 09:20:56 +01:00
|
|
|
'$do_error'(type_error(callable,H),P).
|
2001-04-09 20:54:03 +01:00
|
|
|
'$check_head'(H,P) :- db_reference(H), !,
|
2014-10-20 09:20:56 +01:00
|
|
|
'$do_error'(type_error(callable,H),P).
|
2001-04-09 20:54:03 +01:00
|
|
|
'$check_head'(_,_).
|
|
|
|
|
|
|
|
% term expansion
|
|
|
|
%
|
|
|
|
% return two arguments: Expanded0 is the term after "USER" expansion.
|
|
|
|
% Expanded is the final expanded term.
|
|
|
|
%
|
2014-10-05 23:53:05 +01:00
|
|
|
'$precompile_term'(Term, Expanded0, Expanded, HeadMod, BodyMod, SourceMod) :-
|
2014-11-02 12:10:32 +00:00
|
|
|
%format('[ ~w~n',[Term]),
|
2014-10-05 23:53:05 +01:00
|
|
|
'$module_expansion'(Term, Expanded0, ExpandedI, HeadMod, BodyMod, SourceMod), !,
|
2014-11-02 12:10:32 +00:00
|
|
|
%format(' -> ~w~n',[Expanded0]),
|
2001-04-09 20:54:03 +01:00
|
|
|
(
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(strict_iso, true) /* strict_iso on */
|
2001-04-09 20:54:03 +01:00
|
|
|
->
|
2008-07-23 00:34:50 +01:00
|
|
|
Expanded = ExpandedI,
|
|
|
|
'$check_iso_strict_clause'(Expanded0)
|
2001-04-09 20:54:03 +01:00
|
|
|
;
|
2008-07-23 00:34:50 +01:00
|
|
|
'$expand_array_accesses_in_term'(ExpandedI,Expanded)
|
2001-04-09 20:54:03 +01:00
|
|
|
).
|
2014-10-05 23:53:05 +01:00
|
|
|
'$precompile_term'(Term, Term, Term, _, _, _).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
|
|
|
/** @pred expand_term( _T_,- _X_)
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
This predicate is used by YAP for preprocessing each top level
|
|
|
|
term read when consulting a file and before asserting or executing it.
|
|
|
|
It rewrites a term _T_ to a term _X_ according to the following
|
|
|
|
rules: first try term_expansion/2 in the current module, and then try to use the user defined predicate
|
|
|
|
`user:term_expansion/2`. If this call fails then the translating process
|
|
|
|
for DCG rules is applied, together with the arithmetic optimizer
|
|
|
|
whenever the compilation of arithmetic expressions is in progress.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
2001-04-09 20:54:03 +01:00
|
|
|
expand_term(Term,Expanded) :-
|
2012-12-07 08:08:32 +00:00
|
|
|
( '$do_term_expansion'(Term,Expanded)
|
|
|
|
->
|
|
|
|
true
|
2001-04-09 20:54:03 +01:00
|
|
|
;
|
|
|
|
'$expand_term_grammar'(Term,Expanded)
|
2012-12-07 08:08:32 +00:00
|
|
|
).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
%
|
|
|
|
% Grammar Rules expansion
|
|
|
|
%
|
|
|
|
'$expand_term_grammar'((A-->B), C) :-
|
|
|
|
'$translate_rule'((A-->B),C), !.
|
|
|
|
'$expand_term_grammar'(A, A).
|
|
|
|
|
|
|
|
%
|
|
|
|
% Arithmetic expansion
|
|
|
|
%
|
|
|
|
'$expand_array_accesses_in_term'(Expanded0,ExpandedF) :-
|
|
|
|
'$array_refs_compiled',
|
2015-01-18 01:32:13 +00:00
|
|
|
'$arrays':'$c_arrays'(Expanded0,ExpandedF), !.
|
2001-04-09 20:54:03 +01:00
|
|
|
'$expand_array_accesses_in_term'(Expanded,Expanded).
|
|
|
|
|
2001-12-17 18:31:11 +00:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
|
% catch/throw implementation
|
|
|
|
|
2001-12-17 18:31:11 +00:00
|
|
|
% at each catch point I need to know:
|
|
|
|
% what is ball;
|
2014-11-02 12:10:32 +00:00
|
|
|
% where was the previous catch
|
|
|
|
/** @pred catch( : _Goal_,+ _Exception_,+ _Action_) is iso
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
The goal `catch( _Goal_, _Exception_, _Action_)` tries to
|
|
|
|
execute goal _Goal_. If during its execution, _Goal_ throws an
|
|
|
|
exception _E'_ and this exception unifies with _Exception_, the
|
|
|
|
exception is considered to be caught and _Action_ is executed. If
|
|
|
|
the exception _E'_ does not unify with _Exception_, control
|
|
|
|
again throws the exception.
|
|
|
|
|
|
|
|
The top-level of YAP maintains a default exception handler that
|
|
|
|
is responsible to capture uncaught exceptions.
|
|
|
|
|
2014-11-02 12:10:32 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
2002-01-07 06:28:04 +00:00
|
|
|
catch(G, C, A) :-
|
2002-01-28 04:30:40 +00:00
|
|
|
'$catch'(C,A,_),
|
2013-02-13 15:06:06 +00:00
|
|
|
'$$save_by'(CP0),
|
2008-09-24 00:13:02 +01:00
|
|
|
'$execute'(G),
|
2013-02-13 15:06:06 +00:00
|
|
|
'$$save_by'(CP1),
|
2009-05-05 00:10:07 +01:00
|
|
|
(CP0 == CP1 -> !; true ).
|
2008-09-24 00:13:02 +01:00
|
|
|
|
|
|
|
% makes sure we have an environment.
|
|
|
|
'$true'.
|
2001-12-17 18:31:11 +00:00
|
|
|
|
2004-07-15 16:47:08 +01:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
% system_catch is like catch, but it avoids the overhead of a full
|
2001-11-15 00:01:43 +00:00
|
|
|
% meta-call by calling '$execute0' instead of $execute.
|
2001-04-09 20:54:03 +01:00
|
|
|
% This way it
|
|
|
|
% also avoids module preprocessing and goal_expansion
|
|
|
|
%
|
2002-01-07 06:28:04 +00:00
|
|
|
'$system_catch'(G, M, C, A) :-
|
|
|
|
% check current trail
|
2002-01-28 04:30:40 +00:00
|
|
|
'$catch'(C,A,_),
|
2013-02-13 15:06:06 +00:00
|
|
|
'$$save_by'(CP0),
|
2008-09-24 00:13:02 +01:00
|
|
|
'$execute_nonstop'(G, M),
|
2013-02-13 15:06:06 +00:00
|
|
|
'$$save_by'(CP1),
|
2009-05-05 00:10:07 +01:00
|
|
|
(CP0 == CP1 -> !; true ).
|
2002-01-24 23:55:34 +00:00
|
|
|
|
|
|
|
%
|
|
|
|
% throw has to be *exactly* after system catch!
|
|
|
|
%
|
2014-11-02 12:10:32 +00:00
|
|
|
/** @pred throw(+ _Ball_) is iso
|
2014-09-11 20:06:57 +01:00
|
|
|
|
|
|
|
|
|
|
|
The goal `throw( _Ball_)` throws an exception. Execution is
|
|
|
|
stopped, and the exception is sent to the ancestor goals until reaching
|
|
|
|
a matching catch/3, or until reaching top-level.
|
|
|
|
|
|
|
|
*/
|
2009-11-27 11:21:24 +00:00
|
|
|
throw(_Ball) :-
|
|
|
|
% use existing ball
|
2009-12-02 21:59:41 +00:00
|
|
|
'$get_exception'(Ball),
|
2009-11-27 11:21:24 +00:00
|
|
|
!,
|
|
|
|
'$jump_env_and_store_ball'(Ball).
|
2002-01-24 23:55:34 +00:00
|
|
|
throw(Ball) :-
|
2014-11-02 12:10:32 +00:00
|
|
|
( var(Ball) ->
|
2013-01-17 14:00:12 +00:00
|
|
|
'$do_error'(instantiation_error,throw(Ball))
|
|
|
|
;
|
2002-01-24 23:55:34 +00:00
|
|
|
% get current jump point
|
2013-01-17 14:00:12 +00:00
|
|
|
'$jump_env_and_store_ball'(Ball)
|
|
|
|
).
|
2001-06-11 16:12:07 +01:00
|
|
|
|
2002-01-14 22:26:53 +00:00
|
|
|
|
2002-01-24 23:55:34 +00:00
|
|
|
% just create a choice-point
|
2002-01-28 04:30:40 +00:00
|
|
|
'$catch'(_,_,_).
|
|
|
|
'$catch'(_,_,_) :- fail.
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2002-01-24 23:55:34 +00:00
|
|
|
'$handle_throw'(_, _, _).
|
2009-11-27 11:21:24 +00:00
|
|
|
'$handle_throw'(C, A, _Ball) :-
|
2009-12-02 21:59:41 +00:00
|
|
|
'$reset_exception'(Ball),
|
2009-04-22 17:32:07 +01:00
|
|
|
% reset info
|
2011-07-09 12:56:11 +01:00
|
|
|
(catch_ball(Ball, C) ->
|
2002-01-07 06:28:04 +00:00
|
|
|
'$execute'(A)
|
|
|
|
;
|
|
|
|
throw(Ball)
|
|
|
|
).
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2011-07-09 12:56:11 +01:00
|
|
|
catch_ball(Abort, _) :- Abort == '$abort', !, fail.
|
2014-09-11 20:06:57 +01:00
|
|
|
% system defined throws should be ignored by user, unless the
|
2009-04-22 17:32:07 +01:00
|
|
|
% user is hacking away.
|
2011-07-09 12:56:11 +01:00
|
|
|
catch_ball(Ball, V) :-
|
2009-04-22 17:32:07 +01:00
|
|
|
var(V),
|
|
|
|
nonvar(Ball),
|
2009-04-22 22:13:08 +01:00
|
|
|
Ball = error(Type,_), % internal error ??
|
|
|
|
functor(Type, Name, _),
|
2009-04-22 17:32:07 +01:00
|
|
|
atom_codes(Name, [0'$|_]), %'0
|
|
|
|
!, fail.
|
2011-07-09 12:56:11 +01:00
|
|
|
catch_ball(C, C).
|
2009-04-22 17:32:07 +01:00
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
'$run_toplevel_hooks' :-
|
2015-06-19 01:11:30 +01:00
|
|
|
current_prolog_flag(break_level, 0 ),
|
2014-11-02 12:10:32 +00:00
|
|
|
recorded('$toplevel_hooks',H,_),
|
2012-12-07 08:08:32 +00:00
|
|
|
H \= fail, !,
|
2013-02-15 02:40:11 +00:00
|
|
|
( call(user:H1) -> true ; true).
|
2001-04-09 20:54:03 +01:00
|
|
|
'$run_toplevel_hooks'.
|
|
|
|
|
2009-04-25 18:54:21 +01:00
|
|
|
'$run_at_thread_start' :-
|
|
|
|
recorded('$thread_initialization',M:D,_),
|
2013-12-13 08:42:57 +00:00
|
|
|
'$meta_call'(D, M),
|
2009-04-25 18:54:21 +01:00
|
|
|
fail.
|
|
|
|
'$run_at_thread_start'.
|
|
|
|
|
2014-06-22 17:35:05 +01:00
|
|
|
log_event( String, Args ) :-
|
|
|
|
format( atom( M ), String, Args),
|
|
|
|
log_event( M ).
|
2011-03-09 23:28:30 +00:00
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
/**
|
2015-01-04 23:58:23 +00:00
|
|
|
@}
|
2014-09-11 20:06:57 +01:00
|
|
|
*/
|
2014-12-04 07:59:30 +00:00
|
|
|
|