From fdf7bb516f964207c6ad92170a16b0024e191dc9 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 19 Jan 2018 14:38:26 +0000 Subject: [PATCH] fix --- C/absmi.c | 2 + C/c_interface.c | 6 +- C/scanner.c | 26 +-- C/yap-args.c | 26 +-- H/ATOMS | 2 +- H/generated/iatoms.h | 5 +- console/yap.c | 27 +-- include/YapInterface.h | 2 +- os/YapIOConfig.h.cmake | 2 +- os/charsio.c | 8 +- os/iopreds.c | 6 +- os/iopreds.h | 56 +++--- pl/boot.yap | 414 ++++------------------------------------- pl/directives.yap | 4 +- pl/meta.yap | 53 ++++-- pl/preddyns.yap | 11 +- 16 files changed, 170 insertions(+), 480 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 6d8213f9d..6821e09dc 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -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); diff --git a/C/c_interface.c b/C/c_interface.c index 354cd4315..3feaae4c7 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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; } diff --git a/C/scanner.c b/C/scanner.c index 96316fb4b..faeb41f5f 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -1247,16 +1247,16 @@ const char *Yap_tokText(void *tokptre) { return ""; 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; diff --git a/C/yap-args.c b/C/yap-args.c index 0b91d2afe..cf05e974e 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -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); } diff --git a/H/ATOMS b/H/ATOMS index f3c33166b..f3468fe3e 100644 --- a/H/ATOMS +++ b/H/ATOMS @@ -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" diff --git a/H/generated/iatoms.h b/H/generated/iatoms.h index 5ff0b2095..9f679d4ed 100644 --- a/H/generated/iatoms.h +++ b/H/generated/iatoms.h @@ -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); diff --git a/console/yap.c b/console/yap.c index f77deba53..20993036a 100755 --- a/console/yap.c +++ b/console/yap.c @@ -58,8 +58,8 @@ #include #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; } diff --git a/include/YapInterface.h b/include/YapInterface.h index 96f68416b..9de947fe2 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -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); diff --git a/os/YapIOConfig.h.cmake b/os/YapIOConfig.h.cmake index 09e1788e2..8501f670f 100644 --- a/os/YapIOConfig.h.cmake +++ b/os/YapIOConfig.h.cmake @@ -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 diff --git a/os/charsio.c b/os/charsio.c index 13d0fbdf8..eb8accccd 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -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); diff --git a/os/iopreds.c b/os/iopreds.c index 0c4aec210..558e48fcb 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -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 { diff --git a/os/iopreds.h b/os/iopreds.h index c524d2e1f..e0b118251 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -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') { diff --git a/pl/boot.yap b/pl/boot.yap index edd29fb68..c3823f8e0 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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). diff --git a/pl/directives.yap b/pl/directives.yap index c3a7cb5d8..f9cc59910 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -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, _, _) :- diff --git a/pl/meta.yap b/pl/meta.yap index f867bdac0..654f75338 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -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 ) + . diff --git a/pl/preddyns.yap b/pl/preddyns.yap index 61335d8f8..0bf210422 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -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.