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

support for passing priority as argument to write. (Ulrich's #45).

Browse Source 
fixes on making write handle infinite loops
This commit is contained in:
Vitor Santos Costa 2009-05-22 13:24:27 -05:00
parent e1421f207e
commit 51e669dcfb
13 changed files with 154 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
BEAM/eam_am.c
View File

@ -140,7 +140,7 @@ int showTime(void);
struct AND_BOX *choose_leftmost(void); struct AND_BOX *choose_leftmost(void);
extern Cell BEAM_is(void); extern Cell BEAM_is(void);
extern void do_eam_indexing(struct Predicates *); extern void do_eam_indexing(struct Predicates *);
extern void Yap_plwrite(Term, int (*mywrite) (int, int), int); extern void Yap_plwrite(Term, int (*mywrite) (int, int), int, int);
#if Debug_Dump_State #if Debug_Dump_State
void dump_eam_state(void); void dump_eam_state(void);
@ -2511,7 +2511,7 @@ break_debug(contador);
#endif #endif
#ifdef DEBUG #ifdef DEBUG
Yap_plwrite ((Term) beam_X[1], Yap_DebugPutc, 0); Yap_plwrite ((Term) beam_X[1], Yap_DebugPutc, 0, 1200);
#else #else
extern int beam_write (void); extern int beam_write (void);
beam_write(); beam_write();

4
BEAM/toeam.c
View File

@ -742,10 +742,10 @@ void ShowCode_new2(int op, int new1,CELL new4)
switch (ch = *f++) switch (ch = *f++)
{ {
case '1': case '1':
Yap_plwrite(MkIntTerm(new1), Yap_DebugPutc, 0); Yap_plwrite(MkIntTerm(new1), Yap_DebugPutc, 0, 1200);
break; break;
case '4': case '4':
Yap_plwrite(MkIntTerm(new4), Yap_DebugPutc, 0); Yap_plwrite(MkIntTerm(new4), Yap_DebugPutc, 0, 1200);
break; break;
default: default:
Yap_DebugPutc (Yap_c_error_stream,'%'); Yap_DebugPutc (Yap_c_error_stream,'%');

2
C/c_interface.c
View File

@ -1868,7 +1868,7 @@ YAP_Write(Term t, int (*myputc)(wchar_t), int flags)
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
do_putcf = myputc; /* */ do_putcf = myputc; /* */
Yap_plwrite (t, do_yap_putc, flags); Yap_plwrite (t, do_yap_putc, flags, 1200);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }

16
C/cdmgr.c
View File

@ -926,31 +926,31 @@ IPred(PredEntry *ap, UInt NSlots)
if (!tmod) if (!tmod)
tmod = TermProlog; tmod = TermProlog;
Yap_DebugPutc(Yap_c_error_stream,'\t'); Yap_DebugPutc(Yap_c_error_stream,'\t');
Yap_plwrite(tmod, Yap_DebugPutc, 0); Yap_DebugPlWrite(tmod);
Yap_DebugPutc(Yap_c_error_stream,':'); Yap_DebugPutc(Yap_c_error_stream,':');
if (ap->ModuleOfPred == IDB_MODULE) { if (ap->ModuleOfPred == IDB_MODULE) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0); Yap_DebugPlWrite(t);
} else if (IsIntegerTerm(t)) { } else if (IsIntegerTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0); Yap_DebugPlWrite(t);
} else { } else {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f); Atom At = NameOfFunctor(f);
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(Yap_c_error_stream,'/'); Yap_DebugPutc(Yap_c_error_stream,'/');
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor(f)));
} }
} else { } else {
if (ap->ArityOfPE == 0) { if (ap->ArityOfPE == 0) {
Atom At = (Atom)ap->FunctorOfPred; Atom At = (Atom)ap->FunctorOfPred;
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(At));
} else { } else {
Functor f = ap->FunctorOfPred; Functor f = ap->FunctorOfPred;
Atom At = NameOfFunctor(f); Atom At = NameOfFunctor(f);
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(At));
Yap_DebugPutc(Yap_c_error_stream,'/'); Yap_DebugPutc(Yap_c_error_stream,'/');
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor(f)));
} }
} }
Yap_DebugPutc(Yap_c_error_stream,'\n'); Yap_DebugPutc(Yap_c_error_stream,'\n');

