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

ugh

This commit is contained in:
Vítor Santos Costa 2016-02-29 03:28:50 +00:00
parent b9eb327d86
commit e81acc117b
6 changed files with 575 additions and 607 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CXX/yapi.cpp
View File

@ -461,8 +461,8 @@ YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]): YAPPredicate(p.ap)
YAPListTerm YAPQuery::namedVars() {
CACHE_REGS
Term o = vnames.term();
Yap_DebugPlWrite(names); printf("<<<<<<<<<<<<<<<<-------------------------\n");
return YAPListTerm( names ); // should be o
Yap_DebugPlWrite(o); printf("<<<<<<<<<<<<<<<<-------------------------\n");
return o; // should be o
}
bool YAPQuery::next()

140
pl/bootlists.yap Normal file
View File

@ -0,0 +1,140 @@
/**
* @file pl/lists.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 09:54:00 2015
*
* @addtogroup lists
* @{
*/
:- system_module( '$_lists', [], []).
:- set_prolog_flag(source, true). % source.
% memberchk(+Element, +Set)
% means the same thing, but may only be used to test whether a known
% Element occurs in a known Set. In return for this limited use, it
% is more efficient when it is applicable.
/** @pred memberchk(+ _Element_, + _Set_)
As member/2, but may only be used to test whether a known
_Element_ occurs in a known Set. In return for this limited use, it
is more efficient when it is applicable.
*/
lists:memberchk(X,[X|_]) :- !.
lists:memberchk(X,[_|L]) :-
lists:memberchk(X,L).
%% member(?Element, ?Set)
% is true when Set is a list, and Element occurs in it. It may be used
% to test for an element or to enumerate all the elements by backtracking.
% Indeed, it may be used to generate the Set!
/** @pred member(? _Element_, ? _Set_)
True when _Set_ is a list, and _Element_ occurs in it. It may be used
to test for an element or to enumerate all the elements by backtracking.
*/
lists:member(X,[X|_]).
lists:member(X,[_|L]) :-
lists:member(X,L).
%% @pred identical_member(?Element, ?Set) is nondet
%
% identical_member holds true when Set is a list, and Element is
% exactly identical to one of the elements that occurs in it.
lists:identical_member(X,[Y|M]) :-
(
X == Y
;
M \= [], lists:identical_member(X,M)
).
/** @pred append(? _List1_,? _List2_,? _List3_)
Succeeds when _List3_ unifies with the concatenation of _List1_
and _List2_. The predicate can be used with any instantiation
pattern (even three variables).
*/
lists:append([], L, L).
lists:append([H|T], L, [H|R]) :-
lists:append(T, L, R).
:- set_prolog_flag(source, true). % :- no_source.
% lists:delete(List, Elem, Residue)
% is true when List is a list, in which Elem may or may not occur, and
% Residue is a copy of List with all elements identical to Elem lists:deleted.
/** @pred delete(+ _List_, ? _Element_, ? _Residue_)
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
True when _List_ is a list, in which _Element_ may or may not
occur, and _Residue_ is a copy of _List_ with all elements
identical to _Element_ deleted.
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
*/
lists:delete([], _, []).
lists:delete([Head|List], Elem, Residue) :-
Head = Elem,
lists:delete(List, Elem, Residue).
lists:delete([Head|List], Elem, [Head|Residue]) :-
lists:delete(List, Elem, Residue).
:- set_prolog_flag(source, false). % disable source.
% length of a list.
/** @pred length(? _L_,? _S_)
Unify the well-defined list _L_ with its length. The procedure can
be used to find the length of a pre-defined list, or to build a list
of length _S_.
*/
prolog:length(L, M) :-
'$skip_list'(L, M, M0, R),
( var(R) -> '$$_length'(R, M, M0) ;
R == []
).
%
% in case A1 is unbound or a difference list, things get tricky
%
'$$_length'(R, M, M0) :-
( var(M) -> '$$_length1'(R,M,M0)
; M >= M0 -> '$$_length2'(R,M,M0) ).
%
% Size is unbound, generate lists
%
'$$_length1'([], M, M).
'$$_length1'([_|L], O, N) :-
M is N + 1,
'$$_length1'(L, O, M).
%
% Size is bound, generate single list
%
'$$_length2'(NL, O, N) :-
( N =:= O -> NL = [];
M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ).
%% @}

177
regression/modules/L
View File

