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

mkdir and small stuff

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-07-06 12:04:42 +01:00
parent 33de6766a5
commit 1d6f9981e1
26 changed files with 197 additions and 194 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
CMakeLists.txt
View File

@ -9,6 +9,7 @@ cmake_minimum_required(VERSION 3.0)
# set path to additional CMake modules # set path to additional CMake modules
set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH}) set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH})
set(CMAKE_PREFIX_PATH ~/Qt/5.4/clang_64/ ${CMAKE_PREFIX_PATH})
set(configurations Debug) set(configurations Debug)
@ -53,7 +54,7 @@ message(STATUS "Building YAP version ${YAP_VERSION}")
# #
include(CheckIncludeFile) include(CheckIncludeFile)
include(CheckIncludeFileCXX) include(CheckIncludeFileCXX)
INCLUDE (CheckIncludeFiles) include (CheckIncludeFiles)
include(CheckLibraryExists) include(CheckLibraryExists)
include(CheckSymbolExists) include(CheckSymbolExists)
include(CheckFunctionExists) include(CheckFunctionExists)
@ -72,7 +73,7 @@ include(GetGitRevisionDescription)
# Test signal handler return type (mimics AC_TYPE_SIGNAL) # Test signal handler return type (mimics AC_TYPE_SIGNAL)
include(TestSignalType) #check if this is really needed as c89 defines this as void include(TestSignalType) #check if this is really needed as c89 defines this as void
# Test standard headers (mimics AC_HEADER_STDC) # Test standard headers (mimics AC_HEADER_STDC)
include(TestSTDC) include(TestSTDC)
set(bitness 32) set(bitness 32)
@ -528,6 +529,7 @@ configure_file ("${PROJECT_SOURCE_DIR}/YapTermConfig.h.cmake"
"${PROJECT_BINARY_DIR}/YapTermConfig.h" ) "${PROJECT_BINARY_DIR}/YapTermConfig.h" )
configure_file("${PROJECT_SOURCE_DIR}/GitSHA1.c.in" "${PROJECT_BINARY_DIR}/GitSHA1.c" @ONLY) configure_file("${PROJECT_SOURCE_DIR}/GitSHA1.c.in" "${PROJECT_BINARY_DIR}/GitSHA1.c" @ONLY)
ADD_SUBDIRECTORY(console/terminal)
install ( install (

1
include/YapDefs.h
View File

@ -196,6 +196,7 @@ typedef enum {
#define YAP_CONSULT_MODE 0 #define YAP_CONSULT_MODE 0
#define YAP_RECONSULT_MODE 1 #define YAP_RECONSULT_MODE 1
#define YAP_BOOT_MODE 2
typedef struct yap_boot_params { typedef struct yap_boot_params {
/* if NON-NULL, path where we can find the saved state */ /* if NON-NULL, path where we can find the saved state */

57
library/lineutils.yap
View File

@ -15,8 +15,9 @@
copy_line/2, copy_line/2,
filter/3, filter/3,
file_filter/3, file_filter/3,
file_select/2, file_select/2,
file_filter_with_initialization/5, file_filter_with_initialization/5,
file_filter_with_initialization/5 as file_filter_with_init,
process/2 process/2
]). ]).
@ -26,7 +27,7 @@
This package provides a set of useful predicates to manipulate This package provides a set of useful predicates to manipulate
sequences of characters codes, usually first read in as a line. It is sequences of characters codes, usually first read in as a line. It is
available by loading the available by loading the
~~~~ ~~~~
:- use_module(library(lineutils)). :- use_module(library(lineutils)).
~~~~ ~~~~
@ -47,7 +48,7 @@ available by loading the
[read_line_to_codes/2]). [read_line_to_codes/2]).
/** /**
@pred search_for(+ _Char_,+ _Line_) @pred search_for(+ _Char_,+ _Line_)
Search for a character _Char_ in the list of codes _Line_. Search for a character _Char_ in the list of codes _Line_.
*/ */
search_for(C,L) :- search_for(C,L) :-
@ -57,11 +58,11 @@ search_for(C) --> [C], !.
search_for(C) --> [_], search_for(C) --> [_],
search_for(C). search_for(C).
/** @pred scan_integer(? _Int_,+ _Line_,+ _RestOfLine_) /** @pred scan_integer(? _Int_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for an integer _Nat_, either a Scan the list of codes _Line_ for an integer _Nat_, either a
positive, zero, or negative integer, and unify _RestOfLine_ with positive, zero, or negative integer, and unify _RestOfLine_ with
the remainder of the line. the remainder of the line.
*/ */
scan_integer(N) --> scan_integer(N) -->
"-", !, "-", !,
@ -70,11 +71,11 @@ scan_integer(N) -->
scan_integer(N) --> scan_integer(N) -->
scan_natural(0, N). scan_natural(0, N).
/** @pred integer(? _Int_,+ _Line_,+ _RestOfLine_) /** @pred integer(? _Int_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for an integer _Nat_, either a Scan the list of codes _Line_ for an integer _Nat_, either a
positive, zero, or negative integer, and unify _RestOfLine_ with positive, zero, or negative integer, and unify _RestOfLine_ with
the remainder of the line. the remainder of the line.
*/ */
integer(N) --> integer(N) -->
"-", !, "-", !,
@ -83,7 +84,7 @@ integer(N) -->
integer(N) --> integer(N) -->
natural(0, N). natural(0, N).
/** @pred scan_natural(? _Nat_,+ _Line_,+ _RestOfLine_) /** @pred scan_natural(? _Nat_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for a natural number _Nat_, zero Scan the list of codes _Line_ for a natural number _Nat_, zero
or a positive integer, and unify _RestOfLine_ with the remainder or a positive integer, and unify _RestOfLine_ with the remainder
@ -99,7 +100,7 @@ scan_natural(N0,N) -->
get_natural(N1,N). get_natural(N1,N).
scan_natural(N,N) --> []. scan_natural(N,N) --> [].
/** @pred natural(? _Nat_,+ _Line_,+ _RestOfLine_) /** @pred natural(? _Nat_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for a natural number _Nat_, zero Scan the list of codes _Line_ for a natural number _Nat_, zero
or a positive integer, and unify _RestOfLine_ with the remainder or a positive integer, and unify _RestOfLine_ with the remainder
@ -115,7 +116,7 @@ natural(N0,N) -->
get_natural(N1,N). get_natural(N1,N).
natural(N,N) --> []. natural(N,N) --> [].
/** @pred skip_whitespace(+ _Line_,+ _RestOfLine_) /** @pred skip_whitespace(+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for white space, namely for tabbing and space characters. Scan the list of codes _Line_ for white space, namely for tabbing and space characters.
*/ */
@ -128,7 +129,7 @@ skip_whitespace([0' |Blanks]) -->
skip_whitespace( [] ) --> skip_whitespace( [] ) -->
!. !.
/** @pred blank(+ _Line_,+ _RestOfLine_) /** @pred blank(+ _Line_,+ _RestOfLine_)
The list of codes _Line_ is formed by white space, namely by tabbing and space characters. The list of codes _Line_ is formed by white space, namely by tabbing and space characters.
*/ */
@ -145,12 +146,12 @@ blank( [] ) -->
/** @pred split(+ _Line_,- _Split_) /** @pred split(+ _Line_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by Unify _Words_ with a set of strings obtained from _Line_ by
using the blank characters as separators. using the blank characters as separators.
*/ */
split(String, Strings) :- split(String, Strings) :-
split_at_blank(" ", Strings, String, []). split_at_blank(" ", Strings, String, []).
/** @pred split(+ _Line_,+ _Separators_,- _Split_) /** @pred split(+ _Line_,+ _Separators_,- _Split_)
@ -165,7 +166,7 @@ S = ["Hello","I","am","free"] ?
no no
~~~~~ ~~~~~
*/ */
split(String, SplitCodes, Strings) :- split(String, SplitCodes, Strings) :-
split_at_blank(SplitCodes, Strings, String, []). split_at_blank(SplitCodes, Strings, String, []).
@ -197,7 +198,7 @@ using the blank characters as field separators.
fields(String, Strings) :- fields(String, Strings) :-
fields(" ", Strings, String, []). fields(" ", Strings, String, []).
/** @pred fields(+ _Line_,+ _Separators_,- _Split_) /** @pred fields(+ _Line_,+ _Separators_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by Unify _Words_ with a set of strings obtained from _Line_ by
using the character codes in _Separators_ as separators for using the character codes in _Separators_ as separators for
@ -229,7 +230,7 @@ dofields(FieldsCodes, [C|New], Set) -->
dofields(FieldsCodes, New, Set). dofields(FieldsCodes, New, Set).
dofields(_, [], []) --> []. dofields(_, [], []) --> [].
/** @pred glue(+ _Words_,+ _Separator_,- _Line_) /** @pred glue(+ _Words_,+ _Separator_,- _Line_)
Unify _Line_ with string obtained by glueing _Words_ with Unify _Line_ with string obtained by glueing _Words_ with
the character code _Separator_. the character code _Separator_.
@ -240,7 +241,7 @@ glue([H|T], [B|_], Merged) :-
append(H, [B|Rest], Merged), append(H, [B|Rest], Merged),
glue(T, [B], Rest). glue(T, [B], Rest).
/** @pred copy_line(+ _StreamInput_,+ _StreamOutput_) /** @pred copy_line(+ _StreamInput_,+ _StreamOutput_)
Copy a line from _StreamInput_ to _StreamOutput_. Copy a line from _StreamInput_ to _StreamOutput_.
*/ */
@ -249,16 +250,16 @@ copy_line(StreamInp, StreamOut) :-
format(StreamOut, '~s~n', [Line]). format(StreamOut, '~s~n', [Line]).
/** @pred filter(+ _StreamInp_, + _StreamOut_, + _Goal_) /** @pred filter(+ _StreamInp_, + _StreamOut_, + _Goal_)
For every line _LineIn_ in stream _StreamInp_, execute For every line _LineIn_ in stream _StreamInp_, execute
`call(Goal,LineIn,LineOut)`, and output _LineOut_ to `call(Goal,LineIn,LineOut)`, and output _LineOut_ to
stream _StreamOut_. If `call(Goal,LineIn,LineOut)` fails, stream _StreamOut_. If `call(Goal,LineIn,LineOut)` fails,
nothing will be output but execution continues with the next nothing will be output but execution continues with the next
line. As an example, consider a procedure to select the second and line. As an example, consider a procedure to select the second and
fifth field of a CSV table : fifth field of a CSV table :
~~~~~{.prolog} ~~~~~{.prolog}
select(Sep, In, Out) :- select(Sep, In, Out) :-
fields(In, Sep, [_,F2,_,_,F5|_]), fields(In, Sep, [_,F2,_,_,F5|_]),
fields(Out,Sep, [F2,F5]). fields(Out,Sep, [F2,F5]).
@ -284,7 +285,7 @@ filter(StreamInp, StreamOut, Command) :-
/** @pred process(+ _StreamInp_, + _Goal_) is meta /** @pred process(+ _StreamInp_, + _Goal_) is meta
For every line _LineIn_ in stream _StreamInp_, call For every line _LineIn_ in stream _StreamInp_, call
`call(Goal,LineIn)`. `call(Goal,LineIn)`.
*/ */
process(StreamInp, Command) :- process(StreamInp, Command) :-
repeat, repeat,
@ -298,14 +299,14 @@ process(StreamInp, Command) :-
fail fail
). ).
/** /**
* @pred file_filter(+ _FileIn_, + _FileOut_, + _Goal_) is meta * @pred file_filter(+ _FileIn_, + _FileOut_, + _Goal_) is meta
* *
* @param _FileIn_ File to process * @param _FileIn_ File to process
* @param _FileOut_ Output file, often user_error * @param _FileOut_ Output file, often user_error
* @param _Goal_ to be metacalled, receives FileIn and FileOut as * @param _Goal_ to be metacalled, receives FileIn and FileOut as
* extra arguments * extra arguments
* *
* @return succeeds * @return succeeds
For every line _LineIn_ in file _FileIn_, execute For every line _LineIn_ in file _FileIn_, execute
@ -337,13 +338,13 @@ file_filter_with_initialization(Inp, Out, Command, FormatString, Parameters) :-
close(StreamOut). close(StreamOut).
/** /**
* @pred file_select(+ _FileIn_, + _Goal_) is meta * @pred file_select(+ _FileIn_, + _Goal_) is meta
* *
* @param _FileIn_ File to process * @param _FileIn_ File to process
* @param _Goal_ to be metacalled, receives FileIn as * @param _Goal_ to be metacalled, receives FileIn as
* extra arguments * extra arguments
* *
* @return bindings to arguments of _Goal_. * @return bindings to arguments of _Goal_.
For every line _LineIn_ in file _FileIn_, execute For every line _LineIn_ in file _FileIn_, execute

2
library/rltree/range_list.c
View File

@ -177,7 +177,7 @@ RL_Tree* set_in_rl(RL_Tree* tree,NUM number,STATUS status) {
if ( number >0 && number <=tree->range_max) if ( number >0 && number <=tree->range_max)
set_in(number,ROOT(tree),1,ROOT_INTERVAL(tree),tree->range_max,tree,status); set_in(number,ROOT(tree),1,ROOT_INTERVAL(tree),tree->range_max,tree,status);
#ifdef DEBUG #ifdef DEBUG
printf("Setting: %ul size=%ul\n",number,tree->size); printf("Setting: %lu size=%lu\n",number,tree->size);
#endif #endif
/*if (status==IN && !in_rl(tree,number)) { /*if (status==IN && !in_rl(tree,number)) {
fprintf(stderr,"Error adding %lu to tree: size=%lu max=%lu\n",number,tree->size,tree->range_max); fprintf(stderr,"Error adding %lu to tree: size=%lu max=%lu\n",number,tree->size,tree->range_max);

7
library/system.yap
View File

@ -211,13 +211,6 @@ Unify _Name_ with a name for the current host. YAP uses the
`GetComputerName` function in WIN32 systems. `GetComputerName` function in WIN32 systems.
*/
/** @pred make_directory(+ _Dir_)
Create a directory _Dir_. The name of the directory must be an atom.
*/ */
/** @pred mktemp( _Spec_,- _File_) /** @pred mktemp( _Spec_,- _File_)

16
library/system/sys.c
View File

@ -355,21 +355,6 @@ p_unlink(void)
return(TRUE); return(TRUE);
} }
static YAP_Bool
p_mkdir(void)
{
char *fd = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if defined(__MINGW32__) || _MSC_VER
if (_mkdir(fd) == -1) {
#else
if (mkdir(fd, 0777) == -1) {
#endif
/* return an error number */
return(YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
return(TRUE);
}
static YAP_Bool static YAP_Bool
p_rmdir(void) p_rmdir(void)
{ {
@ -1131,7 +1116,6 @@ init_sys(void)
YAP_UserCPredicate("list_directory", list_directory, 3); YAP_UserCPredicate("list_directory", list_directory, 3);
YAP_UserCPredicate("file_property", file_property, 7); YAP_UserCPredicate("file_property", file_property, 7);
YAP_UserCPredicate("unlink", p_unlink, 2); YAP_UserCPredicate("unlink", p_unlink, 2);
YAP_UserCPredicate("mkdir", p_mkdir, 2);
YAP_UserCPredicate("rmdir", p_rmdir, 2); YAP_UserCPredicate("rmdir", p_rmdir, 2);
YAP_UserCPredicate("dir_separator", dir_separator, 1); YAP_UserCPredicate("dir_separator", dir_separator, 1);
YAP_UserCPredicate("p_environ", p_environ, 2); YAP_UserCPredicate("p_environ", p_environ, 2);

1
misc/ATOMS
View File

@ -342,6 +342,7 @@ A STRING F "String"
A Swi N "swi" A Swi N "swi"
A SymbolChar N "symbol_char" A SymbolChar N "symbol_char"
A SyntaxError N "syntax_error" A SyntaxError N "syntax_error"
A SyntaxErrors N "syntax_errors"
A SyntaxErrorHandler N "syntax_error_handler" A SyntaxErrorHandler N "syntax_error_handler"
A System N "system" A System N "system"
A SystemError N "system_error" A SystemError N "system_error"

14
misc/LOCALS
View File

@ -3,7 +3,7 @@ START_WORKER_LOCAL
// Streams // Streams
struct AliasDescS* FileAliases =Yap_InitStandardAliases() struct AliasDescS* FileAliases =Yap_InitStandardAliases()
int NOfFileAliases void int NOfFileAliases void
int SzOfFileAliases void int SzOfFileAliases void
int c_input_stream =0 int c_input_stream =0
@ -12,6 +12,8 @@ int c_error_stream =2
bool sockets_io =false bool sockets_io =false
bool within_print_message =false
// //
// Used by the prompts to check if they are after a newline, and then a // Used by the prompts to check if they are after a newline, and then a
// prompt should be output, or if we are in the middle of a line. // prompt should be output, or if we are in the middle of a line.
@ -94,7 +96,9 @@ UInt IPredArity =0L
yamop* ProfEnd =NULL yamop* ProfEnd =NULL
int UncaughtThrow =FALSE int UncaughtThrow =FALSE
int DoingUndefp =FALSE int DoingUndefp =FALSE
Int StartLine =0L Int StartCharCount =0L
Int StartLineCount =0L
Int StartLinePos =0L
scratch_block ScratchPad InitScratchPad(wid) scratch_block ScratchPad InitScratchPad(wid)
#ifdef COROUTINING #ifdef COROUTINING
Term WokenGoals =0L TermToGlobalAdjust Term WokenGoals =0L TermToGlobalAdjust
@ -147,7 +151,7 @@ struct array_entry* DynamicArrays =NULL PtoArrayEAdjust
struct static_array_entry* StaticArrays =NULL PtoArraySAdjust struct static_array_entry* StaticArrays =NULL PtoArraySAdjust
struct global_entry* GlobalVariables =NULL PtoGlobalEAdjust struct global_entry* GlobalVariables =NULL PtoGlobalEAdjust
int AllowRestart =FALSE int AllowRestart =FALSE
// Thread Local Area for Fast Storage of Intermediate Compiled Code // Thread Local Area for Fast Storage of Intermediate Compiled Code
struct mem_blk* CMemFirstBlock =NULL struct mem_blk* CMemFirstBlock =NULL
UInt CMemFirstBlockSz =0L UInt CMemFirstBlockSz =0L
@ -221,7 +225,7 @@ UInt flagCount void
YAP_ULONG_LONG opcount[_std_top+1] void YAP_ULONG_LONG opcount[_std_top+1] void
YAP_ULONG_LONG 2opcount[_std_top+1][_std_top+1] void YAP_ULONG_LONG 2opcount[_std_top+1][_std_top+1] void
#endif /* ANALYST */ #endif /* ANALYST */
//dbase.c //dbase.c
struct db_globs* s_dbg void struct db_globs* s_dbg void
@ -236,7 +240,7 @@ int heap_overflows =0
Int total_heap_overflow_time =0 Int total_heap_overflow_time =0
int stack_overflows =0 int stack_overflows =0
Int total_stack_overflow_time =0 Int total_stack_overflow_time =0
int delay_overflows =0 int delay_overflows =0
Int total_delay_overflow_time =0 Int total_delay_overflow_time =0
int trail_overflows =0 int trail_overflows =0
Int total_trail_overflow_time =0 Int total_trail_overflow_time =0

1
misc/buildatoms
View File

@ -62,4 +62,3 @@ gen_decl(Inp,Out) :-
%gen_decl(Inp,Out) :- %gen_decl(Inp,Out) :-
% split(Inp," ",["F",Name,Arity]), !, % split(Inp," ",["F",Name,Arity]), !,
% append([" Functor_",Name,Arity," = Yap_MkFunctor(Atom_",Name,",",Arity,");"],Out). % append([" Functor_",Name,Arity," = Yap_MkFunctor(Atom_",Name,",",Arity,");"],Out).

6
packages/bdd/cudd.c
View File

@ -309,7 +309,7 @@ add_implies(DdManager *manager, DdNode *x1, DdNode *x2)
{ {
DdNode *tmp; DdNode *tmp;
tmp = Cudd_addApply(manager,Cudd_addLeq,x1,x2); tmp = Cudd_addConst(manager,Cudd_addLeq(manager,x1,x2));
Cudd_Ref(tmp); Cudd_Ref(tmp);
return tmp; return tmp;
} }
@ -878,7 +878,7 @@ p_cudd_print_with_names(void)
DdManager *manager = (DdManager *)YAP_IntOfTerm(YAP_ARG1); DdManager *manager = (DdManager *)YAP_IntOfTerm(YAP_ARG1);
DdNode *n0 = (DdNode *)YAP_IntOfTerm(YAP_ARG2); DdNode *n0 = (DdNode *)YAP_IntOfTerm(YAP_ARG2);
const char *s = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)); const char *s = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3));
char **namesp; const char **namesp;
YAP_Term names = YAP_ARG4; YAP_Term names = YAP_ARG4;
FILE *f; FILE *f;
YAP_Int len; YAP_Int len;
@ -918,7 +918,7 @@ p_cudd_print_with_names(void)
fclose(f); fclose(f);
while (i > 0) { while (i > 0) {
i--; i--;
free(namesp[i]); free((void *)namesp[i]);
} }
free( namesp ); free( namesp );
return TRUE; return TRUE;

