diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index 7f0f4715d..dced857f4 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -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() diff --git a/pl/bootlists.yap b/pl/bootlists.yap new file mode 100644 index 000000000..39e631347 --- /dev/null +++ b/pl/bootlists.yap @@ -0,0 +1,140 @@ +/** + * @file pl/lists.yap + * @author VITOR SANTOS COSTA + * @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) ). + +%% @} + diff --git a/regression/modules/L b/regression/modules/L deleted file mode 100644 index 463dd4649..000000000 --- a/regression/modules/L +++ /dev/null @@ -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 -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 diff --git a/utils/analysis/graphs.yap b/utils/analysis/graphs.yap index e8dd831e9..5827c30ab 100644 --- a/utils/analysis/graphs.yap +++ b/utils/analysis/graphs.yap @@ -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 ). + diff --git a/utils/analysis/load.yap b/utils/analysis/load.yap index 616ba683e..6559ea630 100644 --- a/utils/analysis/load.yap +++ b/utils/analysis/load.yap @@ -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. + diff --git a/utils/sysgraph b/utils/sysgraph index 7d5b6d2f3..cc67b78e0 100755 --- a/utils/sysgraph +++ b/utils/sysgraph @@ -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. + \ No newline at end of file