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

ugh

Browse Source
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() { YAPListTerm YAPQuery::namedVars() {
CACHE_REGS CACHE_REGS
Term o = vnames.term(); Term o = vnames.term();
Yap_DebugPlWrite(names); printf("<<<<<<<<<<<<<<<<-------------------------\n"); Yap_DebugPlWrite(o); printf("<<<<<<<<<<<<<<<<-------------------------\n");
return YAPListTerm( names ); // should be o return o; // should be o
} }
bool YAPQuery::next() 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) :- pl_graphs(Dir - Mod) :-
atom( Dir ), atom( Dir ),
format(' ************* GRAPH: ~a ***********************/~n', [Dir]), format(' ************* GRAPH: ~a ***********************/~n', [Dir]),
atom_concat([Dir,'/*'], Pattern), atom_concat([Dir,'/*'], Pattern),
expand_file_name( Pattern, Files ), expand_file_name( Pattern, Files ),
member( File, Files ), member( File, Files ),
( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) -> ( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) ->
@ -18,7 +18,7 @@ pl_graphs(Dir - Mod) :-
pl_graphs(_). 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 % adds a node to the file graph and marks which files are modules
% %
% main side-effect facts like edge( F0-Mod:File ) % 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 ), catch( open(PF, read, S, [script(true)]), _, fail ),
repeat, repeat,
nb_getval( current_module, MR ), 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 T == end_of_file
-> ->
@ -76,7 +76,7 @@ get_graph( (H :- B), F, _Pos, M ) :-
!, !,
functor( H, N, Ar), functor( H, N, Ar),
add_deps( B, M, M:N/Ar, F, _Pos, 0 ). 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 ) :- get_graph( (:-include( Fs ) ), F, _Pos, M ) :-
!, !,
source_graphs( M, F, Fs ). 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(A, M, P, F, _Pos, 0).
add_deps([_|_], M, P, F, Pos, 2) :- 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(String, _M, _P, _F, _Pos, _) :- string(String), !.
add_deps([], _M, _P, _F, _Pos, 2) :- !. add_deps([], _M, _P, _F, _Pos, 2) :- !.
add_deps(!, _M, _P, _F, _Pos, _) :- !. add_deps(!, _M, _P, _F, _Pos, _) :- !.
@ -131,32 +131,13 @@ add_deps(A, M, P, F, Pos, L) :-
Ar is Ar0+L, Ar is Ar0+L,
put_dep( ( F-M:P :- F-M:N/Ar ), Pos ). put_dep( ( F-M:P :- F-M:N/Ar ), Pos ).
put_dep( (Target :- F0-M:Goal ), Pos ) :- put_dep( (Target :- F0-M:Goal ), _Pos ) :-
exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !, ground(F0-M:Goal), !,
%follow ancestor chain assert_new_e( ( Target :- F0-M:N/Ar ) ).
ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ), put_dep(_,_).
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) ).
ancestor( ( Younger :- Older) ) :- % prolog is visible ( but maybe not same file ).
exported( ( Mid :- Older ) ), !,
ancestor( ( Younger :- Mid) ).
ancestor( (Older :- Older) ).
m_exists(P, F) :- private( F, P ), !. m_exists(P, F) :- private( F, P ), !.
m_exists(P, F) :- public( F, P ). m_exists(P, F) :- public( F, P ).

555
utils/analysis/load.yap
View File

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

255
utils/sysgraph
View File

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