3
packages/swig/yap.i
View File

@ -64,7 +64,8 @@
/* turn on director wrapping Callback */ /* turn on director wrapping Callback */
%feature("director") YAPCallback; %feature("director") YAPCallback;
%include "yapi.hh"
// %include "yapi.hh"
%include "yapa.hh" %include "yapa.hh"

5
pl/absf.yap
View File

@ -147,7 +147,7 @@ absolute_file_name(File0,File) :-
/* our own local findall */ /* our own local findall */
nb:nb_queue(Ref), nb:nb_queue(Ref),
( (
'$find_in_path'(File,opts(Extensions,RelTo,Type,Access,Errors,Expand,Debug),TrueFileName,G), '$find_in_path'(File,opts(Extensions,RelTo,Type,Access,FErrors,Expand,Debug),TrueFileName,G),
nb:nb_queue_enqueue(Ref, TrueFileName), nb:nb_queue_enqueue(Ref, TrueFileName),
fail fail
; ;
@ -169,7 +169,7 @@ absolute_file_name(File0,File) :-
current_prolog_flag(fileerrors, Flag), current_prolog_flag(fileerrors, Flag),
( OnError == error ; ( OnError == error ;
OnError == fail ; OnError == fail ;
Flag == true, OnError = error ; Flag == true, OnError = error ;
Flag == false, OnError = fail ; Flag == false, OnError = fail ;
OnError = error ), !. OnError = error ), !.
'$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !, '$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
@ -672,4 +672,3 @@ user:file_search_path(path, C) :-
). ).
%%@} %%@}

