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

Merge branch 'master' of ssh://ssh.dcc.fc.up.pt:31064/home/vsc/yap

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-01-30 11:18:09 +00:00
commit 847edfd432
7 changed files with 481 additions and 522 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/errors.c
View File

@ -1030,6 +1030,13 @@ static Int print_exception(USES_REGS1) {
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsAddressTerm(t1)) { if (IsAddressTerm(t1)) {
yap_error_descriptor_t *t = AddressOfTerm(t1); yap_error_descriptor_t *t = AddressOfTerm(t1);
if (t->parserFile && t->parserLine) {
fprintf(stderr,"\n%s:%ld:0 error: while parsing %s\n\n", t->parserFile, t->parserLine,t->errorAsText);
} else if (t->prologPredFile && t->prologPredLine) {
fprintf(stderr,"\n%s:%ld:0 error: while running %s\n\n", t->prologPredFile, t->prologPredLine,t->errorAsText);
} else if (t->errorFile && t->errorLine) {
fprintf(stderr,"\n%s:%ld:0 error: while executing %s\n\n", t->errorFile, t->errorLine,t->errorAsText);
}
printErr(t); printErr(t);
} else { } else {
return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS); return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS);

2
C/globals.c
View File

@ -228,7 +228,7 @@ static Int p_default_arena_size(USES_REGS1) {
return Yap_unify(ARG1, MkIntegerTerm(ArenaSz(LOCAL_GlobalArena))); return Yap_unify(ARG1, MkIntegerTerm(ArenaSz(LOCAL_GlobalArena)));
} }
void Yap_AllocateDefaultArena(Int gsize, Int attsize, int wid) { void Yap_AllocateDefaultArena(size_t gsize, int wid) {
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL); REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL);
} }

17
C/write.c
View File