67
C/iopreds.c
View File

@ -696,7 +696,7 @@ Yap_DebugPutc(int sno, wchar_t ch)
void void
Yap_DebugPlWrite(Term t) Yap_DebugPlWrite(Term t)
{ {
Yap_plwrite(t, Yap_DebugPutc, 0); Yap_plwrite(t, Yap_DebugPutc, 0, 1200);
} }
void void
@ -3578,7 +3578,7 @@ p_current_output (void)
int beam_write (void) int beam_write (void)
{ {
Yap_StartSlots(); Yap_StartSlots();
Yap_plwrite (ARG1, Stream[Yap_c_output_stream].stream_wputc, 0); Yap_plwrite (ARG1, Stream[Yap_c_output_stream].stream_wputc, 0, 1200);
if (EX != 0L) { if (EX != 0L) {
Term ball = EX; Term ball = EX;
EX = 0L; EX = 0L;
@ -3591,12 +3591,55 @@ int beam_write (void)
static Int static Int
p_write (void) p_write (void)
{ /* '$write'(+Flags,?Term) */ {
/* '$write'(+Flags,?Term) */
int flags = (int) IntOfTerm (Deref (ARG1)); int flags = (int) IntOfTerm (Deref (ARG1));
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
Yap_StartSlots(); Yap_StartSlots();
Yap_plwrite (ARG2, Stream[Yap_c_output_stream].stream_wputc, flags); Yap_plwrite (ARG2, Stream[Yap_c_output_stream].stream_wputc, flags, 1200);
if (EX != 0L) {
Term ball = EX;
EX = 0L;
Yap_JumpToEnv(ball);
return(FALSE);
}
return (TRUE);
}
static Int
p_write_prio (void)
{
/* '$write'(+Flags,?Term) */
int flags = (int) IntOfTerm (Deref (ARG1));
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
Yap_StartSlots();
Yap_plwrite (ARG3, Stream[Yap_c_output_stream].stream_wputc, flags, (int)IntOfTerm(Deref(ARG2)));
if (EX != 0L) {
Term ball = EX;
EX = 0L;
Yap_JumpToEnv(ball);
return(FALSE);
}
return (TRUE);
}
static Int
p_write2_prio (void)
{ /* '$write'(+Stream,+Flags,?Term) */
int old_output_stream = Yap_c_output_stream;
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2");
if (Yap_c_output_stream == -1) {
Yap_c_output_stream = old_output_stream;
return(FALSE);
}
UNLOCK(Stream[Yap_c_output_stream].streamlock);
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
Yap_StartSlots();
Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2)), (int) IntOfTerm (Deref (ARG3)));
Yap_c_output_stream = old_output_stream;
if (EX != 0L) { if (EX != 0L) {
Term ball = EX; Term ball = EX;
EX = 0L; EX = 0L;
@ -3619,7 +3662,7 @@ p_write2 (void)
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
Yap_StartSlots(); Yap_StartSlots();
Yap_plwrite (ARG3, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2))); Yap_plwrite (ARG3, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2)), 1200);
Yap_c_output_stream = old_output_stream; Yap_c_output_stream = old_output_stream;
if (EX != 0L) { if (EX != 0L) {
Term ball = EX; Term ball = EX;
@ -4950,7 +4993,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
goto do_instantiation_error; goto do_instantiation_error;
if (!IsAtomTerm(t)) if (!IsAtomTerm(t))
goto do_type_atom_error; goto do_type_atom_error;
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f); Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f, 1200);
FormatInfo = &finfo; FormatInfo = &finfo;
break; break;
case 'c': case 'c':
@ -5173,7 +5216,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
goto do_consistency_error; goto do_consistency_error;
t = targs[targ++]; t = targs[targ++];
Yap_StartSlots(); Yap_StartSlots();
Yap_plwrite (t, f_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f ); Yap_plwrite (t, f_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f , 1200);
FormatInfo = &finfo; FormatInfo = &finfo;
ASP++; ASP++;
break; break;
@ -5212,7 +5255,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
Yap_StartSlots(); Yap_StartSlots();
{ {
long sl = Yap_InitSlot(args); long sl = Yap_InitSlot(args);
Yap_plwrite(t, f_putc, Handle_vars_f|Use_portray_f|To_heap_f); Yap_plwrite(t, f_putc, Handle_vars_f|Use_portray_f|To_heap_f, 1200);
FormatInfo = &finfo; FormatInfo = &finfo;
args = Yap_GetFromSlot(sl); args = Yap_GetFromSlot(sl);
Yap_RecoverSlots(1); Yap_RecoverSlots(1);
@ -5242,7 +5285,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
goto do_consistency_error; goto do_consistency_error;
t = targs[targ++]; t = targs[targ++];
Yap_StartSlots(); Yap_StartSlots();
Yap_plwrite (t, f_putc, Handle_vars_f|Quote_illegal_f|To_heap_f); Yap_plwrite (t, f_putc, Handle_vars_f|Quote_illegal_f|To_heap_f, 1200);
FormatInfo = &finfo; FormatInfo = &finfo;
ASP++; ASP++;
break; break;
@ -5251,7 +5294,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
goto do_consistency_error; goto do_consistency_error;
t = targs[targ++]; t = targs[targ++];
Yap_StartSlots(); Yap_StartSlots();
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f); Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f, 1200);
FormatInfo = &finfo; FormatInfo = &finfo;
ASP++; ASP++;
break; break;
@ -6102,7 +6145,7 @@ Yap_TermToString(Term t, char *s, unsigned int sz, int flags)
return FALSE; return FALSE;
Yap_StartSlots(); Yap_StartSlots();
Yap_c_output_stream = sno; Yap_c_output_stream = sno;
Yap_plwrite (t, Stream[sno].stream_wputc, flags); Yap_plwrite (t, Stream[sno].stream_wputc, flags, 1200);
s[Stream[sno].u.mem_string.pos] = '\0'; s[Stream[sno].u.mem_string.pos] = '\0';
Stream[sno].status = Free_Stream_f; Stream[sno].status = Free_Stream_f;
Yap_c_output_stream = old_output_stream; Yap_c_output_stream = old_output_stream;
@ -6174,6 +6217,8 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$write", 2, p_write, SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$write", 2, p_write, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$write", 3, p_write2, SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$write", 3, p_write2, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$write_with_prio", 3, p_write_prio, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$write_with_prio", 4, p_write2_prio, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("format", 2, p_format, SyncPredFlag); Yap_InitCPred ("format", 2, p_format, SyncPredFlag);
Yap_InitCPred ("format", 3, p_format2, SyncPredFlag); Yap_InitCPred ("format", 3, p_format2, SyncPredFlag);
Yap_InitCPred ("$current_line_number", 2, p_cur_line_no, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$current_line_number", 2, p_cur_line_no, SafePredFlag|SyncPredFlag|HiddenPredFlag);

2
C/parser.c
View File

@ -705,7 +705,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff)
#ifdef DEBUG #ifdef DEBUG
if (Yap_Option['p' - 'a' + 1]) { if (Yap_Option['p' - 'a' + 1]) {
Yap_DebugPutc(Yap_c_error_stream,'['); Yap_DebugPutc(Yap_c_error_stream,'[');
Yap_plwrite (t, Yap_DebugPutc, 0); Yap_DebugPlWrite(t);
Yap_DebugPutc(Yap_c_error_stream,']'); Yap_DebugPutc(Yap_c_error_stream,']');
Yap_DebugPutc(Yap_c_error_stream,'\n'); Yap_DebugPutc(Yap_c_error_stream,'\n');
} }

2
C/tracer.c
View File

@ -72,7 +72,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
max_depth = 5; max_depth = 5;
max_list = 5; max_list = 5;
max_write_args = 10; max_write_args = 10;
Yap_plwrite(args[i], TracePutchar, Handle_vars_f); Yap_plwrite(args[i], TracePutchar, Handle_vars_f, 1200);
max_depth = omax_depth; max_depth = omax_depth;
max_list = omax_list; max_list = omax_list;
max_write_args = omax_write_args; max_write_args = omax_write_args;

36
C/write.c
View File

@ -444,14 +444,14 @@ static Term
from_pointer(CELL *ptr, struct rewind_term *rwt) from_pointer(CELL *ptr, struct rewind_term *rwt)
{ {
Term t; Term t;
while (IsVarTerm(*ptr) && *ptr) while (IsVarTerm(*ptr) && !IsUnboundVar(ptr))
ptr = (CELL *)*ptr; ptr = (CELL *)*ptr;
t = *ptr; t = *ptr;
if (!IsVarTerm(t)) {
rwt->old = t;
rwt->ptr = ptr; rwt->ptr = ptr;
rwt->old = t;
*ptr = TermFoundVar; *ptr = TermFoundVar;
}
return t; return t;
} }
@ -520,7 +520,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
} }
writeTerm(from_pointer(RepPair(t), &nrwt), 999, new_depth, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t), &nrwt), 999, new_depth, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (wglb->keep_terms) { if (wglb->keep_terms) {
t = Yap_GetFromSlot(sl); t = Yap_GetFromSlot(sl);
Yap_RecoverSlots(1); Yap_RecoverSlots(1);
@ -538,7 +538,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputc('|', wglb->writewch); wrputc('|', wglb->writewch);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepPair(t)+1, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepPair(t)+1, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
} }
wrputc(']', wglb->writewch); wrputc(']', wglb->writewch);
lastw = separator; lastw = separator;
@ -647,7 +647,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
sl = Yap_InitSlot((CELL)p); sl = Yap_InitSlot((CELL)p);
} }
writeTerm(from_pointer(p++, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(p++, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
p = (CELL *)Yap_GetFromSlot(sl); p = (CELL *)Yap_GetFromSlot(sl);
@ -707,7 +707,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
lastw = separator; lastw = separator;
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt), rp, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+1, &nrwt), rp, depth + 1, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (bracket_right) { if (bracket_right) {
wrputc(')', wglb->writewch); wrputc(')', wglb->writewch);
lastw = separator; lastw = separator;
@ -739,7 +739,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt), lp, depth + 1, rinfixarg, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+1, &nrwt), lp, depth + 1, rinfixarg, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
t = Yap_GetFromSlot(sl); t = Yap_GetFromSlot(sl);
@ -783,7 +783,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt), lp, depth + 1, rinfixarg, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+1, &nrwt), lp, depth + 1, rinfixarg, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
t = Yap_GetFromSlot(sl); t = Yap_GetFromSlot(sl);
@ -805,7 +805,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
lastw = separator; lastw = separator;
} }
writeTerm(from_pointer(RepAppl(t)+2, &nrwt), rp, depth + 1, TRUE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+2, &nrwt), rp, depth + 1, TRUE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (bracket_right) { if (bracket_right) {
wrputc(')', wglb->writewch); wrputc(')', wglb->writewch);
lastw = separator; lastw = separator;
@ -848,7 +848,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
} }
writeTerm(from_pointer(RepAppl(t)+1, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+1, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
t = Yap_GetFromSlot(sl); t = Yap_GetFromSlot(sl);
@ -861,7 +861,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
wrputc('{', wglb->writewch); wrputc('{', wglb->writewch);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepAppl(t)+1, &nrwt), 1200, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+1, &nrwt), 1200, depth + 1, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
wrputc('}', wglb->writewch); wrputc('}', wglb->writewch);
lastw = separator; lastw = separator;
} else if (atom == AtomArray) { } else if (atom == AtomArray) {
@ -881,7 +881,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
} }
writeTerm(from_pointer(RepAppl(t)+op, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+op, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
t = Yap_GetFromSlot(sl); t = Yap_GetFromSlot(sl);
@ -912,7 +912,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
} }
writeTerm(from_pointer(RepAppl(t)+op, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt); writeTerm(from_pointer(RepAppl(t)+op, &nrwt), 999, depth + 1, FALSE, wglb, &nrwt);
*nrwt.ptr = nrwt.old; nrwt.ptr = NULL; if (nrwt.ptr) { *nrwt.ptr = nrwt.old; nrwt.ptr = NULL; };
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
t = Yap_GetFromSlot(sl); t = Yap_GetFromSlot(sl);
@ -930,7 +930,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
} }
void void
Yap_plwrite(Term t, int (*mywrite) (int, wchar_t), int flags) Yap_plwrite(Term t, int (*mywrite) (int, wchar_t), int flags, int priority)
/* term to be written */ /* term to be written */
/* consumer */ /* consumer */
/* write options */ /* write options */
@ -953,7 +953,7 @@ Yap_plwrite(Term t, int (*mywrite) (int, wchar_t), int flags)
wglb.keep_terms = (flags & (Use_portray_f|To_heap_f)); wglb.keep_terms = (flags & (Use_portray_f|To_heap_f));
wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Ignore_ops = flags & Ignore_ops_f;
/* protect slots for portray */ /* protect slots for portray */
writeTerm(from_pointer(&t, &rwt), 1200, 1, FALSE, &wglb, &rwt); writeTerm(from_pointer(&t, &rwt), priority, 1, FALSE, &wglb, &rwt);
*rwt.ptr = rwt.old; rwt.ptr = NULL; if (rwt.ptr) { *rwt.ptr = rwt.old; rwt.ptr = NULL; };
} }