16
pl/arrays.yap
View File

@ -20,12 +20,12 @@
/** /**
@addtogroup YAPArrays @addtogroup YAPArrays
*/ */
% %
% These are the array built-in predicates. They will only work if % These are the array built-in predicates. They will only work if
% YAP_ARRAYS is defined in Yap.h.m4. % YAP_ARRAYS is defined in Yap.h
% %
/** @pred array(+ _Name_, + _Size_) /** @pred array(+ _Name_, + _Size_)
Creates a new dynamic array. The _Size_ must evaluate to an Creates a new dynamic array. The _Size_ must evaluate to an
@ -35,7 +35,7 @@ unbound variable (anonymous array).
Dynamic arrays work as standard compound terms, hence space for the Dynamic arrays work as standard compound terms, hence space for the
array is recovered automatically on backtracking. array is recovered automatically on backtracking.
*/ */
array(Obj, Size) :- array(Obj, Size) :-
'$create_array'(Obj, Size). '$create_array'(Obj, Size).
@ -82,17 +82,17 @@ array(Obj, Size) :-
'$add_array_entries'(Tail, G, NG). '$add_array_entries'(Tail, G, NG).
/** @pred static_array_properties(? _Name_, ? _Size_, ? _Type_) /** @pred static_array_properties(? _Name_, ? _Size_, ? _Type_)
Show the properties size and type of a static array with name Show the properties size and type of a static array with name
_Name_. Can also be used to enumerate all current _Name_. Can also be used to enumerate all current
static arrays. static arrays.
This built-in will silently fail if the there is no static array with This built-in will silently fail if the there is no static array with
that name. that name.
*/ */
static_array_properties(Name, Size, Type) :- static_array_properties(Name, Size, Type) :-
atom(Name), !, atom(Name), !,
@ -104,4 +104,4 @@ static_array_properties(Name, Size, Type) :-
static_array_properties(Name, Size, Type) :- static_array_properties(Name, Size, Type) :-
'$do_error'(type_error(atom,Name),static_array_properties(Name,Size,Type)). '$do_error'(type_error(atom,Name),static_array_properties(Name,Size,Type)).
%% @} %% @}