@ -726,8 +726,6 @@ static void write_list(Term t, int direction, int depth,
nrwt.u_sd.s.ptr = 0; nrwt.u_sd.s.ptr = 0;
while (1) { while (1) {
int ndirection;
int do_jump;
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t); ti = TailOfTerm(t);
@ -735,18 +733,6 @@ static void write_list(Term t, int direction, int depth,
break; break;
if (!IsPairTerm(ti)) if (!IsPairTerm(ti))
break; break;
ndirection = RepPair(ti) - RepPair(t);
/* make sure we're not trapped in loops */
if (ndirection > 0) {
do_jump = (direction <= 0);
} else if (ndirection == 0) {
wrputc(',', wglb->stream);
putAtom(AtomFoundVar, wglb->Quote_illegal, wglb);
lastw = separator;
return;
} else {
do_jump = (direction >= 0);
}
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
if (lastw == symbol || lastw == separator) { if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
@ -756,10 +742,7 @@ static void write_list(Term t, int direction, int depth,
return; return;
} }
lastw = separator; lastw = separator;
direction = ndirection;
depth++; depth++;
if (do_jump)
break;
wrputc(',', wglb->stream); wrputc(',', wglb->stream);
t = ti; t = ti;
} }

819
pl/absf.yap
View File

@ -1,4 +1,4 @@
qqqqq/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
@ -30,14 +30,413 @@ qqqqq/*************************************************************************
add_to_path/1, add_to_path/1,
add_to_path/2, add_to_path/2,
path/1, path/1,
remove_from_path/1], ['$full_filename'/2, remove_from_path/1]).
'$system_library_directories'/2]).
:- use_system_module( '$_boot', ['$system_catch'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]). absolute_file_name__(File,LOpts,TrueFileName) :-
% must_be_of_type( atom, File ),
% look for solutions
gated_call(
:- use_system_module( '$_lists', [member/2]). '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ),
'$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst),
Port,
'$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors )
).
'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
( var(File) -> instantiation_error(File) ; true),
abs_file_parameters(LOpts,Opts),
current_prolog_flag(open_expands_filename, OldF),
current_prolog_flag( fileerrors, PreviousFileErrors ),
current_prolog_flag( verbose_file_search, PreviousVerbose ),
get_abs_file_parameter( verbose_file_search, Opts,Verbose ),
get_abs_file_parameter( expand, Opts, Expand ),
set_prolog_flag( verbose_file_search, Verbose ),
get_abs_file_parameter( file_errors, Opts, FErrors ),
get_abs_file_parameter( solutions, Opts, TakeFirst ),
( FErrors == fail -> FileErrors = false ; FileErrors = true ),
set_prolog_flag( fileerrors, FileErrors ),
set_prolog_flag(file_name_variables, Expand),
absf_trace(File),
'$absf_trace_options'(LOpts),
HasSol = t(no).
'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
'$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :-
(TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( open_expands_filename, OldF),
set_prolog_flag( verbose_file_search, PreviousVerbose ),
absf_trace(' |------- found ~a', [TrueFileName]).
'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :-
set_prolog_flag( fileerrors, FileErrors ),
set_prolog_flag( verbose_file_search, Verbose ),
set_prolog_flag( file_name_variables, Expand ),
absf_trace(' |------- restarted search for ~a', [File]).
'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :-
absf_trace(' !------- failed.', []),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( verbose_file_search, PreviousVerbose ),
set_prolog_flag(file_name_variables, OldF),
% check if no solution
arg(1,HasSol,no),
FileErrors = error,
'$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])).
'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ).
'$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
'$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
core_file_name(Name, Opts) -->
'$file_name'(Name, Opts, E),
'$suffix'(E, Opts),
'$glob'(Opts).
%
% handle library(lists) or foreign(jpl)
%
'$file_name'(Name, Opts, E) -->
{ Name =.. [Lib, P0] },
!,
{ user:file_search_path(Lib, IDirs) },
{ '$paths'(IDirs, Dir ) },
absf_trace(' ~w first', [Dir]),
'$file_name'(Dir, Opts, _),
'$dir',
{ absf_trace(' ~w next', [P0]) },
'$cat_file_name'(P0, E).
'$file_name'(Name, _Opts, E) -->
'$cat_file_name'(Name, E ).
/*
(
{
get_abs_file_parameter( file_type, _Opts, Lib ),
nonvar(Lib)
}
->
{ user:file_search_path(Lib, IDirs) },
{ '$paths'(IDirs, Dir ) },
absf_trace(' ~w first', [Dir]),
'$file_name'(Dir, Opts, _),
'$dir',
{ absf_trace(' ~w next', [P0]) }
;
[]
).
*/
'$cat_file_name'(A/B, E ) -->
'$cat_file_name'(A, _),
'$dir',
'$cat_file_name'(B, E).
'$cat_file_name'(File, F) -->
{ atom(File), atom_codes(File, F) },
!,
F.
'$cat_file_name'(File, S) -->
{string(File), string_codes(File, S) },
S.
'$variable_expansion'( Path, Opts, APath ) :-
get_abs_file_parameter( expand, Opts, true ),
!,
'$expand_file_name'( Path, APath ).
'$variable_expansion'( Path, _, Path ).
'$var'(S) -->
"{", !, '$id'(S), "}".
'$var'(S) -->
'$id'(S).
'$drive'(C) -->
'$id'(C),
":\\\\".
'$id'([C|S]) --> [C],
{ C >= "a", C =< "z" ; C >= "A", C =< "Z" ;
C >= "0", C =< "9" ; C =:= "_" },
!,
'$id'(S).
'$id'([]) --> [].
% always verify if a directory
'$check_file'(F, directory, _) :-
!,
exists_directory(F).
'$check_file'(_F, _Type, none) :- !.
'$check_file'(F, _Type, exist) :-
'$access_file'(F, exist). % if it has a type cannot be a directory..
'$check_file'(F, _Type, Access) :-
'$access_file'(F, Access),
\+ exists_directory(F). % if it has a type cannot be a directory..
'$suffix'(Last, _Opts) -->
{ lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
absf_trace(' suffix in ~s', [Alphas]),
!.
'$suffix'(_, Opts) -->
{
(
get_abs_file_parameter( extensions, Opts, Exts ),
Exts \= []
->
lists:member(Ext, Exts),
absf_trace(' trying suffix ~a from ~w', [Ext,Exts])
;
get_abs_file_parameter( file_type, Opts, Type ),
( Type == source -> NType = prolog ; NType = Type ),
user:prolog_file_type(Ext, NType)
),
absf_trace(' trying suffix ~a from type ~a', [Ext, NType]),
atom_codes(Ext, Cs)
},
'$add_suffix'(Cs).
'$suffix'(_,_Opts) -->
absf_trace(' try no suffix', []).
'$add_suffix'(Cs) -->
(
{ Cs = [0'. |_Codes] }
->
Cs
;
".", Cs ).
'$glob'(Opts) -->
{
get_abs_file_parameter( glob, Opts, G ),
G \= '',
atom_codes( G, Gs )
},
!,
'$dir',
Gs.
'$glob'(_Opts) -->
[].
'$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
!.
'$enumerate_glob'(_File1, ExpFiles, ExpFile) :-
lists:member(ExpFile, ExpFiles),
file_base_name( ExpFile, Base ),
Base \= '.',
Base \='..'.
'$file_prefix'( CorePath, _Opts) -->
{ is_absolute_file_name( CorePath ) },
!,
CorePath.
'$file_prefix'( CorePath, Opts) -->
{ get_abs_file_parameter( relative_to, Opts, File_Prefix ),
File_Prefix \= '',
absf_trace(' relative_to ~a', [File_Prefix]),
sub_atom(File_Prefix, _, 1, 0, Last),
atom_codes(File_Prefix, S)
},
!,
S,
'$dir'(Last),
CorePath.
'$file_prefix'( CorePath, _) -->
{
recorded('$path',File_Prefix,_),
absf_trace(' try YAP path database ~a', [File_Prefix]),
sub_atom(File_Prefix, _, _, 1, Last),
atom_codes(File_Prefix, S) },
S,
'$dir'(Last),
CorePath.
'$file_prefix'(CorePath, _ ) -->
absf_trace(' empty file_prefix ', []),
CorePath.
'$dir' --> { current_prolog_flag(windows, true) },
"\\",
!.
'$dir' --> "/".
'$dir'('/') --> !.
'$dir'('\\') --> { current_prolog_flag(windows, true) },
!.
'$dir'(_) --> '$dir'.
%
%
%
'$system_library_directories'(library, Dir) :-
user:library_directory( Dir ).
% '$split_by_sep'(0, 0, Dirs, Dir).
'$system_library_directories'(foreign, Dir) :-
user:foreign_directory( Dir ).
% compatibility with old versions
%
% search the current directory first.
'$system_library_directories'(commons, Dir) :-
user:commons_directory( Dir ).
% enumerate all paths separated by a path_separator.
'$paths'(Cs, C) :-
atom(Cs),
( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
sub_atom(Cs, N0, 1, N, Sep),
!,
(
sub_atom(Cs,0,N0,_,C)
;
sub_atom(Cs,_,N,0,RC),
'$paths'(RC, C)
).
'$paths'(S, S).
absf_trace(Msg, Args ) -->
{ current_prolog_flag( verbose_file_search, true ) },
{ print_message( informational, absolute_file_path( Msg, Args ) ) },
!.
absf_trace(_Msg, _Args ) --> [].
absf_trace(Msg, Args ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, absolute_file_path( Msg, Args ) ),
!.
absf_trace(_Msg, _Args ).
absf_trace( File ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, absolute_file_path( File ) ),
!.
absf_trace( _File ).
'$absf_trace_options'(Args ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, arguments( Args ) ),
!.
'$absf_trace_options'( _Args ).
/** @pred prolog_file_name( +File, -PrologFileaNme)
Unify _PrologFileName_ with the Prolog file associated to _File_.
*/
prolog_file_name(File, PrologFileName) :-
var(File), !,
'$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)).
prolog_file_name(user, Out) :- !, Out = user.
prolog_file_name(File, PrologFileName) :-
atom(File), !,
system:true_file_name(File, PrologFileName).
prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
/**
@pred path(-Directories:list) is det,deprecated
YAP specific procedure that returns a list of user-defined directories
in the library search-path.We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
path(Path) :-
findall(X,'$in_path'(X),Path).
'$in_path'(X) :-
recorded('$path',Path,_),
atom_codes(Path,S),
( S = [] -> X = '.' ;
atom_codes(X,S) ).
/**
@pred add_to_path(+Directory:atom) is det,deprecated
YAP-specific predicate to include directory in library search path.
We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
add_to_path(New) :-
add_to_path(New,last).
/**
@pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated
YAP-specific predicate to include directory in front or back of
library search path. We suggest using user:file_search_path/2 for
compatibility with other Prologs and more extensive functionality.
*/
add_to_path(New,Pos) :-
atom(New), !,
'$check_path'(New,Str),
atom_codes(Path,Str),
'$add_to_path'(Path,Pos).
'$add_to_path'(New,_) :-
recorded('$path',New,R),
erase(R),
fail.
'$add_to_path'(New,last) :-
!,
recordz('$path',New,_).
'$add_to_path'(New,first) :-
recorda('$path',New,_).
/** @pred remove_from_path(+Directory:atom) is det,deprecated
@}
*/
remove_from_path(New) :- '$check_path'(New,Path),
recorded('$path',Path,R), erase(R).
'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
'$check_path'([],[]).
'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).
% This sequence must be followed:
% user and user_input are special;
% library(F) must check library_directories
% T(F) must check file_search_path
% all must try search in path
'$find_in_path'(user,_,user_input, _, _) :- !.
'$find_in_path'(user_input,_,user_input, _, _) :- !.
'$find_in_path'(user_output,_,user_ouput, _, _) :- !.
'$find_in_path'(user_error,_,user_error, _, _) :- !.
'$find_in_path'(Name, Opts, File, _, First) :-
% ( atom(Name) -> true ; start_low_level_trace ),
get_abs_file_parameter( file_type, Opts, Type ),
get_abs_file_parameter( access, Opts, Access ),
get_abs_file_parameter( expand, Opts, Expand ),
absf_trace('start with ~w', [Name]),
core_file_name(Name, Opts, CorePath, []),
absf_trace(' after name/library unfolding: ~w', [Name]),
'$variable_expansion'(CorePath, Opts,ExpandedPath),
absf_trace(' after environment variable expansion: ~s', [ExpandedPath]),
'$file_prefix'(ExpandedPath, Opts, Path , []),
absf_trace(' after file_prefix expansion: ~s', [Path]),
atom_codes( APath, Path ),
(
Expand = true
->
expand_file_name( APath, EPaths),
absf_trace(' after shell globbing: ~w', [EPaths]),
lists:member(EPath, EPaths)
;
EPath = APath
),
real_path( EPath, File),
absf_trace(' after canonical path name: ~a', [File]),
'$check_file'( File, Type, Access ),
absf_trace(' after testing ~a for ~a and ~a', [File,Type,Access]),
(First == first -> ! ; true ).
/** /**
@ -144,7 +543,7 @@ absolute_file_name(File,TrueFileName,Opts) :-
!, !,
absolute_file_name(File,Opts,TrueFileName). absolute_file_name(File,Opts,TrueFileName).
absolute_file_name(File,Opts,TrueFileName) :- absolute_file_name(File,Opts,TrueFileName) :-
'$absolute_file_name'(File,Opts,TrueFileName). absolute_file_name__(File,Opts,TrueFileName).
/** /**
@pred absolute_file_name(+Name:atom,+Path:atom) is nondet @pred absolute_file_name(+Name:atom,+Path:atom) is nondet
@ -156,408 +555,4 @@ absolute_file_name(V,Out) :- var(V),
'$do_error'(instantiation_error, absolute_file_name(V, Out)). '$do_error'(instantiation_error, absolute_file_name(V, Out)).
absolute_file_name(user,user) :- !. absolute_file_name(user,user) :- !.
absolute_file_name(File0,File) :- absolute_file_name(File0,File) :-
'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File). absolute_file_name__(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File).
'$absolute_file_name'(File,LOpts,TrueFileName) :-
% must_be_of_type( atom, File ),
% look for solutions
gated_call(
'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ),
'$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst),
Port,
'$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors )
).
'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
( var(File) -> instantiation_error(File) ; true),
abs_file_parameters(LOpts,Opts),
current_prolog_flag(open_expands_filename, OldF),
current_prolog_flag( fileerrors, PreviousFileErrors ),
current_prolog_flag( verbose_file_search, PreviousVerbose ),
get_abs_file_parameter( verbose_file_search, Opts,Verbose ),
get_abs_file_parameter( expand, Opts, Expand ),
set_prolog_flag( verbose_file_search, Verbose ),
get_abs_file_parameter( file_errors, Opts, FErrors ),
get_abs_file_parameter( solutions, Opts, TakeFirst ),
( FErrors == fail -> FileErrors = false ; FileErrors = true ),
set_prolog_flag( fileerrors, FileErrors ),
set_prolog_flag(file_name_variables, Expand),
'$absf_trace'(File),
'$absf_trace_options'(LOpts),
HasSol = t(no).
'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
'$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :-
(TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( open_expands_filename, OldF),
set_prolog_flag( verbose_file_search, PreviousVerbose ),
'$absf_trace'(' |------- found ~a', [TrueFileName]).
'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :-
set_prolog_flag( fileerrors, FileErrors ),
set_prolog_flag( verbose_file_search, Verbose ),
set_prolog_flag( file_name_variables, Expand ),
'$absf_trace'(' |------- restarted search for ~a', [File]).
'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :-
'$absf_trace'(' !------- failed.', []),
set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( verbose_file_search, PreviousVerbose ),
set_prolog_flag(file_name_variables, OldF),
% check if no solution
arg(1,HasSol,no),
FileErrors = error,
'$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])).
'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ).
'$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
'$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
% This sequence must be followed:
% user and user_input are special;
% library(F) must check library_directories
% T(F) must check file_search_path
% all must try search in path
'$find_in_path'(user,_,user_input, _, _) :- !.
'$find_in_path'(user_input,_,user_input, _, _) :- !.
'$find_in_path'(user_output,_,user_ouput, _, _) :- !.
'$find_in_path'(user_error,_,user_error, _, _) :- !.
'$find_in_path'(Name, Opts, File, _, First) :-
% ( atom(Name) -> true ; start_low_level_trace ),
get_abs_file_parameter( file_type, Opts, Type ),
get_abs_file_parameter( access, Opts, Access ),
get_abs_file_parameter( expand, Opts, Expand ),
'$absf_trace'('start with ~w', [Name]),
'$core_file_name'(Name, Opts, CorePath, []),
'$absf_trace'(' after name/library unfolding: ~w', [Name]),
'$variable_expansion'(CorePath, Opts,ExpandedPath),
'$absf_trace'(' after environment variable expansion: ~s', [ExpandedPath]),
'$file_prefix'(ExpandedPath, Opts, Path , []),
'$absf_trace'(' after file_prefix expansion: ~s', [Path]),
atom_codes( APath, Path ),
(
Expand = true
->
expand_file_name( APath, EPaths),
'$absf_trace'(' after shell globbing: ~w', [EPaths]),
lists:member(EPath, EPaths)
;
EPath = APath
),
real_path( EPath, File),
'$absf_trace'(' after canonical path name: ~a', [File]),
'$check_file'( File, Type, Access ),
'$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]),
(First == first -> ! ; true ).
% allow paths in File Name
'$core_file_name'(Name, Opts) -->
'$file_name'(Name, Opts, E),
'$suffix'(E, Opts),
'$glob'(Opts).
%
% handle library(lists) or foreign(jpl)
%
'$file_name'(Name, Opts, E) -->
{ Name =.. [Lib, P0] },
!,
{ user:file_search_path(Lib, IDirs) },
{ '$paths'(IDirs, Dir ) },
'$absf_trace'(' ~w first', [Dir]),
'$file_name'(Dir, Opts, _),
'$dir',
{ '$absf_trace'(' ~w next', [P0]) },
'$cat_file_name'(P0, E).
'$file_name'(Name, _Opts, E) -->
'$cat_file_name'(Name, E ).
/*
(
{
get_abs_file_parameter( file_type, _Opts, Lib ),
nonvar(Lib)
}
->
{ user:file_search_path(Lib, IDirs) },
{ '$paths'(IDirs, Dir ) },
'$absf_trace'(' ~w first', [Dir]),
'$file_name'(Dir, Opts, _),
'$dir',
{ '$absf_trace'(' ~w next', [P0]) }
;
[]
).
*/
'$cat_file_name'(A/B, E ) -->
'$cat_file_name'(A, _),
'$dir',
'$cat_file_name'(B, E).
'$cat_file_name'(File, F) -->
{ atom(File), atom_codes(File, F) },
!,
F.
'$cat_file_name'(File, S) -->
{string(File), string_codes(File, S) },
S.
'$variable_expansion'( Path, Opts, APath ) :-
get_abs_file_parameter( expand, Opts, true ),
!,
'$expand_file_name'( Path, APath ).
'$variable_expansion'( Path, _, Path ).
'$var'(S) -->
"{", !, '$id'(S), "}".
'$var'(S) -->
'$id'(S).
'$drive'(C) -->
'$id'(C),
":\\\\".
'$id'([C|S]) --> [C],
{ C >= "a", C =< "z" ; C >= "A", C =< "Z" ;
C >= "0", C =< "9" ; C =:= "_" },
!,
'$id'(S).
'$id'([]) --> [].
% always verify if a directory
'$check_file'(F, directory, _) :-
!,
exists_directory(F).
'$check_file'(_F, _Type, none) :- !.
'$check_file'(F, _Type, exist) :-
'$access_file'(F, exist). % if it has a type cannot be a directory..
'$check_file'(F, _Type, Access) :-
'$access_file'(F, Access),
\+ exists_directory(F). % if it has a type cannot be a directory..
'$suffix'(Last, _Opts) -->
{ lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
'$absf_trace'(' suffix in ~s', [Alphas]),
!.
'$suffix'(_, Opts) -->
{
(
get_abs_file_parameter( extensions, Opts, Exts ),
Exts \= []
->
lists:member(Ext, Exts),
'$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts])
;
get_abs_file_parameter( file_type, Opts, Type ),
( Type == source -> NType = prolog ; NType = Type ),
user:prolog_file_type(Ext, NType)
),
'$absf_trace'(' trying suffix ~a from type ~a', [Ext, NType]),
atom_codes(Ext, Cs)
},
'$add_suffix'(Cs).
'$suffix'(_,_Opts) -->
'$absf_trace'(' try no suffix', []).
'$add_suffix'(Cs) -->
(
{ Cs = [0'. |_Codes] }
->
Cs
;
".", Cs ).
'$glob'(Opts) -->
{
get_abs_file_parameter( glob, Opts, G ),
G \= '',
atom_codes( G, Gs )
},
!,
'$dir',
Gs.
'$glob'(_Opts) -->
[].
'$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
!.
'$enumerate_glob'(_File1, ExpFiles, ExpFile) :-
lists:member(ExpFile, ExpFiles),
file_base_name( ExpFile, Base ),
Base \= '.',
Base \='..'.
'$file_prefix'( CorePath, _Opts) -->
{ is_absolute_file_name( CorePath ) },
!,
CorePath.
'$file_prefix'( CorePath, Opts) -->
{ get_abs_file_parameter( relative_to, Opts, File_Prefix ),
File_Prefix \= '',
'$absf_trace'(' relative_to ~a', [File_Prefix]),
sub_atom(File_Prefix, _, 1, 0, Last),
atom_codes(File_Prefix, S)
},
!,
S,
'$dir'(Last),
CorePath.
'$file_prefix'( CorePath, _) -->
{
recorded('$path',File_Prefix,_),
'$absf_trace'(' try YAP path database ~a', [File_Prefix]),
sub_atom(File_Prefix, _, _, 1, Last),
atom_codes(File_Prefix, S) },
S,
'$dir'(Last),
CorePath.
'$file_prefix'(CorePath, _ ) -->
'$absf_trace'(' empty file_prefix ', []),
CorePath.
'$dir' --> { current_prolog_flag(windows, true) },
"\\",
!.
'$dir' --> "/".
'$dir'('/') --> !.
'$dir'('\\') --> { current_prolog_flag(windows, true) },
!.
'$dir'(_) --> '$dir'.
%
%
%
'$system_library_directories'(library, Dir) :-
user:library_directory( Dir ).
% '$split_by_sep'(0, 0, Dirs, Dir).
'$system_library_directories'(foreign, Dir) :-
user:foreign_directory( Dir ).
% compatibility with old versions
%
% search the current directory first.
'$system_library_directories'(commons, Dir) :-
user:commons_directory( Dir ).
% enumerate all paths separated by a path_separator.
'$paths'(Cs, C) :-
atom(Cs),
( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
sub_atom(Cs, N0, 1, N, Sep),
!,
(
sub_atom(Cs,0,N0,_,C)
;
sub_atom(Cs,_,N,0,RC),
'$paths'(RC, C)
).
'$paths'(S, S).
'$absf_trace'(Msg, Args ) -->
{ current_prolog_flag( verbose_file_search, true ) },
{ print_message( informational, absolute_file_path( Msg, Args ) ) },
!.
'$absf_trace'(_Msg, _Args ) --> [].
'$absf_trace'(Msg, Args ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, absolute_file_path( Msg, Args ) ),
!.
'$absf_trace'(_Msg, _Args ).
'$absf_trace'( File ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, absolute_file_path( File ) ),
!.
'$absf_trace'( _File ).
'$absf_trace_options'(Args ) :-
current_prolog_flag( verbose_file_search, true ),
print_message( informational, arguments( Args ) ),
!.
'$absf_trace_options'( _Args ).
/** @pred prolog_file_name( +File, -PrologFileaNme)
Unify _PrologFileName_ with the Prolog file associated to _File_.
*/
prolog_file_name(File, PrologFileName) :-
var(File), !,
'$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)).
prolog_file_name(user, Out) :- !, Out = user.
prolog_file_name(File, PrologFileName) :-
atom(File), !,
system:true_file_name(File, PrologFileName).
prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
/**
@pred path(-Directories:list) is det,deprecated
YAP specific procedure that returns a list of user-defined directories
in the library search-path.We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
path(Path) :-
findall(X,'$in_path'(X),Path).
'$in_path'(X) :-
recorded('$path',Path,_),
atom_codes(Path,S),
( S = [] -> X = '.' ;
atom_codes(X,S) ).
/**
@pred add_to_path(+Directory:atom) is det,deprecated
YAP-specific predicate to include directory in library search path.
We suggest using user:file_search_path/2 for
compatibility with other Prologs.
*/
add_to_path(New) :-
add_to_path(New,last).
/**
@pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated
YAP-specific predicate to include directory in front or back of
library search path. We suggest using user:file_search_path/2 for
compatibility with other Prologs and more extensive functionality.
*/
add_to_path(New,Pos) :-
atom(New), !,
'$check_path'(New,Str),
atom_codes(Path,Str),
'$add_to_path'(Path,Pos).
'$add_to_path'(New,_) :-
recorded('$path',New,R),
erase(R),
fail.
'$add_to_path'(New,last) :-
!,
recordz('$path',New,_).
'$add_to_path'(New,first) :-
recorda('$path',New,_).
/** @pred remove_from_path(+Directory:atom) is det,deprecated
@}
*/
remove_from_path(New) :- '$check_path'(New,Path),
recorded('$path',Path,R), erase(R).
'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
'$check_path'([],[]).
'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).

125
pl/boot.yap
View File

@ -28,13 +28,33 @@
*/ */
/**
* @pred system_module( +_Mod_, +_ListOfPublicPredicates, +ListOfPrivatePredicates *
* Define a system module _Mod_. _ListOfPublicPredicates_ . Currentlt, all
* predicates are in the 'prolog' module. The first
* are visible outside the Prolog module, all others are hidden at the end of booting.
*
*/
system_module(Mod, SysExps) :-
system_module(Mod, SysExps, []).
system_module(_Mod, _SysExps, _Decls). system_module(_Mod, SysExps, _Decls) :-
% new_system_module(Mod). (
'$new_system_predicates'(SysExps),
fail
;
stream_property(loop_stream,file_name(File))
->
recordz(system_file, File, _ )
;
recordz(system_file, loop_stream, _ )
).
use_system_module(_Module, _SysExps). '$new_system_predicates'([P|_Ps]) :-
functor(P, N, Ar),
private(_). '$new_system_predicate'(N, Ar, prolog).
'$new_system_predicates'([_P|Ps]) :-
'$new_system_predicates'(Ps).
% %
% boootstrap predicates. % boootstrap predicates.
@ -45,93 +65,41 @@ private(_).
catch/3, catch/3,
catch_ball/2, catch_ball/2,
expand_term/2, expand_term/2,
print_message/2,
import_system_module/2, import_system_module/2,
system_module/2,
private/1,
incore/1, incore/1,
(not)/1, (not)/1,
repeat/0, repeat/0,
throw/1, throw/1,
true/0], ['$$compile'/4, true/0]).
'$call'/4,
'$catch'/3,
'$check_head_and_body'/4,
'$check_if_reconsulted'/2,
'$clear_reconsulting'/0,
'$command'/4,
'$cut_by'/1,
'$disable_debugging'/0,
'$do_live'/0,
'$'/0,
'$find_goal_definition'/4,
'$head_and_body'/3,
'$inform_as_reconsulted'/2,
'$init_system'/0,
'$init_win_graphics'/0,
'$loop'/2,
'$meta_call'/2,
'$prompt_alternatives_on'/1,
'$run_at_thread_start'/0,
'$system_catch'/4,
'$undefp'/1,
'$version'/0]).
:- use_system_module( '$_absf', ['$system_library_directories'/2]).
:- use_system_module( '$_checker', ['$check_term'/5,
'$sv_warning'/2]).
:- use_system_module( '$_consult', ['$csult'/2]).
:- use_system_module( '$_control', ['$run_atom_goal'/1]).
:- use_system_module( '$_directives', ['$all_directives'/1,
'$exec_directives'/5]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_grammar', ['$translate_rule'/2]).
:- use_system_module( '$_modules', ['$get_undefined_pred'/4,
'$meta_expansion'/6,
'$module_expansion'/6]).
:- use_system_module( '$_preddecls', ['$dynamic'/2]).
:- use_system_module( '$_preds', ['$assert_static'/5,
'$assertz_dynamic'/4,
'$init_preds'/0,
'$unknown_error'/1,
'$unknown_warning'/1]).
:- use_system_module( '$_qly', ['$init_state'/0]).
:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
'$iso_check_goal'/2]).
% be careful here not to generate an undefined exception.. % be careful here not to generate an undefined exception..
use_system_module(_,_).
private(_).
print_message(L,E) :- print_message(L,E) :-
%stop_low_level_trace,
'$number_of_clauses'(print_message(L,E), prolog_complete, 1),
!,
(L = informational (L = informational
-> ->
true '$query_exception'(prologPredFile, Desc, File),
'$query_exception'(prologPredLine, Desc, FilePos),
format(user_error,'~a:~d: error:', [File,FilePos])
; ;
system_error(_,Info),
'$error_descriptor'(Info, Desc), %throw(error(error, print_message(['while calling goal = ~w'-E,nl]))).
query_exception(prologPredFile, Desc, File), '$get_exception'(Desc),
query_exception(prologPredLine, Desc, FilePos), '$query_exception'(prologPredFile, Desc, File),
'$query_exception'(prologPredLine, Desc, FilePos),
format(user_error,'~a:~d: error:', [File,FilePos]), format(user_error,'~a:~d: error:', [File,FilePos]),
'$print_exception'(Info), '$print_exception'(Desc),
format( user_error, '~w from bootstrap: got ~w~n',[L,E]) format( user_error, '~w from bootstrap: got ~w~n',[L,E])
). ).
'$undefp0'([M|G], _Action) :- '$undefp0'([M|G], _Action) :-
stream_property( loop_stream, [file_name(F), line_number(L)]), functor(G,N,A),
format(user_error,'~a:~d: error: undefined ~w~n:',[F,L,M:G]), print_message( error, error(error(unknown, M:N/A),M:G)),
fail
;
format(user_error,' call to undefined procedure ~w~n',[M:G]),
fail. fail.
:- '$undefp_handler'('$undefp0'(_,_),prolog). :- '$undefp_handler'('$undefp0'(_,_),prolog).
@ -172,6 +140,7 @@ print_message(L,E) :-
otherwise/0, otherwise/0,
term_expansion/2, term_expansion/2,
version/2, version/2,
[
'$do_log_upd_clause'/6, '$do_log_upd_clause'/6,
'$do_log_upd_clause0'/6, '$do_log_upd_clause0'/6,
'$do_log_upd_clause_erase'/6, '$do_log_upd_clause_erase'/6,
@ -232,7 +201,11 @@ print_message(L,E) :-
'$execute_command'(EG,EM,VL,Pos,Con,C) ; '$execute_command'(EG,EM,VL,Pos,Con,C) ;
% do term expansion % do term expansion
'$expand_term'(C, Con, EC), '$expand_term'(C, Con, EC),
'$yap_strip_module'(EC, EM2, EG2), ( var(EC) ->
'$yap_strip_module'(EC, EM2, EG2)
;
'$yap_strip_module'(C, EM2, EG2)
),
% execute a list of commands % execute a list of commands
'$execute_commands'(EG2,EM2,VL,Pos,Con,_Source) '$execute_commands'(EG2,EM2,VL,Pos,Con,_Source)
), ),

12
pl/consult.yap
View File

@ -516,8 +516,8 @@ load_files(Files0,Opts) :-
'$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :- '$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :-
% check if there is a qly file % check if there is a qly file
% start_low_level_trace, % start_low_level_trace,
'$pred_exists'('$absolute_file_name'(File,[],F),prolog), '$pred_exists'(absolute_file_name__(File,[],F),prolog),
'$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), absolute_file_name__(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F),
open( F, read, Stream , [type(binary)] ), open( F, read, Stream , [type(binary)] ),
( (
'$q_header'( Stream, Type ), '$q_header'( Stream, Type ),
@ -804,7 +804,7 @@ db_files(Fs) :-
'$lf_opt'('$source_pos', TOpts, Pos), '$lf_opt'('$source_pos', TOpts, Pos),
'$lf_opt'('$from_stream', TOpts, false), '$lf_opt'('$from_stream', TOpts, false),
( QComp == auto ; QComp == large, Pos > 100*1024), ( QComp == auto ; QComp == large, Pos > 100*1024),
'$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F), absolute_file_name__(UserF,[file_type(qly),solutions(first),expand(true)],F),
!, !,
'$qsave_file_'( File, UserF, F ). '$qsave_file_'( File, UserF, F ).
'$q_do_save_file'(_File, _, _TOpts ). '$q_do_save_file'(_File, _, _TOpts ).
@ -1043,7 +1043,7 @@ prolog_load_context(stream, Stream) :-
%format( 'L=~w~n', [(F0)] ), %format( 'L=~w~n', [(F0)] ),
( (
atom_concat(Prefix, '.qly', F0 ), atom_concat(Prefix, '.qly', F0 ),
'$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) absolute_file_name__(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F)
; ;
F0 = F F0 = F
), ),
@ -1150,11 +1150,11 @@ exists_source(File) :-
'$full_filename'(F0, F) :- '$full_filename'(F0, F) :-
'$undefined'('$absolute_file_name'(F0,[],F),prolog_complete), '$undefined'(absolute_file_name__(F0,[],F),prolog_complete),
!, !,
absolute_file_system_path(F0, F). absolute_file_system_path(F0, F).
'$full_filename'(F0, F) :- '$full_filename'(F0, F) :-
'$absolute_file_name'(F0,[access(read), absolute_file_name__(F0,[access(read),
file_type(prolog), file_type(prolog),
file_errors(fail), file_errors(fail),
solutions(first), solutions(first),

1
pl/protect.yap
View File

@ -84,3 +84,4 @@ prolog:'$protect'.
'$visible'('$init_prolog'). '$visible'('$init_prolog').
'$visible'('$x_yap_flag' ). '$visible'('$x_yap_flag' ).
%% @} %% @}