@ -1,177 +0,0 @@
% YAP 6.3.4-60a8efb4RS Yap_RecoverSlots:208
(compiled 2015-12-15T14:05:17@VITORs-MacBook-Pro.localRS Yap_RecoverSlots:208
)
!!! syntax error: expected to find ')', found ]
:-RS Yap_RecoverSlots:208
moduleRS Yap_RecoverSlots:208
( ytestRS Yap_RecoverSlots:208
, [run_testRS Yap_RecoverSlots:208
/RS Yap_RecoverSlots:208
1RS Yap_RecoverSlots:208
,
run_testsRS Yap_RecoverSlots:208
/RS Yap_RecoverSlots:208
0RS Yap_RecoverSlots:208
,
test_modeRS Yap_RecoverSlots:208
/RS Yap_RecoverSlots:208
0RS Yap_RecoverSlots:208
,
opRS Yap_RecoverSlots:208
( 1150RS Yap_RecoverSlots:208
, fxRS Yap_RecoverSlots:208
, testRS Yap_RecoverSlots:208
),
opRS Yap_RecoverSlots:208
( 999RS Yap_RecoverSlots:208
, xfxRS Yap_RecoverSlots:208
, givenRS Yap_RecoverSlots:208
,
opRS Yap_RecoverSlots:208
( 998RS Yap_RecoverSlots:208
, xfxRS Yap_RecoverSlots:208
, returnsRS Yap_RecoverSlots:208
) <== HERE ==> ] )
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
!!! syntax error: expected operator, got 'returns'
run_testRS Yap_RecoverSlots:208
( Lab ):-RS Yap_RecoverSlots:208
source_moduleRS Yap_RecoverSlots:208
( M ),
testRS Yap_RecoverSlots:208
( Lab, ( G <== HERE ==> returnsRS Yap_RecoverSlots:208
SolsgivenRS Yap_RecoverSlots:208
Program ), Done ),
ensure_groundRS Yap_RecoverSlots:208
( Done ),
formatRS Yap_RecoverSlots:208
( '~w : 'RS Yap_RecoverSlots:208
, [Lab] ),
resetRS Yap_RecoverSlots:208
( Streams ),
assertallRS Yap_RecoverSlots:208
( Program, Refs ),
conj2listRS Yap_RecoverSlots:208
( Sols, LSols ),
catchRS Yap_RecoverSlots:208
( do_returnsRS Yap_RecoverSlots:208
( M:RS Yap_RecoverSlots:208
G, LSols, Lab ), Ball, endRS Yap_RecoverSlots:208
( Ball ) ),
shutdownRS Yap_RecoverSlots:208
( Streams, Refs )
!!! syntax error: expected operator, got 'returns'
run_testRS Yap_RecoverSlots:208
( Lab ):-RS Yap_RecoverSlots:208
source_moduleRS Yap_RecoverSlots:208
( M ),
testRS Yap_RecoverSlots:208
( Lab, ( G <== HERE ==> returnsRS Yap_RecoverSlots:208
Sols ), Done ),
ensure_groundRS Yap_RecoverSlots:208
( Done ),
formatRS Yap_RecoverSlots:208
( '~w : 'RS Yap_RecoverSlots:208
, [Lab] ),
resetRS Yap_RecoverSlots:208
( Streams ),
conj2listRS Yap_RecoverSlots:208
( Sols, LSols ),
catchRS Yap_RecoverSlots:208
( do_returnsRS Yap_RecoverSlots:208
( M:RS Yap_RecoverSlots:208
G, LSols, Lab ), Ball, endRS Yap_RecoverSlots:208
( Ball ) ),
shutdownRS Yap_RecoverSlots:208
( Streams, _ )
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
!!! syntax error: expected operator, got 'returns'
infoRS Yap_RecoverSlots:208
( A <== HERE ==> returnsRS Yap_RecoverSlots:208
B, _, ( AreturnsRS Yap_RecoverSlots:208
B ), gRS Yap_RecoverSlots:208
( _, okRS Yap_RecoverSlots:208
) ):-RS Yap_RecoverSlots:208
!RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
!!! syntax error: expected to find ')', found <EOT>
do_returnsRS Yap_RecoverSlots:208
( G0, Sols0, Lab ):-RS Yap_RecoverSlots:208
counterRS Yap_RecoverSlots:208
( I ),
fetchRS Yap_RecoverSlots:208
( I, Sols0, Pattern0, Next ),
(
Pattern0=RS Yap_RecoverSlots:208
( V0=@=RS Yap_RecoverSlots:208
Target0 ),
copy_termRS Yap_RecoverSlots:208
( G0-RS Yap_RecoverSlots:208
V0, G-RS Yap_RecoverSlots:208
VGF ),
catchRS Yap_RecoverSlots:208
( answerRS Yap_RecoverSlots:208
( G, VGF, Target0, Lab, Sol ), Error, Sol=RS Yap_RecoverSlots:208
errorRS Yap_RecoverSlots:208
( G, Error ) ),
stepRS Yap_RecoverSlots:208
( _I, Sols, G0, Sol, Lab ),
!RS Yap_RecoverSlots:208
<== HERE ==>
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
RS Yap_RecoverSlots:208
?- \^\% YAP exiting: cannot handle signal 3

41
utils/analysis/graphs.yap
View File

@ -2,7 +2,7 @@
pl_graphs(Dir - Mod) :-
atom( Dir ),
format(' ************* GRAPH: ~a ***********************/~n', [Dir]),
atom_concat([Dir,'/*'], Pattern),
atom_concat([Dir,'/*'], Pattern),
expand_file_name( Pattern, Files ),
member( File, Files ),
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) ->
@ -18,7 +18,7 @@ pl_graphs(Dir - Mod) :-
pl_graphs(_).
%%
%% @pred build_graph( File, Mod)
%% @pred build_graph( File, Mod)
% adds a node to the file graph and marks which files are modules
%
% main side-effect facts like edge( F0-Mod:File )
@ -32,7 +32,7 @@ build_graph(F, Mod) :-
catch( open(PF, read, S, [script(true)]), _, fail ),
repeat,
nb_getval( current_module, MR ),
catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, error(Throw) ),
catch(read_clause( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, error(Throw) ),
(
T == end_of_file
->
@ -76,7 +76,7 @@ get_graph( (H :- B), F, _Pos, M ) :-
!,
functor( H, N, Ar),
add_deps( B, M, M:N/Ar, F, _Pos, 0 ).
%% switches to new file n
%% switches to new file n
get_graph( (:-include( Fs ) ), F, _Pos, M ) :-
!,
source_graphs( M, F, Fs ).
@ -117,7 +117,7 @@ add_deps({A}, M, P, F, _Pos, 2) :- !,
add_deps(A, M, P, F, _Pos, 0).
add_deps([_|_], M, P, F, Pos, 2) :-
!,
put_dep( (F-M:P :- prolog:'C'/3 ), Pos ).
put_dep( (F-M:P :- boot-prolog:'C'/3 ), Pos ).
add_deps(String, _M, _P, _F, _Pos, _) :- string(String), !.
add_deps([], _M, _P, _F, _Pos, 2) :- !.
add_deps(!, _M, _P, _F, _Pos, _) :- !.
@ -131,32 +131,13 @@ add_deps(A, M, P, F, Pos, L) :-
Ar is Ar0+L,
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
put_dep( (Target :- F0-M:Goal ), Pos ) :-
exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !,
%follow ancestor chain
ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ),
put_dep( ( Target :- FA-MA:NA/Ar ), Pos ).
% the base case, copying from the same module ( but maybe not same file 0.
put_dep( ( Target :- _F-M:N/Ar ) , _ ) :-
m_exists(M:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-M:N/Ar ) ) ).
% prolog is visible ( but maybe not same file ).
put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :-
m_exists(prolog:N/Ar, F0),
!,
assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ).
put_dep( ( _Target :- _F-Mod:_N/_Ar ), _Pos) :-
var( Mod ), !.
put_dep( ( Target :- F-Mod:N/Ar ), Pos) :-
atom( Mod ),
stream_position_data( line_count, Pos, Line ),
assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ).
put_dep( (Target :- F0-M:Goal ), _Pos ) :-
ground(F0-M:Goal), !,
assert_new_e( ( Target :- F0-M:N/Ar ) ).
put_dep(_,_).
ancestor( ( Younger :- Older) ) :-
exported( ( Mid :- Older ) ), !,
ancestor( ( Younger :- Mid) ).
ancestor( (Older :- Older) ).
% prolog is visible ( but maybe not same file ).
m_exists(P, F) :- private( F, P ), !.
m_exists(P, F) :- public( F, P ).

559
utils/analysis/load.yap
View File

