diff --git a/C/iopreds.c b/C/iopreds.c index 3ae4dfd98..41434ebb9 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -2287,8 +2287,12 @@ StreamName(int i) return(MkAtomTerm(LookupAtom("pipe"))); if (Stream[i].status & InMemory_Stream_f) return(MkAtomTerm(LookupAtom("charsio"))); - else - return(MkAtomTerm(Stream[i].u.file.name)); + else { + if (yap_flags[LANGUAGE_MODE_FLAG] == ISO_CHARACTER_ESCAPES) { + return(Stream[i].u.file.user_name); + } else + return(MkAtomTerm(Stream[i].u.file.name)); + } } static Int @@ -2301,6 +2305,9 @@ init_cur_s (void) Term t1, t2; i = CheckStream (t3, Input_Stream_f|Output_Stream_f, "current_stream/3"); + if (i < 0) { + return(FALSE); + } t1 = StreamName(i); t2 = (Stream[i].status & Input_Stream_f ? MkAtomTerm (AtomRead) : @@ -2483,6 +2490,46 @@ p_past_eof (void) return(Stream[sno].status & Eof_Stream_f); } +static Int +p_peek_byte (void) +{ /* at_end_of_stream */ + /* the next character is a EOF */ + int sno = CheckStream (ARG1, Input_Stream_f, "peek/2"); + StreamDesc *s; + Int ocharcount, olinecount, olinepos; + Int status; + Int ch; + + if (sno < 0) + return(FALSE); + status = Stream[sno].status; + if (!(status & Binary_Stream_f)) { + Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek/2"); + return(FALSE); + } + if (status & Eof_Stream_f) { + Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, ARG1, "peek/2"); + return(FALSE); + } + s = Stream+sno; + ocharcount = s->charcount; + olinecount = s->linecount; + olinepos = s->linepos; + ch = Stream[sno].stream_getc(sno); + s->charcount = ocharcount; + s->linecount = olinecount; + s->linepos = olinepos; + /* buffer the character */ + s->och = ch; + /* mark a special function to recover this character */ + s->stream_getc = PlUnGetc; + if (CharConversionTable != NULL) + s->stream_getc_for_read = ISOGetc; + else + s->stream_getc_for_read = s->stream_getc; + return(unify_constant(ARG2,MkIntTerm(ch))); +} + static Int p_peek (void) { /* at_end_of_stream */ @@ -4840,7 +4887,7 @@ InitIOPreds(void) InitCPred ("$file_name", 2, p_file_name, SafePredFlag|SyncPredFlag), InitCPred ("$past_eof", 1, p_past_eof, SafePredFlag|SyncPredFlag), InitCPred ("$peek", 2, p_peek, SafePredFlag|SyncPredFlag), - InitCPred ("$peek_byte", 2, p_peek, SafePredFlag|SyncPredFlag), + InitCPred ("$peek_byte", 2, p_peek_byte, SafePredFlag|SyncPredFlag), InitCPred ("current_input", 1, p_current_input, SafePredFlag|SyncPredFlag); InitCPred ("current_output", 1, p_current_output, SafePredFlag|SyncPredFlag); InitCPred ("prompt", 1, p_setprompt, SafePredFlag|SyncPredFlag); diff --git a/pl/preds.yap b/pl/preds.yap index efce73016..f781be451 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -436,9 +436,17 @@ abolish(X) :- throw(error(type_error(atom,M), Msg)). '$old_abolish'(V,M) :- var(V), !, - '$abolish_all_old'(M). + ( '$access_yap_flags'(8, 1) -> + throw(error(instantiation_error,abolish(M:V))) + ; + '$abolish_all_old'(M) + ). '$old_abolish'(A,M) :- atom(A), !, - '$abolish_all_atoms_old'(A,M). + ( '$access_yap_flags'(8, 1) -> + throw(error(type_error(predicate_indicator,A),abolish(M:A))) + ; + '$abolish_all_atoms_old'(A,M) + ). '$old_abolish'(M:N,_) :- !, '$old_abolish'(N,M). '$old_abolish'([], _) :- !. diff --git a/pl/utils.yap b/pl/utils.yap index 9dae719d5..e70cdcfec 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -338,10 +338,10 @@ current_predicate(M:F) :- % module specified current_predicate(M:F) :- % module specified !, '$current_predicate3'(M,F). -current_predicate(F) :- % only for the predicate +current_predicate(S) :- % only for the predicate '$current_module'(M), - '$current_predicate3'(M,F). - + '$current_predicate3'(M,S). + system_predicate(A,P) :- '$current_predicate_no_modules'(prolog,A,P), \+ '$hidden'(A). @@ -356,11 +356,13 @@ system_predicate(P) :- functor(T,A,Arity), '$pred_exists'(T,M). -'$current_predicate3'(M,A/Arity) :- +'$current_predicate3'(M,A/Arity) :- !, '$current_predicate'(M,A,Arity), \+ '$hidden'(A), functor(T,A,Arity), '$pred_exists'(T,M). +'$current_predicate3'(M,BadSpec) :- % only for the predicate + throw(error(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec))). %%% User interface for statistics diff --git a/pl/yio.yap b/pl/yio.yap index 904ce7d5b..b4c162aaf 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -664,7 +664,6 @@ put(Stream,N) :- N1 is N, '$put'(Stream,N1). skip(N) :- current_input(S), N1 is N, '$skip'(S,N1). -skip(Stream,_) :- \+ '$check_stream'(Stream,read), !, fail. skip(Stream,N) :- N1 is N, '$skip'(Stream,N1). '$tab'(N) :- N<1, !. @@ -774,7 +773,6 @@ stream_property(Stream, Props) :- var(Stream), !, '$current_stream'(_,_,Stream), '$stream_property'(Stream, Props). stream_property(Stream, Props) :- - '$check_stream'(Stream), !, '$stream_property'(Stream, Props). stream_property(Stream, Props) :- throw(error(domain_error(stream,Stream),stream_property(Stream, Props))).