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

fix

This commit is contained in:
Vitor Santos Costa 2018-01-19 14:38:26 +00:00
parent 4c25aa21c5
commit fdf7bb516f
16 changed files with 170 additions and 480 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/absmi.c
View File

@ -930,6 +930,8 @@ static void undef_goal(USES_REGS1) {
if (UndefCode == NULL || UndefCode->OpcodeOfPred == UNDEF_OPCODE) {
fprintf(stderr,"call to undefined Predicates %s ->", IndicatorOfPred(pe));
Yap_DebugPlWriteln(ARG1);
fputc(':', stderr);
Yap_DebugPlWriteln(ARG2);
fprintf(stderr," error handler not available, failing\n");
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);

6
C/c_interface.c
View File

@ -2136,7 +2136,7 @@ X_API int YAP_InitConsult(int mode, const char *fname, char *full, int *osnop) {
GLOBAL_Stream[sno].name = Yap_LookupAtom(fl);
GLOBAL_Stream[sno].user_name = MkAtomTerm(Yap_LookupAtom(fname));
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
pop_text_stack(lvl);
RECOVER_MACHINE_REGS();
UNLOCK(GLOBAL_Stream[sno].streamlock);
return sno;
@ -2191,10 +2191,10 @@ X_API Term YAP_ReadFromStream(int sno) {
return o;
}
X_API Term YAP_ReadClauseFromStream(int sno) {
X_API Term YAP_ReadClauseFromStream(int sno, Term vs) {
BACKUP_MACHINE_REGS();
Term t = Yap_read_term(sno, TermNil, true);
Term t = Yap_read_term(sno, t = MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames,1),1,&vs), TermNil), true);
RECOVER_MACHINE_REGS();
return t;
}

26
C/scanner.c
View File