@ -18,9 +18,17 @@ load( _ , Dirs ) :-
nb_setval( private, false ),
nb_setval( file_entry, user:user ),
init_loop( Dirs ),
maplist( pl_interfs, Dirs ),
maplist(scan_dir, Dirs).
scan_dir( Dir -user) :-
pl_interfs(0, Dir-user ),
%%% phase 2: find C-code predicates
c_preds( Dir-user ).
// the c-builtins do not depend on prolog code.
scan_dir( Dir -prolog) :-
c_preds( Dir-user ).
pl_interfs(0, Dir-user ).
%%% phase 2: find C-code predicates
maplist( c_preds, Dirs ).
dirs( Roots ) :-
member( Root-_, Roots ),
@ -31,17 +39,23 @@ dirs( _Roots ).
rdir( FRoot ) :-
absolute_file_name( FRoot, [glob(*), solutions(all), file_errors(fail)], File ),
writeln(File),
\+ doskip( File ),
catch( file_property( File, type(directory) ), _, fail ),
(
catch( file_property( File, type(directory) ), _, fail )
->
assert_new( dir( File ) ),
assert_new( sub_dir( FRoot, File ) ),
rdir( File ),
rdir( File )
;
file_base_name(File, B),
assert( file(File, B) )
),
fail.
rdir(_).
c_preds(Dir - Mod) :-
atom( Dir ),
format('%~*| C ************* ~a\n', [1,Dir]),
atom( Dir ),
absolute_file_name( Dir, [glob(*), solutions(all), file_errors(fail)], File ),
( ( sub_atom(File,_,_,0,'.c')
;
@ -70,146 +84,148 @@ c_file(F, _Mod) :-
consulted( F, _ ),
!.
c_file(F, Mod) :-
% writeln(F),
assert( consulted( F, Mod ) ),
nb_setval( current_module, Mod ),
open(F, read, S, [alias(c_file)]),
repeat,
read_line_to_string( S, String ),
( String == end_of_file
read_line_to_codes( S, Codes ),
( Codes == end_of_file
->
!,
close(S)
;
sub_string(String, _, _, _, `PL_extension`),
append( _, "PL_extension", Codes),
%writeln(Fields),
c_ext(S, Mod, F),
fail
;
split_string(String, `,; ()\t\"\'`, Fields), %'
split(Codes, ",; ()\t\"\'", Fields), %'
%writeln(Fields),
line_count(S, Lines),
c_line(Fields , Mod, F:Lines),
fail
).
c_line([`}`], Mod, _) :- !,
c_line(["}"], Mod, _) :- !,
nb_setval( current_module, Mod ).
c_line(Line, _Mod, _) :-
append( _, [ `CurrentModule`, `=`, M|_], Line),
append( _, [ "CurrentModule", "=", M|_], Line),
system_mod(M, _Mod, Mod, _),
nb_setval( current_module, Mod ).
c_line(Line, Mod, F: LineP) :-
break_line( Line, N/A, Fu),
assert( node( Mod, N/A, F-LineP, Fu ) ),
handle_pred( Mod, N, A, F ).
c_ext( S, Mod, F ) :-
repeat,
read_line_to_string( S, String ),
stream_property( S, position(Pos) ),
read_line_to_codes( S, Codes ),
(
String == end_of_file
Codes == end_of_file
->
!
;
sub_string( String, _, _, _, `NULL` )
string_codes(String, Codes),
( sub_string( Codes, _, _, _, `NULL` )
->
!
;
;
split_string(String, `,; (){}\t\"\'`, [`FRG`, NS,AS,FS|_]),
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS),
catch( number_string(A, AS), Error, handle( String , Error ) ),
stream_position_data( line_count, Pos, Line ),
assert( node( Mod , N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F )
;
split_string(String, `,; (){}\t\"\'`, [NS,AS,FS|_]),
split_string(String , `,; (){}\t\"\'`, [NS,AS,FS|_]),
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS),
stream_property( S, position( Pos ) ), writeln( Pos ),
stream_position_data( line_count, Pos, Line ),
Line0 is Line-1,
assert( node( Mod, N/A, F-Line0, Fu ) ),
catch( number_string(A, AS), Error, handle( String , Error ) ),
break_line( Line, N/A, swi(Fu)) ,
assert( node( Mod, N/A, F-Line, Fu ) ),
handle_pred( Mod, N, A, F )
).
)
).
break_line( Line, N/A, c(Fu)) :-
take_line( Line, NS, AS, FS ), !,
atom_string(N,NS),
atom_string(Fu,FS),
number_string(A, AS).
atom_codes(N,NS),
atom_codes(Fu,FS),
catch( number_codes(A, AS), Error, handle( Line, Error ) ).
break_line( Line, N/A, swi(Fu)) :-
take_line( Line, NS, AS, FS ), !,
atom_string(N,NS),
number_string(A, AS),
atomic_concat([`pl_`,FS,`_`,A,`_va`], Fu).
atom_codes(N,NS),
catch( number_codes(A, AS), Error, handle( Line, Error ) ),
append(["pl_",FS,"_",A,"_va"], FuS),
atom_codes(Fu,FuS).
break_line( Line, N/A, bp(Fu)) :-
take_line( Line, NS, AS, FS ), !,
atom_string(N,NS),
number_string(A, AS),
atomic_concat([`pc_`,FS,`_`,A], Fu).
atom_codes(N,NS),
catch( number_codes(A, AS), Error, handle( Line, Error ) ),
append(["pc_",FS,"_",A], FuS),
atom_codes(Fu,FuS).
break_line( Line, N/A, c(FuE, FuB)) :-
take_line( Line, NS, AS, FSE, FSB ), !,
atom_string(N,NS),
atom_string(FuE,FSE),
atom_string(FuB,FSB),
number_string(A, AS).
atom_codes(N,NS),
atom_codes(FuE,FSE),
atom_codes(FuB,FSB),
atom_codes(A, AS).
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitCPred`, NS, AS, FS|_], Line), !.
append( _, [ "Yap_InitCPred", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitAsmPred`, NS, AS, _, FS|_], Line), !.
append( _, [ "Yap_InitAsmPred", NS, AS, _, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !.
append( _, [ "Yap_InitCmpPred", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !.
append( _, [ "Yap_InitCmpPred", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `YAP_UserCPredicate`, NS, FS, AS|_], Line), !.
append( _, [ "YAP_UserCPredicate", NS, FS, AS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `PRED`, NS0, AS, FS|_], Line), !,
append( [`pl_`, NS0, AS, `_va`], NS ).
append( _, [ "PRED", NS0, AS, FS|_], Line), !,
append( ["pl_", NS0, AS, "_va"], NS ).
take_line( Line, NS0, AS, FS ) :-
append( _, [ "PRED_IMPL", NS0, AS, FS|_], Line), !,
append( ["pl_", NS0, AS, "_va"], FS ).
take_line( Line, NS, AS, FS ) :-
append( _, [ `PRED_IMPL`, NS0, AS, FS|_], Line), !,
append( [`pl_`, NS0, AS, `_va`], NS ).
append( _, [ "PL_register_foreign", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `PL_register_foreign`, NS, AS, FS|_], Line), !.
append( _, [ "PRED_DEF", NS, AS,_FS|_], Line), !,
append( ["pl_", NS, AS, "_va"], FS ).
take_line( Line, NS, AS, FS ) :-
append( _, [ `PRED_DEF`, NS0, AS, FS|_], Line), !,
append( [`pl_`, NS0, AS, `_va`], NS ).
take_line( Line, NS, AS, FS ) :-
append( _, [ `FRG`, NS, AS, FS|_], Line), !.
append( _, [ "FRG", NS, AS, FS|_], Line), !.
% from odbc
take_line( Line, NS, AS, FS ) :-
append( _, [ `NDET`, NS, AS, FS|_], Line), !.
append( _, [ "NDET", NS, AS, FS|_], Line), !.
take_line( Line, NS, AS, FS ) :-
append( _, [ `DET`, NS, AS, FS|_], Line), !.
append( _, [ "DET", NS, AS, FS|_], Line), !.
take_line( Line, AS, FS ) :-
append( _, [ `REGISTER_CPRED`, FS, AS], Line), !.
append( _, [ "REGISTER_CPRED", FS, AS], Line), !.
take_line( Line, NS, AS, FSE, FSB ) :-
append( _, [ `Yap_InitCPredBack`, NS, AS, _, FSE, FSB|_], Line), !.
append( _, [ "Yap_InitCPredBack", NS, AS, _, FSE, FSB|_], Line), !.
system_mod(`ATTRIBUTES_MODULE`, _, attributes, user ).
system_mod(`HACKS_MODULE`, _, '$hacks' , sys ).
system_mod(`USER_MODULE`, _, user, user ).
system_mod(`DBLOAD_MODULE`, _, '$db_load', sys ).
system_mod(`GLOBALS_MODULE`, _, globals, sys ).
system_mod(`ARG_MODULE`, _, arg, sys ).
system_mod(`PROLOG_MODULE`, _ , prolog, sys ).
system_mod(`RANGE_MODULE`, _, range, user ).
system_mod(`SWI_MODULE`, _, swi, sys ).
system_mod(`OPERATING_SYSTEM_MODULE`, _, system , sys ).
system_mod(`TERMS_MODULE`, _, terms , sys).
system_mod(`SYSTEM_MODULE`, _, system, sys ).
system_mod(`IDB_MODULE`, _, idb, user ).
system_mod(`CHARSIO_MODULE`, _, charsio, sys ).
system_mod(`cm`, M, M, user ).
system_mod("ATTRIBUTES_MODULE", _, attributes, user ).
system_mod("HACKS_MODULE", _, '$hacks' , sys ).
system_mod("USER_MODULE", _, user, user ).
system_mod("DBLOAD_MODULE", _, '$db_load', sys ).
system_mod("GLOBALS_MODULE", _, globals, sys ).
system_mod("ARG_MODULE", _, arg, sys ).
system_mod("PROLOG_MODULE", _ , prolog, sys ).
system_mod("RANGE_MODULE", _, range, user ).
system_mod("SWI_MODULE", _, swi, sys ).
system_mod("OPERATING_SYSTEM_MODULE", _, system , sys ).
system_mod("TERMS_MODULE", _, terms , sys).
system_mod("SYSTEM_MODULE", _, system, sys ).
system_mod("IDB_MODULE", _, idb, user ).
system_mod("CHARSIO_MODULE", _, charsio, sys ).
system_mod("cm", M, M, user ).
call_c_files( File, Mod, _Fun, [CFile] ) :-
search_file( CFile, File, c, F ),
@ -224,28 +240,29 @@ call_c_files( File, Mod, _Fun, CFile ) :-
:- dynamic undo/3.
directive(G, F, M) :-
% asserta( directive(G, F, M) ),
( G = set_prolog_flag(F,V)
->
prolog_flag(F, O, V),
asserta( undo( set_prolog_flag(F, O), F, M)),
set_prolog_flag(F, V)
;
G = yap_flag(F,V)
->
prolog_flag(F, O, V),
asserta( undo( yap_flag(F, O), F, M)),
yap_flag(F, V)
;
G = op(A,B,O)
->
(current_op(OA,OB,O) -> true ; OA = 0, OB = fx ),
asserta( undo( op(OA,OB,O), F, M)),
op( A, B, O)
;
assert(M:G, R),
asserta( undo(erase(R), F, M))
).
undo(G,F,M),
!.
directive(set_prolog_flag(Fl,V), F, M) :-
!,
prolog_flag(Fl, O, V),
asserta( undo( set_prolog_flag(Fl, O), F, M)),
set_prolog_flag(Fl, V).
directive(yap_flag(Fl,V), F, M) :-
!,
prolog_flag(Fl, O, V),
asserta( undo( set_prolog_flag(Fl, O), F, M)),
set_prolog_flag(Fl, V).
directive(yap_flag(Fl,O,V), F, M) :-
!,
prolog_flag(Fl, O, V),
asserta( undo( set_prolog_flag(Fl, O), F, M)),
set_prolog_flag(Fl, V).
directive(op(X,Y,O), _F, M) :-
!,
op( X, Y, M:O).
directive(G, F, M) :-
assert(M:G, R),
asserta( undo(erase(R), F, M)).
clean_up(F, M) :-
undo( G , F, M),
@ -257,17 +274,19 @@ clean_up(_,_).
%
%
%
pl_interfs(Dir - Mod) :-
\+ doskip( Dir ),
format('% ************* ~a\n', [Dir]),
nb_setval( current_module, Mod ),
pl_interfs(Lev0, Dir - Mod) :-
\+ ( fullskip( Dir ) ),
format('%~*| ************* ~a\n', [Lev0,Dir]),
Lev is Lev0+1,
nb_setval( current_module, Mod ),
atom( Dir ),
directory_files( Dir , Files),
member( File, Files ),
atom_concat([Dir,'/',File], Path),
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ; sub_atom(File,_,_,0,'.ypp') ) ->
absolute_file_name( Path, APath ),
pl_interface( APath , Mod )
pl_interface( APath , Mod, Lev )
;
exists_directory( Path ),
\+ atom_concat(_, '/.', Path),
@ -275,31 +294,33 @@ pl_interfs(Dir - Mod) :-
\+ atom_concat(_, '/.git', Path),
absolute_file_name( Path, APath ),
\+ doskip( APath ),
pl_interfs( APath - Mod )
),
pl_interfs( Lev0, APath - Mod )
),
fail.
pl_interfs(_).
pl_interfs(_, _).
%%
% pl_interface( File, Mod)
% pl_interface( File, Mod, Level)
% adds a node to the file graph and marks which files are modules
%
% main side-effect facts like edge( F0-Mod:File )
% exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ),
% module_on ( M, File )
%
pl_interface(F, _Mod) :-
module_on( F , _M, _Is),
!.
pl_interface(F, Mod) :-
pl_interface(F, Mod, _Lev) :-
module_on( F , _Mod, L ),
maplist( private(F, Mod), L ),
!.
pl_interface(F, Mod, _) :-
consulted(F, Mod ),
!.
pl_interface(F, Mod) :-
format('------------------------- ~a~n',[F]),
pl_interface(F, Mod, Lev) :-
% format('~*|------------------------- ~a~n',[Lev,F]),
% ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ),
% ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ),
%( F = '/Users/vsc/git/yap-6.3/library/ytest.yap' -> spy get_interface/3 ; true ),
% ( F = '/Users/vsc/git/yap-6.3/library/examples/mat.yap' -> trace ; true ),
assert_new(consulted(F, Mod ) ),
nb_getval( current_module, M0 ),
nb_getval( private, Default ),
nb_setval( private, false ),
nb_getval( file_entry, OF:OMod ),
@ -308,52 +329,53 @@ pl_interface(F, Mod) :-
catch( open(PF, read, S, [script(true)]) , _, fail ),
repeat,
nb_getval( current_module, MR ),
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, error( Throw)), %( sub_atom(F,_,_,_,'e.y
writeln(T),
catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( MR:Throw)),
( T == end_of_file
->
!,
close(S),
clean_up( MR, F ),
!,
close(S),
(
c_dep( F, Fc),
c_file( Fc, MR ),
fail
;
build_graph( F, MR ),
fail
% cleanup
% cleanup
;
module_on( F , _M, _Is)
->
% also, close ops defined in the module M, if M \= Mod
nb_setval( current_module, Mod ),
nb_setval( private, Default ),
nb_setval( file_entry, OF:OMod )
;
true
)
),
clean_up( MR, F ),
nb_setval( current_module, M0 )
% writeln('***************************<<<<<<<<<<<'-M0),
% (current_op(X,Y,O), write(M0:O), fail;nl)
;
nb_getval( current_module, MC0 ),
stream_position_data( line_count, Pos, Line ),
nb_setval( line, Line ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_interface( T, F, MC ),
fail
Lev1 is Lev+1,
get_interface( T, F, MC, Lev1 ),
get_graph( T, F, Pos, MC ),
fail
).
get_interface( T, _F, _M0 ) :-
get_interface( T, _F, _M0, _ ) :-
% ( T = (:- op(_,_,_)) -> trace ; true ),
var(T),
!.
%% switches to new file n
get_interface( (:- D ), F, M ) :-
get_interface( (:- D ), F, M , Lev) :-
!,
get_directive( D, F, M ).
get_interface( (?- _ ), _F, _M ) :-
get_directive( D, F, M, Lev ).
get_interface( (?- _ ), _F, _M , _Lev) :-
!.
get_interface( T, F, M0 ) :-
get_interface( T, F, M0 , _Lev) :-
always_strip_module( M0:T, M, NT),
(
NT = goal_expansion(_,_) ;
@ -361,131 +383,147 @@ get_interface( T, F, M0 ) :-
NT = term_expansion( _, _ )
),
!,
directive(NT, F, M).
get_interf( ( M:H :- _B), F, _M ) :-
catch(directive(NT, F, M), Error, loop_error(Error)).
get_interface( ( M:H :- _B), F, _M , _Lev) :-
!,
get_interface( H, F, M ).
functor( H, N, A),
handle_pred( M, N, A, F ).
% not the time t
get_interface( (H :- _B), F, M ) :-
get_interface( (H :- _B), F, M , _Lev) :-
!,
get_interface( H, F, M ).
get_interface( G , F, M ) :-
functor( H, N, A),
handle_pred( M, N, A, F ).
get_interface( G , F, M , _Lev) :-
functor( G, N, A),
handle_pred( M, N, A, F ).
get_directive( V , _F, _M ) :-
get_directive( V , _F, _M , _Lev) :-
var( V ),
!.
get_directive( module( NM0, Is ), F, _M ) :-
get_directive( module( NM0, Is ), F, _M , _Lev) :-
!,
(NM0 = system(_) -> NM = prolog ; NM = NM0 ),
assert(module_file( F, NM ) ),
nb_setval( current_module, NM ),
assert( module_on( F , NM, Is) ),
maplist( public(F, NM), Is ),
nb_setval( private, true ).
get_directive( reexport( Loc, Is ), F, M ) :-
(
(NM0 = system(_) -> NM = prolog ; NM = NM0 ),
assert(module_file( F, NM ) ),
nb_setval( current_module, NM ),
assert( module_on( F , NM, Is) ),
maplist( public(F, NM), Is ),
nb_setval( private, true )
->
true
;
writeln(oops:module( NM0, Is )),
fail
).
get_directive( reexport( Loc, Is ), F, M , Lev) :-
!,
% find the file
search_file( Loc, F, prolog, NF ),
include_files( F, M, Is, NF ),
% extend the interface.rg
retract( module_on( F , M, Is0) ),
append( Is0, Is, NIs ),
assert( module_on( F , M, NIs) ),
maplist( public(F, M), NIs ).
get_directive( use_module( Loc, Is ), F, M ) :- !,
( % find the file
search_file(Loc, F, prolog, F1),
pl_interface(F1, M, Lev),
module_on( F1 , NM, Is0),
(var(Is) ->
Is = Is0
;
true
),
% extend the interface.rg
retract( module_on( F , M, IsOld) ),
append( Is, IsOld, NIs ),
assert( module_on( F , M, NIs) ),
maplist( exported(F, M, F1, NM), NIs )
fail
).
get_directive( use_module( Loc, Is ), F, M , Lev) :- !,
!,
include_files( F, M, Is, Loc ).
get_directive( use_module( Loc ), F, M ) :- !,
include_files( F, M, Is, Lev, Loc ).
get_directive( use_module( Loc ), F, M , Lev) :- !,
!,
include_files( F, M, Loc ).
include_files0( F, M, Lev, Loc ).
% nb_getval(current_module,MM), writeln(NM:MM:M).
get_directive( use_module( Loc, Is, _ ), F, M ) :-
get_directive( use_module( Loc, Is, _ ), F, M , Lev) :-
!,
include_files( F, M, Is, Loc ).
get_directive( consult( Files ), F, M ) :-
include_files( F, M, Is, Lev, Loc).
get_directive( consult( Files ), F, M , Lev) :-
!,
include_files( F, M, Files ).
get_directive( reconsult( Files ), F, M ) :-
include_files0( F, M , Lev, Files).
get_directive( reconsult( Files ), F, M , Lev) :-
!,
include_files( F, M, Files ).
get_directive( ensure_loaded( Files ), F, M ) :-
include_files0( F, M, Lev, Files ).
get_directive( ensure_loaded( Files ), F, M , Lev) :-
!,
include_files( F, M, Files ).
get_directive( include( Files ), F, M ) :-
include_files0( F, M, Lev, Files ).
get_directive( include( Files ), F, M , Lev) :-
!,
source_files( F, M, Files ).
get_directive( load_files( Files , [_|_] ), F, M ) :-
include_files0( F, M, Lev, Files ).
get_directive( load_files( Files , [_|_] ), F, M , Lev) :-
!,
include_files( F, M, Files ).
get_directive( bootstrap( Files ), F, M ) :-
include_files0( F, M, Lev, Files ).
get_directive( bootstrap( Files ), F, M , Lev) :-
!,
include_files( F, M, Files ).
get_directive( ( G -> _ ; _ ) , F, M) :-
include_files0( F, M, Lev, Files ).
get_directive( ( G -> _ ; _ ) , F, M, Lev) :-
!,
get_directive( G , F, M).
get_directive( catch( G , _, _ ) , F, M) :-
get_directive( G , F, M, Lev ).
get_directive( catch( G , _, _ ) , F, M, Lev) :-
!,
get_directive( G , F, M).
get_directive( initialization( G , now ) , F, M) :-
!,
get_directive( G , F, M).
get_directive( load_files( Files , [_|_] ), F, M ) :-
get_directive( G , F, M, Lev).
get_directive( initialization( G , now ) , F, M, Lev) :-
!,
include_files( F, M, Files ).
get_directive( [] , _F0, _M ) :- !.
get_directive( [F1|Fs] , F, M ) :-
get_directive( G , F, M, Lev).
get_directive( load_files( Files , [_|_] ), F, M , Lev) :-
!,
include_files0( F, M, Lev, Files ).
get_directive( [] , _F0, _M , _Lev) :- !.
get_directive( [F1|Fs] , F, M , Lev) :-
strip_module( M:F, M1, F1),
!,
include_files( F, M1, F1 ),
get_directive( Fs , F, M ).
include_files0( F, M1, Lev, F1 ),
get_directive( Fs , F, M , Lev).
% don't actually use \this one.
get_directive( load_foreign_files(Fs, _, Fun), F, M ) :-
get_directive( load_foreign_files(Fs, _, Fun), F, M , _Lev) :-
!,
call_c_files( F, M, Fun, Fs ).
get_directive( load_foreign_library(F), F0, M ) :-
get_directive( load_foreign_library(F), F0, M , _Lev) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_directive( load_foreign_library(F,Fun), F0, M ) :-
get_directive( load_foreign_library(F,Fun), F0, M , _Lev) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, Fun, F1 ).
get_directive( use_foreign_library(F), F0, M ) :-
get_directive( use_foreign_library(F), F0, M , _Lev) :-
!,
always_strip_module(M:F, M1, F1),
call_c_files( F0, M1, '', F1 ).
get_directive( system_module( _NM, _Publics, _Hiddens), _F, _M ) :-
get_directive( system_module( _NM, _Publics, _Hiddens), _F, _M , _Lev) :-
nb_setval( current_module, prolog ),
!.
get_directive( style_checker( _ ), _F, _M ) :-
get_directive( style_checker( _ ), _F, _M , _Lev) :-
!.
get_directive( dynamic( T ), F, M ) :-
get_directive( dynamic( T ), F, M , _Lev) :-
!,
declare_functors( T, F, M ).
get_directive( multifile( T ), F, M ) :- % public?
get_directive( multifile( T ), F, M , _Lev) :- % public?
!,
declare_functors( T, F, M ).
get_directive( meta_predicate( T ), F, M ) :-!,
get_directive( meta_predicate( T ), F, M , _Lev) :-!,
declare_terms( T, F, M ), % public?
!.
get_directive( '$install_meta_predicate'( H, M), F, __M ) :-
get_directive( '$install_meta_predicate'( H, M), F, __M , _Lev) :-
!,
declare_functors( H, F, M ).
get_directive( thread_local( T ), F, M ) :-
get_directive( thread_local( T ), F, M , _Lev) :-
!,
declare_functors( T, F, M ).
get_directive( op( X, Y, Z), F, M ) :-
get_directive( op( X, Y, Z), _F, M , _Lev) :-
!,
always_strip_module(M:Z, M1, Z1),
directive(op( X, Y, Z1), F, M1).
get_directive( record( Records ), F, M ) :-
new_op(M,X,Y,Z).
get_directive( record( Records ), F, M , _Lev) :-
!,
handle_record( Records, F, M).
get_directive( set_prolog_flag(dollar_as_lower_case,On), F, M ) :-
handle_record( Records, F, M).
get_directive( set_prolog_flag(dollar_as_lower_case,On), F, M , _Lev) :-
!,
directive(set_prolog_flag(dollar_as_lower_case,On), F, M).
catch(directive(set_prolog_flag(dollar_as_lower_case,M:On), F), Msg, loop_error(585, Msg) ).
% support SWI package record
handle_record( (Records1, Records2), F, M ) :-
@ -552,112 +590,104 @@ handle_pred( M, N, A, F ) :-
)
).
handle_op( F, M, Op ) :-
directive( Op, F, M ).
exported( NF, F, NM, M, op(X,Y,Z)) :-
exported( _NF, _F, _NM, M, op(X,Y,Z)) :-
!,
public( NF , NM:op(X,Y,Z) ),
handle_op( F, M , op(X,Y,Z) ).
new_op(M,X,Y,Z).
exported( NF, F, NM, M, N/A) :- !,
% sink no more
retractall( exported(( _ :- F-M:N/A) ) ),
assert_new( exported( (F-M:N/A :- NF-NM:N/A )) ).
assert_new_e( ( (F-M:N/A :- NF-NM:N/A )) ).
exported( NF, F, NM, M, N/A as NN) :- !,
% sink no more
retractall( exported(( _ :- F-M:N/A) ) ),
assert_new( exported( ( F-M:NN/A :- NF-NM:N/A ) ) ).
assert_new_e( ( ( F-M:NN/A :- NF-NM:N/A ) ) ).
exported( NF, F, NM, M, N//A) :- !,
A2 is A+2,
% sink no more
retractall( exported(( _ :- F-M:N/A2) ) ),
assert_new( exported( (F-M:N/A2 :- NF-NM:N/A2) ) ).
assert_new_e( ( (F-M:N/A2 :- NF-NM:N/A2) ) ).
exported( NF, F, NM, M, N//A as NN) :- !,
A2 is A+2,
% sink no more
retractall( exported(( _ :- F-M:N/A2) ) ),
assert_new( exported( ( F-M:NN/A2 :- NF-NM:N/A2 )) ).
import_publics( F, ProducerMod, ConsumerMod ) :-
public(F, ProducerMod:op(X,Y,Z) ),
handle_op( F, ConsumerMod, op(X,Y,Z) ),
fail.
import_publics( _F, _ProducerMod, _ConsumerMod ).
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
public(ProducerFile, ProducerMod:op(X,Y,Z) ),
handle_op( ConsumerFile, ConsumerMod, op(X,Y,Z) ),
fail.
all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :-
public(ProducerFile, ProducerMod:N/A ),
exported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod, N/A ),
fail.
all_imported( _ProducerFile, _ConsumerFile, _ProducerMod, _ConsumerMod ).
assert_new_e( ( ( F-M:NN/A2 :- NF-NM:N/A2 )) ).
include_files( F, M, Files ) :-
include_files( F, M, _Is, Files ).
include_files( F, M, Is, Files ) :-
maplist( include_files( F, M, Is ), Files ),
include_files0( F, M, Lev, Files ) :-
include_files( F, M, _Is, Lev, Files ).
include_files( F, M, Is, Lev, Files ) :-
maplist( include_files( F, M, Is, Lev ), Files ),
!.
include_files( F, M, Is, -Files ) :-
include_files( F, M, Is, Lev, -Files ) :-
!,
include_files( F, M, Is, Files).
include_files( F, M, Is, Files ) :-
include_files( F, M, Is, Lev, Files).
include_files( F, M, Is, Lev, Files ) :-
!,
always_strip_module(M:Files, M1, NFiles),
include_file( F, M1, Is, NFiles ).
include_file( F, M1, Is, Lev, NFiles ).
include_file( F, M, Is, Loc ) :-
include_file( F, M, Is, Lev, Loc ) :-
is_list( Loc ), !,
maplist( include_file( F, M, Is), Loc ).
include_file( F, M, Is0, Loc ) :-
maplist( include_file( F, M, Is, Lev), Loc ).
include_file( F, M, Is0, Lev, Loc ) :-
% depth visit
(
nb_getval( private, Private ), % find the file
once( search_file( Loc, F, prolog, NF ) ),
% depth visit
pl_interface(NF, M),
pl_interface(NF, M, Lev),
% should verify Is in _Is
% link b
( module_on(NF, NM, Is)
->
( var(Is0) -> Is = Is0 ; true ),
maplist( exported( NF, F, NM, M), Is0 )
;
all_imported( NF, F, NM, M)
),
nb_setval( private, Private ).
% link b
%trace,
( module_on(NF, NM, Is)
->
( var(Is0) -> Is = Is0 ; true ),
maplist( exported( NF, F, NM, M), Is0 )
;
true
),
nb_setval( private, Private )
->
true
;
writeln(bad_include_file( F, M, Is0, Lev, Loc )),
fail
).
source_files( F, M, Files ) :-
maplist( source_files( F, M ), Files ),
source_files( F, M, Lev, Files ) :-
maplist( source_files( F, M, Lev ), Files ),
!.
source_files( F, M, Loc ) :-
source_file( F, M, Loc ).
source_files( F, M, Lev, Loc ) :-
source_file( F, M, Lev, Loc ).
source_file( F, M, Loc ) :-
source_file( F, M, Loc, Lev ) :-
once( search_file( Loc, F, prolog, NF ) ),
% depth visit
pl_source(NF, F, M). % should verify Is in _Is
pl_source(NF, F, M, Lev). % should verify Is in _Is
pl_source(F, F0, Mod) :-
%writeln( -F ),
preprocess_file( F, PF ),
pl_source(F, F0, Mod, Lev) :-
nb_getval( current_module, MR0 ),
preprocess_file( F, PF ),
% format('%~*| ************* ~a\n', [Lev,PF]),
catch( open(PF, read, S, []) , _, fail ),
repeat,
nb_getval( current_module, MR ),
%( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ),
catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, error( Throw)),
catch( read_clause( S, T, [module( MR ),term_position(Pos)] ), Throw, loop_error( Throw)),
(
T == end_of_file
->
!,
close(S)
nb_setval( current_module, MR ),
close(S),
nb_setval( current_module, MR0 )
;
nb_getval( current_module, MC0 ),
stream_position_data( line_count, Pos, Line ),
nb_setval( line, Line ),
( Mod == prolog -> MC = prolog ; MC = MC0 ),
get_interface( T, F0, MC ),
get_interface( T, F0, Lev, MC ),
fail
).
@ -696,3 +726,8 @@ declare_terms( T, F, M1) :-
declare_term(F, M, S) :-
functor(S, N, A),
handle_pred( M, N, A, F ).
handle(Line, Error ) :-
format('~s caused Error ~w~n~n', [Line, Error]),
fail.

