fixes in modules
system support for WIN32 (first try). small fixes. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@45 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
27e367f0a5
commit
82438c1d6f
19
C/iopreds.c
19
C/iopreds.c
|
|
@ -51,6 +51,14 @@ static char SccsId[] = "%W% %G%";
|
|||
#if HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
#if HAVE_FCNTL_H
|
||||
/* for O_BINARY and O_TEXT in WIN32 */
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
#if HAVE_IO_H
|
||||
/* Windows */
|
||||
#include <io.h>
|
||||
#endif
|
||||
#if !HAVE_STRNCAT
|
||||
#define strncat(X,Y,Z) strcat(X,Y)
|
||||
#endif
|
||||
|
|
@ -1676,9 +1684,14 @@ p_open_pipe_stream (void)
|
|||
int sno;
|
||||
int filedes[2];
|
||||
|
||||
if (pipe(filedes) != 0) {
|
||||
return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
|
||||
}
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
if (_pipe(filedes, 256, O_TEXT) == -1)
|
||||
#else
|
||||
if (pipe(filedes) != 0)
|
||||
#endif
|
||||
{
|
||||
return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
|
||||
}
|
||||
for (sno = 0; sno < MaxStreams; ++sno)
|
||||
if (Stream[sno].status & Free_Stream_f)
|
||||
break;
|
||||
|
|
|
|||
12
C/save.c
12
C/save.c
|
|
@ -39,6 +39,12 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90";
|
|||
#ifdef HAVE_UNISTD_H
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
#ifdef HAVE_SYS_TYPES_H
|
||||
#include <sys/types.h>
|
||||
#endif
|
||||
#ifdef HAVE_SYS_STAT_H
|
||||
#include <sys/stat.h>
|
||||
#endif
|
||||
|
||||
|
||||
/********* hack for accesing several kinds of terms. Should be cleaned **/
|
||||
|
|
@ -124,9 +130,7 @@ STATIC_PROTO(void NewFileInfo, (long, long));
|
|||
extern int DefVol;
|
||||
#endif
|
||||
|
||||
#if _MSC_VER
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#if HAVE_IO_H
|
||||
#include <io.h>
|
||||
#endif
|
||||
|
||||
|
|
@ -254,7 +258,7 @@ open_file(char *ss, int flag)
|
|||
#else
|
||||
#ifdef O_BINARY
|
||||
#if _MSC_VER
|
||||
if ((splfild = open(ss, flag | O_BINARY), _S_IREAD | _S_IWRITE) < 0)
|
||||
if ((splfild = _open(ss, flag | O_BINARY), _S_IREAD | _S_IWRITE) < 0)
|
||||
#else
|
||||
if ((splfild = open(ss, flag | O_BINARY), 0755) < 0)
|
||||
#endif
|
||||
|
|
|
|||
25
C/stdpreds.c
25
C/stdpreds.c
|
|
@ -2012,6 +2012,20 @@ mk_argc_list(void)
|
|||
Term t = TermNil;
|
||||
while (i < yap_argc) {
|
||||
char *arg = yap_args[i];
|
||||
/* check for -L -- */
|
||||
if (arg[0] == '-' && arg[1] == 'L') {
|
||||
arg += 2;
|
||||
while (*arg != '\0' && (*arg == ' ' || *arg == '\t'))
|
||||
arg++;
|
||||
if (*arg == '-' && arg[1] == '-' && arg[2] == '\0') {
|
||||
/* we found the separator */
|
||||
int j;
|
||||
for (j = yap_argc-1; j > i+1; --j) {
|
||||
t = MkPairTerm(MkAtomTerm(LookupAtom(yap_args[j])),t);
|
||||
}
|
||||
return(t);
|
||||
}
|
||||
}
|
||||
if (arg[0] == '-' && arg[1] == '-' && arg[2] == '\0') {
|
||||
/* we found the separator */
|
||||
int j;
|
||||
|
|
@ -2173,6 +2187,13 @@ p_set_yap_flags(void)
|
|||
return(TRUE);
|
||||
}
|
||||
|
||||
#ifndef YAPOR
|
||||
static Int
|
||||
p_default_sequential(void) {
|
||||
return(TRUE);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef DEBUG
|
||||
extern void DumpActiveGoals(void);
|
||||
|
||||
|
|
@ -2257,7 +2278,9 @@ InitCPreds(void)
|
|||
InitCPred("unhide", 1, p_unhide, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("$hidden", 1, p_hidden, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("$has_yap_or", 0, p_has_yap_or, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("$has_tabling", 0, p_has_tabling, SafePredFlag|SyncPredFlag);
|
||||
#ifndef YAPOR
|
||||
InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag|SyncPredFlag);
|
||||
#endif
|
||||
#ifdef DEBUG
|
||||
InitCPred("dump_active_goals", 0, p_dump_active_goals, SafePredFlag|SyncPredFlag);
|
||||
#endif
|
||||
|
|
|
|||
15
C/ypsocks.c
15
C/ypsocks.c
|
|
@ -36,6 +36,9 @@
|
|||
#if HAVE_SYS_TIME_H && !HAVE_WINSOCK2_H && !_MSC_VER
|
||||
#include <sys/time.h>
|
||||
#endif
|
||||
#if HAVE_IO_H
|
||||
#include <io.h>
|
||||
#endif
|
||||
#if HAVE_WINSOCK2_H
|
||||
#include <winsock2.h>
|
||||
#ifdef HAVE_SYS_UN_H
|
||||
|
|
@ -239,7 +242,7 @@ void init_socks(char *host, long interface_port)
|
|||
crash("[ could not connect to interface]");
|
||||
}
|
||||
/* now reopen stdin stdout and stderr */
|
||||
#if HAVE_DUP2
|
||||
#if HAVE_DUP2 && !defined(__MINGW32__)
|
||||
if(dup2(s,0)<0) {
|
||||
YP_fprintf(YP_stderr,"could not dup2 stdin\n");
|
||||
return;
|
||||
|
|
@ -252,7 +255,7 @@ void init_socks(char *host, long interface_port)
|
|||
YP_fprintf(YP_stderr,"could not dup2 stderr\n");
|
||||
return;
|
||||
}
|
||||
#elif _MSC_VER
|
||||
#elif _MSC_VER || defined(__MINGW32__)
|
||||
if(_dup2(s,0)<0) {
|
||||
YP_fprintf(YP_stderr,"could not dup2 stdin\n");
|
||||
return;
|
||||
|
|
@ -286,7 +289,11 @@ void init_socks(char *host, long interface_port)
|
|||
yp_iob[2].flags = _YP_IO_SOCK | _YP_IO_WRITE;
|
||||
#endif
|
||||
YP_sockets_io = 1;
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
_close(s);
|
||||
#else
|
||||
close(s);
|
||||
#endif
|
||||
}
|
||||
|
||||
static Int
|
||||
|
|
@ -436,7 +443,11 @@ p_socket(void)
|
|||
out = InitSocketStream(fd, new_socket, af_inet);
|
||||
else {
|
||||
/* ok, we currently don't support these sockets */
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
_close(fd);
|
||||
#else
|
||||
close(fd);
|
||||
#endif
|
||||
return(FALSE);
|
||||
}
|
||||
return(unify(out,ARG4));
|
||||
|
|
|
|||
|
|
@ -68,11 +68,11 @@ static int p_debug_prolog(void);
|
|||
** -------------------------- */
|
||||
|
||||
void init_optyap_preds(void) {
|
||||
InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag);
|
||||
#ifdef YAPOR
|
||||
InitCPred("$yapor_on", 0, yapor_on, SafePredFlag);
|
||||
InitCPred("$start_yapor", 0, start_yapor, SafePredFlag);
|
||||
InitCPred("$sequential", 1, p_sequential, SafePredFlag);
|
||||
InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag);
|
||||
InitCPred("execution_mode", 1, p_execution_mode, SafePredFlag);
|
||||
InitCPred("performance", 1, p_performance, SafePredFlag);
|
||||
InitCPred("$parallel_new_answer", 1, p_parallel_new_answer, SafePredFlag);
|
||||
|
|
|
|||
4
TO_DO
4
TO_DO
|
|
@ -1,5 +1,5 @@
|
|||
BEFORE 4.4:
|
||||
- weird going ons with prompt
|
||||
- weird going ons with prompt and readline
|
||||
- mixed constraints and delays.
|
||||
- write infinite terms
|
||||
- constraints in DB.
|
||||
|
|
@ -13,6 +13,7 @@ BEFORE 4.4:
|
|||
- library(system) for WIN32
|
||||
- document system(library)
|
||||
- document new interface functions.
|
||||
- remove pl/nfr.yap and misc/yap.spec from CVS.
|
||||
|
||||
TO CHECK:
|
||||
- bad register allocation for a(X,Y) :- X is Y+2.3 ?
|
||||
|
|
@ -70,3 +71,4 @@ DONE:
|
|||
- initial port to OS_X
|
||||
- listing (Steve Moyle).
|
||||
- logtalk.
|
||||
- fix bugs from Nicos.
|
||||
|
|
|
|||
|
|
@ -16,19 +16,38 @@
|
|||
|
||||
<h2>Yap-4.3.19:</h2>
|
||||
<ul>
|
||||
<li> NEW: library(system), only for Unix system right now..
|
||||
<li> FIXED: allow current_stream/3 to work with third argument known.
|
||||
<li> FIXED: make yap modules more compatible with SICStus Prolog</li>
|
||||
<li> NEW: portray_clause/2 (request from Nicos Angelopoulos)</li>
|
||||
<li> FIXED: document absolute_file_name/2</li>
|
||||
<li> FIXED: absolute_file_name/2 should return absolute path,
|
||||
never user name! (bug report from Nicos Angelopoulos)</li>
|
||||
<li> FIXED: in a:-b:call(X) X belongs to the module b (bug
|
||||
report from Nicos Angelopoulos)</li>
|
||||
<li> FIXED: make consult/1 and friends meta-predicates (bug
|
||||
report from Nicos Angelopoulos)</li>
|
||||
<li> FIXED: allow [M:F] and friends (bug report from
|
||||
Nicos Angelopoulos)</li>
|
||||
<li> FIXED: ensure_loaded/1 can be used as a goal (bug report
|
||||
from Nicos Angelopoulos)</li>
|
||||
<li> FIXED: abolish(VAR) should abolish all predicates in
|
||||
current module (bug report from Nicos Angelopoulos).</li>
|
||||
<li> NEW: library(system), only for Unix system right now.</li>
|
||||
<li> FIXED: allow current_stream/3 to work with third argument
|
||||
known.</li>
|
||||
<li> FIXED: always leave enough space so that the hybrid garbage
|
||||
collection may work.
|
||||
<li> FIXED: add_to_path should not leave choice-points.
|
||||
collection may work.</li>
|
||||
<li> FIXED: add_to_path should not leave choice-points.</li>
|
||||
<li> FIXED: don't initialise first occurrences in branches for
|
||||
func outputs.
|
||||
<li> FIXED: handle void variables in body.
|
||||
func outputs.</li>
|
||||
<li> FIXED: handle void variables in body.</li>
|
||||
<li> NEW: externd C-interface with StreamToFileNo,
|
||||
BufferToString, and BufferToAtomList.
|
||||
<li> NEW: support pipes with open_pipe_stream/2.
|
||||
<li>FIXED: <code>functor/3</code> was generating too many deallocates at the end of a clause.</li>
|
||||
<li>FIXED: <code>call_residue/2</code> should not allow constraints to escape (use <code>copy_term_no_variables/2</code> to avoid this).</li>
|
||||
BufferToString, and BufferToAtomList.</li>
|
||||
<li> NEW: support pipes with open_pipe_stream/2.</li>
|
||||
<li>FIXED: <code>functor/3</code> was generating too many
|
||||
deallocates at the end of a clause.</li>
|
||||
<li>FIXED: <code>call_residue/2</code> should not allow
|
||||
constraints to escape (use
|
||||
<code>copy_term_no_variables/2</code> to avoid this).</li>
|
||||
<li>SPEEDUP: optimise away <code>true/0</code> at the end of a clause.</li>
|
||||
<li>FIXED: do not short circuit trail entries.</li>
|
||||
<li>FIXED: Patches for memory allocation in Apple's OS/X.</li>
|
||||
|
|
@ -39,8 +58,10 @@
|
|||
<li>FIXED: force line buffering for text stream.</li>
|
||||
<li>FIXED: force no buffering for <code>user_error</code>.</li>
|
||||
<li>FIXED: flush all streams before writing answer.</li>
|
||||
<li>FIXED: <code>YP_std*</code> are now streams, so that <code>yap_flag(user_*)</code> will change them too.</li>
|
||||
<li>FIXED: <code>nth/3</code> and <code>nth0/3</code> would leave one extra choice-point.</li>
|
||||
<li>FIXED: <code>YP_std*</code> are now streams, so that
|
||||
<code>yap_flag(user_*)</code> will change them too.</li>
|
||||
<li>FIXED: <code>nth/3</code> and <code>nth0/3</code> would
|
||||
leave one extra choice-point.</li>
|
||||
<li>FIXED: use <code>Contents</code> instead of <code>Uses</code> to determine live variables.</li>
|
||||
<li>FIXED: <code>cputime</code> was actually <code>walltime</code> in WIN32, ugh (report from Steve Moyle).</li>
|
||||
<li>FIXED: regexp library would not compile on recent versions of cygwin.</li>
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@
|
|||
#undef HAVE_FPU_CONTROL_H
|
||||
#undef HAVE_GMP_H
|
||||
#undef HAVE_IEEEFP_H
|
||||
#undef HAVE_IO_H
|
||||
#undef HAVE_LIMITS_H
|
||||
#undef HAVE_MEMORY_H
|
||||
#undef HAVE_NETDB_H
|
||||
|
|
|
|||
|
|
@ -2461,7 +2461,7 @@ else
|
|||
fi
|
||||
done
|
||||
|
||||
for ac_hdr in sys/select.h direct.h dirent.h signal.h
|
||||
for ac_hdr in sys/select.h direct.h dirent.h signal.h io.h
|
||||
do
|
||||
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
|
||||
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
|
||||
|
|
|
|||
|
|
@ -395,7 +395,7 @@ AC_CHECK_HEADERS(sys/param.h errno.h netdb.h netinet/in.h arpa/inet.h)
|
|||
AC_CHECK_HEADERS(string.h memory.h sys/mman.h sys/stat.h stdarg.h ctype.h)
|
||||
AC_CHECK_HEADERS(sys/resource.h limits.h siginfo.h time.h fenv.h)
|
||||
AC_CHECK_HEADERS(fpu_control.h sys/shm.h regex.h winsock.h winsock2.h)
|
||||
AC_CHECK_HEADERS(sys/select.h direct.h dirent.h signal.h)
|
||||
AC_CHECK_HEADERS(sys/select.h direct.h dirent.h signal.h io.h)
|
||||
if test "$yap_cv_gmp" != "no"
|
||||
then
|
||||
AC_CHECK_HEADERS(gmp.h)
|
||||
|
|
|
|||
|
|
@ -327,8 +327,25 @@ parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args)
|
|||
output_msg = TRUE;
|
||||
break;
|
||||
#endif
|
||||
case 'l':
|
||||
case 'L':
|
||||
p++;
|
||||
while (*p != '\0' && (*p == ' ' || *p == '\t'))
|
||||
p++;
|
||||
/* skip zeroth argument */
|
||||
argc--;
|
||||
if (argc == 0) {
|
||||
fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n");
|
||||
exit(1);
|
||||
}
|
||||
argv++;
|
||||
if (p[0] == '-' && p[1] == '-'&& p[2] == '\0') {
|
||||
/* we're done here */
|
||||
argc = 1;
|
||||
}
|
||||
init_args->YapPrologBootFile = *argv;
|
||||
init_args->HaltAfterConsult = TRUE;
|
||||
break;
|
||||
case 'l':
|
||||
if ((*argv)[0] == '\0')
|
||||
init_args->YapPrologBootFile = *argv;
|
||||
else {
|
||||
|
|
@ -340,8 +357,6 @@ parse_yap_arguments(int argc, char *argv[], yap_init_args *init_args)
|
|||
argv++;
|
||||
init_args->YapPrologBootFile = *argv;
|
||||
}
|
||||
if (p[0] == 'L')
|
||||
init_args->HaltAfterConsult = TRUE;
|
||||
break;
|
||||
case '-':
|
||||
/* skip remaining arguments */
|
||||
|
|
|
|||
241
docs/yap.tex
241
docs/yap.tex
|
|
@ -885,7 +885,7 @@ Unix-like environments. A simple example is shown next:
|
|||
|
||||
@example
|
||||
@cartouche
|
||||
#!/usr/local/bin/yap -L $0 "$@"
|
||||
#!/usr/local/bin/yap -L
|
||||
#
|
||||
# Hello World script file using Yap
|
||||
#
|
||||
|
|
@ -898,16 +898,16 @@ Unix-like environments. A simple example is shown next:
|
|||
The @code{#!} characters specify that the script should call the binary
|
||||
file Yap. Notice that many systems will require the complete path to the
|
||||
Yap binary. The @code{-L} flag indicates that YAP should consult the
|
||||
file "$0" at booting and then halt. The remaining arguments are then
|
||||
passed to YAP. Note that YAP will skip the first lines if they start
|
||||
with @code{#} (the comment sign for Unix's shell). YAP will consult the
|
||||
file and execute any commands.
|
||||
current file when booting and then halt. The remaining arguments are
|
||||
then passed to YAP. Note that YAP will skip the first lines if they
|
||||
start with @code{#} (the comment sign for Unix's shell). YAP will
|
||||
consult the file and execute any commands.
|
||||
|
||||
A slightly more sophisticated example is:
|
||||
|
||||
@example
|
||||
@cartouche
|
||||
#!/usr/bin/yap -L $0 "$@"
|
||||
#!/usr/bin/yap -L
|
||||
#
|
||||
# Hello World script file using Yap
|
||||
#
|
||||
|
|
@ -923,6 +923,58 @@ The @code{initialization} directive tells Yap to execute the goal main
|
|||
after consulting the file. Source code is thus compiled and @code{main}
|
||||
executed at the end.
|
||||
|
||||
By default, arguments to a script are considered arguments to YAP. As an
|
||||
example, consider the following script @code{dump_args}:
|
||||
|
||||
@example
|
||||
@cartouche
|
||||
#!/usr/bin/yap -L
|
||||
|
||||
main( [] ).
|
||||
main( [H|T] ) :-
|
||||
write( H ), nl,
|
||||
main( T ).
|
||||
|
||||
:- unix( argv(AllArgs) ), main( AllArgs ).
|
||||
|
||||
@end cartouche
|
||||
@end example
|
||||
|
||||
If you this run this script with the arguments:
|
||||
@example
|
||||
./dump_args -s 10000
|
||||
@end example
|
||||
@noindent
|
||||
the script will start an YAP process with stack size @code{10MB}, and
|
||||
the list of arguments to the process will be empty.
|
||||
|
||||
Often one wants to run the script as any other program, and for this it
|
||||
is convenient to ignore arguments to YAP. This is possible by using
|
||||
@code{L --} as in the next version of @code{dump_args}:
|
||||
|
||||
@example
|
||||
@cartouche
|
||||
#!/usr/bin/yap -L --
|
||||
|
||||
main( [] ).
|
||||
main( [H|T] ) :-
|
||||
write( H ), nl,
|
||||
main( T ).
|
||||
|
||||
:- unix( argv(AllArgs) ), main( AllArgs ).
|
||||
|
||||
@end cartouche
|
||||
@end example
|
||||
|
||||
The @code{--} indicates the next arguments are not for YAP. Instead,
|
||||
they must be sent directly to the @code{argv} builtin. Hence, running
|
||||
@example
|
||||
./dump_args test
|
||||
@end example
|
||||
@noindent
|
||||
will write @code{test} on the standard output.
|
||||
|
||||
|
||||
@node Syntax, Loading Programs, Run, Top
|
||||
@chapter Syntax
|
||||
|
||||
|
|
@ -1547,6 +1599,13 @@ directories are the places where files specified in the form
|
|||
@code{consult/1}, @code{reconsult/1}, @code{use_module/1} or
|
||||
@code{ensure_loaded/1}.
|
||||
|
||||
@item prolog_file_name(+@var{Name},-@var{FullPath})
|
||||
@findex prolog_file_name/2
|
||||
@syindex prolog_file_name/1
|
||||
@cnindex prolog_file_name/2
|
||||
Unify @var{FullPath} with the absolute path YAP would use to consult
|
||||
file @var{Name}.
|
||||
|
||||
@item public @var{P} [ISO]
|
||||
@findex public/1 (directive)
|
||||
@snindex public/1 (directive)
|
||||
|
|
@ -4510,11 +4569,13 @@ support may go away in future versions.
|
|||
@findex abolish/1
|
||||
@saindex abolish/1
|
||||
@caindex abolish/1
|
||||
Deletes the predicate given by @var{PredSpec} from the database. The
|
||||
Deletes the predicate given by @var{PredSpec} from the database. If
|
||||
@var{PredSpec} is an unbound variable, delete all predicates for the
|
||||
current module. The
|
||||
specification must include the name and arity, and it may include module
|
||||
information. Under @t{iso} language mode this builtin will only abolish
|
||||
dynamic procedures. Under other modes it will abolish any procedures, as
|
||||
long as they are not currently in use.
|
||||
long as they are not currently in use.
|
||||
|
||||
@item abolish(+@var{P},+@var{N})
|
||||
@findex abolish/2
|
||||
|
|
@ -4609,7 +4670,13 @@ Lists predicate @var{P} if its source code is available.
|
|||
@findex portray_clause/1
|
||||
@syindex portray_clause/1
|
||||
@cnindex portray_clause/1
|
||||
Write clause @var{C} as if written by listing.
|
||||
Write clause @var{C} as if written by @code{listing/0}.
|
||||
|
||||
@item portray_clause(+@var{S},+@var{C})
|
||||
@findex portray_clause/2
|
||||
@syindex portray_clause/2
|
||||
@cnindex portray_clause/2
|
||||
Write clause @var{C} on stream @var{S} as if written by @code{listing/0}.
|
||||
|
||||
@item current_atom(@var{A})
|
||||
@findex current_atom/1
|
||||
|
|
@ -7233,6 +7300,159 @@ YAP does not currently support opening a @code{charsio} stream in
|
|||
@section Calling The Operating System from YAP
|
||||
@cindex Operating System Utilities
|
||||
|
||||
Yap now provides a library of system utilities compatible with the
|
||||
SICStus Prolog system library. This library extends and to some point
|
||||
replaces the functionality of Operating System access routines. The
|
||||
library includes Unix/Linux and Win32 @code{C} code. They
|
||||
are available through the @code{use_module(library(system))} command.
|
||||
|
||||
@table @code
|
||||
|
||||
@item datime(datime(-@var{Year}, -@var{Month}, -@var{DayOfTheMonth},
|
||||
-@var{Hour}, -@var{Minute}, -@var{Second})
|
||||
@findex datime/1
|
||||
@syindex datime/1
|
||||
@cnindex datime/1
|
||||
The @code{datime/1} procedure returns the current date and time, with
|
||||
information on @var{Year}, @var{Month}, @var{DayOfTheMonth},
|
||||
@var{Hour}, @var{Minute}, and @var{Second}. The @var{Hour} is returned
|
||||
on local time. This function uses the WIN32
|
||||
@code{GetLocalTime} function or the Unix @code{localtime} function.
|
||||
|
||||
@example
|
||||
?- datime(X).
|
||||
|
||||
X = datime(2001,5,28,15,29,46) ?
|
||||
@end example
|
||||
|
||||
@item delete_file(+@var{File})
|
||||
@findex delete_file/1
|
||||
@syindex delete_file/1
|
||||
@cnindex delete_file/1
|
||||
The @code{delete_file/1} procedure removes file @var{File}. If
|
||||
@var{File} is a directory, remove the directory @emph{and all its
|
||||
subdirectories}.
|
||||
|
||||
@example
|
||||
?- delete_file(x).
|
||||
@end example
|
||||
|
||||
@item delete_file(+@var{File},+@var{Opts})
|
||||
@findex delete_file/2
|
||||
@syindex delete_file/2
|
||||
@cnindex delete_file/2
|
||||
The @code{delete_file/2} procedure removes file @var{File} according to
|
||||
options @var{Opts}. These options are @code{directory} if one should
|
||||
remove directories, @code{recursive} if one should remove directories
|
||||
recursively, and @code{ignore} if errors are not to be reported.
|
||||
|
||||
This example is equivalent to using the @code{delete_file/1} predicate:
|
||||
@example
|
||||
?- delete_file(x, [recursive]).
|
||||
@end example
|
||||
|
||||
|
||||
@item directory_files(+@var{Dir},+@var{List})
|
||||
@findex directory_files/2
|
||||
@syindex directory_files/2
|
||||
@cnindex directory_files/2
|
||||
Given a directory @var{Dir}, @code{directory_files/2} procedures a
|
||||
listing of all files and directories in the directory:
|
||||
@example
|
||||
?- directory_files('.',L), writeq(L).
|
||||
['Makefile.~1~','sys.so','Makefile','sys.o',x,..,'.']
|
||||
@end example
|
||||
The predicates uses the @code{dirent} family of routines in Unix
|
||||
environments, and @code{findfirst} in WIN32.
|
||||
|
||||
@item file_exists(+@var{File})
|
||||
@findex file_exists/1
|
||||
@syindex file_exists/1
|
||||
@cnindex file_exists/1
|
||||
The atom @var{File} corresponds to an existing file.
|
||||
|
||||
@item file_exists(+@var{File},+@var{Permissions})
|
||||
@findex file_exists/2
|
||||
@syindex file_exists/2
|
||||
@cnindex file_exists/2
|
||||
The atom @var{File} corresponds to an existing file with permissions
|
||||
compatible with @var{Permissions}. YAP currently only accepts for
|
||||
permissions to be described as a number. The actual meaning of this
|
||||
number is Operating System dependent.
|
||||
|
||||
@item file_property(+@var{File},?@var{Property})
|
||||
@findex file_property/2
|
||||
@syindex file_property/2
|
||||
@cnindex file_property/2
|
||||
The atom @var{File} corresponds to an existing file, and @var{Property}
|
||||
will be unified with a property of this file. The poperties are of the
|
||||
form @code{type(@var{Type))}, which gives whether the file is a regular
|
||||
file, a directory, a fifo file, or of unknown type;
|
||||
@code{size(@var{Size))}, with gives the size for a file, and
|
||||
@code{mod_time(@var{Time))}, which gives the last time a file was
|
||||
modified according to some Operating System dependent
|
||||
timestamp. Properties can be obtained through backtracking:
|
||||
|
||||
@example
|
||||
?- file_property('Makefile',P).
|
||||
|
||||
P = type(regular) ? ;
|
||||
|
||||
P = size(2375) ? ;
|
||||
|
||||
P = mod_time(990826911) ? ;
|
||||
|
||||
no
|
||||
@end example
|
||||
|
||||
@item make_directory(+@var{Dir})
|
||||
@findex make_directory/2
|
||||
@syindex make_directory/2
|
||||
@cnindex make_directory/2
|
||||
Create a directory @var{Dir}. The name of the directory must be an atom.
|
||||
|
||||
@item rename_file(+@var{OldFile},+@var{NewFile})
|
||||
@findex rename_file/2
|
||||
@syindex rename_file/2
|
||||
@cnindex rename_file/2
|
||||
Create file @var{OldFile} to @var{NewFile}. This predicate uses the
|
||||
@code{C} builtin function @code{rename}.
|
||||
|
||||
|
||||
@item environ(?@var{EnvVar},+@var{EnvValue})
|
||||
@findex environ/2
|
||||
@syindex environ/2
|
||||
@cnindex environ/2
|
||||
Unify environment variable @var{EnvVar} with its value @var{EnvValue},
|
||||
if there is one. This predicate is backtrackable in Unix systems, but
|
||||
not currently in Win32 configurations.
|
||||
|
||||
@example
|
||||
?- environ('HOME',X).
|
||||
|
||||
X = 'C:\\cygwin\\home\\administrator' ?
|
||||
@end example
|
||||
|
||||
@item
|
||||
exec(+@var{Command},[+@var{InputStream},+@var{OutputStream},,+@var{ErrorStream},
|
||||
-@var{Status})
|
||||
@findex exec/3
|
||||
@syindex exec/3
|
||||
@cnindex exec/3
|
||||
Execute command @var{Command} with its streams connected to
|
||||
@var{InputStream}, @var{OutputStream}, and @var{ErrorStream}. The result
|
||||
for the command is returned in @var{Status}.
|
||||
|
||||
@item working_directory(-@var{CurDir},?@var{NextDir})
|
||||
@findex working_directory/2
|
||||
@syindex working_directory/2
|
||||
@cnindex working_directory/2
|
||||
Fetch the current directory at @var{CurDir}. If @var{NextDir} is bound
|
||||
to an atom, make its value the current working directory.
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
@node Terms, Timeout, System, Library
|
||||
@section Utilities On Terms
|
||||
@cindex utilities on terms
|
||||
|
|
@ -12520,7 +12740,8 @@ compatible built-in.
|
|||
implemented in YAP (note that this is only a partial list):
|
||||
@code{call_cleanup/1}, @code{file_search_path/2},
|
||||
@code{stream_interrupt/3}, @code{reinitialize/0}, @code{help/0},
|
||||
@code{help/1}, @code{module/3}, @code{trimcore/0}.
|
||||
@code{help/1}, @code{trimcore/0}, @code{load_files/1},
|
||||
@code{load_files/2}, and @code{require/1}.
|
||||
|
||||
The previous list is incomplete. We also cannot guarantee full
|
||||
compatibility for other built-ins (although we will try to address any
|
||||
|
|
|
|||
|
|
@ -275,12 +275,48 @@ check_mode(write,1, _) :- !.
|
|||
check_mode(Mode, G) :-
|
||||
throw(domain_error(io_mode,Mode),G).
|
||||
|
||||
shell :-
|
||||
G = shell,
|
||||
get_shell(Shell),
|
||||
atom_codes(FullCommand, Shell),
|
||||
exec_command(FullCommand, '$stream'(0),'$stream'(0), '$stream'(1), PID, Error),
|
||||
handle_system_error(Error, off, G),
|
||||
wait(PID, _Status, Error),
|
||||
handle_system_error(Error, off, G).
|
||||
|
||||
shell(Command) :-
|
||||
G = shell(Command),
|
||||
check_command(Command, G),
|
||||
get_shell(Shell),
|
||||
atom_codes(Command, SC),
|
||||
append(Shell, SC, ShellCommand),
|
||||
atom_codes(FullCommand, ShellCommand),
|
||||
exec_command(FullCommand, '$stream'(0),'$stream'(0), '$stream'(1), PID, Error),
|
||||
handle_system_error(Error, off, G),
|
||||
wait(PID, _Status, Error),
|
||||
handle_system_error(Error, off, G).
|
||||
|
||||
shell(Command, Status) :-
|
||||
G = shell(Command, Status),
|
||||
check_command(Command, G),
|
||||
do_shell(Status, Error),
|
||||
( var(Error) -> Status = 0 ; Status = Error).
|
||||
get_shell(Shell),
|
||||
atom_codes(Command, SC),
|
||||
append(Shell, SC, ShellCommand),
|
||||
atom_codes(FullCommand, ShellCommand),
|
||||
exec_command(FullCommand, '$stream'(0),'$stream'(0), '$stream'(1), PID, Error),
|
||||
handle_system_error(Error, off, G),
|
||||
wait(PID, Status,Error),
|
||||
handle_system_error(Error, off, G).
|
||||
|
||||
get_shell(Shell) :-
|
||||
getenv('SHELL', Shell0), !,
|
||||
atom_codes(Shell0, Codes),
|
||||
append(Codes," -c ", Shell).
|
||||
get_shell(COMSPEC) :-
|
||||
getenv('COMPSEC', Shell),
|
||||
atom_codes(Shell0, Codes),
|
||||
append(Codes," /c ", Shell).
|
||||
|
||||
system(Command, Status) :-
|
||||
G = system(Command, Status),
|
||||
check_command(Command, G),
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ sys.so: sys.o
|
|||
#
|
||||
DLLTOOL=dlltool
|
||||
DLLNAME=sys.dll
|
||||
DLL_LIBS=-lcrtdll -L../.. -lWYap
|
||||
DLL_LIBS=-L /usr/lib/mingw -lmoldname -lcrtdll -lkernel32 -L../.. -lWYap
|
||||
BASE_FILE=sys.base
|
||||
EXP_FILE=sys.exp
|
||||
DEF_FILE=$(srcdir)/sys.def
|
||||
|
|
|
|||
|
|
@ -54,7 +54,13 @@
|
|||
#if HAVE_DIRENT_H
|
||||
#include <dirent.h>
|
||||
#endif
|
||||
|
||||
#if HAVE_DIRECT_H
|
||||
#include <direct.h>
|
||||
#endif
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
#include <windows.h>
|
||||
#include <process.h>
|
||||
#endif
|
||||
#ifdef __MINGW32__
|
||||
#ifdef HAVE_ENVIRON
|
||||
#undef HAVE_ENVIRON
|
||||
|
|
@ -68,7 +74,16 @@ static int
|
|||
datime(void)
|
||||
{
|
||||
Term tf, out[6];
|
||||
#ifdef HAVE_TIME
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
SYSTEMTIME stime;
|
||||
GetLocalTime(&stime);
|
||||
out[0] = MkIntTerm(stime.wYear);
|
||||
out[1] = MkIntTerm(stime.wMonth);
|
||||
out[2] = MkIntTerm(stime.wDay);
|
||||
out[3] = MkIntTerm(stime.wHour);
|
||||
out[4] = MkIntTerm(stime.wMinute);
|
||||
out[5] = MkIntTerm(stime.wSecond);
|
||||
#elif HAVE_TIME
|
||||
time_t tp;
|
||||
|
||||
if ((tp = time(NULL)) == -1) {
|
||||
|
|
@ -106,6 +121,32 @@ list_directory(void)
|
|||
Term tf = MkAtomTerm(LookupAtom("[]"));
|
||||
|
||||
char *buf = AtomName(AtomOfTerm(ARG1));
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
struct _finddata_t c_file;
|
||||
char bs[BUF_SIZE];
|
||||
long hFile;
|
||||
|
||||
bs[0] = '\0';
|
||||
#if HAVE_STRNCPY
|
||||
strncpy(bs, buf, BUF_SIZE);
|
||||
#else
|
||||
strcpy(bs, buf);
|
||||
#endif
|
||||
#if HAVE_STRNCAT
|
||||
strncat(bs, "/*", BUF_SIZE);
|
||||
#else
|
||||
strncat(bs, "/*");
|
||||
#endif
|
||||
if ((hFile = _findfirst(bs, &c_file)) == -1L) {
|
||||
return(unify(ARG2,tf));
|
||||
}
|
||||
tf = MkPairTerm(MkAtomTerm(LookupAtom(c_file.name)), tf);
|
||||
while (_findnext( hFile, &c_file) == 0) {
|
||||
Term ti = MkAtomTerm(LookupAtom(c_file.name));
|
||||
tf = MkPairTerm(ti, tf);
|
||||
}
|
||||
_findclose( hFile );
|
||||
#else
|
||||
#if HAVE_OPENDIR
|
||||
{
|
||||
DIR *de;
|
||||
|
|
@ -121,6 +162,7 @@ list_directory(void)
|
|||
closedir(de);
|
||||
}
|
||||
#endif /* HAVE_OPENDIR */
|
||||
#endif
|
||||
return(unify(ARG2, tf));
|
||||
}
|
||||
|
||||
|
|
@ -128,10 +170,15 @@ static int
|
|||
p_unlink(void)
|
||||
{
|
||||
char *fd = AtomName(AtomOfTerm(ARG1));
|
||||
if (unlink(fd) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
if (_unlink(fd) == -1)
|
||||
#else
|
||||
if (unlink(fd) == -1)
|
||||
#endif
|
||||
{
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
|
|
@ -139,7 +186,11 @@ static int
|
|||
p_mkdir(void)
|
||||
{
|
||||
char *fd = AtomName(AtomOfTerm(ARG1));
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
if (_mkdir(fd) == -1) {
|
||||
#else
|
||||
if (mkdir(fd, 0777) == -1) {
|
||||
#endif
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
|
|
@ -150,7 +201,11 @@ static int
|
|||
p_rmdir(void)
|
||||
{
|
||||
char *fd = AtomName(AtomOfTerm(ARG1));
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
if (_rmdir(fd) == -1) {
|
||||
#else
|
||||
if (rmdir(fd) == -1) {
|
||||
#endif
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
|
|
@ -181,7 +236,7 @@ static int
|
|||
file_property(void)
|
||||
{
|
||||
char *fd;
|
||||
#if HAVE_LSTAT
|
||||
#if HAVE_LSTAT
|
||||
struct stat buf;
|
||||
|
||||
fd = AtomName(AtomOfTerm(ARG1));
|
||||
|
|
@ -189,9 +244,9 @@ file_property(void)
|
|||
/* return an error number */
|
||||
return(unify(ARG6, MkIntTerm(errno)));
|
||||
}
|
||||
if (S_ISREG(buf.st_mode))
|
||||
if (buf.st_mode & _S_IFREG)
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("regular")));
|
||||
else if (S_ISDIR(buf.st_mode))
|
||||
else if (buf.st_mode & _S_IFDIR)
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("directory")));
|
||||
else if (S_ISFIFO(buf.st_mode))
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("fifo")));
|
||||
|
|
@ -201,10 +256,25 @@ file_property(void)
|
|||
unify(ARG2, MkAtomTerm(LookupAtom("socket")));
|
||||
else
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("unknown")));
|
||||
#elif defined(__MINGW32__) || _MSC_VER
|
||||
/* for some weird reason _stat did not work with mingw32 */
|
||||
struct stat buf;
|
||||
|
||||
fd = AtomName(AtomOfTerm(ARG1));
|
||||
if (stat(fd, &buf) != 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG6, MkIntTerm(errno)));
|
||||
}
|
||||
if (buf.st_mode & S_IFREG)
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("regular")));
|
||||
else if (buf.st_mode & S_IFDIR)
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("directory")));
|
||||
else
|
||||
unify(ARG2, MkAtomTerm(LookupAtom("unknown")));
|
||||
#endif
|
||||
unify(ARG3, MkIntTerm(buf.st_size));
|
||||
unify(ARG4, MkIntTerm(buf.st_mtime));
|
||||
unify(ARG5, MkIntTerm(buf.st_mode));
|
||||
#endif
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
|
|
@ -221,7 +291,11 @@ p_mktemp(void)
|
|||
#else
|
||||
strcpy(tmp, s);
|
||||
#endif
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
if ((s = _mktemp(tmp)) == NULL) {
|
||||
#else
|
||||
if ((s = mktemp(tmp)) == NULL) {
|
||||
#endif
|
||||
/* return an error number */
|
||||
return(unify(ARG3, MkIntTerm(errno)));
|
||||
}
|
||||
|
|
@ -247,12 +321,20 @@ static int
|
|||
p_environ(void)
|
||||
{
|
||||
#if HAVE_ENVIRON
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
extern char **_environ;
|
||||
#else
|
||||
extern char **environ;
|
||||
#endif
|
||||
Term t1 = ARG1;
|
||||
Int i;
|
||||
|
||||
i = IntOfTerm(t1);
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
if (_environ[i] == NULL)
|
||||
#else
|
||||
if (environ[i] == NULL)
|
||||
#endif
|
||||
return(FALSE);
|
||||
else {
|
||||
Term t = BufferToString(environ[i]);
|
||||
|
|
@ -264,6 +346,37 @@ p_environ(void)
|
|||
#endif
|
||||
}
|
||||
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
static int
|
||||
get_handle(Term ti, int fd, Term tzero)
|
||||
{
|
||||
if (ti == tzero) {
|
||||
int new_fd = _dup(fd);
|
||||
_close(fd);
|
||||
return(new_fd);
|
||||
} else {
|
||||
int sd = YapStreamToFileNo(ti), new_fd;
|
||||
if (sd == fd)
|
||||
return(-1);
|
||||
new_fd = _dup(fd);
|
||||
_close(fd);
|
||||
_dup2(sd, fd);
|
||||
return(new_fd);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
restore_descriptor(int fd0, int fd, Term t, Term tzero)
|
||||
{
|
||||
if (fd != -1) {
|
||||
if (t != tzero) {
|
||||
_close(fd0);
|
||||
}
|
||||
_dup2(fd, fd0);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* execute a command as a detached process */
|
||||
static int
|
||||
execute_command(void)
|
||||
|
|
@ -272,6 +385,46 @@ execute_command(void)
|
|||
Term tzero = MkIntTerm(0);
|
||||
int res;
|
||||
int inpf, outf, errf;
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
DWORD CreationFlags = 0;
|
||||
STARTUPINFO StartupInfo;
|
||||
PROCESS_INFORMATION ProcessInformation;
|
||||
inpf = get_handle(ti, 0, tzero);
|
||||
outf = get_handle(to, 1, tzero);
|
||||
errf = get_handle(te, 2, tzero);
|
||||
if (inpf != -1 || outf != -1 || errf != -1) {
|
||||
/* we are keeping the curent streams */
|
||||
CreationFlags = DETACHED_PROCESS;
|
||||
}
|
||||
StartupInfo.cb = sizeof(STARTUPINFO);
|
||||
StartupInfo.lpReserved = NULL;
|
||||
StartupInfo.lpDesktop = NULL; /* inherit */
|
||||
StartupInfo.lpTitle = NULL; /* we do not create a new console window */
|
||||
StartupInfo.dwFlags = STARTF_USESTDHANDLES;
|
||||
StartupInfo.cbReserved2 = 0;
|
||||
StartupInfo.lpReserved2 = NULL;
|
||||
StartupInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
|
||||
StartupInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
StartupInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE);
|
||||
/* got stdin, stdout and error as I like it */
|
||||
if (CreateProcess(NULL,
|
||||
AtomName(AtomOfTerm(ARG1)),
|
||||
NULL,
|
||||
NULL,
|
||||
TRUE,
|
||||
CreationFlags,
|
||||
NULL,
|
||||
NULL,
|
||||
&StartupInfo,
|
||||
&ProcessInformation) == FALSE) {
|
||||
return(unify(ARG6, MkIntTerm(GetLastError())));
|
||||
}
|
||||
restore_descriptor(0, inpf, ti, tzero);
|
||||
restore_descriptor(1, outf, to, tzero);
|
||||
restore_descriptor(2, errf, te, tzero);
|
||||
res = ProcessInformation.dwProcessId;
|
||||
return(unify(ARG5,MkIntTerm(res)));
|
||||
#else /* UNIX CODE */
|
||||
/* process input first */
|
||||
if (ti == tzero) {
|
||||
inpf = open("/dev/null", O_RDONLY);
|
||||
|
|
@ -341,50 +494,7 @@ execute_command(void)
|
|||
close(errf);
|
||||
return(unify(ARG5,MkIntTerm(res)));
|
||||
}
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
static int
|
||||
shell(void)
|
||||
{
|
||||
char *command = AtomName(AtomOfTerm(ARG1));
|
||||
int pid;
|
||||
/* we are now ready to fork */
|
||||
if ((pid = fork()) < 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
} else if (pid == 0) {
|
||||
char *argv[4];
|
||||
char *shell;
|
||||
|
||||
/* child */
|
||||
/* close current streams, but not std streams */
|
||||
YapCloseAllOpenStreams();
|
||||
#if HAVE_GETENV
|
||||
shell = getenv ("SHELL");
|
||||
if (shell == NULL)
|
||||
shell = "/bin/sh";
|
||||
#endif
|
||||
argv[0] = shell;
|
||||
argv[1] = "-c";
|
||||
argv[2] = command;
|
||||
argv[3] = NULL;
|
||||
execv("/bin/sh", argv);
|
||||
exit(127);
|
||||
/* we have the streams where we want them, just want to execute now */
|
||||
} else {
|
||||
do {
|
||||
int status;
|
||||
|
||||
/* check for interruptions */
|
||||
if (waitpid(pid, &status, 0) == -1) {
|
||||
if (errno != EINTR)
|
||||
return -1;
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
} else
|
||||
return(TRUE);
|
||||
} while(TRUE);
|
||||
}
|
||||
#endif /* UNIX code */
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
|
|
@ -403,6 +513,21 @@ static int
|
|||
p_wait(void)
|
||||
{
|
||||
Int pid = IntOfTerm(ARG1);
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|SYNCHRONIZE, FALSE, pid);
|
||||
DWORD ExitCode;
|
||||
if (proc == NULL) {
|
||||
return(unify(ARG3, MkIntTerm(GetLastError())));
|
||||
}
|
||||
if (WaitForSingleObject(proc, INFINITE) == WAIT_FAILED) {
|
||||
return(unify(ARG3, MkIntTerm(GetLastError())));
|
||||
}
|
||||
if (GetExitCodeProcess(proc, &ExitCode) == 0) {
|
||||
return(unify(ARG3, MkIntTerm(GetLastError())));
|
||||
}
|
||||
CloseHandle(proc);
|
||||
return(unify(ARG2, MkIntTerm(ExitCode)));
|
||||
#else
|
||||
do {
|
||||
int status;
|
||||
|
||||
|
|
@ -415,6 +540,7 @@ p_wait(void)
|
|||
return(unify(ARG2, MkIntTerm(status)));
|
||||
}
|
||||
} while(TRUE);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* execute a command as a detached process */
|
||||
|
|
@ -428,10 +554,18 @@ p_popen(void)
|
|||
int flags;
|
||||
|
||||
#if HAVE_POPEN
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
/* This will only work for console applications. FIX */
|
||||
if (mode == 0)
|
||||
pfd = _popen(command, "r");
|
||||
else
|
||||
pfd = _popen(command, "w");
|
||||
#else
|
||||
if (mode == 0)
|
||||
pfd = popen(command, "r");
|
||||
else
|
||||
pfd = popen(command, "w");
|
||||
#endif
|
||||
if (pfd == NULL) {
|
||||
return(unify(ARG4, MkIntTerm(errno)));
|
||||
}
|
||||
|
|
@ -461,6 +595,11 @@ p_sleep(void)
|
|||
else
|
||||
usecs = tfl*1000;
|
||||
}
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
if (secs) usecs = secs*1000;
|
||||
Sleep(usecs);
|
||||
out = 0;
|
||||
#else
|
||||
#if HAVE_USLEEP
|
||||
if (usecs > 0) {
|
||||
usleep(usecs);
|
||||
|
|
@ -472,6 +611,7 @@ p_sleep(void)
|
|||
out = sleep(secs);
|
||||
}
|
||||
#endif
|
||||
#endif /* defined(__MINGW32__) || _MSC_VER */
|
||||
return(unify(ARG2, MkIntTerm(out)));
|
||||
}
|
||||
|
||||
|
|
@ -480,13 +620,21 @@ p_sleep(void)
|
|||
static int
|
||||
host_name(void)
|
||||
{
|
||||
char name[256];
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
char name[MAX_COMPUTERNAME_LENGTH+1];
|
||||
DWORD nSize = MAX_COMPUTERNAME_LENGTH+1;
|
||||
if (GetComputerName(name, &nSize) == 0) {
|
||||
return(unify(ARG2, MkIntTerm(GetLastError())));
|
||||
}
|
||||
#else
|
||||
#if HAVE_GETHOSTNAME
|
||||
char name[256];
|
||||
if (gethostname(name, 256) == -1) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
}
|
||||
#endif
|
||||
#endif /* defined(__MINGW32__) || _MSC_VER */
|
||||
return(unify(ARG1, MkAtomTerm(LookupAtom(name))));
|
||||
}
|
||||
|
||||
|
|
@ -495,26 +643,42 @@ host_id(void)
|
|||
{
|
||||
#if HAVE_GETHOSTID
|
||||
return(unify(ARG1, MkIntTerm(gethostid())));
|
||||
#else
|
||||
return(unify(ARG1, MkIntTerm(0)));
|
||||
#endif
|
||||
}
|
||||
|
||||
static int
|
||||
pid(void)
|
||||
{
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
return(unify(ARG1, MkIntTerm(_getpid())));
|
||||
#else
|
||||
return(unify(ARG1, MkIntTerm(getpid())));
|
||||
#endif
|
||||
}
|
||||
|
||||
static int
|
||||
p_kill(void)
|
||||
{
|
||||
#if HAVE_KILL
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
/* Windows does not support cross-process signals, so we shall do the
|
||||
SICStus thing and assume that a signal to a process will
|
||||
always kill it */
|
||||
HANDLE proc = OpenProcess(STANDARD_RIGHTS_REQUIRED|PROCESS_TERMINATE, FALSE, IntOfTerm(ARG1));
|
||||
if (proc == NULL) {
|
||||
return(unify(ARG3, MkIntTerm(GetLastError())));
|
||||
}
|
||||
if (TerminateProcess(proc, -1) == 0) {
|
||||
return(unify(ARG3, MkIntTerm(GetLastError())));
|
||||
}
|
||||
CloseHandle(proc);
|
||||
#else
|
||||
if (kill(IntOfTerm(ARG1), IntOfTerm(ARG2)) < 0) {
|
||||
/* return an error number */
|
||||
return(unify(ARG2, MkIntTerm(errno)));
|
||||
return(unify(ARG3, MkIntTerm(errno)));
|
||||
}
|
||||
#else
|
||||
oops
|
||||
#endif
|
||||
#endif /* defined(__MINGW32__) || _MSC_VER */
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
|
|
@ -542,7 +706,6 @@ init_sys(void)
|
|||
UserCPredicate("dir_separator", dir_separator, 1);
|
||||
UserCPredicate("p_environ", p_environ, 2);
|
||||
UserCPredicate("exec_command", execute_command, 6);
|
||||
UserCPredicate("do_shell", shell, 2);
|
||||
UserCPredicate("do_system", do_system, 2);
|
||||
UserCPredicate("popen", p_popen, 4);
|
||||
UserCPredicate("wait", p_wait, 3);
|
||||
|
|
@ -561,9 +724,9 @@ init_sys(void)
|
|||
|
||||
#include <windows.h>
|
||||
|
||||
int WINAPI PROTO(win_system, (HANDLE, DWORD, LPVOID));
|
||||
int WINAPI PROTO(win_sys, (HANDLE, DWORD, LPVOID));
|
||||
|
||||
int WINAPI win_system(HANDLE hinst, DWORD reason, LPVOID reserved)
|
||||
int WINAPI win_sys(HANDLE hinst, DWORD reason, LPVOID reserved)
|
||||
{
|
||||
switch (reason)
|
||||
{
|
||||
|
|
@ -576,6 +739,6 @@ int WINAPI win_system(HANDLE hinst, DWORD reason, LPVOID reserved)
|
|||
case DLL_THREAD_DETACH:
|
||||
break;
|
||||
}
|
||||
p return 1;
|
||||
return 1;
|
||||
}
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -866,6 +866,8 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
|
|||
;
|
||||
throw(error(permission_error(input,stream,Y),consult(X)))
|
||||
).
|
||||
'$consult'(M:X) :-
|
||||
'$mod_switch'(M,'$consult'(X)).
|
||||
'$consult'(library(X)) :- !,
|
||||
'$find_in_path'(library(X),Y),
|
||||
( open(Y,'$csult',Stream), !,
|
||||
|
|
|
|||
|
|
@ -15,6 +15,9 @@
|
|||
* *
|
||||
*************************************************************************/
|
||||
|
||||
ensure_loaded(V) :-
|
||||
'$ensure_loaded'(V).
|
||||
|
||||
'$ensure_loaded'(V) :- var(V), !,
|
||||
throw(error(instantiation_error,ensure_loaded(V))).
|
||||
'$ensure_loaded'([]) :- !.
|
||||
|
|
@ -40,6 +43,8 @@
|
|||
|
||||
throw(error(permission_error(input,stream,X),ensure_loaded(X)))
|
||||
).
|
||||
'$ensure_loaded'(M:X) :-
|
||||
'$mod_switch'(M,'$ensure_loaded'(X)).
|
||||
'$ensure_loaded'(library(X)) :- !,
|
||||
'$find_in_path'(library(X),Y),
|
||||
( open(Y,'$csult',Stream), !,
|
||||
|
|
@ -100,6 +105,8 @@ reconsult(Fs) :-
|
|||
;
|
||||
throw(error(permission_error(input,stream,X),reconsult(X)))
|
||||
).
|
||||
'$reconsult'(M:X) :-
|
||||
'$mod_switch'(M,'$reconsult'(X)).
|
||||
'$reconsult'(library(X)) :- !,
|
||||
'$find_in_path'(library(X),Y),
|
||||
( open(Y,'$csult',Stream), !,
|
||||
|
|
|
|||
|
|
@ -54,6 +54,12 @@ listing(_).
|
|||
'$write_clause'(Pred,Body),
|
||||
fail.
|
||||
|
||||
portray_clause(Stream, Clause) :-
|
||||
current_output(OldStream),
|
||||
set_output(Stream),
|
||||
portray_clause(Clause),
|
||||
set_output(OldStream).
|
||||
|
||||
portray_clause((Pred:-Body)) :- !,
|
||||
'$beautify_vars'((Pred:-Body)),
|
||||
'$write_clause'(Pred,Body).
|
||||
|
|
|
|||
134
pl/modules.yap
134
pl/modules.yap
|
|
@ -249,7 +249,6 @@ $check_import(_,_,_,_).
|
|||
;
|
||||
true
|
||||
).
|
||||
|
||||
|
||||
|
||||
'$abolish_module_data'(M) :-
|
||||
|
|
@ -267,12 +266,12 @@ $check_import(_,_,_,_).
|
|||
'$prepare_body_with_correct_modules'(B, M, B0),
|
||||
'$module_u_vars'(H,UVars), % collect head variables in
|
||||
% expanded positions
|
||||
'$module_expansion'(B0,B1,BO,M,UVars). % expand body
|
||||
'$module_expansion'(B0,B1,BO,M,M,M,UVars). % expand body
|
||||
'$module_expansion'((H:-B),(H:-B1),(H:-BO)) :-
|
||||
'$module_u_vars'(H,UVars), % collect head variables in
|
||||
% expanded positions
|
||||
'$current_module'(M),
|
||||
'$module_expansion'(B,B1,BO,M,UVars). % expand body
|
||||
'$module_expansion'(B,B1,BO,M,M,M,UVars). % expand body
|
||||
% $trace_module((H:-B),(H:-B1)).
|
||||
|
||||
% expand module names in a body
|
||||
|
|
@ -295,15 +294,15 @@ $check_import(_,_,_,_).
|
|||
'$prepare_body_with_correct_modules'(G,M,M:G).
|
||||
|
||||
|
||||
$trace_module(X) :-
|
||||
'$trace_module'(X) :-
|
||||
telling(F),
|
||||
tell('P0:debug'),
|
||||
write(X),nl,
|
||||
tell(F), fail.
|
||||
$trace_module(X).
|
||||
'$trace_module'(X).
|
||||
|
||||
$trace_module(X,Y) :- X==Y, !.
|
||||
$trace_module(X,Y) :-
|
||||
'$trace_module'(X,Y) :- X==Y, !.
|
||||
'$trace_module'(X,Y) :-
|
||||
telling(F),
|
||||
tell('~/.dbg.modules'),
|
||||
write('***************'), nl,
|
||||
|
|
@ -330,72 +329,60 @@ $trace_module(X,Y).
|
|||
'$execute0'(G).
|
||||
|
||||
|
||||
'$complete_goal_expansion'(G, M, _, G1, G2, HVars) :-
|
||||
'$pred_goal_expansion_on',
|
||||
user:goal_expansion(G,M,GI), !,
|
||||
'$prepare_body_with_correct_modules'(GI, M, GF),
|
||||
'$module_expansion'(GF,G1,G2,M,HVars).
|
||||
'$complete_goal_expansion'(G, _, _, G, GF, _) :-
|
||||
'$system_predicate'(G), !,
|
||||
'$c_built_in'(G,GF).
|
||||
'$complete_goal_expansion'(G, Mod, Mod, G, G, _) :- '$current_module'(Mod), !.
|
||||
'$complete_goal_expansion'(G, GMod, _, GMod:G, GMod:G, _).
|
||||
|
||||
|
||||
% expand module names in a body
|
||||
'$module_expansion'(V,call(M:V),call(M:V),M,HVars) :- var(V), !.
|
||||
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,HVars).
|
||||
'$module_expansion'((A;B),(A1;B1),(AO;BO),M,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,HVars).
|
||||
'$module_expansion'((A->B),(A1->B1),(AO->BO),M,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,HVars).
|
||||
'$module_expansion'(true,true,true,_,_) :- !.
|
||||
'$module_expansion'(fail,fail,fail,_,_) :- !.
|
||||
'$module_expansion'(false,false,false,_,_) :- !.
|
||||
% args are:
|
||||
% goals to expand
|
||||
% code to pass to compiler
|
||||
% code to pass to listing
|
||||
% current module for looking up preds
|
||||
% current module for fixing up meta-call arguments
|
||||
% current module for predicate
|
||||
% head variables.
|
||||
'$module_expansion'(V,call(MM:V),call(MM:V),M,MM,TM,HVars) :- var(V), !.
|
||||
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,TM,HVars) :- !,
|
||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||
'$module_expansion'(true,true,true,_,_,_,_) :- !.
|
||||
'$module_expansion'(fail,fail,fail,_,_,_,_) :- !.
|
||||
'$module_expansion'(false,false,false,_,_,_,_) :- !.
|
||||
% if I don't know what the module is, I cannot do anything to the goal,
|
||||
% so I just put a call for later on.
|
||||
'$module_expansion'(M:G,call(M:G),call(M:G),_,HVars) :- var(M), !.
|
||||
'$module_expansion'(M:(M1:G),G1,GO,M0,HVars) :- !,
|
||||
'$module_expansion'(M1:G,G1,GO,M0,HVars).
|
||||
'$module_expansion'(M:G,G1,GO,Mod,HVars) :- !,
|
||||
'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,HVars) :- var(M), !.
|
||||
% if M1 is given explicitly process G within M1's context.
|
||||
'$module_expansion'(M:G,G1,GO,Mod,MM,TM,HVars) :- !,
|
||||
% is this imported from some other module M1?
|
||||
( '$imported_pred'(G, M, M1) ->
|
||||
% continue recursively...
|
||||
'$module_expansion'(M1:G,G1,GO,Mod,HVars)
|
||||
'$module_expansion'(G,G1,GO,M1,M,TM,HVars)
|
||||
;
|
||||
(
|
||||
'$meta_expansion_of_subgoal'(G, M, Mod, NG, HVars, NM)
|
||||
'$meta_expansion'(M, M, G, NG, HVars)
|
||||
;
|
||||
G = NG, M = NM
|
||||
G = NG
|
||||
),
|
||||
'$complete_goal_expansion'(NG, NM, Mod, G1, GO, HVars)
|
||||
'$complete_goal_expansion'(NG, M, M, TM, G1, GO, HVars)
|
||||
).
|
||||
%
|
||||
% next, check if this is something imported.
|
||||
%
|
||||
'$module_expansion'(G, G1, GO, CurMod, HVars) :-
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars) :-
|
||||
% is this imported from some other module M1?
|
||||
( '$imported_pred'(G, CurMod, M1) ->
|
||||
% continue recursively...
|
||||
'$module_expansion'(M1:G,G1,GO,CurMod,HVars)
|
||||
'$module_expansion'(G, G1, GO, M1, MM, TM, HVars)
|
||||
;
|
||||
( '$meta_expansion_of_subgoal'(G, CurMod, CurMod, GI, HVars, GoalModule)
|
||||
( '$meta_expansion'(CurMod, MM, G, GI, HVars)
|
||||
;
|
||||
GI = G, GoalModule = CurMod
|
||||
GI = G
|
||||
),
|
||||
'$complete_goal_expansion'(GI, GoalModule, CurMod, G1, GO, HVars)
|
||||
'$complete_goal_expansion'(GI, CurMod, MM, TM, G1, GO, HVars)
|
||||
).
|
||||
|
||||
'$meta_expansion_of_subgoal'(G, GMod, CurMod, GF, HVars, ImportedMod) :-
|
||||
functor(G,F,N),
|
||||
'$recorded'('$import','$import'(ImportedMod,GMod,F,N),_), !,
|
||||
'$meta_expansion'(ImportedMod, CurMod, G, GF, HVars).
|
||||
'$meta_expansion_of_subgoal'(G, GMod, CurMod, NG, HVars, GMod) :-
|
||||
'$meta_expansion'(GMod, CurMod, G, NG, HVars).
|
||||
|
||||
'$imported_pred'(G, ImportingMod, ExportingMod) :-
|
||||
'$undefined'(ImportingMod:G),
|
||||
|
|
@ -403,27 +390,40 @@ $trace_module(X,Y).
|
|||
'$recorded'('$import','$import'(ExportingMod,ImportingMod,F,N),_),
|
||||
ExportingMod \= ImportingMod.
|
||||
|
||||
% args are:
|
||||
% goal to expand
|
||||
% current module for looking up pred
|
||||
% current module from top-level clause
|
||||
% goal to pass to compiler
|
||||
% goal to pass to listing
|
||||
% head variables.
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :-
|
||||
'$pred_goal_expansion_on',
|
||||
user:goal_expansion(G,M,GI), !,
|
||||
'$module_expansion'(GI,G1,G2,M,CM,TM,HVars).
|
||||
'$complete_goal_expansion'(G, _, _, _, G, GF, _) :-
|
||||
'$system_predicate'(G), !,
|
||||
'$c_built_in'(G,GF).
|
||||
'$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !.
|
||||
'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).
|
||||
|
||||
% meta_predicate declaration
|
||||
% records $meta_predicate(SourceModule,Functor,Arity,Declaration)
|
||||
|
||||
% directive now meta_predicate Ps :- $meta_predicate(Ps).
|
||||
|
||||
'$meta_predicate'((P,Ps)) :- !,
|
||||
$meta_predicate(P),
|
||||
$meta_predicate(Ps).
|
||||
'$meta_predicate'(P),
|
||||
'$meta_predicate'(Ps).
|
||||
'$meta_predicate'(P) :-
|
||||
functor(P,F,N),
|
||||
'$current_module'(M1),
|
||||
( M1 = prolog -> M = _ ; M1 = M),
|
||||
% ( '$recorded'($meta_predicate,$meta_predicate(M,F,N,_),R), erase(R), fail;
|
||||
% true
|
||||
% ),
|
||||
% recorda('$meta_predicate','$meta_predicate'(M,F,N,P),_),
|
||||
( retractall('$meta_predicate'(F,M,N,_)), fail ; true),
|
||||
asserta($meta_predicate(F,M,N,P)),
|
||||
asserta('$meta_predicate'(F,M,N,P)),
|
||||
'$flags'(P, Fl, Fl),
|
||||
NFlags is Fl \/ 0x200000,
|
||||
'$flags'(P, Fl, NFlags).
|
||||
'$flags'(P, Fl, NFlags).
|
||||
|
||||
% return list of vars in expanded positions on the head of a clause.
|
||||
%
|
||||
|
|
@ -432,8 +432,8 @@ $trace_module(X,Y).
|
|||
'$module_u_vars'(H,UVars) :-
|
||||
functor(H,F,N),
|
||||
'$current_module'(M),
|
||||
% '$recorded'($meta_predicate,$meta_predicate(M,F,N,D),_), !,
|
||||
$meta_predicate(F,M,N,D), !,
|
||||
% '$recorded'('$meta_predicate','$meta_predicate'(M,F,N,D),_), !,
|
||||
'$meta_predicate'(F,M,N,D), !,
|
||||
'$module_u_vars'(N,D,H,UVars).
|
||||
'$module_u_vars'(H,[]).
|
||||
|
||||
|
|
@ -490,15 +490,15 @@ current_module(Mod,TFN) :-
|
|||
source_module(Mod) :-
|
||||
'$current_module'(Mod).
|
||||
|
||||
|
||||
$member(X,[X|_]) :- !.
|
||||
$member(X,[_|L]) :- $member(X,L).
|
||||
'$member'(X,[X|_]) :- !.
|
||||
'$member'(X,[_|L]) :- '$member'(X,L).
|
||||
|
||||
%
|
||||
% this declaration should only be here, as meta_predicates should belong
|
||||
% to the user module, not to the prolog module
|
||||
|
||||
:- meta_predicate
|
||||
% [:,:],
|
||||
abolish(:),
|
||||
abolish(:,+),
|
||||
all(?,:,?),
|
||||
|
|
@ -512,8 +512,11 @@ $member(X,[_|L]) :- $member(X,L).
|
|||
call(:),
|
||||
clause(:,?),
|
||||
clause(:,?,?),
|
||||
compile(:),
|
||||
consult(:),
|
||||
current_predicate(:),
|
||||
current_predicate(?,:),
|
||||
ensure_loaded(:),
|
||||
findall(?,:,?),
|
||||
findall(?,:,?,?),
|
||||
if(:,:,:),
|
||||
|
|
@ -524,6 +527,7 @@ $member(X,[_|L]) :- $member(X,L).
|
|||
retract(:),
|
||||
retract(:,?),
|
||||
retractall(:),
|
||||
reconsult(:),
|
||||
setof(?,:,?),
|
||||
spy(:),
|
||||
^(+,:),
|
||||
|
|
|
|||
12
pl/preds.yap
12
pl/preds.yap
|
|
@ -324,8 +324,8 @@ abolish(X) :-
|
|||
abolish(X) :-
|
||||
'$old_abolish'(X).
|
||||
|
||||
'$new_abolish'(V) :-
|
||||
'$check_error_in_predicate_indicator'(V, abolish(V)), !.
|
||||
'$new_abolish'(V) :- var(V), !,
|
||||
'$abolish_all'.
|
||||
'$new_abolish'(M:PS) :- !,
|
||||
'$mod_switch'(M,'$new_abolish'(PS)).
|
||||
'$new_abolish'(Na/Ar) :-
|
||||
|
|
@ -339,6 +339,12 @@ abolish(X) :-
|
|||
'$current_module'(M),
|
||||
throw(error(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar))).
|
||||
|
||||
'$abolish_all' :-
|
||||
current_predicate(_,P),
|
||||
functor(P, Na, Ar),
|
||||
'$new_abolish'(Na, Ar),
|
||||
fail.
|
||||
'$abolish_all'.
|
||||
|
||||
'$check_error_in_predicate_indicator'(V, Msg) :-
|
||||
var(V), !,
|
||||
|
|
@ -377,7 +383,7 @@ abolish(X) :-
|
|||
throw(error(type_error(atom,Na), Msg)).
|
||||
|
||||
'$old_abolish'(V) :-
|
||||
'$check_error_in_predicate_indicator'(V, abolish(V)).
|
||||
'$abolish_all'.
|
||||
'$old_abolish'(M:N) :- !,
|
||||
'$mod_switch'(M,'$old_abolish'(N)).
|
||||
'$old_abolish'([]) :- !.
|
||||
|
|
|
|||
|
|
@ -850,7 +850,9 @@ user_defined_directive(Dir,Action) :-
|
|||
'$fast_do'(M:G) :- '$mod_switch'(M,G).
|
||||
'$fast_do'('$spycalls'(G,Res)) :- '$spycalls'(G,Res).
|
||||
'$fast_do'('$profile_data'(P, Parm, Data)) :- '$profile_data'(P, Parm, Data).
|
||||
|
||||
'$fast_do'('$ensure_loaded'(F)) :- '$ensure_loaded'(F).
|
||||
'$fast_do'('$consult'(F)) :- '$consult'(F).
|
||||
'$fast_do'('$reconsult'(F)) :- '$reconsult'(F).
|
||||
|
||||
'$set_toplevel_hook'(_) :-
|
||||
'$recorded'('$toplevel_hooks',_,R),
|
||||
|
|
|
|||
|
|
@ -22,7 +22,8 @@
|
|||
% * -------- YAPOR -------- *
|
||||
% ***************************
|
||||
|
||||
default_sequential(X) :- '$default_sequential'(X), !.
|
||||
default_sequential(X) :-
|
||||
'$default_sequential'(X), !.
|
||||
default_sequential(_).
|
||||
|
||||
'$sequential' :-
|
||||
|
|
|
|||
|
|
@ -833,7 +833,7 @@ absolute_file_name(RelFile,AbsFile) :-
|
|||
'$get_value'(fileerrors,V),
|
||||
'$set_value'(fileerrors,0),
|
||||
( open(F,Mode,S), !,
|
||||
'$user_file_name'(S, AbsFile),
|
||||
'$file_name'(S, AbsFile),
|
||||
close(S), '$set_value'(fileerrors,V);
|
||||
'$set_value'(fileerrors,V), fail).
|
||||
|
||||
|
|
|
|||
Reference in New Issue