50
pl/attributes.yap
View File

@ -19,7 +19,7 @@
/** /**
@file attributes.yap @file attributes.yap
@defgroup Attributed_Variables Attributed Variables @defgroup Attributed_Variables Attributed Variables
@ingroup extensions @ingroup extensions
@ -30,11 +30,11 @@ updated during forward execution. Moreover, the unification algorithm is
aware of attributed variables and will call user defined handlers when aware of attributed variables and will call user defined handlers when
trying to unify these variables. trying to unify these variables.
Attributed variables provide an elegant abstraction over which one can Attributed variables provide an elegant abstraction over which one can
extend Prolog systems. Their main application so far has been in extend Prolog systems. Their main application so far has been in
implementing constraint handlers, such as Holzbaur's CLPQR, Fruewirth implementing constraint handlers, such as Holzbaur's CLPQR, Fruewirth
and Holzbaur's CHR, and CLP(BN). and Holzbaur's CHR, and CLP(BN).
Different Prolog systems implement attributed variables in different Different Prolog systems implement attributed variables in different
ways. Originally, YAP used the interface designed by SICStus ways. Originally, YAP used the interface designed by SICStus
@ -48,9 +48,9 @@ variables, such as CHR, CLP(FD), and CLP(QR), rely on the SWI-Prolog
interface. interface.
+ Old_Style_Attribute_Declarations + Old_Style_Attribute_Declarations
+ New_Style_Attribute_Declarations + New_Style_Attribute_Declarations
*/ */
@ -83,10 +83,10 @@ interface.
/** /**
@{ @{
@defgroup New_Style_Attribute_Declarations hProlog and SWI-Prolog style Attribute Declarations @defgroup New_Style_Attribute_Declarations hProlog and SWI-Prolog style Attribute Declarations
@ingroup Attributed_Variables @ingroup Attributed_Variables
The following documentation is taken from the SWI-Prolog manual. The following documentation is taken from the SWI-Prolog manual.
Binding an attributed variable schedules a goal to be executed at the Binding an attributed variable schedules a goal to be executed at the
@ -157,7 +157,7 @@ interface.
:- dynamic attributes:attributed_module/3, attributes:modules_with_attributes/1. :- dynamic attributes:attributed_module/3, attributes:modules_with_attributes/1.
/** @pred get_attr(+ _Var_,+ _Module_,- _Value_) /** @pred get_attr(+ _Var_,+ _Module_,- _Value_)
@ -166,7 +166,7 @@ Request the current _value_ for the attribute named _Module_. If
associated to _Var_ this predicate fails silently. If _Module_ associated to _Var_ this predicate fails silently. If _Module_
is not an atom, a type error is raised. is not an atom, a type error is raised.
*/ */
prolog:get_attr(Var, Mod, Att) :- prolog:get_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2), functor(AttTerm, Mod, 2),
@ -174,7 +174,7 @@ prolog:get_attr(Var, Mod, Att) :-
attributes:get_module_atts(Var, AttTerm). attributes:get_module_atts(Var, AttTerm).
/** /**
@pred put_attr(+ _Var_,+ _Module_,+ _Value_) @pred put_attr(+ _Var_,+ _Module_,+ _Value_)
@ -185,14 +185,14 @@ Backtracking will restore the old value (i.e., an attribute is a mutable
term. See also `setarg/3`). This predicate raises a representation error if term. See also `setarg/3`). This predicate raises a representation error if
_Var_ is not a variable and a type error if _Module_ is not an atom. _Var_ is not a variable and a type error if _Module_ is not an atom.
*/ */
prolog:put_attr(Var, Mod, Att) :- prolog:put_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2), functor(AttTerm, Mod, 2),
arg(2, AttTerm, Att), arg(2, AttTerm, Att),
attributes:put_module_atts(Var, AttTerm). attributes:put_module_atts(Var, AttTerm).
/** @pred del_attr(+ _Var_,+ _Module_) /** @pred del_attr(+ _Var_,+ _Module_)
@ -202,20 +202,20 @@ is not an atom, a type error is raised. In all other cases this
predicate succeeds regardless whether or not the named attribute is predicate succeeds regardless whether or not the named attribute is
present. present.
*/ */
prolog:del_attr(Var, Mod) :- prolog:del_attr(Var, Mod) :-
functor(AttTerm, Mod, 2), functor(AttTerm, Mod, 2),
attributes:del_all_module_atts(Var, AttTerm). attributes:del_all_module_atts(Var, AttTerm).
/** @pred del_attrs(+ _Var_) /** @pred del_attrs(+ _Var_)
If _Var_ is an attributed variable, delete <em>all</em> its If _Var_ is an attributed variable, delete <em>all</em> its
attributes. In all other cases, this predicate succeeds without attributes. In all other cases, this predicate succeeds without
side-effects. side-effects.
*/ */
prolog:del_attrs(Var) :- prolog:del_attrs(Var) :-
attributes:del_all_atts(Var). attributes:del_all_atts(Var).
@ -223,13 +223,13 @@ prolog:del_attrs(Var) :-
prolog:get_attrs(AttVar, SWIAtts) :- prolog:get_attrs(AttVar, SWIAtts) :-
attributes:get_all_swi_atts(AttVar,SWIAtts). attributes:get_all_swi_atts(AttVar,SWIAtts).
/** @pred put_attrs(+ _Var_,+ _Attributes_) /** @pred put_attrs(+ _Var_,+ _Attributes_)
Set all attributes of _Var_. See get_attrs/2 for a description of Set all attributes of _Var_. See get_attrs/2 for a description of
_Attributes_. _Attributes_.
*/ */
prolog:put_attrs(_, []). prolog:put_attrs(_, []).
prolog:put_attrs(V, Atts) :- prolog:put_attrs(V, Atts) :-
@ -241,7 +241,7 @@ cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
ModAttribute =.. [Mod, YapAtts, Attribute], ModAttribute =.. [Mod, YapAtts, Attribute],
cvt_to_swi_atts(Atts, YapAtts). cvt_to_swi_atts(Atts, YapAtts).
/** @pred copy_term(? _TI_,- _TF_,- _Goals_) /** @pred copy_term(? _TI_,- _TF_,- _Goals_)
Term _TF_ is a variant of the original term _TI_, such that for Term _TF_ is a variant of the original term _TI_, such that for
each variable _V_ in the term _TI_ there is a new variable _V'_ each variable _V_ in the term _TI_ there is a new variable _V'_
@ -255,7 +255,7 @@ Before the actual copying, `copy_term/3` calls
`attribute_goals/1` in the module where the attribute is `attribute_goals/1` in the module where the attribute is
defined. defined.
*/ */
prolog:copy_term(Term, Copy, Gs) :- prolog:copy_term(Term, Copy, Gs) :-
term_attvars(Term, Vs), term_attvars(Term, Vs),
@ -306,7 +306,7 @@ prolog:'$wake_up_goal'([Module1|Continuation], LG) :-
% in the first two cases restore register immediately and proceed % in the first two cases restore register immediately and proceed
% to continuation. In the last case take care with modules, but do % to continuation. In the last case take care with modules, but do
% not act as if a meta-call. % not act as if a meta-call.
% %
% %
do_continuation('$cut_by'(X), _) :- !, do_continuation('$cut_by'(X), _) :- !,
'$$cut_by'(X). '$$cut_by'(X).
@ -385,7 +385,7 @@ lcall2([Goal|Goals], Mod) :-
/** @pred call_residue_vars(: _G_, _L_) /** @pred call_residue_vars(: _G_, _L_)
@ -477,7 +477,7 @@ delete_attributes_([V|Vs]) :-
/** @pred call_residue(: _G_, _L_) /** @pred call_residue(: _G_, _L_)
@ -502,9 +502,9 @@ dif(X,f(Z)) ? ;
no no
~~~~~ ~~~~~
The system only reports one invocation of dif/2 as having The system only reports one invocation of dif/2 as having
suspended. suspended.
*/ */
prolog:call_residue(Goal,Residue) :- prolog:call_residue(Goal,Residue) :-
var(Goal), !, var(Goal), !,
@ -556,7 +556,7 @@ att_vars([_|LGs], AttVars) :-
% make sure we set the suspended goal list to its previous state! % make sure we set the suspended goal list to its previous state!
% make sure we have installed a SICStus like constraint solver. % make sure we have installed a SICStus like constraint solver.
/** @pred _Module_:project_attributes( _+QueryVars_, _+AttrVars_) /** @pred _Module_:project_attributes( _+QueryVars_, _+AttrVars_)
Given a list of variables _QueryVars_ and list of attributed Given a list of variables _QueryVars_ and list of attributed

28
pl/boot.yap
View File

@ -15,13 +15,13 @@
* * * *
*************************************************************************/ *************************************************************************/
%% @{ %% @{
/** /**
@defgroup YAPControl Control Predicates @defgroup YAPControl Control Predicates
@ingroup builtins @ingroup builtins
*/ */
@ -351,7 +351,7 @@ true :- true.
('$exit_undefp' -> true ; true), ('$exit_undefp' -> true ; true),
prompt1(' ?- '), prompt1(' ?- '),
set_prolog_flag(debug, false), set_prolog_flag(debug, false),
% simple trick to find out if this is we are booting from Prolog. % simple trick to find out if this is we are booting from Prolog.
% boot from a saved state % boot from a saved state
( (
'$undefined'('$init_preds',prolog) '$undefined'('$init_preds',prolog)
@ -442,7 +442,7 @@ true :- true.
prompt(_,'|: '), prompt(_,'|: '),
'$system_catch'(read_term(user_input, '$system_catch'(read_term(user_input,
Goal, Goal,
[variable_names(Bindings)]), [variable_names(Bindings), syntax_errors(dec10)]),
prolog, E, '$handle_toplevel_error'( E) ). prolog, E, '$handle_toplevel_error'( E) ).
'$handle_toplevel_error'( syntax_error(_)) :- '$handle_toplevel_error'( syntax_error(_)) :-
@ -454,7 +454,7 @@ true :- true.
throw(E). throw(E).
/** @pred stream_property( _Stream_, _Prop_) /** @pred stream_property( _Stream_, _Prop_)
*/ */
@ -1123,10 +1123,6 @@ incore(G) :- '$execute'(G).
'$creep'. '$creep'.
'$enable_debugging'. '$enable_debugging'.
'$disable_debugging' :-
'$stop_creeping'.
/** @pred :_P_ , :_Q_ is iso, meta /** @pred :_P_ , :_Q_ is iso, meta
Conjunction of goals (and). Conjunction of goals (and).
@ -1365,9 +1361,13 @@ bootstrap(F) :-
user:'$LoopError'(Error, Status)), user:'$LoopError'(Error, Status)),
!. !.
'$enter_command'(Stream,Mod,Status) :- '$enter_command'(Stream,Mod,top) :- !,
read_term(Stream, Command, [variable_names(Vars), term_position(Pos), syntax_errors(dec10) ]), writeln(top),
'$command'(Command,Vars,Pos,Status). read_term(Stream, Command, [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status).
'$enter_command'(Stream,Mod,Status) :-
read_clause(Stream, Command, [variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :- '$abort_loop'(Stream) :-
'$do_error'(permission_error(input,closed_stream,Stream), loop). '$do_error'(permission_error(input,closed_stream,Stream), loop).
@ -1421,8 +1421,7 @@ bootstrap(F) :-
This predicate is used by YAP for preprocessing each top level This predicate is used by YAP for preprocessing each top level
term read when consulting a file and before asserting or executing it. term read when consulting a file and before asserting or executing it.
It rewrites a term _T_ to a term _X_ according to the following It rewrites a term _T_ to a term _X_ according to the following
rules: first try term_expansion/2 in the current module, and then try to use the user defined predicate rules: first try term_expansion/2 in the current module, and then try to use the user defined predicate user:term_expansion/2`. If this call fails then the translating process
`user:term_expansion/2`. If this call fails then the translating process
for DCG rules is applied, together with the arithmetic optimizer for DCG rules is applied, together with the arithmetic optimizer
whenever the compilation of arithmetic expressions is in progress. whenever the compilation of arithmetic expressions is in progress.
@ -1568,4 +1567,3 @@ log_event( String, Args ) :-
/** /**
@} @}
*/ */

21
pl/consult.yap
View File

@ -649,7 +649,6 @@ db_files(Fs) :-
'$extract_minus'([-F|Fs], [F|MFs]) :- '$extract_minus'([-F|Fs], [F|MFs]) :-
'$extract_minus'(Fs, MFs). '$extract_minus'(Fs, MFs).
'$do_lf'(ContextModule, Stream, UserFile, File, TOpts) :- '$do_lf'(ContextModule, Stream, UserFile, File, TOpts) :-
stream_property(OldStream, alias(loop_stream) ), stream_property(OldStream, alias(loop_stream) ),
'$lf_opt'(encoding, TOpts, Encoding), '$lf_opt'(encoding, TOpts, Encoding),
@ -843,27 +842,29 @@ db_files(Fs) :-
b_getval('$lf_status', TOpts), b_getval('$lf_status', TOpts),
'$msg_level'( TOpts, Verbosity), '$msg_level'( TOpts, Verbosity),
'$full_filename'(X, Y , ( :- include(X)) ), '$full_filename'(X, Y , ( :- include(X)) ),
writeln((X:Y)),
'$lf_opt'(stream, TOpts, OldStream), '$lf_opt'(stream, TOpts, OldStream),
source_location(OldY, L),
'$current_module'(Mod), '$current_module'(Mod),
( open(Y, read, Stream) -> ( open(Y, read, Stream) ->
true ; true ;
'$do_error'(permission_error(input,stream,Y),include(X)) '$do_error'(permission_error(input,stream,Y),include(X))
), ),
H0 is heapused, '$cputime'(T0,_), file_directory_name(Y, Dir),
working_directory(Dir, Dir), H0 is heapused, '$cputime'(T0,_),
working_directory(Dir0, Dir),
'$lf_opt'(encoding, TOpts, Encoding), '$lf_opt'(encoding, TOpts, Encoding),
set_stream(Stream, [encoding(Encoding),alias(loop_stream)] ), set_stream(Stream, [encoding(Encoding),alias(loop_stream)] ),
'$loaded'(Y, X, Mod, OldY, L, include, _, Dir, []), '$loaded'(Y, X, Mod, _OldY, _L, include, _, Dir, []),
( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ), ( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ),
nb_setval('$included_file', Y), nb_setval('$included_file', Y),
print_message(Verbosity, loading(including, Y)), print_message(Verbosity, loading(including, Y)),
'$loop'(Stream,Status), '$loop'(Stream,Status),
set_stream(OldStream, alias(loop_stream) ), set_stream(OldStream, alias(loop_stream) ),
close(Stream), close(Stream),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
print_message(Verbosity, loaded(included, Y, Mod, T, H)), print_message(Verbosity, loaded(included, Y, Mod, T, H)),
nb_setval('$included_file',OY). working_directory(_Dir, Dir0),
nb_setval('$included_file',OY).
@ -970,6 +971,7 @@ most files in the library are from the Edinburgh Prolog library.
*/ */
prolog_load_context(directory, DirName) :- prolog_load_context(directory, DirName) :-
strat_low_level_trace,
( source_location(F, _) ( source_location(F, _)
-> file_directory_name(F, DirName) ; -> file_directory_name(F, DirName) ;
working_directory( DirName, DirName ) working_directory( DirName, DirName )
@ -997,7 +999,8 @@ prolog_load_context(stream, Stream) :-
'$nb_getval'('$consulting_file', _, fail), '$nb_getval'('$consulting_file', _, fail),
'$current_loop_stream'(Stream). '$current_loop_stream'(Stream).
prolog_load_context(term_position, Position) :- prolog_load_context(term_position, Position) :-
stream_property( Stream, [alias(loop_stream),position(Position)] ). '$current_loop_stream'(Stream)
stream_property( Stream, [alias(loop_stream),position(Position)] ).
% if the file exports a module, then we can % if the file exports a module, then we can
@ -1072,7 +1075,7 @@ prolog_load_context(term_position, Position) :-
), ),
( F == user_input -> Age = 0 ; time_file64(F, Age) ), ( F == user_input -> Age = 0 ; time_file64(F, Age) ),
% modules are logically loaded only once % modules are logically loaded only once
( recorded('$module','$module'(F,_DonorM,_SourceF, _AllExports, _Line),_) -> true ; ( recorded('$module','$module'(F,_DonorM,_SourceF, _AllExports, _Line),_) -> true ;
recordaifnot('$source_file','$source_file'( F, Age, M), _) -> true ; recordaifnot('$source_file','$source_file'( F, Age, M), _) -> true ;
true ), true ),

1
pl/debug.yap
View File

@ -848,6 +848,7 @@ be lost.
fail /* to backtrack to spycalls */ fail /* to backtrack to spycalls */
) )
; ;
'$stop_creeping',
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */ '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */
'$continue_debugging'(fail, CalledFromDebugger), '$continue_debugging'(fail, CalledFromDebugger),
/* fail port */ /* fail port */

1
pl/depth_bound.yap
View File

@ -31,4 +31,3 @@ system_module( '$_depth_bound', [depth_bound_call/2], []).
%write(depth_bound_call(A,D)), nl, fail. %write(depth_bound_call(A,D)), nl, fail.
depth_bound_call(A,D) :- depth_bound_call(A,D) :-
'$execute_under_depth_limit'(A,D). '$execute_under_depth_limit'(A,D).

16
pl/dialect.yap
View File

@ -6,18 +6,25 @@
:- use_system_module( '$_errors', ['$do_error'/2]). :- use_system_module( '$_errors', ['$do_error'/2]).
prolog:'$expects_dialect'(yap) :- !, % @pred expects_dialect(+Dialect)
%
% True if YAP can enable support for a different Prolog dialect.
% Currently there is support for bprolog, hprolog and swi-prolog.
% Notice that this support may be incomplete.
%
% The
prolog:expects_dialect(yap) :- !,
eraseall('$dialect'), eraseall('$dialect'),
recorda('$dialect',yap,_). recorda('$dialect',yap,_).
prolog:'$expects_dialect'(Dialect) :- prolog:expects_dialect(Dialect) :-
check_dialect(Dialect), check_dialect(Dialect),
eraseall('$dialect'), eraseall('$dialect'),
load_files(library(dialect/Dialect),[silent(true),if(not_loaded)]), load_files(library(dialect/Dialect),[silent(true),if(not_loaded)]),
( current_predicate(Dialect:setup_dialect/0) ( current_predicate(Dialect:setup_dialect/0)
-> Dialect:setup_dialect -> Dialect:setup_dialect
; true ; true
), ),
recorda('$dialect',Dialect,_). recorda('$dialect',Dialect,_).
check_dialect(Dialect) :- check_dialect(Dialect) :-
var(Dialect),!, var(Dialect),!,
@ -84,4 +91,3 @@ open_source(File, In) :-
exports(In, Exports) :- exports(In, Exports) :-
read(In, Term), read(In, Term),
Term = (:- module(_Name, Exports)). Term = (:- module(_Name, Exports)).

18
pl/directives.yap
View File

@ -106,7 +106,7 @@
'$directive'(use_module(_,_,_)). '$directive'(use_module(_,_,_)).
'$directive'(wait(_)). '$directive'(wait(_)).
'$exec_directives'((G1,G2), Mode, M, VL, Pos) :- '$exec_directives'((G1,G2), Mode, M, VL, Pos) :-
!, !,
'$exec_directives'(G1, Mode, M, VL, Pos), '$exec_directives'(G1, Mode, M, VL, Pos),
'$exec_directives'(G2, Mode, M, VL, Pos). '$exec_directives'(G2, Mode, M, VL, Pos).
@ -130,7 +130,7 @@
Execute the goals defined by initialization/1. Only the first answer is Execute the goals defined by initialization/1. Only the first answer is
considered. considered.
*/ */
'$exec_directive'(initialization(D), _, M, _, _) :- '$exec_directive'(initialization(D), _, M, _, _) :-
'$initialization'(M:D). '$initialization'(M:D).
@ -139,7 +139,7 @@ considered.
'$exec_directive'(thread_initialization(D), _, M, _, _) :- '$exec_directive'(thread_initialization(D), _, M, _, _) :-
'$thread_initialization'(M:D). '$thread_initialization'(M:D).
'$exec_directive'(expects_dialect(D), _, _, _, _) :- '$exec_directive'(expects_dialect(D), _, _, _, _) :-
'$expects_dialect'(D). expects_dialect(D).
'$exec_directive'(encoding(Enc), _, _, _, _) :- '$exec_directive'(encoding(Enc), _, _, _, _) :-
'$set_encoding'(Enc). '$set_encoding'(Enc).
'$exec_directive'(include(F), Status, _, _, _) :- '$exec_directive'(include(F), Status, _, _, _) :-
@ -216,17 +216,17 @@ considered.
'$command'(Clause, VL, Pos, Context), '$command'(Clause, VL, Pos, Context),
'$assert_list'(Clauses, Context, Module, VL, Pos). '$assert_list'(Clauses, Context, Module, VL, Pos).
% %
% allow users to define their own directives. % allow users to define their own directives.
% %
user_defined_directive(Dir,_) :- user_defined_directive(Dir,_) :-
'$directive'(Dir), !. '$directive'(Dir), !.
user_defined_directive(Dir,Action) :- user_defined_directive(Dir,Action) :-
functor(Dir,Na,Ar), functor(Dir,Na,Ar),
functor(NDir,Na,Ar), functor(NDir,Na,Ar),
'$current_module'(M, prolog), '$current_module'(M, prolog),
assert_static('$directive'(NDir)), assert_static(prolog:'$directive'(NDir)),
assert_static(('$exec_directive'(Dir, _, _, _, _) :- Action)), assert_static(prolog:('$exec_directive'(Dir, _, _, _, _) :- Action)),
'$current_module'(_, M). '$current_module'(_, M).
'$thread_initialization'(M:D) :- '$thread_initialization'(M:D) :-
@ -235,5 +235,3 @@ user_defined_directive(Dir,Action) :-
fail. fail.
'$thread_initialization'(M:D) :- '$thread_initialization'(M:D) :-
'$initialization'(M:D). '$initialization'(M:D).

14
pl/errors.yap
View File

@ -202,7 +202,7 @@ The error handler is called when there is an execution error or a
warning needs to be displayed. The handlers include a number of hooks warning needs to be displayed. The handlers include a number of hooks
to allow user-control. to allow user-control.
*/ */
:- system_module( '$_errors', [message_to_string/2, :- system_module( '$_errors', [message_to_string/2,
print_message/2], ['$Error'/1, print_message/2], ['$Error'/1,
@ -246,7 +246,7 @@ to allow user-control.
print_message(informational,abort(user)). print_message(informational,abort(user)).
'$process_error'(abort, _) :- !, '$process_error'(abort, _) :- !,
throw(abort). throw(abort).
'$process_error'(error(thread_cancel(Id), G),top) :- !. '$process_error'(error(thread_cancel(_Id), _G),top) :- !.
'$process_error'(error(thread_cancel(Id), G), _) :- !, '$process_error'(error(thread_cancel(Id), G), _) :- !,
throw(error(thread_cancel(Id), G)). throw(error(thread_cancel(Id), G)).
'$process_error'(error(permission_error(module,redefined,A),B), Level) :- '$process_error'(error(permission_error(module,redefined,A),B), Level) :-
@ -258,7 +258,7 @@ to allow user-control.
'$process_error'(Throw, _) :- '$process_error'(Throw, _) :-
print_message(error,error(unhandled_exception,Throw)). print_message(error,error(unhandled_exception,Throw)).
/** @pred message_to_string(+ _Term_, - _String_) /** @pred message_to_string(+ _Term_, - _String_)
Translates a message-term into a string object. Primarily intended for SWI-Prolog emulation. Translates a message-term into a string object. Primarily intended for SWI-Prolog emulation.
@ -269,7 +269,7 @@ Translates a message-term into a string object. Primarily intended for SWI-Prolo
message_to_string(Event, Message) :- message_to_string(Event, Message) :-
'$messages':generate_message(Event, Message, []). '$messages':generate_message(Event, Message, []).
/** @pred print_message(+ _Kind_, _Term_) /** @pred print_message(+ _Kind_, _Term_)
The predicate print_message/2 is used to print messages, notably from The predicate print_message/2 is used to print messages, notably from
exceptions in a human-readable format. _Kind_ is one of exceptions in a human-readable format. _Kind_ is one of
@ -293,10 +293,10 @@ invent new ones, you can define corresponding error messages by
asserting clauses for `prolog:message/2`. You will need to declare asserting clauses for `prolog:message/2`. You will need to declare
the predicate as multifile. the predicate as multifile.
*/ */
print_message(_, _) :- print_message(_, _) :-
'$nb_getval'('$if_skip_mode',skip,fail), '$nb_getval'('$if_skip_mode',skip,fail),
!. !.
print_message(force(_Severity), Msg) :- !, print_message(force(_Severity), Msg) :- !,
print(user_error,Msg). print(user_error,Msg).
@ -352,5 +352,3 @@ print_message(_, Term) :-
flush_output(user_error), flush_output(user_error),
'$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines), !, '$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines), !,
print_message_lines(Stream, LinePrefix, LinesF). print_message_lines(Stream, LinePrefix, LinesF).

8
pl/init.yap
View File

@ -221,7 +221,6 @@ rules.
:- dynamic goal_expansion/2. :- dynamic goal_expansion/2.
:- use_module('messages.yap'). :- use_module('messages.yap').
:- use_module('hacks.yap'). :- use_module('hacks.yap').
:- use_module('attributes.yap'). :- use_module('attributes.yap').
@ -328,12 +327,7 @@ If this hook predicate succeeds it must instantiate the _Action_ argument to th
+ `undefined_global_variable` + `undefined_global_variable`
_Context_ is instantiated to the name of the missing global variable. The hook must call nb_setval/2 or b_setval/2 before returning with the action retry. _Context_ is instantiated to the name of the missing global variable. The hook must call nb_setval/2 or b_setval/2 before returning with the action retry.
*/
*/
:- multifile user:exception/3. :- multifile user:exception/3.

20
pl/messages.yap
View File

@ -76,14 +76,6 @@ file_position(user_input,LN) -->
file_position(FileName,LN) --> file_position(FileName,LN) -->
[ '~a:~d:0: ' - [FileName,LN] ]. [ '~a:~d:0: ' - [FileName,LN] ].
translate_message(Term) -->
generate_message(Term), !.
translate_message(Term) -->
{ Term = error(_, _) },
[ 'Unknown exception: ~p'-[Term] ].
translate_message(Term) -->
[ 'Unknown message: ~p'-[Term] ].
generate_message(Term, Lines, []) :- generate_message(Term, Lines, []) :-
user:generate_message_hook(Term, [], Lines), !. user:generate_message_hook(Term, [], Lines), !.
generate_message(Term) --> generate_message(Term) -->
@ -679,11 +671,15 @@ pred_arity(H,Name,Arity) :-
functor(H,Name,Arity). functor(H,Name,Arity).
translate_message(Term) -->
generate_message(Term), !.
translate_message(Term) -->
{ Term = error(_, _) },
[ 'Unknown exception: ~p'-[Term] ].
translate_message(Term) -->
[ 'Unknown message: ~p'-[Term] ].
/** /**
@} @}
@} @}
*/ */

70
pl/modules.yap
View File

@ -1,3 +1,4 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
@ -158,7 +159,7 @@ not at all defined.
'$do_import'/3, '$do_import'/3,
'$extend_exports'/3, '$extend_exports'/3,
'$get_undefined_pred'/4, '$get_undefined_pred'/4,
'$imported_pred'/4, '$imported_predicate'/4,
'$meta_expansion'/6, '$meta_expansion'/6,
'$meta_predicate'/2, '$meta_predicate'/2,
'$meta_predicate'/4, '$meta_predicate'/4,
@ -666,7 +667,15 @@ source_module(Mod) :-
'$expand_modules'((A;B),(A1;B1),(AO;BO),HM,BM,SM,HVars) :- var(A), !, '$expand_modules'((A;B),(A1;B1),(AO;BO),HM,BM,SM,HVars) :- var(A), !,
'$expand_modules'(A,A1,AO,HM,BM,SM,HVars), '$expand_modules'(A,A1,AO,HM,BM,SM,HVars),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars). '$expand_modules'(B,B1,BO,HM,BM,SM,HVars).
'$expand_modules'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,BM,SM,HVars) :- !, '$expand_modules'((A*->B;C),(A1*->B1;C1),
(
yap_hacks:current_choicepoint(DCP),
AO,
yap_hacks:cut_at(DCP),BO
;
CO
),
HM,BM,SM,HVars) :- !,
'$expand_modules'(A,A1,AOO,HM,BM,SM,HVars), '$expand_modules'(A,A1,AOO,HM,BM,SM,HVars),
'$clean_cuts'(AOO, AO), '$clean_cuts'(AOO, AO),
'$expand_modules'(B,B1,BO,HM,BM,SM,HVars), '$expand_modules'(B,B1,BO,HM,BM,SM,HVars),
@ -724,18 +733,29 @@ source_module(Mod) :-
'$expand_modules'(false,false,false,_,_,_,_) :- !. '$expand_modules'(false,false,false,_,_,_,_) :- !.
% if I don't know what the module is, I cannot do anything to the goal, % 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. % so I just put a call for later on.
'$expand_modules'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !. '$expand_modules'(M:G,call(M:G),
'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !.
'$expand_modules'(M:G,G1,GO,HM,_M,_SM,HVars) :- !, '$expand_modules'(M:G,G1,GO,HM,_M,_SM,HVars) :- !,
'$expand_modules'(G,G1,GO,HM,M,M,HVars). '$expand_modules'(G,G1,GO,HM,M,M,HVars).
'$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :- '$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :-
'$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars).
% is this imported from some other module M1? % is this imported from some other module M1?
'$imported_pred'(G, BM, GG, M1),
'$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars) :-
'$pred_exists'(G, BM), !,
'$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars).
'$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars) :-
'$imported_predicate'(G, BM, GG, M1),
!, !,
'$expand_modules'(GG, G1, GO, HM, M1, SM, HVars). '$expand_goal_meta'(GG, G1, GO, HM, M1, SM, HVars).
'$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :- % we assume that if it is not defined here, it must be elsewhere.
'$expand_goal_modules'(G, G1, GO, HM, BM, SM, HVars) :-
'$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars).
'$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars) :-
'$meta_expansion'(G, HM, BM, SM, GI, HVars), !, '$meta_expansion'(G, HM, BM, SM, GI, HVars), !,
'$complete_goal_expansion'(GI, HM, BM, SM, G1, GO, HVars). '$complete_goal_expansion'(GI, HM, BM, SM, G1, GO, HVars).
'$expand_modules'(G, G1, GO, HM, BM, SM, HVars) :- '$expand_goal_meta'(G, G1, GO, HM, BM, SM, HVars) :-
'$complete_goal_expansion'(G, HM, BM, SM, G1, GO, HVars). '$complete_goal_expansion'(G, HM, BM, SM, G1, GO, HVars).
expand_goal(G, G) :- expand_goal(G, G) :-
@ -823,7 +843,7 @@ expand_goal(G, G).
% be careful here not to generate an undefined exception. % be careful here not to generate an undefined exception.
'$imported_pred'(G, ImportingMod, G0, ExportingMod) :- '$imported_predicate'(G, ImportingMod, G0, ExportingMod) :-
'$enter_undefp', '$enter_undefp',
( var(G) -> true ; ( var(G) -> true ;
var(ImportingMod) -> true ; var(ImportingMod) -> true ;
@ -832,7 +852,7 @@ expand_goal(G, G).
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod), '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
ExportingMod \= ImportingMod, !, ExportingMod \= ImportingMod, !,
'$exit_undefp'. '$exit_undefp'.
'$imported_pred'(_G, _ImportingMod, _, _) :- '$imported_predicate'(_G, _ImportingMod, _, _) :-
'$exit_undefp', '$exit_undefp',
fail. fail.
@ -847,26 +867,28 @@ expand_goal(G, G).
'$get_undefined_pred'(G, _ImportingMod, G, user) :- '$get_undefined_pred'(G, _ImportingMod, G, user) :-
nonvar(G), nonvar(G),
'$pred_exists'(G, user), !. '$pred_exists'(G, user), !.
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
recorded('$dialect',Dialect,_),
Dialect \= yap,
functor(G, Name, Arity),
call(Dialect:index(Name,Arity,ExportingModI,_)), !,
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
% autoload
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
yap_flag(autoload, V), recorded('$dialect',swi,_),
V = true, get_prolog_flag(autoload, true),
functor(G, N, K), '$autoload'(G, ImportingMod, ExportingModI, swi),
functor(G0, N, K), '$continue_imported'(ExportingMod, ExportingModI, G0, G).
'$autoloader_find_predicate'(G0,ExportingMod), % autoload
ExportingMod \= ImportingMod,
(recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ).
% parent module mechanism % parent module mechanism
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
prolog:'$parent_module'(ImportingMod,ExportingModI), prolog:'$parent_module'(ImportingMod,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G). '$continue_imported'(ExportingMod, ExportingModI, G0, G).
'$autoload'(G, _ImportingMod, ExportingMod, Dialect) :-
functor(G, Name, Arity),
call(Dialect:index(Name,Arity,ExportingMod,_)), !.
'$autoload'(G, ImportingMod, ExportingMod, _Dialect) :-
functor(G, N, K),
functor(G0, N, K),
'$autoloader_find_predicate'(G0,ExportingMod),
ExportingMod \= ImportingMod,
(recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ).
'$autoloader_find_predicate'(G,ExportingModI) :- '$autoloader_find_predicate'(G,ExportingModI) :-
'$nb_getval'('$autoloader_set', true, fail), !, '$nb_getval'('$autoloader_set', true, fail), !,
@ -1397,7 +1419,7 @@ export_list(Module, List) :-
'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :- '$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :-
op(Prio,Assoc,ContextMod:Name). op(Prio,Assoc,ContextMod:Name).
'$do_import'(N0/K0-N0/K0, Mod, Mod) :- !. '$do_import'(N0/K0-N0/K0, Mod, Mod) :- !.
'$do_import'(N0/K0-N0/K0, Mod, prolog) :- !. '$do_import'(N0/K0-N0/K0, _Mod, prolog) :- !.
'$do_import'(_N/K-N1/K, _Mod, ContextMod) :- '$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_), recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
once(lists:member(N1/K, MyExports)), once(lists:member(N1/K, MyExports)),

4
pl/preds.yap
View File

@ -574,7 +574,7 @@ predicate_property(Pred,Prop) :-
'$pred_exists'(Pred,Mod), !, '$pred_exists'(Pred,Mod), !,
'$predicate_property'(Pred,Mod,Mod,Prop). '$predicate_property'(Pred,Mod,Mod,Prop).
'$predicate_property2'(Pred,Prop,Mod) :- '$predicate_property2'(Pred,Prop,Mod) :-
'$imported_pred'(Pred, Mod, NPred, M), '$imported_predicate'(Pred, Mod, NPred, M),
( (
Prop = imported_from(M) Prop = imported_from(M)
; ;
@ -679,7 +679,7 @@ current_predicate(A,T) :-
% format('1 ~w ~16r~n', [M:T0,Flags, TFlags]), % format('1 ~w ~16r~n', [M:T0,Flags, TFlags]),
\+ '$system_predicate'(T0, M) \+ '$system_predicate'(T0, M)
; ;
'$imported_pred'(T0, M, SourceT, SourceMod), '$imported_predicate'(T0, M, SourceT, SourceMod),
functor(T0, A, _), functor(T0, A, _),
% format('2 ~w ~16r~n', [M:T0,Flags]), % format('2 ~w ~16r~n', [M:T0,Flags]),
\+ '$system_predicate'(SourceT, SourceMod) \+ '$system_predicate'(SourceT, SourceMod)

5
pl/qly.yap
View File

@ -237,7 +237,7 @@ qend_program :-
X \= encoding. X \= encoding.
'$init_state' :- '$init_state' :-
recorded('$program_state', P, _), !, recorded('$program_state', _P, _), !,
'$do_init_state'. '$do_init_state'.
'$init_state'. '$init_state'.
@ -325,6 +325,9 @@ qend_program :-
'$init_path_extensions'. '$init_path_extensions'.
% then we can execute the programs. % then we can execute the programs.
'$startup_goals' :-
module(user),
fail.
'$startup_goals' :- '$startup_goals' :-
recorded('$startup_goal',G,_), recorded('$startup_goal',G,_),
'$current_module'(Module), '$current_module'(Module),