fix path issues when opening files
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2137 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
cab59d9f3a
commit
d0cd8182d9
18
C/iopreds.c
18
C/iopreds.c
@ -2239,17 +2239,17 @@ p_open (void)
|
||||
Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "open/3");
|
||||
return(FALSE);
|
||||
}
|
||||
if (!Yap_TrueFileName (RepAtom (AtomOfTerm (file_name))->StrOfAE, Yap_FileNameBuf, FALSE))
|
||||
return (PlIOError (EXISTENCE_ERROR_SOURCE_SINK,file_name,"open/3"));
|
||||
sno = GetFreeStreamD();
|
||||
if (sno < 0)
|
||||
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open/3"));
|
||||
st = &Stream[sno];
|
||||
/* can never happen */
|
||||
topts = Deref(ARG4);
|
||||
if (IsVarTerm(topts) || !IsIntegerTerm(topts))
|
||||
return(FALSE);
|
||||
opts = IntegerOfTerm(topts);
|
||||
if (!strncpy(Yap_FileNameBuf, RepAtom (AtomOfTerm (file_name))->StrOfAE, YAP_FILENAME_MAX))
|
||||
return (PlIOError (SYSTEM_ERROR,file_name,"file name is too long in open/3"));
|
||||
sno = GetFreeStreamD();
|
||||
if (sno < 0)
|
||||
return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open/3"));
|
||||
st = &Stream[sno];
|
||||
/* can never happen */
|
||||
tenc = Deref(ARG5);
|
||||
if (IsVarTerm(tenc) || !IsIntegerTerm(tenc))
|
||||
@ -4309,7 +4309,7 @@ p_get (void)
|
||||
|
||||
static Int
|
||||
p_get0 (void)
|
||||
{ /* '$get0'(Stream,-N) */
|
||||
{ /* get0(Stream,-N) */
|
||||
int sno = CheckStream (ARG1, Input_Stream_f, "get0/2");
|
||||
Int status;
|
||||
Int out;
|
||||
@ -6014,8 +6014,8 @@ Yap_InitIOPreds(void)
|
||||
Yap_InitCPred ("$close", 1, p_close, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("flush_output", 1, p_flush, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$flush_all_streams", 0, p_flush_all_streams, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$get", 2, p_get, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$get0", 2, p_get0, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("get", 2, p_get, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("get0", 2, p_get0, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$get0_line_codes", 2, p_get0_line_codes, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$get_byte", 2, p_get_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred ("$access", 1, p_access, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||
|
||||
229
C/sysbits.c
229
C/sysbits.c
@ -1589,13 +1589,14 @@ Yap_volume_header(char *file)
|
||||
return volume_header(file);
|
||||
}
|
||||
|
||||
/******
|
||||
TODO: rewrite to use wordexp
|
||||
****/
|
||||
static int
|
||||
TrueFileName (char *source, char *root, char *result, int in_lib)
|
||||
{
|
||||
register int ch;
|
||||
register char *res0 = result, *work;
|
||||
char ares1[YAP_FILENAME_MAX], *res1 = ares1;
|
||||
char *var_name;
|
||||
char *res0 = result, *work;
|
||||
char ares1[YAP_FILENAME_MAX];
|
||||
|
||||
result[0] = '\0';
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
@ -1610,149 +1611,137 @@ TrueFileName (char *source, char *root, char *result, int in_lib)
|
||||
}
|
||||
#endif
|
||||
/* step 1: eating home information */
|
||||
if (source[0] == '~')
|
||||
{
|
||||
if (dir_separator(source[1]) || source[1] == '\0')
|
||||
{
|
||||
char *s;
|
||||
source++;
|
||||
if (source[0] == '~') {
|
||||
if (dir_separator(source[1]) || source[1] == '\0')
|
||||
{
|
||||
char *s;
|
||||
source++;
|
||||
#if defined(_WIN32)
|
||||
s = getenv("HOMEDRIVE");
|
||||
if (s != NULL)
|
||||
strncpy (result, getenv ("HOMEDRIVE"), YAP_FILENAME_MAX);
|
||||
s = getenv("HOMEPATH");
|
||||
if (s != NULL)
|
||||
strncpy (result, s, YAP_FILENAME_MAX);
|
||||
s = getenv("HOMEDRIVE");
|
||||
if (s != NULL)
|
||||
strncpy (result, getenv ("HOMEDRIVE"), YAP_FILENAME_MAX);
|
||||
s = getenv("HOMEPATH");
|
||||
if (s != NULL)
|
||||
strncpy (result, s, YAP_FILENAME_MAX);
|
||||
#else
|
||||
s = getenv ("HOME");
|
||||
if (s != NULL)
|
||||
strncpy (result, s, YAP_FILENAME_MAX);
|
||||
s = getenv ("HOME");
|
||||
if (s != NULL)
|
||||
strncpy (result, s, YAP_FILENAME_MAX);
|
||||
#endif
|
||||
}
|
||||
} else {
|
||||
#if HAVE_GETPWNAM
|
||||
else
|
||||
{
|
||||
struct passwd *user_passwd;
|
||||
struct passwd *user_passwd;
|
||||
|
||||
source++;
|
||||
while (!dir_separator((*res0 = *source)) && *res0 != '\0')
|
||||
res0++, source++;
|
||||
*res0++ = '\0';
|
||||
if ((user_passwd = getpwnam (result)) == NULL)
|
||||
{
|
||||
return(FALSE);
|
||||
}
|
||||
strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX);
|
||||
}
|
||||
source++;
|
||||
while (!dir_separator((*res0 = *source)) && *res0 != '\0')
|
||||
res0++, source++;
|
||||
*res0++ = '\0';
|
||||
if ((user_passwd = getpwnam (result)) == NULL) {
|
||||
return FALSE;
|
||||
}
|
||||
strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
strncat (result, source, YAP_FILENAME_MAX);
|
||||
}
|
||||
else
|
||||
strncat (result, source, YAP_FILENAME_MAX);
|
||||
} else if (source[0] == '$') {
|
||||
/* follow SICStus expansion rules */
|
||||
int ch;
|
||||
char *s;
|
||||
char *res0 = source+1;
|
||||
|
||||
while ((ch = *res0) && is_valid_env_char (ch)) {
|
||||
res0++;
|
||||
}
|
||||
*res0 = '\0';
|
||||
if (!(s = (char *) getenv (source+1))) {
|
||||
return FALSE;
|
||||
}
|
||||
*res0 = ch;
|
||||
strncpy (result, s, YAP_FILENAME_MAX);
|
||||
strncat (result, res0, YAP_FILENAME_MAX);
|
||||
} else {
|
||||
strncpy (result, source, YAP_FILENAME_MAX);
|
||||
/* step 2: handling environment variables in file names */
|
||||
strncpy (ares1, result, YAP_FILENAME_MAX);
|
||||
res0 = result;
|
||||
while ((ch = *res1++)!=0)
|
||||
{
|
||||
if (ch == '\\' && !dir_separator('\\'))
|
||||
{
|
||||
ch = *res1++;
|
||||
if (ch == '\0')
|
||||
{
|
||||
*res0 = '\0';
|
||||
break;
|
||||
}
|
||||
else
|
||||
*res0++ = ch;
|
||||
}
|
||||
if (ch != '$')
|
||||
*res0++ = ch;
|
||||
else
|
||||
{
|
||||
char env_var[256], *sptr = env_var;
|
||||
while (((ch = *res1)!=0) && is_valid_env_char (ch))
|
||||
{
|
||||
res1++;
|
||||
*sptr++ = ch;
|
||||
}
|
||||
*sptr = '\0';
|
||||
if ((var_name = (char *) getenv (env_var)) == NULL)
|
||||
{
|
||||
return(FALSE);
|
||||
}
|
||||
else
|
||||
while ((*res0 = *var_name++)!=0)
|
||||
res0++;
|
||||
}
|
||||
}
|
||||
#if defined(_WIN32)
|
||||
res1 = result;
|
||||
/* step 2 WINDOWS: replacing \ by / */
|
||||
while ((ch = *res1++)) {
|
||||
if (ch == '\\' && dir_separator('\\')) {
|
||||
res1[-1] = '/';
|
||||
}
|
||||
*res0 = '\0';
|
||||
}
|
||||
#endif
|
||||
/* step 3: get the full file name */
|
||||
if (!dir_separator(result[0]) && !volume_header(result)) {
|
||||
if (root) {
|
||||
strncpy(ares1, root, YAP_FILENAME_MAX);
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
strncat (ares1, "\\", YAP_FILENAME_MAX);
|
||||
#else
|
||||
strncat (ares1, "/", YAP_FILENAME_MAX);
|
||||
#endif
|
||||
strncat (ares1, result, YAP_FILENAME_MAX);
|
||||
} else {
|
||||
#if __simplescalar__
|
||||
/* does not implement getcwd */
|
||||
strncpy(ares1,yap_pwd,YAP_FILENAME_MAX);
|
||||
/* does not implement getcwd */
|
||||
strncpy(ares1,yap_pwd,YAP_FILENAME_MAX);
|
||||
#elif HAVE_GETCWD
|
||||
if (getcwd (ares1, YAP_FILENAME_MAX) == NULL)
|
||||
return FALSE;
|
||||
if (getcwd (ares1, YAP_FILENAME_MAX) == NULL)
|
||||
return FALSE;
|
||||
#else
|
||||
if (getwd (ares1) == NULL)
|
||||
return FALSE;
|
||||
if (getwd (ares1) == NULL)
|
||||
return FALSE;
|
||||
#endif
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
strncat (ares1, "\\", YAP_FILENAME_MAX);
|
||||
#else
|
||||
strncat (ares1, "/", YAP_FILENAME_MAX);
|
||||
#endif
|
||||
if (root) {
|
||||
if (!dir_separator(root[0]) && !volume_header(root)) {
|
||||
strncat(ares1, root, YAP_FILENAME_MAX);
|
||||
} else {
|
||||
strncpy(ares1, root, YAP_FILENAME_MAX);
|
||||
}
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
strncat (ares1, "\\", YAP_FILENAME_MAX);
|
||||
#else
|
||||
strncat (ares1, "/", YAP_FILENAME_MAX);
|
||||
#endif
|
||||
strncat (ares1, result, YAP_FILENAME_MAX);
|
||||
if (in_lib) {
|
||||
int tmpf;
|
||||
if ((tmpf = open(ares1, O_RDONLY)) < 0) {
|
||||
/* not in current directory, let us try the library */
|
||||
if (Yap_LibDir != NULL) {
|
||||
strncpy(Yap_FileNameBuf, Yap_LibDir, YAP_FILENAME_MAX);
|
||||
}
|
||||
strncat (ares1, result, YAP_FILENAME_MAX);
|
||||
if (in_lib) {
|
||||
int tmpf;
|
||||
if ((tmpf = open(ares1, O_RDONLY)) < 0) {
|
||||
/* not in current directory, let us try the library */
|
||||
if (Yap_LibDir != NULL) {
|
||||
strncpy(Yap_FileNameBuf, Yap_LibDir, YAP_FILENAME_MAX);
|
||||
#if HAVE_GETENV
|
||||
} else {
|
||||
char *yap_env = getenv("YAPLIBDIR");
|
||||
if (yap_env != NULL) {
|
||||
strncpy(ares1, yap_env, YAP_FILENAME_MAX);
|
||||
#endif
|
||||
} else {
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
if (libdir)
|
||||
strncpy(ares1, libdir, YAP_FILENAME_MAX);
|
||||
else
|
||||
#endif
|
||||
strncpy(ares1, LIB_DIR, YAP_FILENAME_MAX);
|
||||
}
|
||||
#if HAVE_GETENV
|
||||
}
|
||||
#endif
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
strncat(ares1,"\\", YAP_FILENAME_MAX);
|
||||
#else
|
||||
strncat(ares1,"/", YAP_FILENAME_MAX);
|
||||
#endif
|
||||
strncat(ares1,result, YAP_FILENAME_MAX);
|
||||
if ((tmpf = open(ares1, O_RDONLY)) >= 0) {
|
||||
close(tmpf);
|
||||
strncpy (result, ares1, YAP_FILENAME_MAX);
|
||||
}
|
||||
} else {
|
||||
strncpy (result, ares1, YAP_FILENAME_MAX);
|
||||
char *yap_env = getenv("YAPLIBDIR");
|
||||
if (yap_env != NULL) {
|
||||
strncpy(ares1, yap_env, YAP_FILENAME_MAX);
|
||||
#endif
|
||||
} else {
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
if (libdir)
|
||||
strncpy(ares1, libdir, YAP_FILENAME_MAX);
|
||||
else
|
||||
#endif
|
||||
strncpy(ares1, LIB_DIR, YAP_FILENAME_MAX);
|
||||
}
|
||||
#if HAVE_GETENV
|
||||
}
|
||||
#endif
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
strncat(ares1,"\\", YAP_FILENAME_MAX);
|
||||
#else
|
||||
strncat(ares1,"/", YAP_FILENAME_MAX);
|
||||
#endif
|
||||
strncat(ares1,result, YAP_FILENAME_MAX);
|
||||
if ((tmpf = open(ares1, O_RDONLY)) >= 0) {
|
||||
close(tmpf);
|
||||
strncpy (result, ares1, YAP_FILENAME_MAX);
|
||||
}
|
||||
} else {
|
||||
strncpy (result, ares1, YAP_FILENAME_MAX);
|
||||
close(tmpf);
|
||||
}
|
||||
} else {
|
||||
strncpy (result, ares1, YAP_FILENAME_MAX);
|
||||
}
|
||||
}
|
||||
/* step 4: simplifying the file name */
|
||||
|
||||
@ -126,6 +126,8 @@ StreamDesc;
|
||||
#define RepError_Prolog_f 0x400000
|
||||
#define RepError_Xml_f 0x800000
|
||||
|
||||
#define EXPAND_FILENAME 0x000080
|
||||
|
||||
#define StdInStream 0
|
||||
#define StdOutStream 1
|
||||
#define StdErrStream 2
|
||||
|
||||
@ -17,7 +17,10 @@ xb
|
||||
|
||||
<h2>Yap-5.1.3:</h2>
|
||||
<ul>
|
||||
<li> FIXED: [ ] should be processed by parser, not by scanner (obs
|
||||
<li> FIXED: true_file_name/3 was totally broken (obs from Nicos Agelopoulos).</li>
|
||||
<li> FIXED: Environment variables should only be seen at the beginning
|
||||
of the file (obs from Samir Genaim.)</li>
|
||||
<li> FIXED: [ ] should be processed by parser, not by scanner (obs
|
||||
from Samir Genaim).</li>
|
||||
<li> NEW: file_base_name/2.</li>
|
||||
<li> FIXED: in console, count input characters as being output, as they
|
||||
|
||||
17
docs/yap.tex
17
docs/yap.tex
@ -4047,6 +4047,16 @@ escape code or @code{xml} (write @code{&#...;} XML character entity).
|
||||
The initial mode is @code{prolog} for the user streams and
|
||||
@code{error} for all other streams. See also @ref{Encoding}.
|
||||
|
||||
@item expand_filename(+@var{Mode})
|
||||
If @var{Mode} is @code{true} then do filename expansion, then ask Prolog
|
||||
to do file name expansion before actually trying to opening the file:
|
||||
this includes processing @code{~} characters and processing @code{$}
|
||||
environment variables at the beginning of the file. Otherwise, just try
|
||||
to open the file using the given name.
|
||||
|
||||
The default behavior is given by the Prolog flag
|
||||
@code{open_expands_filename}.
|
||||
|
||||
@end table
|
||||
|
||||
@item close(+@var{S}) [ISO]
|
||||
@ -7616,6 +7626,13 @@ blackboard when the key is an integer.
|
||||
Read or set the size of the hash table that is used for looking up the
|
||||
internal data-base when the key is an integer.
|
||||
|
||||
@item open_expands_filename
|
||||
@findex open_expands_filename (yap_flag/2 option)
|
||||
@*
|
||||
If @code{true} the @code{open/3} builtin performs filename-expansion
|
||||
before opening a file (SICStus Prolog like). If @code{false} it does not
|
||||
(SWI-Prolog like).
|
||||
|
||||
@item profiling
|
||||
@findex profiling (yap_flag/2 option)
|
||||
@*
|
||||
|
||||
@ -95,25 +95,6 @@ last([], Last, Last).
|
||||
last([H|List], _, Last) :-
|
||||
last(List, H, Last).
|
||||
|
||||
% member(?Element, ?Set)
|
||||
% is true when Set is a list, and Element occurs in it. It may be used
|
||||
% to test for an element or to enumerate all the elements by backtracking.
|
||||
% Indeed, it may be used to generate the Set!
|
||||
|
||||
member(Element, [Element|_]).
|
||||
member(Element, [_|Rest]) :-
|
||||
member(Element, Rest).
|
||||
|
||||
|
||||
% memberchk(+Element, +Set)
|
||||
% means the same thing, but may only be used to test whether a known
|
||||
% Element occurs in a known Set. In return for this limited use, it
|
||||
% is more efficient when it is applicable.
|
||||
|
||||
memberchk(Element, [Element|_]) :- !.
|
||||
memberchk(Element, [_|Rest]) :-
|
||||
memberchk(Element, Rest).
|
||||
|
||||
% nextto(X, Y, List)
|
||||
% is true when X and Y appear side-by-side in List. It could be written as
|
||||
% nextto(X, Y, List) :- append(_, [X,Y,_], List).
|
||||
|
||||
@ -5,6 +5,8 @@
|
||||
|
||||
:- yap_flag(unknown,error).
|
||||
|
||||
:- yap_flag(open_expands_filename,false).
|
||||
|
||||
% redefines stuff in prolog module.
|
||||
|
||||
:- module(swi, []).
|
||||
|
||||
@ -65,6 +65,7 @@ true :- true.
|
||||
prompt(' ?- '),
|
||||
nb_setval('$break',0),
|
||||
% '$set_read_error_handler'(error), let the user do that
|
||||
nb_setval('$open_expands_filename',true),
|
||||
nb_setval('$debug',off),
|
||||
nb_setval('$trace',off),
|
||||
b_setval('$spy_glist',[]),
|
||||
@ -532,7 +533,7 @@ true :- true.
|
||||
|
||||
'$another' :-
|
||||
format(user_error,' ? ',[]),
|
||||
'$get0'(user_input,C),
|
||||
get0(user_input,C),
|
||||
( C== 0'; -> '$skip'(user_input,10), %'
|
||||
'$add_nl_outside_console',
|
||||
fail
|
||||
|
||||
@ -436,13 +436,13 @@ yap_flag(float_min_exponent,X) :-
|
||||
yap_flag(float_epsilon,X) :-
|
||||
'$do_error'(domain_error(flag_value,float_min_exponent+X),yap_flag(float_min_exponent,X)).
|
||||
|
||||
yap_flag(float_max_exponent,X) :-
|
||||
yap_flag(float_max_exponent,X) :-
|
||||
var(X), !,
|
||||
?????
|
||||
yap_flag(float_max_exponent,X) :-
|
||||
yap_flag(float_max_exponent,X) :-
|
||||
integer(X), X > 0, !,
|
||||
'$do_error'(permission_error(modify,flag,float_max_exponent),yap_flag(float_max_exponent,X)).
|
||||
yap_flag(float_max_exponent,X) :-
|
||||
yap_flag(float_max_exponent,X) :-
|
||||
'$do_error'(domain_error(flag_value,float_max_exponent+X),yap_flag(float_max_exponent,X)).
|
||||
*/
|
||||
|
||||
@ -580,6 +580,12 @@ yap_flag(chr_toplevel_show_store,X) :-
|
||||
yap_flag(chr_toplevel_show_store,X) :-
|
||||
'$do_error'(domain_error(flag_value,chr_toplevel_show_store+X),yap_flag(chr_toplevel_show_store,X)).
|
||||
|
||||
yap_flag(open_expands_filename,Expand) :-
|
||||
var(Expand), !,
|
||||
'$default_expand'(Expand).
|
||||
yap_flag(open_expands_filename,Expand) :-
|
||||
'$set_default_expand'(Expand).
|
||||
|
||||
yap_flag(single_var_warnings,X) :-
|
||||
var(X), !,
|
||||
('$syntax_check_mode'(on,_), '$syntax_check_single_var'(on,_) ->
|
||||
@ -810,6 +816,10 @@ yap_flag(dialect,yap).
|
||||
% V = fast ;
|
||||
V = fileerrors ;
|
||||
V = float_format ;
|
||||
% V = float_mantissa_digits ;
|
||||
% V = float_epsilon ;
|
||||
% V = float_min_exponent ;
|
||||
% V = float_max_exponent ;
|
||||
V = gc ;
|
||||
V = gc_margin ;
|
||||
V = gc_trace ;
|
||||
@ -828,11 +838,8 @@ yap_flag(dialect,yap).
|
||||
V = max_threads ;
|
||||
V = min_integer ;
|
||||
V = min_tagged_integer ;
|
||||
% V = float_mantissa_digits ;
|
||||
% V = float_epsilon ;
|
||||
% V = float_min_exponent ;
|
||||
% V = float_max_exponent ;
|
||||
V = n_of_integer_keys_in_db ;
|
||||
V = open_expands_filename ;
|
||||
V = profiling ;
|
||||
V = redefine_warnings ;
|
||||
V = shared_object_search_path ;
|
||||
|
||||
@ -134,7 +134,7 @@ module(N) :-
|
||||
'$use_preds'(P,Publics,Mod,M),
|
||||
'$use_preds'(Ps,Publics,Mod,M).
|
||||
'$use_preds'(N/K,Publics,M,Mod) :-
|
||||
( '$member'(N/K,Publics) -> true ;
|
||||
( lists:memberchk(N/K,Publics) -> true ;
|
||||
print_message(warning,import(N/K,Mod,M,private))
|
||||
),
|
||||
'$do_import'(N, K, M, Mod).
|
||||
@ -469,8 +469,23 @@ current_module(Mod,TFN) :-
|
||||
source_module(Mod) :-
|
||||
'$current_module'(Mod).
|
||||
|
||||
'$member'(X,[X|_]) :- !.
|
||||
'$member'(X,[_|L]) :- '$member'(X,L).
|
||||
% member(?Element, ?Set)
|
||||
% is true when Set is a list, and Element occurs in it. It may be used
|
||||
% to test for an element or to enumerate all the elements by backtracking.
|
||||
% Indeed, it may be used to generate the Set!
|
||||
|
||||
lists:memberchk(X,[X|_]) :- !.
|
||||
lists:memberchk(X,[_|L]) :-
|
||||
lists:memberchk(X,L).
|
||||
|
||||
% memberchk(+Element, +Set)
|
||||
% means the same thing, but may only be used to test whether a known
|
||||
% Element occurs in a known Set. In return for this limited use, it
|
||||
% is more efficient when it is applicable.
|
||||
|
||||
lists:member(X,[X|_]) :- !.
|
||||
lists:member(X,[_|L]) :-
|
||||
lists:member(X,L).
|
||||
|
||||
|
||||
% comma has its own problems.
|
||||
@ -639,20 +654,20 @@ abolish_module(_).
|
||||
|
||||
'$clean_conversion'([], _, [], [], _).
|
||||
'$clean_conversion'([P1|Ps], List, [P1-P1|Tab], [P1|MyExports], Goal) :-
|
||||
'$member'(P1, List), !,
|
||||
lists:memberchk(P1, List), !,
|
||||
'$clean_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$clean_conversion'([(N1/A1 as N2)|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :-
|
||||
'$member'(N1/A1, List), !,
|
||||
lists:memberchk(N1/A1, List), !,
|
||||
'$clean_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$clean_conversion'([P|_], _, _, _, Goal) :-
|
||||
'$do_error'(domain_error(module_reexport_predicates,P), Goal).
|
||||
|
||||
'$neg_conversion'([], _, [], [], _).
|
||||
'$neg_conversion'([P1|Ps], List, Tab, MyExports, Goal) :-
|
||||
'$member'(P1, List), !,
|
||||
lists:memberchk(P1, List), !,
|
||||
'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$neg_conversion'([N1/A1|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :-
|
||||
'$member'(N1/A1 as N2, List), !,
|
||||
lists:memberchk(N1/A1 as N2, List), !,
|
||||
'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
'$neg_conversion'([P|Ps], List, [P-P|Tab], [P|MyExports], Goal) :-
|
||||
'$neg_conversion'(Ps, List, Tab, MyExports, Goal).
|
||||
|
||||
@ -852,7 +852,7 @@ predicate_property(Pred,Prop) :-
|
||||
'$predicate_property'(P,M,M,exported) :-
|
||||
functor(P,N,A),
|
||||
recorded('$module','$module'(_TFN,M,Publics),_),
|
||||
'$member'(N/A,Publics), !. /* defined in modules.yap */
|
||||
lists:memberchk(N/A,Publics), !.
|
||||
'$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :-
|
||||
'$number_of_clauses'(P,Mod,NCl).
|
||||
|
||||
|
||||
81
pl/yio.yap
81
pl/yio.yap
@ -23,8 +23,10 @@ open(Source,M,T) :- var(M), !,
|
||||
'$do_error'(instantiation_error,open(Source,M,T)).
|
||||
open(Source,M,T) :- nonvar(T), !,
|
||||
'$do_error'(type_error(variable,T),open(Source,M,T)).
|
||||
open(File,Mode,Stream) :-
|
||||
open(File0,Mode,Stream) :-
|
||||
'$default_encoding'(Encoding),
|
||||
'$default_expand'(Expansion),
|
||||
'$expand_filename'(Expansion, File0, File),
|
||||
'$open'(File,Mode,Stream,16,Encoding).
|
||||
|
||||
/* meaning of flags for '$write' is
|
||||
@ -59,11 +61,16 @@ close(S,Opts) :-
|
||||
|
||||
open(F,T,S,Opts) :-
|
||||
'$check_io_opts'(Opts,open(F,T,S,Opts)),
|
||||
'$process_open_opts'(Opts, 0, N, Aliases, E, BOM),
|
||||
'$open2'(F,T,S,N,E),
|
||||
'$process_open_opts'(Opts, 0, N, Aliases, E, BOM, Expand),
|
||||
'$expand_filename'(Expand, F, NF),
|
||||
'$open2'(NF, T, S, N, E),
|
||||
'$process_bom'(S, BOM),
|
||||
'$process_open_aliases'(Aliases,S).
|
||||
|
||||
'$expand_filename'(false, F, F) :- !.
|
||||
'$expand_filename'(true, F, NF) :-
|
||||
system:true_file_name(F, NF).
|
||||
|
||||
'$open2'(Source,M,T,N,_) :- var(Source), !,
|
||||
'$do_error'(instantiation_error,open(Source,M,T,N)).
|
||||
'$open2'(Source,M,T,N,_) :- var(M), !,
|
||||
@ -83,26 +90,30 @@ open(F,T,S,Opts) :-
|
||||
'$add_alias_to_stream'(Alias, S),
|
||||
'$process_open_aliases'(Aliases,S).
|
||||
|
||||
'$process_open_opts'([], N, N, [], DefaultEncoding, []) :-
|
||||
'$default_encoding'(DefaultEncoding).
|
||||
'$process_open_opts'([type(T)|L], N0, N, Aliases, Encoding, BOM) :-
|
||||
'$process_open_opts'([], N, N, [], DefaultEncoding, [], DefaultExpand) :-
|
||||
'$default_encoding'(DefaultEncoding),
|
||||
'$default_expand'(DefaultExpand).
|
||||
'$process_open_opts'([type(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :-
|
||||
'$value_open_opt'(T,type,I1,I2),
|
||||
N1 is I1\/N0,
|
||||
N2 is I2/\N1,
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM).
|
||||
'$process_open_opts'([reposition(T)|L], N0, N, Aliases, Encoding, BOM) :-
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
'$process_open_opts'([expand_filename(T)|L], N0, N, Aliases, Encoding, BOM, Expand) :-
|
||||
'$valid_expand'(T, Expand),
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, _).
|
||||
'$process_open_opts'([reposition(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :-
|
||||
'$value_open_opt'(T,reposition,I1,I2),
|
||||
N1 is I1\/N0,
|
||||
N2 is I2/\N1,
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM).
|
||||
'$process_open_opts'([encoding(Enc)|L], N0, N, Aliases, EncCode, BOM) :-
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
'$process_open_opts'([encoding(Enc)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :-
|
||||
'$valid_encoding'(Enc, EncCode),
|
||||
'$process_open_opts'(L, N0, N, Aliases, _, BOM).
|
||||
'$process_open_opts'([representation_errors(Mode)|L], N0, N, Aliases, EncCode, BOM) :-
|
||||
'$process_open_opts'(L, N0, N, Aliases, _, BOM, DefaultExpand).
|
||||
'$process_open_opts'([representation_errors(Mode)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :-
|
||||
'$valid_reperrorhandler'(Mode, Flag),
|
||||
NI is N0 \/ Flag,
|
||||
'$process_open_opts'(L, NI, N, Aliases, EncCode, BOM).
|
||||
'$process_open_opts'([bom(BOM)|L], N0, N, Aliases, EncCode, BOM) :-
|
||||
'$process_open_opts'(L, NI, N, Aliases, EncCode, BOM, DefaultExpand).
|
||||
'$process_open_opts'([bom(BOM)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :-
|
||||
(
|
||||
var(BOM)
|
||||
->
|
||||
@ -111,14 +122,14 @@ open(F,T,S,Opts) :-
|
||||
'$valid_bom'(BOM, Flag),
|
||||
NI is N0 \/ Flag
|
||||
),
|
||||
'$process_open_opts'(L, NI, N, Aliases, EncCode, _).
|
||||
'$process_open_opts'([eof_action(T)|L], N0, N, Aliases, Encoding, BOM) :-
|
||||
'$process_open_opts'(L, NI, N, Aliases, EncCode, _, DefaultExpand).
|
||||
'$process_open_opts'([eof_action(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :-
|
||||
'$value_open_opt'(T,eof_action,I1,I2),
|
||||
N1 is I1\/N0,
|
||||
N2 is I2/\N1,
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM).
|
||||
'$process_open_opts'([alias(Alias)|L], N0, N, [Alias|Aliases], Encoding, BOM) :-
|
||||
'$process_open_opts'(L,N0,N, Aliases, Encoding, BOM).
|
||||
'$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
'$process_open_opts'([alias(Alias)|L], N0, N, [Alias|Aliases], Encoding, BOM, DefaultExpand) :-
|
||||
'$process_open_opts'(L,N0,N, Aliases, Encoding, BOM, DefaultExpand).
|
||||
|
||||
|
||||
'$value_open_opt'(text,_,1,X) :- X is 128-2. % default
|
||||
@ -140,6 +151,9 @@ open(F,T,S,Opts) :-
|
||||
'$valid_reperrorhandler'(prolog, 512).
|
||||
'$valid_reperrorhandler'(xml, 1024).
|
||||
|
||||
'$valid_expand'(true, true),
|
||||
'$valid_expand'(false, false),
|
||||
|
||||
/* check whether a list of options is valid */
|
||||
'$check_io_opts'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
@ -587,7 +601,7 @@ print(_,_).
|
||||
|
||||
/* character I/O */
|
||||
|
||||
get(N) :- current_input(S), '$get'(S,N).
|
||||
get(N) :- current_input(S), get(S,N).
|
||||
|
||||
get_byte(V) :-
|
||||
\+ var(V), (\+ integer(V) ; V < -1 ; V > 256), !,
|
||||
@ -621,7 +635,7 @@ get_char(V) :-
|
||||
'$do_error'(type_error(in_character,V),get_char(V)).
|
||||
get_char(V) :-
|
||||
current_input(S),
|
||||
'$get0'(S,I),
|
||||
get0(S,I),
|
||||
( I = -1 -> V = end_of_file ; atom_codes(V,[I])).
|
||||
|
||||
get_char(S,V) :-
|
||||
@ -629,7 +643,7 @@ get_char(S,V) :-
|
||||
( atom(V) -> atom_codes(V,[_,_|_]), V \= end_of_file ; true ), !,
|
||||
'$do_error'(type_error(in_character,V),get_char(S,V)).
|
||||
get_char(S,V) :-
|
||||
'$get0'(S,I),
|
||||
get0(S,I),
|
||||
( I = -1 -> V = end_of_file ; atom_codes(V,[I])).
|
||||
|
||||
peek_char(V) :-
|
||||
@ -653,14 +667,14 @@ get_code(S,V) :-
|
||||
\+ var(V), (\+ integer(V)), !,
|
||||
'$do_error'(type_error(in_character_code,V),get_code(S,V)).
|
||||
get_code(S,V) :-
|
||||
'$get0'(S,V).
|
||||
get0(S,V).
|
||||
|
||||
get_code(V) :-
|
||||
\+ var(V), (\+ integer(V)), !,
|
||||
'$do_error'(type_error(in_character_code,V),get_code(V)).
|
||||
get_code(V) :-
|
||||
current_input(S),
|
||||
'$get0'(S,V).
|
||||
get0(S,V).
|
||||
|
||||
peek_code(S,V) :-
|
||||
\+ var(V), (\+ integer(V)), !,
|
||||
@ -732,11 +746,7 @@ put_code(S,V) :-
|
||||
|
||||
|
||||
|
||||
get(Stream,N) :- '$get'(Stream,N).
|
||||
|
||||
get0(N) :- current_input(S), '$get0'(S,N).
|
||||
|
||||
get0(Stream,N) :- '$get0'(Stream,N).
|
||||
get0(N) :- current_input(S), get0(S,N).
|
||||
|
||||
put(N) :- current_output(S), N1 is N, '$put'(S,N1).
|
||||
|
||||
@ -759,9 +769,9 @@ tab(_).
|
||||
tab(Stream,N) :- '$tab'(Stream,N), fail.
|
||||
tab(_,_).
|
||||
|
||||
ttyget(N) :- '$get'(user_input,N).
|
||||
ttyget(N) :- get(user_input,N).
|
||||
|
||||
ttyget0(N) :- '$get0'(user_input,N).
|
||||
ttyget0(N) :- get0(user_input,N).
|
||||
|
||||
ttyskip(N) :- N1 is N, '$skip'(user_input,N1).
|
||||
|
||||
@ -1070,3 +1080,12 @@ stream_position_data(line_position, '$stream_position'(_,_,Data,_,_), Data).
|
||||
%stream_position_data(char_count, '$stream_position'(Data,_,_,_,_), Data).
|
||||
stream_position_data(byte_count, '$stream_position'(Data,_,_,_,_), Data).
|
||||
|
||||
'$default_expand'(Expand) :-
|
||||
nb_getval('$open_expands_filename',Expand).
|
||||
|
||||
'$set_default_expand'(true) :- !,
|
||||
nb_setval('$open_expands_filename',true).
|
||||
'$set_default_expand'(false) :- !,
|
||||
nb_setval('$open_expands_filename',false).
|
||||
'$set_default_expand'(V) :- !,
|
||||
'$do_error'(domain_error(flag_value,V),yap_flag(open_expands_file_name,X)).
|
||||
|
||||
Reference in New Issue
Block a user