3
H/yapio.h
View File

@ -338,9 +338,10 @@ extern int
#define Handle_vars_f 4 #define Handle_vars_f 4
#define Use_portray_f 8 #define Use_portray_f 8
#define To_heap_f 16 #define To_heap_f 16
#define Unfold_cyclics_f 32
/* write.c */ /* write.c */
void STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t),int)); void STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t), int, int));
/* grow.c */ /* grow.c */
int STD_PROTO(Yap_growheap_in_parser, (tr_fr_ptr *, TokEntry **, VarEntry **)); int STD_PROTO(Yap_growheap_in_parser, (tr_fr_ptr *, TokEntry **, VarEntry **));

6
docs/yap.tex
View File

@ -4653,6 +4653,12 @@ If @code{Depth} is a positive integer, use @t{Depth} as
the maximum depth to portray a term. The default is @code{0}, that is, the maximum depth to portray a term. The default is @code{0}, that is,
unlimited depth. unlimited depth.
@item priority(+@var{Piority})
If @code{Priority} is a positive integer smaller than @code{1200},
give the context priority. The default is @code{1200}.
@item cycles(+@var{Bool})
Do not loop in rational trees (default).
@end table @end table
@item writeq(@var{T}) [ISO] @item writeq(@var{T}) [ISO]