261
utils/sysgraph
View File

@ -1,5 +1,5 @@
#!/usr/local/bin/yap -L -- $*
#.
:- style_check(all).
@ -20,7 +20,7 @@
:- style_check(all).
:- yap_flag( double_quotes, string ).
%:- yap_flag( double_quotes, string ).
%:- yap_flag( dollar_as_lower_case, on ).
:- dynamic
@ -38,7 +38,8 @@
undef/2,
c_dep/2,
do_comment/5,
module_file/2.
module_file/2,
file/2.
%% @pred node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet, dynamic.
%
@ -56,30 +57,30 @@ inline( []/0 ).
% @short edge(+SourceModule:module, +SourcePredicate:pred_indicator, +TargetPredicate:pred_indicator, +InFile:file) is nondet
%
main :-
trace,
main :-
unix(argv([D])),
assert(root(D)),
init,
fail.
main :-
unix(argv([D])),
trace,
Dirs = ['C'-prolog,
Dirs = ['C'-prolog,
'OPTYap'-prolog,
'os'-prolog,
'pl'-prolog,
'OPTYap'-prolog,
'library'-user,
'swi/library'-user,
% 'swi/console'-user
'packages'-user
],
root(D),
% maplist(distribute(D), Dirs, Paths),
assert(root(D)),
load( D, Dirs ),
maplist( pl_graphs, Dirs ),
fail.
main :-
%%% phase 4: construct graph
retractall( consulted(_,_) ),
undefs,
trace,
find_undefs,
doubles,
% pl_exported(pl).
c_links,
@ -94,6 +95,7 @@ distribute( Root, File-Class, Path-Class) :-
init :-
retractall(dir(_)),
retractall(file(_,_)),
retractall(s8Sadir(_)),
retractall(edge(_)),
retractall(private(_,_)),
@ -105,13 +107,19 @@ init :-
retractall(exported(_)),
retractall(do_comment(_,_,_,_,_)),
fail.
init :-
current_op(_, _, D),
assert(system_op(D)),
fail.
init :-
user_c_dep(A,B),
do_user_c_dep(A,B),
fail.
init :-
user_skip(A),
do_user_skip(A),
root(M),
user_skip(D),
absolute_file_name( D, FD, [relative_to(M)]),
assert_static(fullskip(FD)),
fail.
init :-
user_expand(N,A),
@ -120,6 +128,10 @@ init :-
init :-
catch( make_directory(tmp), _, fail),
fail.
init :-
source_module(SM),
nb_setval(current_module, SM),
fail.
init.
init_loop( _Dirs ).
@ -134,8 +146,28 @@ doubles :-
fail.
doubles.
undefs :-
find_undefs :-
format('UNDEFINED procedure calls:~n',[]),
pmodule(M),
format(' module ~a:~n',[M]),
predicate_in_module(M, P),
\+ edge((_-M:P :- _)),
format(' ~w:~n',[P]),
fail.
find_undefs.
pmodule(M) :-
findall(M, node(M, _,_,_), Ms),
sort(Ms, SMs),
member(M, SMs).
predicate_in_module(M, P) :-
findall(P, node(M, P,_,_), Ps),
sort(Ps, SPs),
member(P, SPs).
/*
setof(M, Target^F^Line^NA^undef( ( Target :- F-M:NA ), Line ), Ms ),
member( Mod, Ms ),
format(' module ~a:~n',[Mod]),
@ -157,6 +189,7 @@ undefs :-
fail
).
undefs.
*/
out_list([]) :-
format('[]', []).
@ -313,88 +346,60 @@ prolog_file_type(c, '.i').
%
% handle some special cases.
%
search_file( library(boot/F) , LocF, Type, FN ) :- !,
search_file( '..'/pl/F , LocF, Type, FN ).
search_file( S , LocF, Type, FN ) :-
functor(S, _, N),
N> 0,
!,
arg(N, S, A),
search_file( A , LocF, Type, FN ).
%try to use your base
search_file( F0, LocF, Type, FN ) :-
filename(F0, F),
file_directory_name(LocF, LOC),
file_directory_name(F, D),
file_base_name(F, F1),
candidate_dir(LOC, '/', D, Left),
absolute_file_name(F1, [
relative_to(Left),
search_file( F0, LocF, Type, FO ) :-
file_directory_name(LocF, D),
file_base_name(F0, B),
findall(F, fsuffix(Type, B, F), Fs),
Fs = [_|_],
!,
absolute_file_name(F0, [
relative_to(D),
file_type(Type),file_errors(fail),
access(read) ], FN ).
search_file( Loc , F, _FN ) :-
format('~n~n~n###############~n~n FAILED TO FIND ~w when at ~a~n~n###############~n~n~n', [Loc, F ]),
access(none) ], FN ),
maplist(quantf(FN), Fs, DFs),
keysort(DFs, O),
O = [_D-FO|_].
search_file( Loc , F, Type, _FN ) :-
format('~n~n~n###############~n~n FAILED TO FIND ~w.~a when at ~a~n~n###############~n~n~n', [Loc, Type, F ]),
fail.
candidate_dir( Loc, _, D, Loc) :-
% ensure that the prefix of F, D, is a suffix of Loc
match(D, Loc).
% next, try going down in the current subroot
candidate_dir( Loc, _Source, D, OLoc) :-
sub_dir(Loc, NLoc),
NLoc \= Source,
candidate_dir_down(NLoc, Source, D, OLoc).
% if that fails, go up
candidate_dir( Loc, _Source, D, OLoc) :-
sub_dir(NLoc, Loc),
candidate_dir( NLoc, Loc, D, OLoc).
candidate_dir( Loc, _Source, D, OLoc) :-
root(Loc),
root(NLoc),
NLoc \= Loc,
candidate_dir( NLoc, Loc, D, OLoc).
candidate_dir_down(Loc, _Source, D, Loc) :-
% ensure that the prefix of F, D, is a suffix of Loc
match(D, Loc).
% next, try going down in the current subroot
candidate_dir( Loc, _Source, D, OLoc) :-
sub_dir(NLoc, Loc),
candidate_dir_down(NLoc, Source, D, OLoc).
match('.', _Loc) :- !.
match(D, Loc) :-
file_base_name( D, B),
file_base_name( Loc, B),
file_directory_name( D, ND),
file_directory_name( D, NLoc),
match(ND, NLoc).
filename(A, A) :- atom(A), !.
filename(A/B, NAB) :-
filename(A, NA),
filename(B, NB),
atom_concat([NA,'/', NB], NAB).
filename( library(A), NAB ) :-
!,
filename(A, NA),
(
library(L),
atom_concat( [L, '/', NA], NAB)
;
NAB = NA
).
filename( S, NAB ) :-
arg(1, S, A),
!,
NAB = NA.
fsuffix(Type,F0, F) :-
( user:prolog_file_type(Suffix, Type),
(atom_concat('.', _, Suffix)
->
Suffix = DSuffix
;
atom_concat('.', Suffix, DSuffix)
)
;
DSuffix = ''
),
atom_concat(F0, DSuffix, F1),
file_base_name(F1, B),
file(F, B),
atom_concat(_, F1, F).
quantf(F, F1, I-F1) :-
atom_length(F1,M),
between(0,M,I),
sub_atom(F1, I, J, 0, End),
sub_atom(F, _I, J, 0, End),
!.
% files must be called .yap or .pl
% if it is .yap...
new_op( F, M, op(X,Y,Z) ) :-
nb_getval( private, true ),
!,
private( F, M, op(X,Y,Z) ),
op( X, Y, Z).
new_op( F, M, op( X, Y, Z) ) :-
public( F, M, op( X, Y, Z) ).
new_op( prolog, _X,_Y,_Z ) :- !.
new_op( M, X,Y,Z ) :-
op( X, Y, M:Z).
error(_F, Error) :-
@ -410,15 +415,8 @@ preprocess_file(F,F).
%%%%%%%
%% declare a concept exportable
public( F, M, op(X,Y,Z) ) :- !,
(
assert_new( public( F, op(X,Y,Z) ) ),
directive( op(X,Y,M:Z), F, M ),
retract( private( F, op(X,Y,Z)) ),
fail
;
true
).
public( _F, M, op(X,Y,Z) ) :- !,
new_op(M,X,Y,Z).
public( F, M, M:N/Ar ) :-
retract( private( F, M:N/Ar ) ),
fail.
@ -427,6 +425,11 @@ public( F, M, N/Ar ) :-
\+ node( M, N/Ar, F-_, _ ),
nb_getval( line, L ),
assert( node( M, N/Ar, F-L, prolog ) ), !.
public( F, M, _N/Ar as NN ) :-
assert_new( public( F, M:NN/Ar ) ),
\+ node( M, NN/Ar, F-_, _ ),
nb_getval( line, L ),
assert( node( M, NN/Ar, F-L, prolog ) ), !.
public( _F, _M, _/_Ar ).
public( F, M, M:N//Ar ) :-
Ar2 is Ar+2,
@ -440,16 +443,9 @@ public( F, M, N//Ar ) :-
assert( node( M, N/Ar2, F-L, prolog ) ), !.
public( _F, _M, _//_Ar ).
private( F, M, op(X,Y,Z) ) :-
assert_new( private( F, M:op(X,Y,Z) ) ),
(
( M == user ; M == prolog )
->
op( X, Y, prolog:Z )
;
op( X, Y, M:Z )
), !.
private( _F, _M, op(_X,_Y,_Z) ).
private( _F, M, op(X,Y,Z) ) :-
!,
new_op( M,X, Y, Z ).
private( F, M, N/Ar ) :-
assert_new( private( F, M:N/Ar ) ),
\+ node( M, N/Ar, F-_, _ ),
@ -470,6 +466,14 @@ is_public( F, M, OP ) :-
is_private( F, M, OP ) :-
private( F, M :OP ).
assert_new_e((A-MG :- B-MG1 )) :-
yap_strip_module(MG, M, P),
yap_strip_module(MG1, M1, P1),
assert(edge((A-M:P :- B-M1:P1 ) )).
assert_new( G ) :- G, !.
assert_new( G ) :- assert( G ).
@ -699,27 +703,12 @@ check_quotes( N ) -->
[_],
check_quotes( N ).
%%%
% ops_default sets operators back to YAP default.
%
ops_default :-
abolish( default_ops/1 ),
A = (_,_), functor(A,Comma,2),
findall(op(X,Y,prolog:Z), ( current_op(X,Y,prolog:Z), Z\= Comma ), L),
assert_static( default_ops(L) ).
:- initialization(ops_default, now).
ops_restore :-
A = (_,_), functor(A,Comma,2),
current_op(_X,Y,prolog:Z),
Z\= Comma,
op(0,Y,prolog:Z),
fail.
ops_restore :-
default_ops(L),
maplist( call, L ).
current_op(_,Y,Op),
\+ system_op(Op),
op(0,Y,Op),
fail.
ops_restore.
do_user_c_dep(F1, F2) :-
absolute_file_name(F1, A1),
@ -794,7 +783,6 @@ doskip( D):- sub_atom( D, _, _, 0, '/..' ).
doskip( D):- sub_atom( D, _, _, 0, '/.git' ).
doskip( D):- sub_atom( D, _, _, _, '/.#' ).
doskip( D):- sub_atom( D, _, _, 0, '#' ).
doskip( D):- user_skip( D ).
user_skip( 'packages/gecode/3.6.0').
user_skip( 'packages/gecode/3.7.0').
@ -808,11 +796,12 @@ user_skip( 'packages/gecode/gecode3.yap' ).
user_skip( 'packages/gecode/gecode3_yap.cc' ).
user_skip( 'packages/gecode/gecode3_yap_hand_written.yap').
user_skip( 'packages/gecode/gecode3.yap-common.icc').
user_skip( 'packages/prism/src/prolog/core').
user_skip( 'packages/prism/src/prolog/up').
user_skip( 'packages/prism/src/prolog/mp').
user_skip( 'packages/prism/src/prolog/trans').
user_skip( 'packages/prism/src/prolog/bp').
user_skip( 'packages/prism/src/c').
user_skip( 'packages/prism/src/prolog').
user_skip( 'packages/prism').
user_expand( library(clpfd), 'library/clp/clpfd.pl' ).
loop_error(_, Msg) :-
writeln(Msg),
fail.