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);
if (IsAddressTerm(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);
} else {
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)));
}
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);
}

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;
while (1) {
int ndirection;
int do_jump;
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t);
@ -735,18 +733,6 @@ static void write_list(Term t, int direction, int depth,
break;
if (!IsPairTerm(ti))
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 (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
@ -756,10 +742,7 @@ static void write_list(Term t, int direction, int depth,
return;
}
lastw = separator;
direction = ndirection;
depth++;
if (do_jump)
break;
wrputc(',', wglb->stream);
t = ti;
}

819
pl/absf.yap
View File

@ -1,4 +1,4 @@
qqqqq/*************************************************************************
/*************************************************************************
* *
* YAP Prolog *
* *
@ -30,14 +30,413 @@ qqqqq/*************************************************************************
add_to_path/1,
add_to_path/2,
path/1,
remove_from_path/1], ['$full_filename'/2,
'$system_library_directories'/2]).
remove_from_path/1]).
:- 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).
/**
@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)).
absolute_file_name(user,user) :- !.
absolute_file_name(File0,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).
absolute_file_name__(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File).

143
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).
% new_system_module(Mod).
system_module(_Mod, SysExps, _Decls) :-
(
'$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).
private(_).
'$new_system_predicates'([P|_Ps]) :-
functor(P, N, Ar),
'$new_system_predicate'(N, Ar, prolog).
'$new_system_predicates'([_P|Ps]) :-
'$new_system_predicates'(Ps).
%
% boootstrap predicates.
@ -45,94 +65,42 @@ private(_).
catch/3,
catch_ball/2,
expand_term/2,
print_message/2,
import_system_module/2,
system_module/2,
private/1,
incore/1,
(not)/1,
repeat/0,
throw/1,
true/0], ['$$compile'/4,
'$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]).
true/0]).
% be careful here not to generate an undefined exception..
use_system_module(_,_).
private(_).
print_message(L,E) :-
%stop_low_level_trace,
'$number_of_clauses'(print_message(L,E), prolog_complete, 1),
!,
(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),
query_exception(prologPredFile, Desc, File),
query_exception(prologPredLine, Desc, FilePos),
format(user_error,'~a:~d: error:', [File,FilePos]),
'$print_exception'(Info),
%throw(error(error, print_message(['while calling goal = ~w'-E,nl]))).
'$get_exception'(Desc),
'$query_exception'(prologPredFile, Desc, File),
'$query_exception'(prologPredLine, Desc, FilePos),
format(user_error,'~a:~d: error:', [File,FilePos]),
'$print_exception'(Desc),
format( user_error, '~w from bootstrap: got ~w~n',[L,E])
).
'$undefp0'([M|G], _Action) :-
stream_property( loop_stream, [file_name(F), line_number(L)]),
format(user_error,'~a:~d: error: undefined ~w~n:',[F,L,M:G]),
fail
;
format(user_error,' call to undefined procedure ~w~n',[M:G]),
fail.
functor(G,N,A),
print_message( error, error(error(unknown, M:N/A),M:G)),
fail.
:- '$undefp_handler'('$undefp0'(_,_),prolog).
@ -151,11 +119,11 @@ print_message(L,E) :-
'$compile'(G, assertz, G, prolog, _R),
'$system_meta_predicates'(L).
:- '$mk_dynamic'( prolog_file_type(_Ext, _NType), user).
:- '$new_multifile'( prolog_file_type(_Ext, _NType), user).
:- '$mk_dynamic'( prolog_file_type(_Ext, _NType), user).
:- '$new_multifile'( prolog_file_type(_Ext, _NType), user).
:- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog).
:- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog).
:- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog).
:- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog).
:- '$new_multifile'('$full_clause_optimisation'(_H, _M, _B0, _BF), prolog).
:- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog).
@ -172,7 +140,8 @@ print_message(L,E) :-
otherwise/0,
term_expansion/2,
version/2,
'$do_log_upd_clause'/6,
[
'$do_log_upd_clause'/6,
'$do_log_upd_clause0'/6,
'$do_log_upd_clause_erase'/6,
'$do_static_clause'/5], [
@ -228,15 +197,19 @@ print_message(L,E) :-
'$execute_command'(EG,EM,VL,Pos,Con,_Source).
'$command'(C,VL,Pos,Con) :-
( (Con = top ; var(C) ; C = [_|_]) ->
'$yap_strip_module'(C, EM, EG),
'$yap_strip_module'(C, EM, EG),
'$execute_command'(EG,EM,VL,Pos,Con,C) ;
% do term expansion
'$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_commands'(EG2,EM2,VL,Pos,Con,_Source)
),
% succeed only if the *original* was at end of file.
% succeed only if the *original* was at end of file.
C == end_of_file.
:- c_compile('arith.yap').

12
pl/consult.yap
View File

@ -516,8 +516,8 @@ load_files(Files0,Opts) :-
'$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :-
% check if there is a qly file
% start_low_level_trace,
'$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),
'$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),
open( F, read, Stream , [type(binary)] ),
(
'$q_header'( Stream, Type ),
@ -804,7 +804,7 @@ db_files(Fs) :-
'$lf_opt'('$source_pos', TOpts, Pos),
'$lf_opt'('$from_stream', TOpts, false),
( 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 ).
'$q_do_save_file'(_File, _, _TOpts ).
@ -1043,7 +1043,7 @@ prolog_load_context(stream, Stream) :-
%format( 'L=~w~n', [(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
),
@ -1150,11 +1150,11 @@ exists_source(File) :-
'$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).
'$full_filename'(F0, F) :-
'$absolute_file_name'(F0,[access(read),
absolute_file_name__(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),

3
pl/protect.yap
View File

@ -42,7 +42,7 @@ prolog:'$protect' :-
new_system_module( M ),
fail.
prolog:'$protect' :-
'$current_predicate'(Name,M,P,_),
'$current_predicate'(Name,M,P,_),
'$is_system_module'(M),
functor(P,Name,Arity),
'$new_system_predicate'(Name,Arity,M),
@ -84,3 +84,4 @@ prolog:'$protect'.
'$visible'('$init_prolog').
'$visible'('$x_yap_flag' ).
%% @}