4
pl/boot.yap
View File

@ -644,8 +644,8 @@ true :- true.
'$write_output_vars'(VL), '$write_output_vars'(VL),
format(user_error,' = ', []), format(user_error,' = ', []),
( recorded('$print_options','$toplevel'(Opts),_) -> ( recorded('$print_options','$toplevel'(Opts),_) ->
write_term(user_error,B,Opts) ; write_term(user_error,B,[priority(699)|Opts]) ;
format(user_error,'~w',[B]) write_term(user_error,B,[priority(699)])
). ).
'$write_goal_output'(nl, First, NG, First, NG) :- !, '$write_goal_output'(nl, First, NG, First, NG) :- !,
format(user_error,'~n',[]). format(user_error,'~n',[]).

79
pl/yio.yap
View File

@ -226,6 +226,8 @@ open(F,T,S,Opts) :-
'$check_opt_sp'(A, G) :- '$check_opt_sp'(A, G) :-
'$do_error'(domain_error(stream_property,A),G). '$do_error'(domain_error(stream_property,A),G).
'$check_opt_write'(cycles(T), G) :- !,
'$check_cycles_arg'(T, G).
'$check_opt_write'(quoted(T), G) :- !, '$check_opt_write'(quoted(T), G) :- !,
'$check_write_quoted_arg'(T, G). '$check_write_quoted_arg'(T, G).
'$check_opt_write'(ignore_ops(T), G) :- !, '$check_opt_write'(ignore_ops(T), G) :- !,
@ -234,6 +236,8 @@ open(F,T,S,Opts) :-
'$check_write_numbervars_arg'(T, G). '$check_write_numbervars_arg'(T, G).
'$check_opt_write'(portrayed(T), G) :- !, '$check_opt_write'(portrayed(T), G) :- !,
'$check_write_portrayed'(T, G). '$check_write_portrayed'(T, G).
'$check_opt_write'(priority(T), G) :- !,
'$check_priority_arg'(T, G).
'$check_opt_write'(max_depth(T), G) :- !, '$check_opt_write'(max_depth(T), G) :- !,
'$check_write_max_depth'(T, G). '$check_write_max_depth'(T, G).
'$check_opt_write'(A, G) :- '$check_opt_write'(A, G) :-
@ -319,6 +323,13 @@ open(F,T,S,Opts) :-
'$check_write_quoted_arg'(X,G) :- '$check_write_quoted_arg'(X,G) :-
'$do_error'(domain_error(write_option,write_quoted(X)),G). '$do_error'(domain_error(write_option,write_quoted(X)),G).
'$check_cycles_arg'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_cycles_arg'(true,_) :- !.
'$check_cycles_arg'(false,_) :- !.
'$check_cycles_arg'(X,G) :-
'$do_error'(domain_error(write_option,cycles(X)),G).
'$check_write_ignore_ops_arg'(X, G) :- var(X), !, '$check_write_ignore_ops_arg'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_write_ignore_ops_arg'(true,_) :- !. '$check_write_ignore_ops_arg'(true,_) :- !.
@ -346,6 +357,12 @@ open(F,T,S,Opts) :-
'$check_write_max_depth'(X,G) :- '$check_write_max_depth'(X,G) :-
'$do_error'(domain_error(write_option,max_depth(X)),G). '$do_error'(domain_error(write_option,max_depth(X)),G).
'$check_priority_arg'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_priority_arg'(I,_) :- integer(I), I >= 0, I =< 1200, !.
'$check_priority_arg'(X,G) :-
'$do_error'(domain_error(write_option,priority(X)),G).
set_input(Stream) :- set_input(Stream) :-
'$set_input'(Stream). '$set_input'(Stream).
@ -536,50 +553,58 @@ write_canonical(_,_).
write_term(T,Opts) :- write_term(T,Opts) :-
'$check_io_opts'(Opts, write_term(T,Opts)), '$check_io_opts'(Opts, write_term(T,Opts)),
'$process_wt_opts'(Opts, 0, Flag, Callbacks), '$process_wt_opts'(Opts, 0, Flag, Priority, Callbacks),
'$write'(Flag, T), '$write_with_prio'(Flag, Priority, T),
'$process_wt_callbacks'(Callbacks), '$process_wt_callbacks'(Callbacks),
fail. fail.
write_term(_,_). write_term(_,_).
write_term(S, T, Opts) :- write_term(S, T, Opts) :-
'$check_io_opts'(Opts, write_term(T,Opts)), '$check_io_opts'(Opts, write_term(T,Opts)),
'$process_wt_opts'(Opts, 0, Flag, Callbacks), '$process_wt_opts'(Opts, 0, Flag, Priority, Callbacks),
'$write'(S, Flag, T), '$write_with_prio'(S, Flag, Priority, T),
'$process_wt_callbacks'(Callbacks), '$process_wt_callbacks'(Callbacks),
fail. fail.
write_term(_,_,_). write_term(_,_,_).
'$process_wt_opts'([], Flag, Flag, []). '$process_wt_opts'([], Flag, Flag, 1200, []).
'$process_wt_opts'([quoted(true)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([quoted(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 1, FlagI is Flag0 \/ 1,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 14, FlagI is Flag0 /\ 30,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 16,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 15,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 2, FlagI is Flag0 \/ 2,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 13, FlagI is Flag0 /\ 39,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 4, FlagI is Flag0 \/ 4,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 11, FlagI is Flag0 /\ 27,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 8, FlagI is Flag0 \/ 8,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 7, FlagI is Flag0 /\ 23,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, [max_depth(D1,D0,D2)|CallBacks]) :- '$process_wt_opts'([priority(Priority)|Opts], Flag0, Flag, Priority, CallBacks) :-
'$process_wt_opts'(Opts, Flag0, Flag, _, CallBacks).
'$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, Priority, [max_depth(D1,D0,D2)|CallBacks]) :-
write_depth(D1,D0,D2), write_depth(D1,D0,D2),
D10 is D*10, D10 is D*10,
write_depth(D,D,D10), write_depth(D,D,D10),
'$process_wt_opts'(Opts, Flag0, Flag, CallBacks). '$process_wt_opts'(Opts, Flag0, Flag, Priority, CallBacks).
'$process_wt_callbacks'([]). '$process_wt_callbacks'([]).
'$process_wt_callbacks'([max_depth(D1,D0,D2)|Cs]) :- '$process_wt_callbacks'([max_depth(D1,D0,D2)|Cs]) :-