diff --git a/C/absmi.c b/C/absmi.c index d120ea521..4bf57bea4 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -1121,7 +1121,13 @@ Yap_absmi(int inp) if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) && B->cp_tr != B->cp_b->cp_tr) { cl->ClFlags &= ~InUseMask; - TR = --B->cp_tr; + --B->cp_tr; +#if FROZEN_STACKS + if (B->cp_tr > TR_FZ) +#endif + { + TR = B->cp_tr; + } /* next, recover space for the indexing code if it was erased */ if (cl->ClFlags & (ErasedMask|DirtyMask)) { if (PREG != FAILCODE) { @@ -1392,7 +1398,8 @@ Yap_absmi(int inp) PP = ap; DEC_CLREF_COUNT(cl); /* clear the entry from the trail */ - TR = --B->cp_tr; + --B->cp_tr; + TR = B->cp_tr; /* actually get rid of the code */ if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) { if (PREG != FAILCODE) { @@ -1421,7 +1428,13 @@ Yap_absmi(int inp) if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) && B->cp_tr != B->cp_b->cp_tr) { cl->ClFlags &= ~InUseMask; - TR = --B->cp_tr; + --B->cp_tr; +#if FROZEN_STACKS + if (B->cp_tr > TR_FZ) +#endif + { + TR = B->cp_tr; + } /* next, recover space for the indexing code if it was erased */ if (cl->ClFlags & (ErasedMask|DirtyMask)) { if (PREG != FAILCODE) { @@ -8075,7 +8088,12 @@ Yap_absmi(int inp) B->cp_tr != B->cp_b->cp_tr) { cl->ClFlags &= ~InUseMask; B->cp_tr--; - TR = B->cp_tr; +#if FROZEN_STACKS + if (B->cp_tr > TR_FZ) +#endif + { + TR = B->cp_tr; + } /* next, recover space for the indexing code if it was erased */ if (cl->ClFlags & (ErasedMask|DirtyMask)) { if (PREG != FAILCODE) { diff --git a/C/arith2.c b/C/arith2.c index c4e234a3d..23303e4ac 100755 --- a/C/arith2.c +++ b/C/arith2.c @@ -48,7 +48,8 @@ p_mod(Term t1, Term t2) { Int i2 = IntegerOfTerm(t2); Int mod; - if (i2 == 0) goto zero_divisor; + if (i2 == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1); if (i1 == Int_MIN && i2 == -1) { #ifdef USE_GMP return Yap_gmp_add_ints(Int_MAX, 1); @@ -82,7 +83,8 @@ p_mod(Term t1, Term t2) { { Int i2 = IntegerOfTerm(t2); - if (i2 == 0) goto zero_divisor; + if (i2 == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... mod 0"); return Yap_gmp_mod_big_int(t1, i2); } case (CELL)big_int_e: @@ -97,8 +99,6 @@ p_mod(Term t1, Term t2) { default: RERROR(); } -zero_divisor: - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); } static Term @@ -113,7 +113,8 @@ p_div2(Term t1, Term t2) { Int i2 = IntegerOfTerm(t2); Int res, mod; - if (i2 == 0) goto zero_divisor; + if (i2 == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1); if (i1 == Int_MIN && i2 == -1) { #ifdef USE_GMP return Yap_gmp_add_ints(Int_MAX, 1); @@ -148,7 +149,8 @@ p_div2(Term t1, Term t2) { { Int i2 = IntegerOfTerm(t2); - if (i2 == 0) goto zero_divisor; + if (i2 == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... div 0"); return Yap_gmp_div2_big_int(t1, i2); } case (CELL)big_int_e: @@ -163,8 +165,6 @@ p_div2(Term t1, Term t2) { default: RERROR(); } -zero_divisor: - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is div 0"); } static Term @@ -179,7 +179,8 @@ p_rem(Term t1, Term t2) { Int i2 = IntegerOfTerm(t2); Int mod; - if (i2 == 0) goto zero_divisor; + if (i2 == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1); if (i1 == Int_MIN && i2 == -1) { #ifdef USE_GMP return Yap_gmp_add_ints(Int_MAX, 1); @@ -207,6 +208,8 @@ p_rem(Term t1, Term t2) { #ifdef USE_GMP switch (ETypeOfTerm(t2)) { case long_int_e: + if (IntegerOfTerm(t2) == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rem 0"); return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2)); case (CELL)big_int_e: /* two bignums */ @@ -220,8 +223,6 @@ p_rem(Term t1, Term t2) { default: RERROR(); } - zero_divisor: - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); } @@ -239,7 +240,8 @@ p_rdiv(Term t1, Term t2) { Int i1 = IntegerOfTerm(t1); Int i2 = IntegerOfTerm(t2); - if (i2 == 0) goto zero_divisor; + if (i2 == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rdiv 0", i1); return Yap_gmq_rdiv_int_int(i1, i2); } case (CELL)big_int_e: @@ -252,6 +254,8 @@ p_rdiv(Term t1, Term t2) { case (CELL)big_int_e: switch (ETypeOfTerm(t2)) { case long_int_e: + if (IntegerOfTerm(t2) == 0) + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rdiv 0"); /* I know the term is much larger, so: */ return Yap_gmq_rdiv_big_int(t1, IntegerOfTerm(t2)); case (CELL)big_int_e: @@ -264,8 +268,6 @@ p_rdiv(Term t1, Term t2) { default: RERROR(); } - zero_divisor: - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); #else RERROR(); #endif diff --git a/C/cdmgr.c b/C/cdmgr.c index 6620385ae..2f48990af 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2507,6 +2507,8 @@ p_compile_dynamic( USES_REGS1 ) if (RepAtom(AtomOfTerm(t1))->StrOfAE[0] == 'f') mode = asserta; else mode = assertz; } else mode = IntegerOfTerm(t1); + if (mode == assertz && consult_level) + mode = consult; old_optimize = optimizer_on; optimizer_on = FALSE; YAPEnterCriticalSection(); @@ -2530,8 +2532,6 @@ p_compile_dynamic( USES_REGS1 ) return TRUE; } -static int consult_level = 0; - static Atom YapConsultingFile ( USES_REGS1 ) { diff --git a/C/errors.c b/C/errors.c index b4b688bf1..4d90de960 100755 --- a/C/errors.c +++ b/C/errors.c @@ -1831,9 +1831,13 @@ Yap_Error(yap_error_number type, Term where, char *format,...) if (type != PURE_ABORT) { /* This is used by some complex procedures to detect there was an error */ if (IsAtomTerm(nt[0])) { - Yap_ErrorMessage = RepAtom(AtomOfTerm(nt[0]))->StrOfAE; + strncpy(Yap_ErrorSay, RepAtom(AtomOfTerm(nt[0]))->StrOfAE, MAX_ERROR_MSG_SIZ\ +E); + Yap_ErrorMessage = Yap_ErrorSay; } else { - Yap_ErrorMessage = RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE; + strncpy(Yap_ErrorSay, RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE,\ + MAX_ERROR_MSG_SIZE); + Yap_ErrorMessage = Yap_ErrorSay; } } switch (type) { diff --git a/C/iopreds.c b/C/iopreds.c index a04ef602b..8baceb7e4 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -90,7 +90,6 @@ STATIC_PROTO (Int p_read, ( USES_REGS1 )); STATIC_PROTO (Int p_startline, ( USES_REGS1 )); STATIC_PROTO (Int p_change_type_of_char, ( USES_REGS1 )); STATIC_PROTO (Int p_type_of_char, ( USES_REGS1 )); -STATIC_PROTO (Term StreamPosition, (IOSTREAM *)); extern Atom Yap_FileName(IOSTREAM *s); @@ -559,9 +558,9 @@ static Int int emacs_cares = FALSE; #endif Term tmod = Deref(ARG3), OCurrentModule = CurrentModule, tpos; - extern void Yap_setCurrentSourceLocation(IOSTREAM *s); + extern void Yap_setCurrentSourceLocation(IOSTREAM **s); - Yap_setCurrentSourceLocation(inp_stream); + Yap_setCurrentSourceLocation(&inp_stream); if (IsVarTerm(tmod)) { tmod = CurrentModule; } else if (!IsAtomTerm(tmod)) { @@ -569,7 +568,7 @@ static Int return FALSE; } Yap_Error_TYPE = YAP_NO_ERROR; - tpos = StreamPosition(inp_stream); + tpos = Yap_StreamPosition(inp_stream); if (!Yap_unify(tpos,ARG5)) { /* do this early so that we do not have to protect it in case of stack expansion */ return FALSE; @@ -587,7 +586,7 @@ static Int while (TRUE) { old_H = H; Yap_eot_before_eof = FALSE; - tpos = StreamPosition(inp_stream); + tpos = Yap_StreamPosition(inp_stream); tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(inp_stream, &tpos); if (Yap_Error_TYPE != YAP_NO_ERROR && seekable) { H = old_H; @@ -759,23 +758,6 @@ p_read2 ( USES_REGS1 ) } -static Term -StreamPosition(IOSTREAM *st) -{ - Term t[4]; - t[0] = MkIntegerTerm(st->posbuf.charno); - t[1] = MkIntegerTerm(st->posbuf.lineno); - t[2] = MkIntegerTerm(st->posbuf.linepos); - t[3] = MkIntegerTerm(st->posbuf.byteno); - return Yap_MkApplTerm(FunctorStreamPos,4,t); -} - -Term -Yap_StreamPosition(IOSTREAM *st) -{ - return StreamPosition(st); -} - #if HAVE_SELECT && FALSE /* stream_select(+Streams,+TimeOut,-Result) */ static Int diff --git a/C/parser.c b/C/parser.c index 6b7f5d124..ead666d36 100644 --- a/C/parser.c +++ b/C/parser.c @@ -440,54 +440,55 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) case Name_tok: t = Yap_tokptr->TokInfo; NextToken; + /* special rules apply for +1, -2.3, etc... */ + if (Yap_tokptr->Tok == Number_tok) { + if ((Atom)t == AtomMinus) { + t = Yap_tokptr->TokInfo; + if (IsIntTerm(t)) + t = MkIntTerm(-IntOfTerm(t)); + else if (IsFloatTerm(t)) + t = MkFloatTerm(-FloatOfTerm(t)); +#ifdef USE_GMP + else if (IsBigIntTerm(t)) { + t = Yap_gmp_neg_big(t); + } +#endif + else + t = MkLongIntTerm(-LongIntOfTerm(t)); + NextToken; + break; + } + } if ((Yap_tokptr->Tok != Ord(Ponctuation_tok) || Unsigned(Yap_tokptr->TokInfo) != 'l') && IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS) ) { - /* special rules apply for +1, -2.3, etc... */ - if (Yap_tokptr->Tok == Number_tok) { - if ((Atom)t == AtomMinus) { - t = Yap_tokptr->TokInfo; - if (IsIntTerm(t)) - t = MkIntTerm(-IntOfTerm(t)); - else if (IsFloatTerm(t)) - t = MkFloatTerm(-FloatOfTerm(t)); -#ifdef USE_GMP - else if (IsBigIntTerm(t)) { - t = Yap_gmp_neg_big(t); - } -#endif - else - t = MkLongIntTerm(-LongIntOfTerm(t)); - NextToken; - break; - } - } else if (Yap_tokptr->Tok == Name_tok) { - Atom at = (Atom)Yap_tokptr->TokInfo; + if (Yap_tokptr->Tok == Name_tok) { + Atom at = (Atom)Yap_tokptr->TokInfo; #ifndef _MSC_VER - if ((Atom)t == AtomPlus) { - if (at == AtomInf) { - t = MkFloatTerm(INFINITY); - NextToken; - break; - } else if (at == AtomNan) { - t = MkFloatTerm(NAN); - NextToken; + if ((Atom)t == AtomPlus) { + if (at == AtomInf) { + t = MkFloatTerm(INFINITY); + NextToken; break; + } else if (at == AtomNan) { + t = MkFloatTerm(NAN); + NextToken; + break; + } + } else if ((Atom)t == AtomMinus) { + if (at == AtomInf) { + t = MkFloatTerm(-INFINITY); + NextToken; + break; + } else if (at == AtomNan) { + t = MkFloatTerm(NAN); + NextToken; + break; + } } - } else if ((Atom)t == AtomMinus) { - if (at == AtomInf) { - t = MkFloatTerm(-INFINITY); - NextToken; - break; - } else if (at == AtomNan) { - t = MkFloatTerm(NAN); - NextToken; - break; - } - } #endif - } + } if (opprio <= prio) { /* try to parse as a prefix operator */ TRY( diff --git a/C/tracer.c b/C/tracer.c index 9874ca225..98c433b00 100755 --- a/C/tracer.c +++ b/C/tracer.c @@ -163,10 +163,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; vsc_count++; - if (vsc_count < 45000LL) - return; - if (vsc_count == 47456LL) - jmp_deb(1); #ifdef THREADS MY_ThreadHandle.thread_inst_count++; #endif @@ -189,6 +185,11 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) } } else return; + { + tr_fr_ptr pt = (tr_fr_ptr)Yap_TrailBase; + if (pt[140].term == 0 && pt[140].value != 0) + jmp_deb(1); + } if (worker_id != 04 || worker_id != 03) return; // if (vsc_count == 218280) // vsc_xstop = 1; @@ -231,6 +232,31 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) UNLOCK(Yap_heap_regs->low_level_trace_lock); return; } + if (TR_FZ > TR) + jmp_deb(1); + { + tr_fr_ptr pt = (tr_fr_ptr)Yap_TrailBase; + if (pt[153].term == 0 && pt[153].value == 0 && + pt[154].term != 0 && pt[154].value != 0 && ( TR > pt+154 || + TR_FZ > pt+154)) + jmp_deb(2); + if (pt[635].term == 0 && pt[635].value == 0 && + pt[636].term != 0 && pt[636].value != 0 && ( TR > pt+636 || + TR_FZ > pt+636)) + jmp_deb(3); + if (pt[138].term == 0 && pt[138].value == 0 && + pt[139].term != 0 && pt[139].value != 0 && ( TR > pt+138 || + TR_FZ > pt+138) ) + jmp_deb(4); + } + if (vsc_count == 287939LL) + jmp_deb(1); + if (vsc_count == 173118LL) + jmp_deb(1); + if (!(vsc_count >= 287934LL && vsc_count <= 287939LL) && + !(vsc_count >= 173100LL && vsc_count <= 173239LL) && + vsc_count != -1) + return; if (vsc_count == 51021) { printf("Here I go\n"); } diff --git a/C/write.c b/C/write.c index dae203e2a..62137bdb2 100755 --- a/C/write.c +++ b/C/write.c @@ -309,13 +309,14 @@ legalAtom(unsigned char *s) /* Is this a legal atom ? */ return (s[1] == ']' && !s[2]); } else if (ch == '{') { return (s[1] == '}' && !s[2]); -// else if (ch == '/') -// return (*++s != '*'); } else if (Yap_chtype[ch] == SL) { return (!s[1]); } else if ((ch == ',' || ch == '.') && !s[1]) { return FALSE; } else { + if (ch == '/') { + if (s[1] == '*') return FALSE; + } while (ch) { if (Yap_chtype[ch] != SY) { return FALSE; @@ -451,7 +452,7 @@ putAtom(Atom atom, int Quote_illegal, wrf writewch) /* writes an atom */ if (lastw == atom_or_symbol && atom_or_symbol != separator /* solo */) wrputc(' ', writewch); lastw = atom_or_symbol; - if (!legalAtom(s) && Quote_illegal) { + if (Quote_illegal && !legalAtom(s)) { wrputc('\'', writewch); while (*s) { wchar_t ch = *s++; @@ -738,6 +739,38 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str } else if (IsAtomTerm(t)) { putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb->writewch); } else if (IsPairTerm(t)) { + if (wglb->Ignore_ops) { + Int sl = 0; + + wrputs("'.'(",wglb->writewch); + lastw = separator; + if (wglb->keep_terms) { + /* garbage collection may be called */ + sl = Yap_InitSlot(t); + } + writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); + restore_from_write(&nrwt, wglb); + if (wglb->keep_terms) { + /* garbage collection may be called */ + t = Yap_GetFromSlot(sl); + Yap_RecoverSlots(1); + } + wrputs(",",wglb->writewch); + if (wglb->keep_terms) { + /* garbage collection may be called */ + sl = Yap_InitSlot(t); + } + writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); + restore_from_write(&nrwt, wglb); + if (wglb->keep_terms) { + /* garbage collection may be called */ + t = Yap_GetFromSlot(sl); + Yap_RecoverSlots(1); + } + wrputc(')', wglb->writewch); + lastw = separator; + return; + } if (wglb->Use_portray) { Term targs[1]; struct DB_TERM *old_EX = NULL; diff --git a/H/dlocals.h b/H/dlocals.h index 4dd92ee3b..71b71fd79 100644 --- a/H/dlocals.h +++ b/H/dlocals.h @@ -81,6 +81,7 @@ #if LOW_LEVEL_TRACER #define Yap_total_choicepoints WL->total_cps #endif +#define consult_level WL->consult_level_ #if defined(YAPOR) || defined(THREADS) #define SignalLock WL->signal_lock diff --git a/H/hlocals.h b/H/hlocals.h index b87232df5..6e08f7af2 100644 --- a/H/hlocals.h +++ b/H/hlocals.h @@ -83,6 +83,7 @@ typedef struct worker_local { #if LOW_LEVEL_TRACER Int total_cps; #endif + int consult_level_; #if defined(YAPOR) || defined(THREADS) lockvar signal_lock; diff --git a/H/ilocals.h b/H/ilocals.h index b5cc486d9..d616757ae 100644 --- a/H/ilocals.h +++ b/H/ilocals.h @@ -81,6 +81,7 @@ static void InitWorker(int wid) { #if LOW_LEVEL_TRACER FOREIGN(wid)->total_cps = 0; #endif + FOREIGN(wid)->consult_level_ = 0; #if defined(YAPOR) || defined(THREADS) INIT_LOCK(FOREIGN(wid)->signal_lock); diff --git a/H/rlocals.h b/H/rlocals.h index 7b888b21e..39d783c70 100644 --- a/H/rlocals.h +++ b/H/rlocals.h @@ -82,6 +82,7 @@ static void RestoreWorker(int wid USES_REGS) { #endif + #if defined(YAPOR) || defined(THREADS) REINIT_LOCK(FOREIGN(wid)->signal_lock); diff --git a/OPTYap/opt.config.h b/OPTYap/opt.config.h index daa26944f..e754769df 100644 --- a/OPTYap/opt.config.h +++ b/OPTYap/opt.config.h @@ -92,7 +92,7 @@ ** memory mapping scheme (mandatory, define one) ** ************************************************************/ #define MMAP_MEMORY_MAPPING_SCHEME 1 -/*#define SHM_MEMORY_MAPPING_SCHEME 1*/ +/* #define SHM_MEMORY_MAPPING_SCHEME 1 */ /************************************************* ** enable error checking ? (optional) ** diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index f7ddf7142..48d4dbd7f 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -37,7 +37,6 @@ #ifdef TABLING static Int p_freeze_choice_point( USES_REGS1 ); static Int p_wake_choice_point( USES_REGS1 ); -static Int p_reset_frozen_choice_points( USES_REGS1 ); static Int p_abolish_frozen_choice_points_until( USES_REGS1 ); static Int p_abolish_frozen_choice_points_all( USES_REGS1 ); static Int p_table( USES_REGS1 ); @@ -338,6 +337,7 @@ static Int p_abolish_table( USES_REGS1 ) { TabEnt_hash_chain(tab_ent) = NULL; free_subgoal_hash_chain(hash); sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent)); + TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL; if (sg_node) { if (TabEnt_arity(tab_ent)) { TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL; @@ -366,7 +366,8 @@ static Int p_abolish_all_tables( USES_REGS1 ) { TabEnt_hash_chain(tab_ent) = NULL; free_subgoal_hash_chain(hash); sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent)); - if (sg_node) { + TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL; + if (sg_node) { if (TabEnt_arity(tab_ent)) { TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL; free_subgoal_trie(sg_node, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST); diff --git a/OPTYap/opt.structs.h b/OPTYap/opt.structs.h index 9901d7fb0..06c6d7c7e 100644 --- a/OPTYap/opt.structs.h +++ b/OPTYap/opt.structs.h @@ -218,7 +218,7 @@ struct global_optyap_data{ #ifdef TABLE_LOCK_AT_WRITE_LEVEL lockvar table_lock[TABLE_LOCK_BUCKETS]; #endif /* TABLE_LOCK_AT_WRITE_LEVEL */ -#ifdef TIMESTAMP_CHECKThreads +#ifdef TIMESTAMP_CHECK long timestamp; #endif /* TIMESTAMP_CHECK */ #endif /* TABLING */ diff --git a/docs/yap.tex b/docs/yap.tex index 03f1f2af3..02d8e9b1d 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -6687,14 +6687,11 @@ Grammar related built-in predicates: @table @code -@item @var{CurrentModule}:expand_term(@var{T},-@var{X}) -@item user:expand_term(@var{T},-@var{X}) +@item expand_term(@var{T},-@var{X}) @findex expand_term/2 @syindex expand_term/2 @cyindex expand_term/2 -@findex term_expansion/2 -@syindex term_expansion/2 -@cyindex term_expansion/2 + This predicate is used by YAP for preprocessing each top level term read when consulting a file and before asserting or executing it. It rewrites a term @var{T} to a term @var{X} according to the following @@ -6703,6 +6700,29 @@ rules: first try @code{term_expansion/2} in the current module, and then try to for DCG rules is applied, together with the arithmetic optimizer whenever the compilation of arithmetic expressions is in progress. +@item @var{CurrentModule}:term_expansion(@var{T},-@var{X}) +@item user:term_expansion(@var{T},-@var{X}) +@findex term_expansion/2 +@syindex term_expansion/2 +@cyindex term_expansion/2 +This user-defined predicate is called by @code{expand_term/3} to +preprocess all terms read when consulting a file. If it succeeds: + +@itemize +@item +If @var{X} is of the form @code{:- G} or @code{?- G}, it is processed as +a directive. +@item +If @var{X} is of the form @code{'$source_location'(, +):} it is processed as if from @code{File} and line +@code{Line}. + +@item +If @var{X} is a list, all terms of the list are asserted or processed +as directives. +@item The term @var{X} is asserted instead of @var{T}. +@end itemize + @item @var{CurrentModule}:goal_expansion(+@var{G},+@var{M},-@var{NG}) @item user:goal_expansion(+@var{G},+@var{M},-@var{NG}) @findex goal_expansion/3 @@ -9228,7 +9248,6 @@ also @code{between/3}. Succeeds if @var{Set3} unifies with the intersection of @var{Set1} and @var{Set2}. @var{Set1} and @var{Set2} are lists without duplicates. They need not be ordered. -@end table @item subtract(+@var{Set}, +@var{Delete}, ?@var{Result}) @findex subtract/3 diff --git a/misc/LOCALS b/misc/LOCALS index e234eca2e..bf4ea441a 100644 --- a/misc/LOCALS +++ b/misc/LOCALS @@ -89,6 +89,8 @@ Int last_ss_time LastSSTime =0L Int total_cps Yap_total_choicepoints =0 #endif +int consult_level_ consult_level =0 + // global variables that cannot be global in a thread/or-p implementation #if defined(YAPOR) || defined(THREADS) lockvar signal_lock SignalLock MkLock diff --git a/misc/Yap64.spec b/misc/Yap64.spec index ed2363fab..89607093a 100644 --- a/misc/Yap64.spec +++ b/misc/Yap64.spec @@ -3,7 +3,7 @@ Name: yap Summary: Prolog Compiler -Version: 6.2.0 +Version: 6.3.0 Packager: Vitor Santos Costa Release: 1 Source: http://www.dcc.fc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz diff --git a/misc/yap.nsi b/misc/yap.nsi index 7b96b1c9a..13c61aef6 100755 --- a/misc/yap.nsi +++ b/misc/yap.nsi @@ -266,4 +266,4 @@ Function .onInstFailed installer, please contact yap-users@sf.net" FunctionEnd -outfile "yap-6.2.0-installer.exe" +outfile "yap-6.3.0-installer.exe" diff --git a/packages/PLStream/pl-read.c b/packages/PLStream/pl-read.c index 4f2654f9f..705b4c53f 100644 --- a/packages/PLStream/pl-read.c +++ b/packages/PLStream/pl-read.c @@ -344,10 +344,12 @@ setCurrentSourceLocation(IOSTREAM *s ARG_LD) #if __YAP_PROLOG__ void -Yap_setCurrentSourceLocation(IOSTREAM *s) +Yap_setCurrentSourceLocation(IOSTREAM **s) { GET_LD - setCurrentSourceLocation(s PASS_LD); + if (!*s) + *s = Suser_input; + setCurrentSourceLocation(*s PASS_LD); } #endif diff --git a/packages/PLStream/pl-yap.c b/packages/PLStream/pl-yap.c index 940ddb862..60dfa6bdc 100755 --- a/packages/PLStream/pl-yap.c +++ b/packages/PLStream/pl-yap.c @@ -1096,6 +1096,26 @@ pl_readline(term_t flag) } +static Term +StreamPosition(IOSTREAM *st) +{ + Term t[4]; + if (!st) + st = Suser_input; + t[0] = MkIntegerTerm(st->posbuf.charno); + t[1] = MkIntegerTerm(st->posbuf.lineno); + t[2] = MkIntegerTerm(st->posbuf.linepos); + t[3] = MkIntegerTerm(st->posbuf.byteno); + return Yap_MkApplTerm(FunctorStreamPos,4,t); +} + +Term +Yap_StreamPosition(IOSTREAM *st) +{ + return StreamPosition(st); +} + + #if THREADS #define COUNT_MUTEX_INITIALIZER(name) \