2001-04-09 20:54:03 +01:00
/*************************************************************************
* *
* YAP Prolog *
* *
2015-08-18 21:08:52 +01: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
* *
**************************************************************************
2016-01-31 10:45:00 +00:00
* Ptv *
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
2014-11-02 12:10:32 +00:00
/**
2016-01-31 10:45:00 +00:00
@file boot.yap
2014-09-11 20:06:57 +01:00
@defgroup YAPControl Control Predicates
2015-01-04 23:58:23 +00:00
@ingroup builtins
2015-07-06 12:04:42 +01:00
2014-09-11 20:06:57 +01:00
*/
2016-01-20 22:36:16 +00:00
%% @{
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".
2016-01-31 10:45:00 +00:00
If _P_ includes cuts, the cuts are defined to be scoped by _P_: they cannot cut over the calling prredicate.
2014-11-02 12:10:32 +00:00
~~~~~~~~~~~~
go(P).
2016-01-31 10:45:00 +00:00
:- \+ P, !, fail.
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.
*/
2016-02-28 19:32:55 +00:00
system_module(_Mod, _SysExps, _Decls) :- ! .
2016-01-31 10:45:00 +00:00
% new_system_module(Mod).
2014-04-09 12:39:29 +01:00
use_system_module(_init, _SysExps) :- !.
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,
2015-07-28 04:22:44 +01:00
'$'/0,
2014-04-09 12:39:29 +01:00
'$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,
2015-08-18 21:08:52 +01:00
'$version'/0]).
2014-04-09 12:39:29 +01:00
:- 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]).
2016-02-21 19:09:10 +00:00
2016-02-22 12:55:05 +00:00
2016-02-21 19:09:10 +00:00
'$early_print_message'(_, absolute_file_path(X, Y)) :- !,
format(user_error, X, Y), nl(user_error).
'$early_print_message'(_, loading( C, F)) :- !,
2016-02-22 12:55:05 +00:00
format(user_error, '~*|% ~a ~w...~n', [2,C,F]).
2016-02-21 19:09:10 +00:00
'$early_print_message'(_, loaded(F,C,M,T,H)) :- !,
2016-02-22 12:55:05 +00:00
format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [2, M, F ,C, H, T]).
2016-02-21 19:09:10 +00:00
'$early_print_message'(Level, Msg) :-
source_location(F0, L),
!,
format(user_error, '~a:~d:0: unprocessed ~a ~w ~n', [F0, L,Level,Msg]).
'$early_print_message'(Level, Msg) :-
format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]).
2016-02-22 12:55:05 +00:00
'$handle_error'(_Action,_G0,_M0) :- fail.
% cases where we cannot afford to ever fail.
'$undefp'([_|print_message(Context, Msg)], true) :- !,
2016-02-21 19:09:10 +00:00
'$early_print_message'(Context, Msg).
2016-02-22 12:55:05 +00:00
% undef handler
2016-02-21 19:09:10 +00:00
'$undefp'([M0|G0], Action) :-
% make sure we do not loop on undefined predicates
'$stop_creeping'(Current),
2016-02-22 12:55:05 +00:00
yap_flag( unknown, Action, fail),
2016-02-21 19:09:10 +00:00
% yap_flag( debug, Debug, false),
(
'$undefp_search'(M0:G0, NM:NG),
( M0 \== NM -> true ; G0 \== NG ),
2016-02-22 12:55:05 +00:00
NG \= fail
2016-02-21 19:09:10 +00:00
->
yap_flag( unknown, _, Action),
2016-02-22 12:55:05 +00:00
% yap_flag( debug, _, Debug),
2016-02-21 19:09:10 +00:00
(
Current == true
->
% carry on signal processing
'$start_creep'([NM|NG], creep)
;
'$execute0'(NG, NM)
)
;
yap_flag( unknown, _, Action),
'$handle_error'(Action,G0,M0)
).
2016-02-22 12:55:05 +00:00
2015-12-15 09:01:44 +00:00
/*
'$undefp'([M0|G0], Default) :-
G0 \= '$imported_predicate'(_,_,_,_),
G0 \= '$full_clause_optimisation'(_H, _M, _B0, _BF),
G0 \= '$expand_a_clause'(_,_,_,_),
G0 \= '$all_directives'(_),
format(user_error, 'ERROR: undefined ~a:~q.~n', [M0, G0]), fail.
*/
2015-09-29 23:49:03 +01:00
'$prepare_goals'((A,B),(NA,NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((A;B),(NA;NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((A->B),(NA->NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((A*->B),(NA*->NB),Any) :-
!,
'$prepare_goals'(A,NA,Any),
'$prepare_goals'(B,NB,Any).
'$prepare_goals'((\+ A),(\+ NA),Any) :-
!,
'$prepare_goals'(A,NA,Any).
'$prepare_goals'('$do_error'(Error,Goal),
(clause_location(Call, Caller),
2016-02-21 19:09:10 +00:00
source_module(M),
2015-09-29 23:49:03 +01:00
strip_module(M:Goal,M1,NGoal),
throw(error(Error, [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]]))
),
true) :-
2016-02-21 19:09:10 +00:00
!,
'$head_and_body'(NGoal,Head,_Body).
2015-09-29 23:49:03 +01:00
'$prepare_goals'(X is AOB,
is(X, IOp, A, B ),
true) :-
var(X),
functor(AOB, Op, 2),
arg(1, AOB, A),
arg(2, AOB, B),
!,
2016-01-31 10:45:00 +00:00
'$inbrary_op_as_integer'(Op,IOp).
2015-09-29 23:49:03 +01:00
'$prepare_goals'((A,B),(A,B),_Any).
'$prepare_clause'((H :- B), (H:-NB)) :-
'$prepare_goals'(B,NB,Any),
Any==true.
2014-04-09 12:39:29 +01:00
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.
*/
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 ->
2016-01-03 02:06:09 +00:00
true % '$compile_mode'(_,0)
2015-06-19 01:11:30 +01:00
;
format(user_error,'[~w]~n', [Module])
),
2015-11-18 15:06:25 +00:00
'$system_catch'('$enter_top_level',Module,Error,'$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),
2015-12-15 09:28:43 +00:00
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),
2015-09-21 23:05:36 +01:00
% simple trick to find out if this is we are booting from Prolog.
% boot from a saved state
(
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 \= []
2016-02-11 14:17:30 +00: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-11-05 17:19:25 +00:00
'$prompt',
2015-06-19 01:11:30 +01:00
'$system_catch'(read_term(user_input,
Goal,
2015-07-06 12:04:42 +01:00
[variable_names(Bindings), syntax_errors(dec10)]),
2015-06-19 01:11:30 +01:00
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
2015-07-06 12:04:42 +01:00
/** @pred stream_property( _Stream_, _Prop_)
2015-06-19 01:11:30 +01:00
*/
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' :-
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
(
2015-12-15 09:28:43 +00:00
BreakLevel \= 0
2014-12-14 11:45:42 +00:00
->
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
2016-01-31 10:45:00 +00:00
'$erase_sets' :-
eraseall('$'),
2006-01-02 02:16:19 +00:00
eraseall('$$set'),
2014-11-02 12:10:32 +00:00
eraseall('$$one'),
2006-01-02 02:16:19 +00:00
eraseall('$reconsulted'), fail.
2016-01-31 10:45:00 +00:00
'$erase_sets' :- \+ recorded('$path',_,_), recorda('$path',"",_).
'$erase_sets'.
2006-01-02 02:16:19 +00:00
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 */
2016-02-21 11:31:27 +00:00
'$execute_command'(C,VL,Pos,Con,_Source).
2008-10-23 22:17:45 +01:00
'$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
2016-02-21 11:31:27 +00:00
'$execute_commands'(EC,VL,Pos,Con,_Source),
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
(
2015-12-15 09:01:44 +00:00
'$system_catch'('$execute_command'(C,VL,Pos,Con,C),prolog,Error,'$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
%
%
2016-01-03 02:06:09 +00:00
'$execute_command'(C,_,_,top,Source) :-
var(C),
!,
'$do_error'(instantiation_error,meta_call(Source)).
'$execute_command'(C,_,_,top,Source) :-
number(C),
!,
'$do_error'(type_error(callable,C),meta_call(Source)).
'$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
2016-02-22 12:55:05 +00:00
expand_term((:- M: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)
2016-01-03 02:06:09 +00:00
;
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) :-
2016-01-03 02:06:09 +00: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).
2016-01-03 02:06:09 +00:00
'$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-11-05 17:19:25 +00:00
'$process_directive'(D, _, M, _VL, _Pos) :-
2016-01-03 02:06:09 +00:00
current_prolog_flag(language_mode, iso),
!, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive).
2006-01-02 02:16:19 +00:00
%
% 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
2016-01-03 02:06:09 +00:00
;
2014-10-02 14:34:03 +01:00
'$save_directive'(G, Mode, M, VL, Pos)
2016-01-03 02:06:09 +00:00
->
2014-10-02 14:34:03 +01:00
true
2016-01-03 02:06:09 +00:00
;
2014-10-02 14:34:03 +01:00
true
),
2016-01-03 02:06:09 +00:00
(
'$execute'(M:G)
->
true
;
format(user_error,':- ~w:~w failed.~n',[M,G])
).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!,
'$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) :-
2015-12-15 09:01:44 +00:00
% writeln(G),
2016-01-03 02:06:09 +00:00
'$go_compile_clause'(G,V,Pos,reconsult,Source),
fail.
2014-08-04 15:45:30 +01:00
'$continue_with_command'(consult,V,Pos,G,Source) :-
2015-12-15 09:01:44 +00:00
'$go_compile_clause'(G,V,Pos,consult,Source),
2016-01-03 02:06:09 +00:00
fail.
2014-08-04 15:45:30 +01:00
'$continue_with_command'(top,V,_,G,_) :-
2016-01-03 02:06:09 +00:00
'$query'(G,V).
2006-01-02 02:16:19 +00:00
2016-01-31 10:45:00 +00:00
%%
% @pred '$go_compile_clause'(G,Vs,Pos, Where, Source) is det
2006-01-02 02:16:19 +00:00
%
2016-01-31 10:45:00 +00:00
% interfaces the loader and the compiler
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.
%
2016-01-31 10:45:00 +00:00
% @param [in] _G_ is the clause to compile
2016-02-21 11:31:27 +00:00
% @param [in] _Vs_ a list of variables and their name
2016-01-31 10:45:00 +00:00
% @param [in] _Pos_ the source-code position
% @param [in] _N_ a flag telling whether to add first or last
2016-02-21 11:31:27 +00:00
% @param [out] _Source_ the user-tranasformed clause
'$go_compile_clause'(G, _Vs, _Pos, Where, Source) :-
'$precompile_term'(G, Source, G1),
2015-12-15 09:01:44 +00:00
!,
2016-02-21 11:31:27 +00:00
'$$compile'(G1, Where, Source, _).
'$go_compile_clause'(G,_Vs,_Pos, _Where, _Source) :-
2015-12-15 09:01:44 +00:00
throw(error(system, compilation_failed(G))).
2016-01-03 02:06:09 +00:00
2015-12-15 09:01:44 +00:00
'$$compile'(C, Where, C0, R) :-
'$head_and_body'( C, MH, B ),
strip_module( MH, Mod, H),
(
'$undefined'(H, Mod)
->
'$init_pred'(H, Mod, Where)
;
true
),
% writeln(Mod:((H:-B))),
'$compile'((H:-B), Where, C0, Mod, R).
2008-05-15 14:41:48 +01:00
2015-12-15 09:01:44 +00:00
'$init_pred'(H, Mod, _Where ) :-
recorded('$import','$import'(NM,Mod,NH,H,_,_),RI),
% NM \= Mod,
functor(NH,N,Ar),
2016-02-21 19:09:10 +00:00
'$early_print'(warning,redefine_imported(Mod,NM,Mod:N/Ar)),
2015-12-15 09:01:44 +00:00
erase(RI),
fail.
'$init_pred'(H, Mod, Where ) :-
'$init_as_dynamic'(Where),
!,
functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod).
'$init_pred'(_H, _Mod, _Where ).
'$init_as_dynamic'( asserta ).
'$init_as_dynamic'( assertz ).
2016-01-03 02:06:09 +00:00
'$init_as_dynamic'( consult ) :-
'$nb_getval'('$assert_all',on,fail).
'$init_as_dynamic'( reconsult ) :-
'$nb_getval'('$assert_all',on,fail).
2009-09-20 16:03:10 +01:00
2014-11-02 12:10:32 +00:00
'$check_if_reconsulted'(N,A) :-
2015-12-15 09:28:43 +00:00
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),
2016-01-03 02:06:09 +00:00
X == '$',
!,
2008-05-15 14:41:48 +01:00
( 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,_).
2010-03-27 11:34:10 +00:00
'$query'(G,[]) :-
2011-01-06 17:20:29 +00:00
'$prompt_alternatives_on'(OPT),
2016-01-03 02:06:09 +00:00
( 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',
2016-01-03 02:06:09 +00:00
'$current_choice_point'(NCP1),
2014-12-14 11:45:42 +00:00
'$attributes':delayed_goals(G, V, NV, LGs),
2016-01-03 02:06:09 +00:00
'$current_choice_point'(NCP2),
'$clean_ifcp'(CP),
NCP is NCP2-NCP1
2012-08-08 00:32:45 +01:00
;
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
2016-01-03 02:06:09 +00:00
).
2010-03-27 11:34:10 +00:00
2006-12-13 16:10:26 +00:00
'$out_neg_answer' :-
2015-08-18 21:08:52 +01:00
'$early_print'( help, false),
2006-01-02 02:16:19 +00:00
fail.
2015-08-18 21:08:52 +01:00
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'([]) :- !,
2016-01-03 02:06:09 +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 ),
2015-07-23 01:31:03 +01:00
( current_prolog_flag(toplevel_print_options, 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
;
2016-01-03 02:06:09 +00:00
C== 10
->
'$add_nl_outside_console',
(
'$undefined'('$early_print'(_,_),prolog)
->
format(user_error,'yes~n', [])
;
'$early_print'(help,yes)
2003-12-01 17:27:42 +00:00
)
2010-02-11 18:06:27 +00:00
;
2016-01-03 02:06:09 +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
;
2016-01-03 02:06:09 +00: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'(_,_,_) :-
2016-01-03 02:06:09 +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),
2016-02-18 22:10:40 +00: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) :- !,
2016-01-03 02:06:09 +00: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,' = ', []),
2015-12-15 09:28:43 +00:00
( yap_flag(toplevel_print_options, 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',[]) ),
2015-12-15 09:28:43 +00:00
( yap_flag(toplevel_print_options, 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',[]) ),
2015-12-15 09:28:43 +00:00
( yap_flag(toplevel_print_options, Opts) ->
2009-09-10 00:00:35 +01:00
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',[]) ),
2015-12-15 09:28:43 +00:00
( yap_flag(toplevel_print_options, Opts) ->
2009-04-25 18:54:21 +01:00
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).
2015-12-15 09:28:43 +00:00
'$name_vars_in_goals1'([V|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]),
2015-12-15 09:28:43 +00:00
V = '$VAR'(Name),
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]) :-
2015-08-07 22:57:53 +01:00
format(user_error,' = ~a',[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) :-
2015-07-23 01:31:03 +01:00
(
'$$save_by'(CP),
2013-12-13 08:42:57 +00:00
'$enable_debugging',
'$call'(G, CP, M:G, M),
'$$save_by'(CP2),
2015-07-23 01:31:03 +01:00
(
CP == CP2
->
!
;
( true ; '$enable_debugging', fail )
),
2013-12-13 08:42:57 +00:00
'$disable_debugging'
2015-07-23 01:31:03 +01:00
;
'$disable_debugging',
fail
).
2013-12-13 08:42:57 +00:00
2015-07-23 01:31:03 +01:00
% enable creeping
'$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' :-
2015-07-23 01:31:03 +01:00
'$trace_on', !,
2013-12-13 08:42:57 +00:00
'$creep'.
'$enable_debugging'.
2015-07-23 01:31:03 +01:00
'$trace_on' :-
'$nb_getval'('$trace', on, fail).
'$trace_off' :-
'$nb_getval'('$trace', off, fail).
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),
(
2015-11-05 17:19:25 +00:00
'$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
).
2015-12-15 09:28:43 +00:00
'$call'(\+ X, _CP, G0, M) :- !,
2014-10-19 13:09:35 +01:00
\+ ('$current_choice_point'(CP),
'$call'(X,CP,G0,M) ).
2015-12-15 09:28:43 +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).
2015-12-15 09:28:43 +00:00
'$call'(G, _CP, _G0, CurMod) :-
(
'$is_metapredicate'(G,CurMod)
->
2016-01-03 02:06:09 +00:00
'$disable_debugging',
( '$expand_meta_call'(CurMod:G, [], NG) -> true ; true ),
'$enable_debugging'
2015-12-15 09:28:43 +00:00
;
NG = G
),
'$execute0'(NG, 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
2016-01-03 02:06:09 +00:00
% '$undefp'([M0|G0], Default) :-
% writeln(M0:G0),
% fail.
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),
2015-12-15 09:28:43 +00:00
prompt1(': '), prompt(_,' '),
2013-01-15 11:18:09 +00:00
'$current_module'(OldModule),
repeat,
'$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error,
2015-12-15 09:28:43 +00:00
user:'$LoopError'(Error, top)),
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),
2015-12-15 09:28:43 +00:00
prompt1(': '), prompt(_,' '),
2013-01-15 11:18:09 +00:00
'$current_module'(OldModule),
repeat,
'$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error,
2015-12-15 09:28:43 +00:00
user:'$LoopError'(Error, top)),
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) :-
2016-01-31 10:45:00 +00:00
% start_low_level_trace,
2016-02-28 19:32:55 +00:00
'$current_module'( OldModule ),
2001-04-09 20:54:03 +01:00
repeat,
2016-01-31 10:45:00 +00:00
'$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error,
user:'$LoopError'(Error, Status)
),
2002-01-22 17:11:36 +00:00
!.
2001-04-09 20:54:03 +01:00
2016-01-31 10:45:00 +00:00
'$enter_command'(Stream, Mod, Status) :-
prompt1(': '), prompt(_,' '),
Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],
(
Status == top
->
read_term(Stream, Command, Options)
;
read_clause(Stream, Command, Options)
),
2015-12-15 09:01:44 +00:00
'$command'(Command,Vars,Pos, Status).
2016-01-31 10:45:00 +00:00
/** @pred user:expand_term( _T_,- _X_) is dynamic,multifile.
2015-12-15 09:01:44 +00:00
2016-01-31 10:45:00 +00:00
This user-defined predicate is called by YAP after
reading goals and clauses.
2011-06-14 09:01:10 +01:00
2016-01-31 10:45:00 +00:00
- _Module_:`expand_term(` _T_ , _X_) is called first on the
current source module _Module_ ; if i
- `user:expand_term(` _T_ , _X_ `)` is available on every module.
2001-04-09 20:54:03 +01:00
2016-01-31 10:45:00 +00: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.
%
2016-01-03 02:06:09 +00:00
'$check_head_and_body'(C,M,H,B,P) :-
'$yap_strip_module'(C,M1,(MH:-B0)),
2015-12-15 09:01:44 +00:00
!,
2016-01-03 02:06:09 +00:00
'$yap_strip_module'(M1:MH,M,H),
( M == M1 -> B = B0 ; B = M1:B0),
2016-03-05 12:36:54 +00:00
is_callable(M:H,P).
2016-01-03 02:06:09 +00:00
'$check_head_and_body'(MH, M, H, true, P) :-
'$yap_strip_module'(MH,M,H),
2015-12-15 09:01:44 +00:00
error:is_callable(M:H,P).
% term expansion
2001-04-09 20:54:03 +01:00
%
% return two arguments: Expanded0 is the term after "USER" expansion.
% Expanded is the final expanded term.
%
2016-02-21 11:31:27 +00:00
'$precompile_term'(Term, ExpandedUser, Expanded) :-
2014-11-02 12:10:32 +00:00
%format('[ ~w~n',[Term]),
2016-02-22 12:55:05 +00:00
'$expand_clause'(Term, ExpandedUser, ExpandedI),
2016-02-21 11:31:27 +00:00
!,
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 */
2015-12-15 09:01:44 +00:00
->
2008-07-23 00:34:50 +01:00
Expanded = ExpandedI,
2016-02-21 19:09:10 +00:00
'$check_iso_strict_clause'(ExpandedUser)
2015-12-15 09:01:44 +00:00
;
2008-07-23 00:34:50 +01:00
'$expand_array_accesses_in_term'(ExpandedI,Expanded)
2015-12-15 09:01:44 +00:00
-> true
;
Expanded = ExpandedI
2001-04-09 20:54:03 +01:00
).
2015-12-15 09:01:44 +00:00
'$precompile_term'(Term, Term, Term).
2001-04-09 20:54:03 +01:00
2015-12-15 09:01:44 +00:00
'$expand_clause'(InputCl, C1, CO) :-
source_module(SM),
'$yap_strip_module'(SM:InputCl, M, ICl),
'$expand_a_clause'( M:ICl, SM, C1, CO),
!.
'$expand_clause'(Cl, Cl, Cl).
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
2015-07-06 12:04:42 +01:00
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
2014-09-11 20:06:57 +01:00
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) :-
2016-01-03 02:06:09 +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) :-
2015-09-29 23:49:03 +01:00
prolog:'$translate_rule'((A-->B),C), !.
2001-04-09 20:54:03 +01:00
'$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
2015-12-15 09:28:43 +00: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, !,
2015-12-15 09:28:43 +00:00
( call(user:H) -> 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
2015-08-18 21:08:52 +01:00
'$early_print'( Lev, Msg ) :-
( '$undefined'(print_message(_,_),prolog) ->
'$show'(Lev, Msg)
;
print_message(Lev, Msg)
).
'$show'(_,Msg) :-
format(user_error, '~w~n', [Msg]).
2015-11-05 17:19:25 +00:00
'$prompt' :-
current_prolog_flag(break_level, BreakLevel),
2015-12-15 09:28:43 +00:00
(
BreakLevel == 0
2015-11-05 17:19:25 +00:00
->
LF = LD
2015-12-15 09:28:43 +00:00
;
LF = ['Break (level ', BreakLevel, ')'|LD]
2015-11-05 17:19:25 +00:00
),
2015-12-15 09:28:43 +00:00
current_prolog_flag(debug, DBON),
2015-11-05 17:19:25 +00:00
(
'$trace_on'
->
2015-12-15 09:28:43 +00:00
(
var(LF)
->
LD = ['trace'|LP]
;
LD = [', trace '|LP]
)
2015-11-05 17:19:25 +00:00
;
DBON == true
->
2015-12-15 09:28:43 +00:00
(var(LF)
->
LD = ['debug'|LP]
;
LD = [', debug'|LP]
)
2015-11-05 17:19:25 +00:00
;
LD = LP
),
2015-12-15 09:28:43 +00:00
(
var(LF)
->
LP = [P]
;
LP = [' ',P]
),
2015-11-05 17:19:25 +00:00
yap_flag(toplevel_prompt, P),
atomic_concat(LF, PF),
prompt1(PF),
2016-02-21 19:09:10 +00:00
prompt(_,' '),
'$ensure_prompting'.
2015-08-18 21:08:52 +01: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
*/