diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

allow conditional compilation

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1965 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2007-10-21 08:48:06 +00:00
parent 268ad4ab73
commit ff4aa369be
6 changed files with 330 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/heapgc.c
View File

@ -3492,10 +3492,6 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
total_marked += total_oldies; total_marked += total_oldies;
} }
} else { } else {
if (GcCalls==355) {
fprintf(stderr,"Start=%p,%pn %ld, %ld\n",H0,HGEN, total_oldies, total_marked);
}
if (HGEN != H0) { if (HGEN != H0) {
CurrentH0 = H0; CurrentH0 = H0;
H0 = HGEN; H0 = HGEN;

1
changes-5.1.html
View File

@ -17,6 +17,7 @@
<h2>Yap-5.1.3:</h2> <h2>Yap-5.1.3:</h2>
<ul> <ul>
<li> NEW: support conditional compilation using if/1,elif/1,else/0,endif/0 directives.</li>
<li> FIXED: delay abort until garbage collection or stack shifting is over.</li> <li> FIXED: delay abort until garbage collection or stack shifting is over.</li>
<li> FIXED: grow_trail assumed SREG points to stack top!</li> <li> FIXED: grow_trail assumed SREG points to stack top!</li>
<li> FIXED: latest SWI chr.</li> <li> FIXED: latest SWI chr.</li>

84
docs/yap.tex
View File

@ -160,6 +160,7 @@ Subnodes of Encoding
Subnodes of Loading Programs Subnodes of Loading Programs
* Compiling:: Program Loading and Updating * Compiling:: Program Loading and Updating
* Setting the Compiler:: Changing the compiler's parameters * Setting the Compiler:: Changing the compiler's parameters
* Conditional Compilation:: Compiling program fragments
* Saving:: Saving and Restoring Programs * Saving:: Saving and Restoring Programs
Subnodes of Modules Subnodes of Modules
@ -1535,6 +1536,7 @@ writing, writing a BOM can be requested using the option
Loading Programs Loading Programs
* Compiling:: Program Loading and Updating * Compiling:: Program Loading and Updating
* Setting the Compiler:: Changing the compiler's parameters * Setting the Compiler:: Changing the compiler's parameters
* Conditional Compilation:: Compiling program fragments
* Saving:: Saving and Restoring Programs * Saving:: Saving and Restoring Programs
@end menu @end menu
@ -1616,7 +1618,7 @@ files specified by @var{F} into the file being currently consulted.
@end table @end table
@node Setting the Compiler, Saving, Compiling, Loading Programs @node Setting the Compiler, Conditional Compilation, Compiling, Loading Programs
@section Changing the Compiler's Behavior @section Changing the Compiler's Behavior
This section presents a set of built-ins predicates designed to set the This section presents a set of built-ins predicates designed to set the
@ -1869,7 +1871,85 @@ Since YAP4.3.0 multifile procedures can be static or dynamic.
@end table @end table
@node Saving, , Setting the Compiler, Loading Programs @node Conditional Compilation, Saving, Setting the Compiler, Loading Programs
@section Conditional Compilation
@c \index{if, directive}%
Conditional compilation builds on the same principle as
@code{term_expansion/2}, @code{goal_expansion/2} and the expansion of
grammar rules to compile sections of the source-code
conditionally. One of the reasons for introducing conditional
compilation is to simplify writing portable code.
@c See \secref{dialect}
@c for more information. Here is a simple example:
@c @table code
@c :- if(\+source_exports(library(lists), suffix/2)).
@c suffix(Suffix, List) :-
@c append(_, Suffix, List).
@c :- endif.
@c \end{code}
Note that these directives can only be appear as separate terms in the
input. Typical usage scenarios include:
@itemize @bullet
@item Load different libraries on different dialects
@item Define a predicate if it is missing as a system predicate
@item Realise totally different implementations for a particular
part of the code due to different capabilities.
@item Realise different configuration options for your software.
@end itemize
@table @code
@item if(+@var{Goal})
@findex if/1 directive
@snindex if/1
@cnindex if/1
Compile subsequent code only if @var{Goal} succeeds. For enhanced
portability, @var{Goal} is processed by @code{expand_goal/2} before execution.
If an error occurs, the error is printed and processing proceeds as if
@var{Goal} has failed.
@item else
@findex else/0 directive
@snindex else/0
@cnindex else/0
Start `else' branch.
@item endif
@findex endif/0 directive
@snindex endif/0
@cnindex endif/0
End of conditional compilation.
@item elif(+@var{Goal})
@findex elif/1 directive
@snindex elif/1
@cnindex elif/1
Equivalent to @code{:- else. :-if(Goal) ... :- endif.} In a sequence
as below, the section below the first matching elif is processed, If
no test succeeds the else branch is processed.
@example
:- if(test1).
section_1.
:- elif(test2).
section_2.
:- elif(test3).
section_3.
:- else.
section_else.
:- endif.
@end example
@end table
@node Saving, , Conditional Compilation, Loading Programs
@section Saving and Loading Prolog States @section Saving and Loading Prolog States
@table @code @table @code

256
pl/boot.yap
View File

@ -56,6 +56,8 @@ true :- true.
('$exit_undefp' -> true ; true), ('$exit_undefp' -> true ; true),
prompt(' ?- '), prompt(' ?- '),
nb_setval('$break',0), nb_setval('$break',0),
nb_setval('$if_level',0),
nb_setval('$endif',off),
% '$set_read_error_handler'(error), let the user do that % '$set_read_error_handler'(error), let the user do that
nb_setval('$debug',off), nb_setval('$debug',off),
nb_setval('$trace',off), nb_setval('$trace',off),
@ -80,121 +82,121 @@ true :- true.
'$startup_reconsult', '$startup_reconsult',
'$startup_goals'. '$startup_goals'.
% Start file for yap % Start file for yap
/* I/O predicates */ /* I/O predicates */
/* meaning of flags for '$write' is /* meaning of flags for '$write' is
1 quote illegal atoms 1 quote illegal atoms
2 ignore operator declarations 2 ignore operator declarations
4 output '$VAR'(N) terms as A, B, C, ... 4 output '$VAR'(N) terms as A, B, C, ...
8 use portray(_) 8 use portray(_)
*/ */
/* main execution loop */ /* main execution loop */
'$read_vars'(Stream,T,Mod,Pos,V) :- '$read_vars'(Stream,T,Mod,Pos,V) :-
'$read'(true,T,Mod,V,Pos,Err,Stream), '$read'(true,T,Mod,V,Pos,Err,Stream),
(nonvar(Err) -> (nonvar(Err) ->
'$print_message'(error,Err), fail '$print_message'(error,Err), fail
; ;
true true
). ).
% reset alarms when entering top-level. % reset alarms when entering top-level.
'$enter_top_level' :- '$enter_top_level' :-
'$alarm'(0, 0, _, _), '$alarm'(0, 0, _, _),
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
'$clean_up_dead_clauses', '$clean_up_dead_clauses',
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
recorded('$restore_goal',G,R), recorded('$restore_goal',G,R),
erase(R), erase(R),
prompt(_,' | '), prompt(_,' | '),
'$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)), '$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)),
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
nb_getval('$break',BreakLevel), nb_getval('$break',BreakLevel),
( (
nb_getval('$trace',on) nb_getval('$trace',on)
-> ->
TraceDebug = trace TraceDebug = trace
; ;
nb_getval('$debug', on) nb_getval('$debug', on)
-> ->
TraceDebug = debug TraceDebug = debug
; ;
true true
), ),
'$print_message'(informational,prompt(BreakLevel,TraceDebug)), '$print_message'(informational,prompt(BreakLevel,TraceDebug)),
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
get_value('$top_level_goal',GA), GA \= [], !, get_value('$top_level_goal',GA), GA \= [], !,
set_value('$top_level_goal',[]), set_value('$top_level_goal',[]),
'$run_atom_goal'(GA), '$run_atom_goal'(GA),
set_value('$live','$false'). set_value('$live','$false').
'$enter_top_level' :- '$enter_top_level' :-
prompt(_,' ?- '), prompt(_,' ?- '),
prompt(' | '), prompt(' | '),
'$run_toplevel_hooks', '$run_toplevel_hooks',
'$read_vars'(user_input,Command,_,_,Varnames), '$read_vars'(user_input,Command,_,_,Varnames),
nb_setval('$spy_gn',1), nb_setval('$spy_gn',1),
% stop at spy-points if debugging is on. % stop at spy-points if debugging is on.
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
nb_setval('$debug_zip',off), nb_setval('$debug_zip',off),
prompt(_,' |: '), prompt(_,' |: '),
'$command'((?-Command),Varnames,top), '$command'((?-Command),Varnames,top),
'$sync_mmapped_arrays', '$sync_mmapped_arrays',
set_value('$live','$false'). set_value('$live','$false').
'$startup_goals' :- '$startup_goals' :-
get_value('$extend_file_search_path',P), P \= [], get_value('$extend_file_search_path',P), P \= [],
set_value('$extend_file_search_path',[]), set_value('$extend_file_search_path',[]),
'$extend_file_search_path'(P), '$extend_file_search_path'(P),
fail. fail.
'$startup_goals' :- '$startup_goals' :-
recorded('$startup_goal',G,_), recorded('$startup_goal',G,_),
'$current_module'(Module), '$current_module'(Module),
'$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)), '$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)),
fail. fail.
'$startup_goals' :- '$startup_goals' :-
get_value('$init_goal',GA), get_value('$init_goal',GA),
GA \= [], GA \= [],
set_value('$init_goal',[]), set_value('$init_goal',[]),
'$run_atom_goal'(GA), '$run_atom_goal'(GA),
fail. fail.
'$startup_goals' :- '$startup_goals' :-
get_value('$myddas_goal',GA), GA \= [], get_value('$myddas_goal',GA), GA \= [],
set_value('$myddas_goal',[]), set_value('$myddas_goal',[]),
get_value('$myddas_user',User), User \= [], get_value('$myddas_user',User), User \= [],
set_value('$myddas_user',[]), set_value('$myddas_user',[]),
get_value('$myddas_db',Db), Db \= [], get_value('$myddas_db',Db), Db \= [],
set_value('$myddas_db',[]), set_value('$myddas_db',[]),
get_value('$myddas_host',HostT), get_value('$myddas_host',HostT),
( HostT \= [] -> ( HostT \= [] ->
Host = HostT, Host = HostT,
set_value('$myddas_host',[]) set_value('$myddas_host',[])
; ;
Host = localhost Host = localhost
), ),
get_value('$myddas_pass',PassT), get_value('$myddas_pass',PassT),
( PassT \= [] -> ( PassT \= [] ->
Pass = PassT, Pass = PassT,
set_value('$myddas_pass',[]) set_value('$myddas_pass',[])
; ;
Pass = '' Pass = ''
), ),
use_module(library(myddas)), use_module(library(myddas)),
call(db_open(mysql,myddas,Host/Db,User,Pass)), call(db_open(mysql,myddas,Host/Db,User,Pass)),
'$myddas_import_all', '$myddas_import_all',
fail. fail.
'$startup_goals'. '$startup_goals'.
'$startup_reconsult' :- '$startup_reconsult' :-
get_value('$consult_on_boot',X), X \= [], !, get_value('$consult_on_boot',X), X \= [], !,
set_value('$consult_on_boot',[]), set_value('$consult_on_boot',[]),
'$do_startup_reconsult'(X). '$do_startup_reconsult'(X).
'$startup_reconsult'. '$startup_reconsult'.
% %
% MYDDAS: Import all the tables from one database % MYDDAS: Import all the tables from one database
@ -241,26 +243,29 @@ true :- true.
'$repeat'. '$repeat'.
'$repeat' :- '$repeat'. '$repeat' :- '$repeat'.
'$start_corouts' :- recorded('$corout','$corout'(Name,_,_),R), Name \= main, finish_corout(R), '$start_corouts' :-
fail. recorded('$corout','$corout'(Name,_,_),R),
'$start_corouts' :- Name \= main,
eraseall('$corout'), finish_corout(R),
eraseall('$result'), fail.
eraseall('$actual'), '$start_corouts' :-
fail. eraseall('$corout'),
'$start_corouts' :- recorda('$actual',main,_), eraseall('$result'),
recordz('$corout','$corout'(main,main,'$corout'([],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[])),_Ref), eraseall('$actual'),
recorda('$result',going,_). fail.
'$start_corouts' :- recorda('$actual',main,_),
recordz('$corout','$corout'(main,main,'$corout'([],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[])),_Ref),
recorda('$result',going,_).
'$command'(C,VL,Con) :- '$command'(C,VL,Con) :-
'$access_yap_flags'(9,1), !, '$access_yap_flags'(9,1), !,
'$execute_command'(C,VL,Con,C). '$execute_command'(C,VL,Con,C).
'$command'(C,VL,Con) :- '$command'(C,VL,Con) :-
( (Con = top ; var(C) ; C = [_|_]) -> ( (Con = top ; var(C) ; C = [_|_]) ->
'$execute_command'(C,VL,Con,C), ! ; '$execute_command'(C,VL,Con,C), ! ;
expand_term(C, EC), expand_term(C, EC),
'$execute_commands'(EC,VL,Con,C) '$execute_commands'(EC,VL,Con,C)
). ).
% %
% Hack in case expand_term has created a list of commands. % Hack in case expand_term has created a list of commands.
@ -289,6 +294,11 @@ true :- true.
'$execute_command'(R,_,top,Source) :- db_reference(R), !, '$execute_command'(R,_,top,Source) :- db_reference(R), !,
'$do_error'(type_error(callable,R),meta_call(Source)). '$do_error'(type_error(callable,R),meta_call(Source)).
'$execute_command'(end_of_file,_,_,_) :- !. '$execute_command'(end_of_file,_,_,_) :- !.
'$execute_command'(Command,_,_,_) :-
nb_getval('$if_skip_mode',skip),
\+ '$if_directive'(Command),
!,
fail.
'$execute_command'((:-G),_,Option,_) :- !, '$execute_command'((:-G),_,Option,_) :- !,
'$current_module'(M), '$current_module'(M),
% allow user expansion % allow user expansion

102
pl/consult.yap
View File

@ -200,6 +200,8 @@ use_module(M,F,Is) :-
'$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M). '$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M).
'$do_lf'(ContextModule, Stream, InfLevel, _, Imports, SkipUnixComments, Reconsult, UseModule) :- '$do_lf'(ContextModule, Stream, InfLevel, _, Imports, SkipUnixComments, Reconsult, UseModule) :-
nb_getval('$if_level',OldIncludeLevel),
nb_setval('$if_level',0),
nb_getval('$system_mode', OldMode), nb_getval('$system_mode', OldMode),
( OldMode == off -> '$enter_system_mode' ; true ), ( OldMode == off -> '$enter_system_mode' ; true ),
'$record_loaded'(Stream, ContextModule), '$record_loaded'(Stream, ContextModule),
@ -246,6 +248,11 @@ use_module(M,F,Is) :-
set_value('$consulting',Old), set_value('$consulting',Old),
set_value('$consulting_file',OldF), set_value('$consulting_file',OldF),
cd(OldD), cd(OldD),
nb_setval('$if_level',OldIncludeLevel),
% surely, we were in run mode or we would not have included the file!
nb_setval('$if_skip_mode',run),
% back to include mode!
nb_setval('$if_level',OldIncludeLevel),
'$current_module'(Mod,OldModule), '$current_module'(Mod,OldModule),
'$bind_module'(Mod, UseModule), '$bind_module'(Mod, UseModule),
'$import_to_current_module'(File, ContextModule, Imports), '$import_to_current_module'(File, ContextModule, Imports),
@ -758,3 +765,98 @@ absolute_file_name(File,Opts,TrueFileName) :-
NewName =.. [N,NFile], NewName =.. [N,NFile],
'$find_in_path'(NewName, Opts, OFile, Goal). '$find_in_path'(NewName, Opts, OFile, Goal).
%
% This is complicated because of embedded ifs.
%
'$if'(_,top) :- !, fail.
'$if'(Goal,_) :-
nb_getval('$if_level',Level0),
Level is Level0 + 1,
nb_setval('$if_level',Level),
nb_getval('$endif',OldEndif),
nb_getval('$if_skip_mode',Mode),
nb_setval('$endif',elif(Level,OldEndif,Mode)),
fail.
% we are in skip mode, ignore....
'$if'(Goal,_) :-
nb_getval('$endif',elif(Level, OldEndif, skip)), !,
nb_setval('$endif',endif(Level, OldEndif, skip)).
% we are in non skip mode, check....
'$if'(Goal,_) :-
('$if_call'(Goal)
->
% we will execute this branch, and later enter skip
nb_getval('$endif',elif(Level,OldEndif,Mode)),
nb_setval('$endif',endif(Level,OldEndif,Mode))
;
% we are now in skip, but can start an elif.
nb_setval('$if_skip_mode',skip)
).
'$else'(top) :- !, fail.
'$else'(_) :-
nb_getval('$if_level',0), !,
'$do_error'(context_error(no_if),(:- else)).
% we have done an if, so just skip
'$else'(_) :-
nb_getval('$endif',endif(_,_,_)), !,
nb_setval('$if_skip_mode',skip).
% we can try the elif
'$else'(_) :-
nb_getval('$if_level',Level),
nb_getval('$endif',elif(Level,OldEndif,Mode)),
nb_setval('$endif',endif(Level,OldEndif,Mode)),
nb_setval('$if_skip_mode',run).
'$elif'(_,top) :- !, fail.
'$elif'(Goal,_) :-
nb_getval('$if_level',0),
'$do_error'(context_error(no_if),(:- elif(Goal))).
% we have done an if, so just skip
'$elif'(_,_) :-
nb_getval('$endif',endif(_,_,_)), !,
nb_setval('$if_skip_mode',skip).
% we can try the elif
'$elif'(Goal,_) :-
nb_getval('$if_level',Level),
nb_getval('$endif',elif(Level,OldEndif,Mode)),
('$if_call'(Goal)
->
% we will not skip, and we will not run any more branches.
nb_setval('$endif',endif(Level,OldEndif,Mode)),
nb_setval('$if_skip_mode',run)
;
% we will (keep) on skipping
nb_setval('$if_skip_mode',skip)
).
'$elif'(_,_).
'$endif'(top) :- !, fail.
'$endif'(_) :-
% unmmatched endif.
nb_getval('$if_level',0),
'$do_error'(context_error(no_if),(:- endif)).
'$endif'(_) :-
% back to where you belong.
nb_getval('$if_level',Level),
nb_getval('$endif',Endif),
Level0 is Level-1,
nb_setval('$if_level',Level0),
arg(2,Endif,OldEndif),
arg(3,Endif,OldMode),
nb_setval('$endif',OldEndif),
nb_setval('$if_skip_mode',OldMode).
'$if_call'(G) :-
catch('$eval_if'(G), E, (print_message(error, E), fail)).
'$eval_if'(Goal) :-
expand_term(Goal,TrueGoal),
once(TrueGoal).
'$if_directive'((:- if(_))).
'$if_directive'((:- else)).
'$if_directive'((:- elif(_))).
'$if_directive'((:- endif)).

12
pl/directives.yap
View File

@ -50,6 +50,10 @@
'$directive'(thread_local(_)). '$directive'(thread_local(_)).
'$directive'(uncutable(_)). '$directive'(uncutable(_)).
'$directive'(encoding(_)). '$directive'(encoding(_)).
'$directive'(if(_)).
'$directive'(else).
'$directive'(elif(_)).
'$directive'(endif).
'$exec_directives'((G1,G2), Mode, M) :- !, '$exec_directives'((G1,G2), Mode, M) :- !,
'$exec_directives'(G1, Mode, M), '$exec_directives'(G1, Mode, M),
@ -117,6 +121,14 @@
'$table'(PredSpec, M). '$table'(PredSpec, M).
'$exec_directive'(uncutable(PredSpec), _, M) :- '$exec_directive'(uncutable(PredSpec), _, M) :-
'$uncutable'(PredSpec, M). '$uncutable'(PredSpec, M).
'$exec_directive'(if(Goal), Context, M) :-
'$if'(M:Goal, Context).
'$exec_directive'(else, Context, _) :-
'$else'(Context).
'$exec_directive'(elif(Goal), Context, M) :-
'$elif'(M:Goal, Context).
'$exec_directive'(endif, Context, _) :-
'$endif'(Context).
yap_flag(V,Out) :- yap_flag(V,Out) :-