/*-------------------------------------------------------------------------*/
/* Prolog to Wam Compiler INRIA Rocquencourt - ChLoE Project */
/* Buit-In Predicates Daniel Diaz - 1994 */
/* */
/* call/1 and other control predicates */
/* */
/* call.pl */
/*-------------------------------------------------------------------------*/
/* Control */
:- public otherwise/0, true/0, false/0, fail/0, repeat/0, for/3,
halt/0, halt/1, halt_or_else/1, halt_or_else/2, abort/0.
otherwise.
true.
false:- fail.
fail:- fail.
repeat.
repeat:-
repeat.
for(A,A,B):-
A=<B.
for(I,A,B):-
A<B,
A1 is A+1,
for(I,A1,B).
halt:- halt(0).
halt(_S):-
pragma_c('Halt_1').
halt_or_else(P):-
halt_or_else(0,P).
halt_or_else(S,P):-
(g_read('$top_level',0) -> halt(S)
; call(P)).
abort:-
nodebug,
halt_or_else(1,throw(abort)).
:- public dbg_exec/0.
dbg_exec:-
write('| :-'),
read(X),
(X==end_of_file
;
call(X)
;
formata('{Warning: ~w - goal failed}~n',[X])),
!.
:- public (^)/2, call/1, call/2.
_^Goal:-
Goal.
call(P):-
calling_module_nb(Module),
'$get_bc_reg'(VarCut),
call1(P,VarCut,Module).
call(P,Module):-
'$get_bc_reg'(VarCut),
call1(P,VarCut,Module).
call1(X,_,_):-
var(X),
!,
write('Error: variable given as goal'), nl,
fail.
call1(true,_,_):-
!.
call1((P,Q),VarCut,Module):-
!,
call1(P,VarCut,Module),
call1(Q,VarCut,Module).
call1((P;Q),VarCut,Module):-
!,
pragma_c('Debug_Call("call_or_$aux",4,1);'),
call_or(P,Q,VarCut,Module).
call1(!,VarCut,_):-
% !, this cut is useless because Meta_Cut
'$cut'(VarCut).
call1((P->Q),VarCut,Module):-
!,
call(P,Module),
!,
call1(Q,VarCut,Module).
call1(\+P,_,Module):-
!,
(call(P,Module), !, fail; true).
call1(_P,_VarCut,_Module):-
pragma_c('Call1_3').
/*--- this code is already in call.usr to add an extra Y variable ---
call_dynamic(P,_,Module):-
'$get_bc_reg'(VarCut),
pragma_c('Debug_Call(NULL,0,1);'),
clause1([P|B]),
pragma_c('Debug_Dynamic_Body();'),
call1(B,VarCut,Module),
pragma_c('Debug_Proceed(TRUE);').
--------------------------------------------------------------------*/
call_or((P->Q),R,VarCut,Module):-
!,
(call(P,Module),
!,
call1(Q,VarCut,Module)
;
pragma_c('Debug_Has_Failed_Redo();'),
call1(R,VarCut,Module)).
call_or(P,_,VarCut,Module):-
call1(P,VarCut,Module).
call_or(_,Q,VarCut,Module):-
pragma_c('Debug_Has_Failed_Redo();'),
call1(Q,VarCut,Module).
/* catch and throw */
:- public catch/3, catch/4, throw/1, catch_signal/1, signal_handler/1.
catch(Goal,Catch,Recovery):-
calling_module_nb(Module),
catch(Goal,Catch,Recovery,Module).
catch(Goal,Catch,Recovery,Module):-
g_assign('$ball_','$no_ball_'),
g_read('$handler_',Handler),
catch1(Goal,Catch,Recovery,Module,Handler).
catch1(Goal,_,_,Module,Handler):-
get_current_B(B),
g_assign('$handler_',B),
call(Goal,Module),
get_current_B(B1),
(B1>B -> trail_handler(B)
; !),
g_assign('$handler_',Handler).
catch1(_,Catch,Recovery,Module,Handler):-
g_assign('$handler_',Handler),
g_read('$ball_',Ball),
Ball\=='$no_ball_',
(Catch=Ball -> g_assign('$ball_','$no_ball_'),
call(Recovery,Module)
;
unwind(Ball)).
trail_handler(_).
trail_handler(Handler):-
g_assign('$handler_',Handler),
fail.
throw(Ball):-
g_assign('$ball_',Ball),
unwind(Ball).
unwind(Ball):-
g_read('$handler_',Handler),
(Handler=:=0
-> formata('~nsystem error - cannot catch ~w~n',[throw(Ball)]),
halt_or_else(2,abort)
; set_current_B(Handler),
fail).
catch_signal(_Sig):-
pragma_c('Catch_Signal_1').
signal_handler(Sig):-
throw(signal(Sig)).
/* top level */
:- public top_level/2,
top_level2/1, '$after_throw'/3. % should be prefixed with module name
% at call time
top_level(Banner,Catch):- /* top_level/1 catches everything */
calling_module_nb(Module),
(Banner==true -> version
; true),
g_read('$top_level',Top),
Top1 is Top+1,
g_assign('$top_level',Top1),
top_level1(Module,Catch),
g_assign('$top_level',Top).
top_level1(Module,Catch):-
catch(top_level2(Module),X,'$after_throw'(X,Module,Catch),Module).
'$after_throw'(X,Module,Catch):-
(Catch==true -> nodebug,
seen,
formata('~n{~w}~n',[X]),
top_level1(Module,Catch)
;
g_read('$top_level',Top),
Top1 is Top-1,
g_assign('$top_level',Top1),
throw(X)).
top_level2(Module):-
repeat,
write_debug_indicator,
write('| ?- '),
read_term(X,[variable_names(VarNames)]),
(X==end_of_file -> nodebug,
nl,
!
;
cputime(Time0),
(exec(X,VarNames,Module) -> Ok=yes
; Ok=no),
cputime(Time1),
Time is Time1-Time0,
formata('~n(~d ms) ~a~n',[Time,Ok]),
debug_mode(DbgMode), % read debug mode
debug_mode(DbgMode), % reinit debugger
fail).
write_debug_indicator:-
debug_mode(DebugMode),
write_debug_indicator(DebugMode).
write_debug_indicator(debug):-
write('{debug}'), nl.
write_debug_indicator(trace):-
write('{trace}'), nl.
write_debug_indicator(nodebug).
exec(X,VarNames,Module):-
get_current_B(B),
call(X,Module),
get_current_B(B1),
write_solution(VarNames),
(B1>B -> write(' ? '),
read_command(C),
C==10
;
true).
read_command(C):-
get0(C1),
skip_until_return(C1),
(C1==10 -> C=C1
;
(C1\==0'; -> write('Action (";" for more choices, '),
write('otherwise <return>): '),
read_command(C)
; C=C1)).
skip_until_return(C):-
(C==10 -> true
;
get0(C1),
skip_until_return(C1)).
write_solution([]).
write_solution([X=V|L]):-
formata('~n~a = ',[X]),
write_term(V,[quoted(true),numbervars(false)]),
write_solution(L).
:- public get_current_B/1, set_current_B/1.
get_current_B(_B):-
pragma_c('Get_Current_B_1').
set_current_B(_B):-
pragma_c('Set_Current_B_1').
:- catch_signal(2), % SIGINT
catch_signal(3). % SIGQUIT
syntax highlighted by Code2HTML, v. 0.9.1