@ -1247,16 +1247,16 @@ const char *Yap_tokText(void *tokptre) {
return "<QQ>";
case Number_tok:
if (IsIntegerTerm(info)) {
char *s = Malloc(36);
char *s = malloc(36);
snprintf(s, 35, Int_FORMAT, IntegerOfTerm(info));
return s;
} else if (IsFloatTerm(info)) {
char *s = Malloc(64);
char *s = malloc(64);
snprintf(s, 63, "%6g", FloatOfTerm(info));
return s;
} else {
size_t len = Yap_gmp_to_size(info, 10);
char *s = Malloc(len + 2);
char *s = malloc(len + 2);
return Yap_gmp_to_string(info, s, len + 1, 10);
}
break;
@ -1413,7 +1413,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
int32_t och = ch;
ch = getchr(st);
size_t sz = 512;
TokImage = Malloc(sz PASS_REGS);
TokImage = malloc(sz PASS_REGS);
scan_name:
charp = (unsigned char *)TokImage;
isvar = (chtype(och) != LC);
@ -1443,7 +1443,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
Atom ae;
/* don't do this in iso */
ae = Yap_ULookupAtom(TokImage);
Free(TokImage);
free(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
}
@ -1453,7 +1453,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = Name_tok);
} else {
VarEntry *ve = Yap_LookupVar((const char *)TokImage);
Free(TokImage);
free(TokImage);
t->TokInfo = Unsigned(ve);
if (cur_qq) {
ve->refs++;
@ -1500,7 +1500,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case 'e':
case 'E':
och = cherr;
TokImage = Malloc(1024 PASS_REGS);
TokImage = malloc(1024 PASS_REGS);
goto scan_name;
break;
case '=':
@ -1569,7 +1569,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case QT:
case DC:
quoted_string:
TokImage = Malloc(1048);
TokImage = malloc(1048);
charp = TokImage;
quote = ch;
len = 0;
@ -1633,7 +1633,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
}
Free(TokImage);
free(TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
solo_flag = false;
@ -1746,7 +1746,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} else {
Atom ae;
sz = 1024;
TokImage = Malloc(sz);
TokImage = malloc(sz);
charp = TokImage;
add_ch_to_buff(och);
for (; chtype(ch) == SY; ch = getchr(st)) {
@ -1767,7 +1767,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
if (t->TokInfo == (CELL)NIL) {
return CodeSpaceError(t, p, l);
}
Free(TokImage);
free(TokImage);
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
solo_flag = false;
@ -1890,7 +1890,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = QuasiQuotes_tok);
ch = getchr(st);
sz = 1024;
TokImage = Malloc(sz);
TokImage = malloc(sz);
if (!TokImage) {
LOCAL_ErrorMessage =
"not enough heap space to read in a quasi quoted atom";
@ -1914,7 +1914,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
break;
}
} else if (chtype(ch) == EF) {
Free(TokImage);
free(TokImage);
mark_eof(st);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;

26
C/yap-args.c
View File

@ -159,23 +159,22 @@ const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
*Yap_PLDIR, *Yap_BOOTPLDIR, *Yap_BOOTSTRAPPLDIR, *Yap_COMMONSDIR,
*Yap_STARTUP, *Yap_BOOTFILE;
static int yap_lineno = 0;
/* do initial boot by consulting the file boot.yap */
static void consult(const char *b_file USES_REGS) {
Term t;
int boot_stream, osno;
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1);
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 2);
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1);
Functor functor_bc = Yap_MkFunctor(Yap_LookupAtom("$bc"), 2);
/* consult boot.pl */
char *full = malloc(YAP_FILENAME_MAX + 1);
full[0] = '\0';
/* the consult mode does not matter here, really */
boot_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, full, &osno);
if (boot_stream < 0) {
fprintf(stderr, "[ FATAL ERROR: could not open boot_stream %s ]\n", b_file);
fprintf(stderr, "[ FATAL ERROR: could not open stream %s ]\n", b_file);
exit(1);
}
@ -183,20 +182,25 @@ do {
CACHE_REGS
YAP_Reset(YAP_FULL_RESET, false);
Yap_StartSlots();
t = YAP_ReadClauseFromStream(boot_stream);
Term vs = YAP_MkVarTerm();
t = YAP_ReadClauseFromStream(boot_stream, vs);
//Yap_GetNèwSlot(t);
if (t == 0) {
fprintf(stderr,
"[ SYNTAX ERROR: while parsing boot_stream %s at line %d ]\n",
b_file, yap_lineno);
"[ SYNTAX ERROR: while parsing stream %s at line %ld ]\n",
b_file, GLOBAL_Stream[boot_stream].linecount);
} else if (IsVarTerm(t) || t == TermNil) {
fprintf(stderr, "[ line %d: term cannot be compiled ]", yap_lineno);
fprintf(stderr, "[ line %d: term cannot be compiled ]", GLOBAL_Stream[boot_stream].linecount);
} else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query ||
FunctorOfTerm(t) == functor_command1)) {
t = ArgOfTerm(1, t);
if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) {
consult( RepAtom(AtomOfTerm(ArgOfTerm(1,t)))->StrOfAE);
} else {
YAP_Term ts[2];
ts[0] = t;
ts[1] = vs;
t = YAP_MkApplTerm(functor_bc, 2, ts);
YAP_RunGoalOnce(t);
}
} else {
@ -227,7 +231,7 @@ do {
#endif
}
/** @brief A simple language for detecting where YAP stuff cn be found
/** @brief A simple language for detecting where YAP stuff can be found
*
* @long The options are
* `[V]` use a configuration variable YAP_XXXDIR, prefixed by "DESTDIR"
@ -1194,7 +1198,7 @@ return end_init(yap_init, YAP_QLY);
start_modules();
consult(Yap_BOOTFILE PASS_REGS);
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
MkAtomTerm(Yap_BOOTFILE));
MkAtomTerm(Yap_LookupAtom(Yap_BOOTFILE)));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false);
return end_init(yap_init, YAP_BOOT_PL);
}

2
H/ATOMS
View File

@ -222,7 +222,7 @@ A Least N "least"
A Length F "length"
A List N "list"
A Line N "line"
A Live F "$live"
A Live F "live"
A LoadAnswers N "load_answers"
A Local N "local"
A LocalSp N "local_sp"

5
H/generated/iatoms.h
View File

@ -217,7 +217,7 @@
AtomLength = Yap_FullLookupAtom("length"); TermLength = MkAtomTerm(AtomLength);
AtomList = Yap_LookupAtom("list"); TermList = MkAtomTerm(AtomList);
AtomLine = Yap_LookupAtom("line"); TermLine = MkAtomTerm(AtomLine);
AtomLive = Yap_FullLookupAtom("$live"); TermLive = MkAtomTerm(AtomLive);
AtomLive = Yap_FullLookupAtom("live"); TermLive = MkAtomTerm(AtomLive);
AtomLoadAnswers = Yap_LookupAtom("load_answers"); TermLoadAnswers = MkAtomTerm(AtomLoadAnswers);
AtomLocal = Yap_LookupAtom("local"); TermLocal = MkAtomTerm(AtomLocal);
AtomLocalSp = Yap_LookupAtom("local_sp"); TermLocalSp = MkAtomTerm(AtomLocalSp);
@ -226,8 +226,7 @@
AtomMaximum = Yap_LookupAtom("maximum"); TermMaximum = MkAtomTerm(AtomMaximum);
AtomMaxArity = Yap_LookupAtom("max_arity"); TermMaxArity = MkAtomTerm(AtomMaxArity);
AtomMaxFiles = Yap_LookupAtom("max_files"); TermMaxFiles = MkAtomTerm(AtomMaxFiles);
AtomMegaClause = Yap_FullLookupAtom("$mega_clause"); TermMegaClause = MkAtomTerm(AtomMegaClause);
AtomMegaClause = Yap_FullLookupAtom("$mega_clause"); TermMegaClause = MkAtomTerm(AtomMegaClause);
AtomMetaCall = Yap_FullLookupAtom("$call"); TermMetaCall = MkAtomTerm(AtomMetaCall);
AtomMfClause = Yap_FullLookupAtom("$mf_clause"); TermMfClause = MkAtomTerm(AtomMfClause);
AtomMin = Yap_LookupAtom("min"); TermMin = MkAtomTerm(AtomMin);

27
console/yap.c
View File

@ -58,8 +58,8 @@
#include <ieeefp.h>
#endif
static void do_top_goal(YAP_Term Goal);
static void exec_top_level(int BootMode, YAP_init_args *iap);
static bool do_top_goal(YAP_Term Goal);
static bool exec_top_level(int BootMode, YAP_init_args *iap);
#ifdef lint
/* VARARGS1 */
@ -69,7 +69,7 @@ static void exec_top_level(int BootMode, YAP_init_args *iap);
long _stksize = 32000;
#endif
static void do_top_goal(YAP_Term Goal) { YAP_RunGoalOnce(Goal); }
static bool do_top_goal(YAP_Term Goal) { return YAP_RunGoalOnce(Goal); }
static int init_standard_system(int argc, char *argv[], YAP_init_args *iap) {
@ -86,7 +86,7 @@ static int init_standard_system(int argc, char *argv[], YAP_init_args *iap) {
return BootMode;
}
static void exec_top_level(int BootMode, YAP_init_args *iap) {
static bool exec_top_level(int BootMode, YAP_init_args *iap) {
YAP_Term atomfalse;
YAP_Atom livegoal;
@ -94,19 +94,22 @@ static void exec_top_level(int BootMode, YAP_init_args *iap) {
/* continue executing from the frozen stacks */
YAP_ContinueGoal();
}
livegoal = YAP_FullLookupAtom("$live");
livegoal = YAP_FullLookupAtom("live");
/* the top-level is now ready */
/* read it before case someone, that is, Ashwin, hides
the atom false away ;-).
*/
atomfalse = YAP_MkAtomTerm(YAP_FullLookupAtom("$false"));
atomfalse = YAP_MkAtomTerm(YAP_FullLookupAtom("false"));
while (YAP_GetValue(livegoal) != atomfalse) {
YAP_Reset(YAP_FULL_RESET, false);
do_top_goal(YAP_MkAtomTerm(livegoal));
livegoal = YAP_FullLookupAtom("$live");
}
YAP_Exit(EXIT_SUCCESS);
if (!do_top_goal(YAP_MkAtomTerm(livegoal))) {
return false;
};
livegoal = YAP_FullLookupAtom("live");
}
return true;
//YAP_Exit(EXIT_SUCCESS);
}
@ -144,7 +147,7 @@ int main(int argc, char **argv)
YAP_Reset(YAP_FULL_RESET, false);
/* End preprocessor code */
exec_top_level(BootMode, &init_args);
bool rc = exec_top_level(BootMode, &init_args);
return (0);
return rc;
}

2
include/YapInterface.h
View File

@ -400,7 +400,7 @@ extern X_API YAP_Term YAP_ReadFromStream(int s);
/// read a Prolog clause from a Prolog opened stream $s$. Similar to
/// YAP_ReadFromStream() but takes /// default options from read_clause/3.
extern X_API YAP_Term YAP_ReadClauseFromStream(int s);
extern X_API YAP_Term YAP_ReadClauseFromStream(int s, YAP_Term varNames);
extern X_API void YAP_Write(YAP_Term t, FILE *s, int);

2
os/YapIOConfig.h.cmake
View File

@ -41,7 +41,7 @@ you don't. */
#cmakedefine HAVE_DECL_RL_READLINE_STATE ${HAVE_DECL_RL_READLINE_STATE}
#endif
/* Define to 1 if you have the `rl_begin_undo_group' function. */
/* Define to 1 if you have the `rl_begin_undo_group' function. */
#ifndef HAVE_RL_BEGIN_UNDO_GROUP
#cmakedefine HAVE_RL_BEGIN_UNDO_GROUP ${HAVE_RL_BEGIN_UNDO_GROUP}
#endif

8
os/charsio.c
View File

@ -93,7 +93,7 @@ INLINE_ONLY inline EXTERN Int CharOfAtom(Atom at) {
return val;
}
int peekWideWithGetwc(int sno){
int Yap_peekWideWithGetwc(int sno){
StreamDesc *s;
s = GLOBAL_Stream + sno;
int ch = getwc(s->file);
@ -102,7 +102,7 @@ int peekWideWithGetwc(int sno){
}
int Yap_peekWithGetw(int sno) {
int Yap_peekWithGetc(int sno) {
StreamDesc *s;
s = GLOBAL_Stream + sno;
int ch = getc(s->file);
@ -114,7 +114,7 @@ int Yap_peekWithGetw(int sno) {
int Yap_peekWideWithSeek(int sno) {
StreamDesc *s;
s = GLOBAL_Stream + sno;
Int pos = s->charcount;
Int pos = IntegerOfTerm(Yap_StreamPosition(sno));
Int line = s->linecount;
Int lpos = s->linepos;
int ch = s->stream_wgetc(sno);
@ -135,7 +135,7 @@ int Yap_peekWideWithSeek(int sno) {
int Yap_peekWithSeek(int sno) {
StreamDesc *s;
s = GLOBAL_Stream + sno;
Int pos = s->charcount;
Int pos = IntegerOfTerm(Yap_StreamPosition(sno));
Int line = s->linecount;
Int lpos = s->linepos;
int ch = s->stream_getc(sno);

6
os/iopreds.c
View File

@ -352,7 +352,11 @@ void Yap_DefaultStreamOps(StreamDesc *st) {
st->stream_getc = Yap_popChar;
st->stream_wgetc = Yap_popChar;
}
if (st->status & Seekable_Stream_f ) {
if (st->file) {
st->stream_peek = Yap_peekWithGetc;
st->stream_wpeek = Yap_peekWideWithGetwc;
} else if (st->status & Seekable_Stream_f ) {
st->stream_peek = Yap_peekWithSeek;
st->stream_wpeek = Yap_peekWideWithSeek;
} else {

56
os/iopreds.h
View File

@ -153,9 +153,9 @@ extern void Yap_InitWriteTPreds(void);
extern void Yap_InitReadTPreds(void);
extern void Yap_socketStream(StreamDesc *s);
extern void Yap_ReadlineFlush(int sno);
int Yap_ReadlinePeekChar(int sno);
int Yap_ReadlineForSIGINT(void);
bool Yap_DoPrompt(StreamDesc *s);
extern int Yap_ReadlinePeekChar(int sno);
extern int Yap_ReadlineForSIGINT(void);
extern bool Yap_DoPrompt(StreamDesc *s);
extern int Yap_peek(int sno);
extern int Yap_MemPeekc(int sno);
@ -169,42 +169,42 @@ extern int Yap_peekWide(int sno);
extern int Yap_peekChar(int sno);
Term Yap_syntax_error(TokEntry *tokptr, int sno);
extern Term Yap_syntax_error(TokEntry *tokptr, int sno);
int console_post_process_read_char(int, StreamDesc *);
int console_post_process_eof(StreamDesc *);
int post_process_read_wchar(int, size_t, StreamDesc *);
int post_process_weof(StreamDesc *);
extern int console_post_process_read_char(int, StreamDesc *);
extern int console_post_process_eof(StreamDesc *);
extern int post_process_read_wchar(int, size_t, StreamDesc *);
extern int post_process_weof(StreamDesc *);
bool is_same_tty(FILE *f1, FILE *f2);
extern bool is_same_tty(FILE *f1, FILE *f2);
int ISOWGetc(int sno);
int GetUTF8(int sno);
Term read_line(int sno);
int PlGets(int sno, UInt size, char *buf);
GetsFunc PlGetsFunc(void);
int PlGetc(int sno);
int FilePutc(int sno, int c);
int DefaultGets(int, UInt, char *);
int put_wchar(int sno, wchar_t ch);
Int GetStreamFd(int sno);
int ResetEOF(StreamDesc *s);
int EOFPeek(int sno);
int EOFWPeek(int sno);
extern int ISOWGetc(int sno);
extern int GetUTF8(int sno);
extern Term read_line(int sno);
extern int PlGets(int sno, UInt size, char *buf);
extern GetsFunc PlGetsFunc(void);
extern int PlGetc(int sno);
extern int FilePutc(int sno, int c);
extern int DefaultGets(int, UInt, char *);
extern int put_wchar(int sno, wchar_t ch);
extern Int GetStreamFd(int sno);
extern int ResetEOF(StreamDesc *s);
extern int EOFPeek(int sno);
extern int EOFWPeek(int sno);
extern void Yap_SetAlias(Atom arg, int sno);
bool Yap_AddAlias(Atom arg, int sno);
int Yap_CheckAlias(Atom arg);
int Yap_RemoveAlias(Atom arg, int snoinline);
extern bool Yap_AddAlias(Atom arg, int sno);
extern int Yap_CheckAlias(Atom arg);
extern int Yap_RemoveAlias(Atom arg, int snoinline);
extern void Yap_SetAlias(Atom arg, int sno);
void Yap_InitAliases(void);
void Yap_DeleteAliases(int sno);
extern void Yap_InitAliases(void);
extern void Yap_DeleteAliases(int sno);
extern bool Yap_FindStreamForAlias(Atom al);
extern bool Yap_FetchStreamAlias(int sno, Term t2 USES_REGS);
INLINE_ONLY inline EXTERN void count_output_char(int ch, StreamDesc *s);
Term Yap_StreamUserName(int sno);
extern Term Yap_StreamUserName(int sno);
INLINE_ONLY inline EXTERN void count_output_char(int ch, StreamDesc *s) {
if (ch == '\n') {

414
pl/boot.yap
View File

@ -27,6 +27,32 @@
*/
'$bc'(G , VL) :-
'$pred_exists'( expand_term((:- G), O),prolog),
% allow user expansion
expand_term((:- G), O),
!,
(
O = (:- G1)
->
'$yap_strip_module'(G1, M, G2)
;
'$yap_strip_module'(O, M, G2)
),
'$b2'(G2, VL, M).
'$bc'(G,_VL) :-
'$yap_strip_module'(G, M, G2),
'$execute'(M:G2).
'$b2'(G2, VL, M) :-
(
'$directive'(G2)
->
'$exec_directives'(G2, _Option, M, VL, _Pos)
;
'$execute'(M:G2)
).
system_module(_Mod, _SysExps, _Decls).
% new_system_module(Mod).
@ -66,7 +92,6 @@ private(_).
'$inform_as_reconsulted'/2,
'$init_system'/0,
'$init_win_graphics'/0,
'$live'/0,
'$loop'/2,
'$meta_call'/2,
'$prompt_alternatives_on'/1,
@ -110,15 +135,8 @@ private(_).
% be careful here not to generate an undefined exception.
'$undefp0'([_M|'$imported_predicate'(G, _ImportingMod, G, prolog)], _Action) :-
nonvar(G), '$is_system_predicate'(G, prolog), !.
'$undefp0'([_M|print_message(A,B)], _Action) :-
!.
'$undefp0'([_M|sort(A,B)], _Action) :-
!,
'$sort'(A,B).
'$undefp0'([prolog_complete|print_message(_,_), _Action) :-
format( user_error, '~w in bootstrap: got ~w~n',[L,E]).
'$undefp0'([M|G], _Action) :-
stream_property( loop_stream, file_name(F)),
stream_property( loop_stream, line_number(L)),
@ -129,7 +147,17 @@ private(_).
:- '$undefp_handler'('$undefp0'(_,_),prolog).
%'$undefp0'([_M|'$imported_predicate'(G, _ImportingMod, G, prolog)], _Action) :-
% nonvar(G), '$is_system_predicate'(G, prolog), !.
%'$undefp0'([_M|print_message(A,B)], _Action) :-
% !.
%'$undefp0'([_M|sort(A,B)], _Action) :-
% !,
% '$sort'(A,B).
live :-
initialize_prolog,
repeat,
'$current_module'(Module),
( Module==user ->
@ -385,7 +413,7 @@ initialize_prolog :-
->
'$yap_strip_module'(G1, M, G2),
'$process_directive'(G2, Option, M, VL, Pos)
'$process_directives'(G2, Option, M, VL, Pos)
;
'$execute_commands'(G1,VL,Pos,Option,O)
).
@ -1353,6 +1381,7 @@ log_event( String, Args ) :-
:- compile_expressions.
:- c_compile('directives.yap').
:- c_compile('imports.yap').
:- c_compile('bootutils.yap').
:- c_compile('bootlists.yap').
@ -1581,368 +1610,5 @@ If this hook predicate succeeds it must instantiate the _Action_ argument to th
:- dynamic user:exception/3.
:- ensure_loaded('../pl/pathconf.yap').
/*
Add some tests
*/
:- yap_flag(user:unknown,error).
/*
:- if(predicate_property(run_tests, static)).
aa b.
p(X,Y) :- Y is X*X.
prefix(information, '% ', S, user_error) --> [].
:- format('~d~n', [a]).
:- format('~d~n', []).
:- p(X,Y).
a(1).
a.
a(2).
a(2).
lists:member(1,[1]).
clause_to_indicator(T, M:Name/Arity) :- ,
strip_module(T, M, T1),
pred_arity( T1, Name, Arity ).
:- endif.
*/
/**
@{
@defgroup library The Prolog library
@addtogroup YAPControl
@ingroup builtins
@{
*/
:- '$system_predicate'(
[!/0,
':-'/1,
'?-'/1,
[]/0,
extensions_to_present_answer/1,
fail/0,
false/0,
goal_expansion/2,
goal_expansion/3,
otherwise/0,
term_expansion/2,
version/2]).
%:- start_low_level_trace.
% This is the YAP init file
% should be consulted first step after booting
% These are pseudo declarations
% so that the user will get a redefining system predicate
:- '$init_pred_flag_vals'('$flag_info'(a,0), prolog).
/** @pred fail is iso
Always fails.
*/
fail :- fail.
/** @pred false is iso
The same as fail.
*/
false :- fail.
otherwise.
!.
(:- G) :- '$execute'(G), !.
(?- G) :- '$execute'(G).
'$$!'(CP) :- '$cut_by'(CP).
[] :- true.
% just create a choice-point
% the 6th argument marks the time-stamp.
'$do_log_upd_clause'(_,_,_,_,_,_).
'$do_log_upd_clause'(A,B,C,D,E,_) :-
'$continue_log_update_clause'(A,B,C,D,E).
'$do_log_upd_clause'(_,_,_,_,_,_).
'$do_log_upd_clause_erase'(_,_,_,_,_,_).
'$do_log_upd_clause_erase'(A,B,C,D,E,_) :-
'$continue_log_update_clause_erase'(A,B,C,D,E).
'$do_log_upd_clause_erase'(_,_,_,_,_,_).
'$do_log_upd_clause0'(_,_,_,_,_,_).
'$do_log_upd_clause0'(A,B,C,D,_,_) :-
'$continue_log_update_clause'(A,B,C,D).
'$do_log_upd_clause0'(_,_,_,_,_,_).
'$do_static_clause'(_,_,_,_,_).
'$do_static_clause'(A,B,C,D,E) :-
'$continue_static_clause'(A,B,C,D,E).
'$do_static_clause'(_,_,_,_,_).
:- c_compile('arith.yap', prolog).
:- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
:- compile_expressions.
:- c_compile('bootutils.yap', prolog).
:- c_compile('bootlists.yap', prolog).
:- c_compile('consult.yap', prolog).
:- c_compile('preddecls.yap', prolog).
:- c_compile('preddyns.yap', prolog).
:- c_compile('meta.yap', prolog).
:- c_compile('newmod.yap', prolog).
:- c_compile('atoms.yap', prolog).
:- c_compile('os.yap', prolog).
:- c_compile('grammar.yap', prolog).
:- c_compile('directives.yap', prolog).
:- c_compile('absf.yap', prolog).
:- dynamic prolog:'$parent_module'/2.
%:- set_prolog_flag(verbose_file_search, true ).
%:- yap_flag(write_strings,on).
%:- start_low_level_trace.
:- ensure_loaded([
'preds.yap',
'modules.yap'
]).
%:-stop_low_level_trace.
:- use_module('error.yap').
:- ensure_loaded([
'errors.yap',
'utils.yap',
'control.yap',
'flags.yap'
]).
:- ensure_loaded([
% lists is often used.
'../os/yio.yap',
'debug.yap',
'checker.yap',
'depth_bound.yap',
'ground.yap',
'listing.yap',
'arithpreds.yap',
% modules must be after preds, otherwise we will have trouble
% with meta-predicate expansion being invoked
% must follow grammar
'eval.yap',
'signals.yap',
'profile.yap',
'callcount.yap',
'load_foreign.yap',
% 'save.yap',
'setof.yap',
'sort.yap',
'statistics.yap',
'strict_iso.yap',
'tabling.yap',
'threads.yap',
'eam.yap',
'yapor.yap',
'qly.yap',
'spy.yap',
'udi.yap']).
:- meta_predicate(log_event(+,:)).
:- dynamic prolog:'$user_defined_flag'/4.
:- multifile prolog:debug_action_hook/1.
:- multifile prolog:'$system_predicate'/2.
:- ensure_loaded(['protect.yap']).
version(yap,[6,3]).
:- op(1150,fx,(mode)).
:- dynamic 'extensions_to_present_answer'/1.
:- ensure_loaded(['arrays.yap']).
%:- start_low_level_trace.
:- multifile user:portray_message/2.
:- dynamic user:portray_message/2.
/** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
YAP now supports goal_expansion/3. This is an user-defined
procedure that is called after term expansion when compiling or
asserting goals for each sub-goal in a clause. The first argument is
bound to the goal and the second to the module under which the goal
_G_ will execute. If goal_expansion/3 succeeds the new
sub-goal _NG_ will replace _G_ and will be processed in the same
way. If goal_expansion/3 fails the system will use the defaultyap+flrules.
*/
:- multifile user:goal_expansion/3.
:- dynamic user:goal_expansion/3.
:- multifile user:goal_expansion/2.
:- dynamic user:goal_expansion/2.
:- multifile system:goal_expansion/2.
:- dynamic system:goal_expansion/2.
:- multifile goal_expansion/2.
:- dynamic goal_expansion/2.
:- use_module('messages.yap').
:- ensure_loaded(['undefined.yap']).
:- use_module('hacks.yap').
:- use_module('attributes.yap').
:- use_module('corout.yap').
:- use_module('dialect.yap').
:- use_module('dbload.yap').
:- use_module('../library/ypp.yap').
:- use_module('../os/chartypes.yap').
:- ensure_loaded('../os/edio.yap').
yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- '$change_type_of_char'(36,7). % Make $ a symbol character
:- set_prolog_flag(generate_debug_info,true).
%
% cleanup ensure loaded and recover some data-base space.
%
:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ).
:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ).
:- ( recorded('$module',_,R), erase(R), fail ; true ).
:- set_value('$user_module',user), '$protect'.
:- style_check([+discontiguous,+multiple,+single_var]).
%
% moved this to init_gc in gc.c to separate the alpha
%
% :- yap_flag(gc,on).
% :- yap_flag(gc_trace,verbose).
:- multifile
prolog:comment_hook/3.
:- source.
:- module(user).
/** @pred _CurrentModule_:term_expansion( _T_,- _X_), user:term_expansion( _T_,- _X_)
This user-defined predicate is called by `expand_term/3` to
preprocess all terms read when consulting a file. If it succeeds:
+
If _X_ is of the form `:- G` or `?- G`, it is processed as
a directive.
+
If _X_ is of the form `$source_location`( _File_, _Line_): _Clause_` it is processed as if from `File` and line `Line`.
+
If _X_ is a list, all terms of the list are asserted or processed
as directives.
+ The term _X_ is asserted instead of _T_.
*/
:- multifile term_expansion/2.
:- dynamic term_expansion/2.
:- multifile system:term_expansion/2.
:- dynamic system:term_expansion/2.
:- multifile swi:swi_predicate_table/4.
/** @pred user:message_hook(+ _Term_, + _Kind_, + _Lines_)
Hook predicate that may be define in the module `user` to intercept
messages from print_message/2. _Term_ and _Kind_ are the
same as passed to print_message/2. _Lines_ is a list of
format statements as described with print_message_lines/3.
This predicate should be defined dynamic and multifile to allow other
modules defining clauses for it too.
*/
:- multifile user:message_hook/3.
:- dynamic user:message_hook/3.
/** @pred exception(+ _Exception_, + _Context_, - _Action_)
Dynamic predicate, normally not defined. Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for _Exception_ are described below. See also catch/3 and throw/1.
If this hook predicate succeeds it must instantiate the _Action_ argument to the atom `fail` to make the operation fail silently, `retry` to tell Prolog to retry the operation or `error` to make the system generate an exception. The action `retry` only makes sense if this hook modified the environment such that the operation can now succeed without error.
+ `undefined_predicate`
_Context_ is instantiated to a predicate-indicator ( _Module:Name/Arity_). If the predicate fails Prolog will generate an existence_error exception. The hook is intended to implement alternatives to the SWI built-in autoloader, such as autoloading code from a database. Do not use this hook to suppress existence errors on predicates. See also `unknown`.
+ `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.
*/
:- multifile user:exception/3.
:- dynamic user:exception/3.
:- ensure_loaded('pathconf.yap').
:- yap_flag(user:unknown,error).
:- halt(0).

4
pl/directives.yap
View File

@ -152,8 +152,8 @@ considered.
'$exec_directive'(module(N,P,Op), Status, _, _, _) :-
'$module'(Status,N,P,Op).
'$exec_directive'(meta_predicate(P), _, M, _, _) :-
strip_module(M:P,M0,P0),
'$meta_predicate'(M0:P0).
'$yap_strip_module'(M:P,M0,P0),
'$meta_predicate'(P0,M0).
'$exec_directive'(module_transparent(P), _, M, _, _) :-
'$module_transparent'(P, M).
'$exec_directive'(noprofile(P), _, M, _, _) :-

53
pl/meta.yap
View File

@ -40,29 +40,41 @@ meta_predicate declaration
'$full_clause_optimisation'/4.
'$meta_predicate'(M:P) :-
'$meta_predicate'(P,M) :-
var(P),
!,
'$do_error'(instantiation_error,meta_predicate(M:P)).
'$meta_predicate'(M:P) :-
'$meta_predicate'(P,M) :-
var(M),
!,
'$do_error'(instantiation_error,meta_predicate(M:P)).
'$meta_predicate'(M:(P,Ps)) :- !,
'$meta_predicate'(M:P),
'$meta_predicate'(M:Ps).
'$meta_predicate'( M:D ) :-
'$yap_strip_module'( M:D, M1, P),
'$install_meta_predicate'(M1:P).
'$meta_predicate'((P,_Ps),M) :-
'$meta_predicate'(P,M),
fail.
'$meta_predicate'((_P,Ps),M) :-
!,
'$meta_predicate'(Ps,M).
'$meta_predicate'( D, M ) :-
'$yap_strip_module'( M:D, M1, P),
P\==D,
!,
'$meta_predicate'( P, M1 ).
'$meta_predicate'( D, M ) :-
functor(D,F,N),
( M = prolog -> M2 = _ ; M2 = M),
'$install_meta_predicate'(D,M2,F,N),
fail.
'$meta_predicate'( _D, _M ).
'$install_meta_predicate'(M1:P) :-
functor(P,F,N),
( M1 = prolog -> M = _ ; M1 = M),
( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
'$compile'(('$meta_predicate'(F,M,N,P) :- true),assertz,'$meta_predicate'(F,M,N,P),prolog,_).
'$install_meta_predicate'(P,M,F,N) :-
writeln(P),
retractall(prolog:'$meta_predicate'(F,M,N,_)),
fail.
'$install_meta_predicate'(P,M,F,N) :-
assertz('$meta_predicate'(F,M,N,P)).
% comma has its own problems.
:- '$install_meta_predicate'(prolog:','(0,0)).
%% handle module transparent predicates by defining a
%% new context module.
'$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :-
@ -482,7 +494,9 @@ expand_goal(Input, Output) :-
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
'$yap_strip_module'(M:GF0, MF, GF).
:- '$meta_predicate'(prolog:(
:- '$install_meta_predicate'((_,_),_,(','),2).
:- meta_predicate
abolish(:),
abolish(:,+),
all(?,0,-),
@ -572,13 +586,12 @@ expand_goal(Input, Output) :-
'->'(0 , 0),
'*->'(0 , 0),
';'(0 , 0),
% ','(0 , 0),
^(+,0),
{}(0,?,?),
','(2,2,?,?),
;(2,2,?,?),
';'(2,2,?,?),
'|'(2,2,?,?),
->(2,2,?,?),
\+(2,?,?),
\+( 0 )
)).
\+( 0 )
.

11
pl/preddyns.yap
View File

@ -261,10 +261,11 @@ retractall(V) :-
'$retractall'(M:V,_) :- !,
'$retractall'(V,M).
'$retractall'(T,M) :-
functor(T,Na,Ar),
(
'$is_log_updatable'(T, M) ->
( '$is_multifile'(T, M) ->
'$retractall_lu_mf'(T,M)
'$retractall_lu_mf'(T,M,Na,Ar)
;
'$retractall_lu'(T,M)
)
@ -273,13 +274,11 @@ retractall(V) :-
'$do_error'(type_error(callable,T),retractall(T))
;
'$undefined'(T,M) ->
functor(T,Na,Ar),
'$dynamic'(Na/Ar,M), !
;
'$is_dynamic'(T,M) ->
'$erase_all_clauses_for_dynamic'(T, M)
;
functor(T,Na,Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
).
@ -292,12 +291,12 @@ retractall(V) :-
fail.
'$retractall_lu'(_,_).
'$retractall_lu_mf'(T,M) :-
'$retractall_lu_mf'(T,M,Na,Ar) :-
'$log_update_clause'(T,M,_,R),
( recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
( recorded('$mf','$mf_clause'(_,Na,Ar,M,R),MR), erase(MR), fail ; true),
erase(R),
fail.
'$retractall_lu_mf'(_,_).
'$retractall_lu_mf'(_,_,_,_).
'$erase_all_clauses_for_dynamic'(T, M) :-
'$recordedp'(M:T,(T :- _),R), erase(R), fail.