Merge branch 'master' of ssh://ssh.dcc.fc.up.pt:31064/home/vsc/yap
This commit is contained in:
commit
847edfd432
@ -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);
|
||||
|
@ -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
17
C/write.c
@ -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
819
pl/absf.yap
@ -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
143
pl/boot.yap
@ -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').
|
||||
|
@ -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),
|
||||
|
@ -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' ).
|
||||
%% @}
|
||||
|
||||
|
Reference in New Issue
Block a user