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

simplify format, so that it will be easier to do bug fixes

Browse Source 
fix bug in format output for floats
write and read dbrefs as $dbref(Address,0)


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@986 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-02-13 18:39:29 +00:00
parent 4402a10f44
commit 039655b767
12 changed files with 728 additions and 1132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
C/dbase.c
View File

@ -2282,9 +2282,6 @@ p_still_variant(void)
DBRef dbr;
if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
if (IsIntegerTerm(t1))
dbr = (DBRef)IntegerOfTerm(t1);
else
return (FALSE);
/* limited sanity checking */
if (dbr->id != FunctorDBRef) {
@ -3319,11 +3316,7 @@ p_recorded(void)
if (!IsVarTerm(t3)) {
DBRef ref = DBRefOfTerm(t3);
if (!IsDBRefTerm(t3)) {
if (IsIntegerTerm(t3)) {
ref = (DBRef)IntegerOfTerm(t3);
} else {
return FALSE;
}
} else {
ref = DBRefOfTerm(t3);
}
@ -4160,14 +4153,9 @@ p_erase(void)
return (FALSE);
}
if (!IsDBRefTerm(t1)) {
if (IsIntegerTerm(t1)) {
EraseEntry((DBRef)IntegerOfTerm(t1));
return TRUE;
} else {
Yap_Error(TYPE_ERROR_DBREF, t1, "erase");
return (FALSE);
}
}
EraseEntry(DBRefOfTerm(t1));
return (TRUE);
}
@ -4183,12 +4171,8 @@ p_erase_clause(void)
return (FALSE);
}
if (!IsDBRefTerm(t1)) {
if (IsIntegerTerm(t1)) {
entryref = (DBRef)IntegerOfTerm(t1);
} else {
Yap_Error(TYPE_ERROR_DBREF, t1, "erase");
return (FALSE);
}
} else {
entryref = DBRefOfTerm(t1);
}
@ -4283,13 +4267,9 @@ p_erased(void)
return (FALSE);
}
if (!IsDBRefTerm(t)) {
if (IsIntegerTerm(t)) {
return (((DBRef)IntegerOfTerm(t))->Flags & ErasedMask);
} else {
Yap_Error(TYPE_ERROR_DBREF, t, "erased");
return (FALSE);
}
}
return (DBRefOfTerm(t)->Flags & ErasedMask);
}
@ -4346,14 +4326,7 @@ p_instance(void)
DBRef dbr;
if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
if (IsIntegerTerm(t1))
dbr = (DBRef)IntegerOfTerm(t1);
else
return (FALSE);
/* limited sanity checking */
if (dbr->id != FunctorDBRef) {
return FALSE;
}
} else {
dbr = DBRefOfTerm(t1);
}
@ -4433,14 +4406,7 @@ p_instance_module(void)
if (IsDBRefTerm(t1)) {
dbr = DBRefOfTerm(t1);
} else {
if (IsIntegerTerm(t1))
dbr = (DBRef)IntegerOfTerm(t1);
else
return FALSE;
/* limited sanity checking */
if (dbr > (DBRef)Yap_HeapBase && dbr < (DBRef)HeapTop && dbr->id != FunctorDBRef) {
return FALSE;
}
}
if (dbr->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)dbr;

13
C/errors.c
View File

@ -482,6 +482,19 @@ Yap_Error (yap_error_number type, Term where, char *format,...)
P = (yamop *)FAILCODE;
Yap_PrologMode &= ~InErrorMode;
return(P);
case CONSISTENCY_ERROR:
{
int i;
Term ti[1];
ti[0] = where;
nt[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("consistency_error"),1), 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = Yap_MkFunctor(Yap_LookupAtom("error"),2);
serious = TRUE;
}
break;
case DOMAIN_ERROR_ARRAY_OVERFLOW:
{
int i;

1
C/init.c
View File

@ -884,6 +884,7 @@ InitCodes(void)
heap_regs->atom_dollar_undef = MkAtomTerm(Yap_FullLookupAtom("$undef"));
#endif
#endif
heap_regs->atom_dbref = Yap_FullLookupAtom ("$dbref");
heap_regs->atom_e = Yap_LookupAtom("e");
heap_regs->atom_e_q = Yap_LookupAtom("=");
heap_regs->atom_eof = Yap_LookupAtom ("end_of_file");

1208
C/iopreds.c
View File

File diff suppressed because it is too large Load Diff

3
C/parser.c
View File

@ -330,6 +330,9 @@ ParseArgs(Atom a, JMPBUFF *FailBuff)
else
t = Yap_MkApplTerm(Yap_MkFunctor(a, nargs), nargs, p);
#else
if (a == AtomDBRef && nargs == 2)
t = MkDBRefTerm((DBRef)IntegerOfTerm(p[0]));
else
t = Yap_MkApplTerm(Yap_MkFunctor(a, nargs), nargs, p);
#endif
/* check for possible overflow against local stack */

13
C/write.c
View File

@ -56,7 +56,7 @@ typedef struct write_globs {
STATIC_PROTO(void wrputn, (Int, wrf));
STATIC_PROTO(void wrputs, (char *, wrf));
STATIC_PROTO(void wrputf, (Float, wrf));
STATIC_PROTO(void wrputref, (CODEADDR, wrf));
STATIC_PROTO(void wrputref, (CODEADDR, int, wrf));
STATIC_PROTO(int legalAtom, (char *));
STATIC_PROTO(int LeftOpToProtect, (Atom, int));
STATIC_PROTO(int RightOpToProtect, (Atom, int));
@ -133,18 +133,19 @@ wrputf(Float f, wrf writech) /* writes a float */
}
static void
wrputref(CODEADDR ref, wrf writech) /* writes a data base reference */
wrputref(CODEADDR ref, int Quote_illegal, wrf writech) /* writes a data base reference */
{
char s[256];
putAtom(AtomDBRef, Quote_illegal, writech);
#if SHORT_INTS
sprintf(s, "0x%p", ref);
sprintf(s, "(0x%p,0)", ref);
#else
#ifdef linux
sprintf(s, "%p", ref);
sprintf(s, "(%p,0)", ref);
#else
sprintf(s, "0x%p", ref);
sprintf(s, "(0x%p,0)", ref);
#endif
#endif
wrputs(s, writech);
@ -458,7 +459,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
wrputf(FloatOfTerm(t),wglb->writech);
return;
case (CELL)FunctorDBRef:
wrputref(RefOfTerm(t),wglb->writech);
wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb->writech);
return;
case (CELL)FunctorLongInt:
wrputn(LongIntOfTerm(t),wglb->writech);

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.57 2004-02-12 12:37:11 vsc Exp $ *
* version: $Id: Heap.h,v 1.58 2004-02-13 18:39:29 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -224,6 +224,7 @@ typedef struct various_codes {
atom_dollar_undef,
#endif
#endif
atom_dbref,
atom_e,
atom_e_q,
atom_eof,
@ -478,6 +479,7 @@ struct various_codes *heap_regs;
#if defined(EUROTRA) && defined(SFUNC)
#define AtomDollarUndef heap_regs->atom_dollar_undef
#endif
#define AtomDBRef heap_regs->atom_dbref
#define AtomE heap_regs->atom_e
#define AtomEQ heap_regs->atom_e_q
#define AtomEof heap_regs->atom_eof

1
H/rheap.h
View File

@ -210,6 +210,7 @@ restore_codes(void)
heap_regs->atom_dollar_undef = AtomAdjust(heap_regs->atom_dollar_undef);
#endif
#endif
heap_regs->atom_dbref = AtomAdjust(heap_regs->atom_dbref);
heap_regs->atom_e = AtomAdjust(heap_regs->atom_e);
heap_regs->atom_e_q = AtomAdjust(heap_regs->atom_e_q);
heap_regs->atom_eof = AtomAdjust(heap_regs->atom_eof);

3
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.52 2004-02-12 17:09:17 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.53 2004-02-13 18:39:29 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -418,6 +418,7 @@ typedef enum {
PURE_ABORT,
CALL_COUNTER_UNDERFLOW,
/* ISO_ERRORS */
CONSISTENCY_ERROR,
DOMAIN_ERROR_ARRAY_OVERFLOW,
DOMAIN_ERROR_ARRAY_TYPE,
DOMAIN_ERROR_IO_MODE,

48
pl/boot.yap
View File

@ -34,7 +34,7 @@ true :- true.
( Module=user ->
'$compile_mode'(_,0)
;
'$format'(user_error,"[~w]~n", [Module])
'$format'(user_error,'[~w]~n', [Module])
),
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
@ -125,10 +125,10 @@ read_sig.
fail.
'$enter_top_level' :-
( get_value('$trace', 1) ->
'$format'(user_error, "[trace]~n", [])
'$format'(user_error, '[trace]~n', [])
;
get_value(debug, 1) ->
'$format'(user_error, "[debug]~n", [])
'$format'(user_error, '[debug]~n', [])
),
fail.
'$enter_top_level' :-
@ -177,10 +177,10 @@ read_sig.
'$version' :-
get_value('$version_name',VersionName),
'$format'(user_error, "[ YAP version ~w ]~n", [VersionName]),
'$format'(user_error, '[ YAP version ~w ]~n', [VersionName]),
fail.
'$version' :- recorded('$version',VersionName,_),
'$format'(user_error, "~w~n", [VersionName]),
'$format'(user_error, '~w~n', [VersionName]),
fail.
'$version'.
@ -294,7 +294,7 @@ repeat :- '$repeat'.
% but YAP and SICStus does.
%
'$process_directive'(G, _, M) :-
( '$do_yes_no'(G,M) -> true ; '$format'(user_error,":- ~w:~w failed.~n",[M,G]) ).
( '$do_yes_no'(G,M) -> true ; '$format'(user_error,':- ~w:~w failed.~n',[M,G]) ).
'$all_directives'(_:G1) :- !,
'$all_directives'(G1).
@ -448,7 +448,7 @@ repeat :- '$repeat'.
'$extract_goal_vars_for_dump'(VL,LIV).
'$write_query_answer_true'([]) :- !,
'$format'(user_error,"~ntrue",[]).
'$format'(user_error,'~ntrue',[]).
'$write_query_answer_true'(_).
'$show_frozen'(G,V,LGs) :-
@ -467,16 +467,16 @@ repeat :- '$repeat'.
fail.
'$present_answer'((?-), Answ) :-
get_value('$break',BL),
( BL \= 0 -> '$format'(user_error, "[~p] ",[BL]) ;
( BL \= 0 -> '$format'(user_error, '[~p] ',[BL]) ;
true ),
( recorded('$print_options','$toplevel'(Opts),_) ->
write_term(user_error,Answ,Opts) ;
'$format'(user_error,"~w",[Answ])
'$format'(user_error,'~w',[Answ])
),
'$format'(user_error,"~n", []).
'$format'(user_error,'~n', []).
'$another' :-
'$format'(user_error," ? ",[]),
'$format'(user_error,' ? ',[]),
'$get0'(user_input,C),
( C== 0'; -> '$skip'(user_input,10),
'$add_nl_outside_console',
@ -484,7 +484,7 @@ repeat :- '$repeat'.
;
C== 10 -> '$add_nl_outside_console',
( '$undefined'('$print_message'(_,_),prolog) ->
'$format'(user_error,"yes~n", [])
'$format'(user_error,'yes~n', [])
;
print_message(help,yes)
)
@ -497,12 +497,12 @@ repeat :- '$repeat'.
'$add_nl_outside_console' :-
'$is_same_tty'(user_input, user_error), !.
'$add_nl_outside_console' :-
'$format'(user_error,"~n",[]).
'$format'(user_error,'~n',[]).
'$ask_again_for_another' :-
'$format'(user_error,"Action (\";\" for more choices, <return> for exit)", []),
'$format'(user_error,'Action (\";\" for more choices, <return> for exit)', []),
'$another'.
'$write_answer'(_,_,_) :-
@ -559,25 +559,25 @@ repeat :- '$repeat'.
'$write_remaining_vars_and_goals'([]).
'$write_remaining_vars_and_goals'([G1|LG]) :-
'$format'(user_error,",~n",[]),
'$format'(user_error,',~n',[]),
'$write_goal_output'(G1),
'$write_remaining_vars_and_goals'(LG).
'$write_goal_output'(var([V|VL])) :-
'$format'(user_error,"~s",[V]),
'$format'(user_error,'~s',[V]),
'$write_output_vars'(VL).
'$write_goal_output'(nonvar([V|VL],B)) :-
'$format'(user_error,"~s",[V]),
'$format'(user_error,'~s',[V]),
'$write_output_vars'(VL),
'$format'(user_error," = ", []),
'$format'(user_error,' = ', []),
( recorded('$print_options','$toplevel'(Opts),_) ->
write_term(user_error,B,Opts) ;
'$format'(user_error,"~w",[B])
'$format'(user_error,'~w',[B])
).
'$write_goal_output'(_-G) :-
( recorded('$print_options','$toplevel'(Opts),_) ->
write_term(user_error,G,Opts) ;
'$format'(user_error,"~w",[G])
'$format'(user_error,'~w',[G])
).
'$name_vars_in_goals'(G, VL0, NG) :-
@ -605,7 +605,7 @@ repeat :- '$repeat'.
'$write_output_vars'([]).
'$write_output_vars'([V|VL]) :-
'$format'(user_error," = ~s",[V]),
'$format'(user_error,' = ~s',[V]),
'$write_output_vars'(VL).
call(G) :- '$execute'(G).
@ -816,7 +816,7 @@ break :- get_value('$break',BL), NBL is BL+1,
get_value(spy_leap,_Leap),
set_value('$break',NBL),
current_output(OutStream), current_input(InpStream),
'$format'(user_error, "[ Break (level ~w) ]~n", [NBL]),
'$format'(user_error, '[ Break (level ~w) ]~n', [NBL]),
'$do_live',
!,
set_value('$live','$true'),
@ -877,7 +877,7 @@ break :- get_value('$break',BL), NBL is BL+1,
recorda('$initialisation','$',_),
( '$undefined'('$print_message'(_,_),prolog) ->
( get_value('$verbose',on) ->
'$format'(user_error, "~*|[ consulting ~w... ]~n", [LC,F])
'$format'(user_error, '~*|[ consulting ~w... ]~n', [LC,F])
; true )
;
'$print_message'(informational, loading(consulting, File))
@ -893,7 +893,7 @@ break :- get_value('$break',BL), NBL is BL+1,
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
( '$undefined'('$print_message'(_,_),prolog) ->
( get_value('$verbose',on) ->
'$format'(user_error, "~*|[ ~w consulted ~w bytes in ~d msecs ]~n", [LC,F,H,T])
'$format'(user_error, '~*|[ ~w consulted ~w bytes in ~d msecs ]~n', [LC,F,H,T])
;
true
)

307
pl/errors.yap
View File

@ -55,7 +55,7 @@ print_message(Level, Mss) :-
user:portray_message(Severity, Msg), !.
'$print_message'(error,error(Msg,Info)) :-
( var(Msg) ; var(Info) ), !,
'$format'(user_error,"[ No handler for error ~w ]~n", [error(Msg,Info)]).
'$format'(user_error,'[ No handler for error ~w ]~n', [error(Msg,Info)]).
'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
'$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :-
@ -66,86 +66,86 @@ print_message(Level, Mss) :-
'$print_message'(error,error(Type,Where)) :-
'$output_error_message'(Type, Where), !.
'$print_message'(error,Throw) :-
'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
'$format'(user_error,'[ No handler for error ~w ]~n', [Throw]).
'$print_message'(informational,M) :-
( get_value('$verbose',on) ->
'$do_informational_message'(M) ;
true
).
'$print_message'(warning,M) :-
'$format'(user_error, "[ ", []),
'$format'(user_error, '[ ', []),
'$do_print_message'(M),
'$format'(user_error, " ]~n", []).
'$format'(user_error, ' ]~n', []).
'$print_message'(help,M) :-
'$do_print_message'(M),
'$format'(user_error, "~n", []).
'$format'(user_error, '~n', []).
'$do_informational_message'(abort(_)) :- !,
'$format'(user_error, "[ Execution Aborted ]~n", []).
'$format'(user_error, '[ Execution Aborted ]~n', []).
'$do_informational_message'(loading(_,user)) :- !.
'$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
'$show_consult_level'(LC),
'$format'(user_error, "~*|[ ~a ~a... ]~n", [LC, What, AbsoluteFileName]).
'$format'(user_error, '~*|[ ~a ~a... ]~n', [LC, What, AbsoluteFileName]).
'$do_informational_message'(loaded(_,user,_,_,_)) :- !.
'$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
'$show_consult_level'(LC0),
LC is LC0+1,
'$format'(user_error, "~*|[ ~a ~a in module ~a, ~d msec ~d bytes ]~n", [LC, What, AbsoluteFileName,Mod,Time,Space]).
'$format'(user_error, '~*|[ ~a ~a in module ~a, ~d msec ~d bytes ]~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
'$do_informational_message'(M) :-
'$format'(user_error,"[ ", []),
'$format'(user_error,'[ ', []),
'$do_print_message'(M),
'$format'(user_error," ]~n", []).
'$format'(user_error,' ]~n', []).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$do_print_message'(no) :- !,
'$format'(user_error, "no~n", []).
'$format'(user_error, 'no~n', []).
'$do_print_message'(yes) :- !,
'$format'(user_error, "yes~n", []).
'$format'(user_error, 'yes~n', []).
'$do_print_message'(debug(debug)) :- !,
'$format'(user_error,"Debug mode on.",[]).
'$format'(user_error,'Debug mode on.',[]).
'$do_print_message'(debug(off)) :- !,
'$format'(user_error,"Debug mode off.",[]).
'$format'(user_error,'Debug mode off.',[]).
'$do_print_message'(debug(trace)) :- !,
'$format'(user_error,"Trace mode on.",[]).
'$format'(user_error,'Trace mode on.',[]).
'$do_print_message'('$format'(Msg, Args)) :- !,
'$format'(user_error,Msg,Args).
'$do_print_message'(import(Pred,To,From,private)) :- !,
'$format'(user_error,"Importing private predicate ~w:~w to ~w.",
'$format'(user_error,'Importing private predicate ~w:~w to ~w.',
[From,Pred,To]).
'$do_print_message'(no_match(P)) :- !,
'$format'(user_error,"No matching predicate for ~w.",
'$format'(user_error,'No matching predicate for ~w.',
[P]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !,
'$format'(user_error,"There is already a spy point on ~w:~w/~w.",
'$format'(user_error,'There is already a spy point on ~w:~w/~w.',
[M,F,N]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) :- !,
'$format'(user_error,"Spy point set on ~w:~w/~w.",
'$format'(user_error,'Spy point set on ~w:~w/~w.',
[M,F,N]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) :- !,
'$format'(user_error,"Spy point on ~w:~w/~w removed.",
'$format'(user_error,'Spy point on ~w:~w/~w removed.',
[M,F,N]).
'$do_print_message'(breakp(no,breakpoint_for,M:F/N)) :- !,
'$format'(user_error,"There is no spy point on ~w:~w/~w.",
'$format'(user_error,'There is no spy point on ~w:~w/~w.',
[M,F,N]).
'$do_print_message'(leash([])) :- !,
'$format'(user_error,"No leashing.",
'$format'(user_error,'No leashing.',
[M,F,N]).
'$do_print_message'(leash([A|B])) :- !,
'$format'(user_error,"Leashing set to ~w.",
'$format'(user_error,'Leashing set to ~w.',
[[A|B]]).
'$do_print_message'(breakpoints([])) :- !,
'$format'(user_error,"There are no spy-points set.",
'$format'(user_error,'There are no spy-points set.',
[M,F,N]).
'$do_print_message'(breakpoints(L)) :- !,
'$format'(user_error,"Spy-points set on:", []),
'$format'(user_error,'Spy-points set on:', []),
'$print_list_of_preds'(L).
'$do_print_message'(Messg) :-
'$format'(user_error,"~q",Messg).
'$format'(user_error,'~q',Messg).
'$print_list_of_preds'([]).
'$print_list_of_preds'([P|L]) :-
'$format'(user_error,"~n ~w",[P]),
'$format'(user_error,'~n ~w',[P]),
'$print_list_of_preds'(L).
'$do_stack_dump'(Envs, CPs) :-
@ -248,20 +248,20 @@ print_message(Level, Mss) :-
'$say_stack_dump'([], []) :- !.
'$say_stack_dump'(_, _) :-
'$format'(user_error,"[ Stack dump for error:", []).
'$format'(user_error,'[ Stack dump for error:', []).
'$close_stack_dump'([], []) :- !.
'$close_stack_dump'(_, _) :-
'$format'(user_error," ]~n", []).
'$format'(user_error,' ]~n', []).
'$show_cps'([]) :- !.
'$show_cps'(List) :-
'$format'(user_error,"~n choice-points (goals with alternatives left):",[]),
'$format'(user_error,'~n choice-points (goals with alternatives left):',[]),
'$print_stack'(List).
'$show_envs'([]) :- !.
'$show_envs'(List) :-
'$format'(user_error,"~n environments (partially executed clauses):",[]),
'$format'(user_error,'~n environments (partially executed clauses):',[]),
'$print_stack'(List).
'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
@ -271,16 +271,16 @@ print_message(Level, Mss) :-
'$print_stack'([]).
'$print_stack'([overflow]) :- !,
'$format'(user_error,"~n ...",[]).
'$format'(user_error,'~n ...',[]).
'$print_stack'([cl(Name,Arity,Mod,Clause)|List]) :-
'$show_goal'(Clause,Name,Arity,Mod),
'$print_stack'(List).
'$show_goal'(-1,Name,Arity,Mod) :- !,
'$format'("~n ~a:~a/~d at indexing code",[Mod,Name,Arity]).
'$format'('~n ~a:~a/~d at indexing code',[Mod,Name,Arity]).
'$show_goal'(0,Name,Arity,Mod) :- !.
'$show_goal'(I,Name,Arity,Mod) :-
'$format'(user_error,"~n ~a:~a/~d at clause ~d",[Mod,Name,Arity,I]).
'$format'(user_error,'~n ~a:~a/~d at clause ~d',[Mod,Name,Arity,I]).
'$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !,
number_codes(Arity,ArityCode),
@ -294,348 +294,351 @@ print_message(Level, Mss) :-
atom_codes(ClAtom,ClCode),
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
'$output_error_message'(consistency_error(Who),Where) :-
'$format'(user_error,'[ CONSISTENCY ERROR- ~w ~w ]~n',
[Who,Where]).
'$output_error_message'(context_error(Goal,Who),Where) :-
'$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n",
'$format'(user_error,'[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n',
[Goal,Who,Where]).
'$output_error_message'(domain_error(array_overflow,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid index ~w for array ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid index ~w for array ]~n',
[Where,Opt]).
'$output_error_message'(domain_error(array_type,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid static array type ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid static array type ~w ]~n',
[Where,Opt]).
'$output_error_message'(domain_error(builtin_procedure,P), P) :-
'$format'(user_error,"[ DOMAIN ERROR- non-iso built-in procedure ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- non-iso built-in procedure ~w ]~n',
[P]).
'$output_error_message'(domain_error(character_code_list,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid list of codes ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid list of codes ~w ]~n',
[Where,Opt]).
'$output_error_message'(domain_error(delete_file_option,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid list of options ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid list of options ~w ]~n',
[Where,Opt]).
'$output_error_message'(domain_error(operator_specifier,Op), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid operator specifier ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid operator specifier ~w ]~n',
[Where,Op]).
'$output_error_message'(domain_error(out_of_range,Value), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: expression ~w is out of range ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: expression ~w is out of range ]~n',
[Where,Value]).
'$output_error_message'(domain_error(close_option,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid close option ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid close option ~w ]~n',
[Where,Opt]).
'$output_error_message'(domain_error(radix,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid radix ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid radix ~w ]~n',
[Where,Opt]).
'$output_error_message'(domain_error(shift_count_overflow,Opt), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: shift count overflow in ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: shift count overflow in ~w ]~n',
[Where,Opt]).
'$output_error_message'(domain_error(flag_value,F+V), W) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid value ~w for flag ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid value ~w for flag ~w ]~n',
[W,V,F]).
'$output_error_message'(domain_error(io_mode,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid io mode ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid io mode ~w ]~n',
[Where,N]).
'$output_error_message'(domain_error(mutable,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: invalid mutable ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: invalid mutable ~w ]~n',
[Where,N]).
'$output_error_message'(domain_error(module_decl_options,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: expect module declaration options, found ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: expect module declaration options, found ~w ]~n',
[Where,N]).
'$output_error_message'(domain_error(not_empty_list,_), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: found empty list ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: found empty list ]~n',
[Where]).
'$output_error_message'(domain_error(not_less_than_zero,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: number ~w less than zero ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: number ~w less than zero ]~n',
[Where,N]).
'$output_error_message'(domain_error(not_newline,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: number ~w not newline ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: number ~w not newline ]~n',
[Where,N]).
'$output_error_message'(domain_error(not_zero,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w is not allowed in the domain ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w is not allowed in the domain ]~n',
[Where,N]).
'$output_error_message'(domain_error(operator_priority,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid operator priority ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w invalid operator priority ]~n',
[Where,N]).
'$output_error_message'(domain_error(operator_specifier,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid operator specifier ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w invalid operator specifier ]~n',
[Where,N]).
'$output_error_message'(domain_error(predicate_spec,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid predicate specifier ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w invalid predicate specifier ]~n',
[Where,N]).
'$output_error_message'(domain_error(read_option,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid option to read ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w invalid option to read ]~n',
[Where,N]).
'$output_error_message'(domain_error(semantics_indicator,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected predicate indicator, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected predicate indicator, got ~w ]~n',
[Where,W]).
'$output_error_message'(domain_error(source_sink,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w is not a source sink term ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w is not a source sink term ]~n',
[Where,N]).
'$output_error_message'(domain_error(stream,What), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not a stream ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not a stream ]~n',
[Where,What]).
'$output_error_message'(domain_error(stream_or_alias,What), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not a stream ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not a stream ]~n',
[Where,What]).
'$output_error_message'(domain_error(stream_option,What), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not a stream option ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not a stream option ]~n',
[Where,What]).
'$output_error_message'(domain_error(stream_position,What), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not a stream position ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not a stream position ]~n',
[Where,What]).
'$output_error_message'(domain_error(stream_property,What), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not a stream property ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not a stream property ]~n',
[Where,What]).
'$output_error_message'(domain_error(syntax_error_handler,What), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not a syntax error handler ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not a syntax error handler ]~n',
[Where,What]).
'$output_error_message'(domain_error(thread_create_option,Option+Opts), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not in ~w ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not in ~w ]~n',
[Where,Option, Opts]).
'$output_error_message'(domain_error(time_out_spec,What), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w not a valid specification for a time out ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w not a valid specification for a time out ]~n',
[Where,What]).
'$output_error_message'(domain_error(write_option,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid option to write ]~n",
'$format'(user_error,'[ DOMAIN ERROR- ~w: ~w invalid option to write ]~n',
[Where,N]).
'$output_error_message'(existence_error(array,F), W) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w could not open array ~w ]~n",
'$format'(user_error,'[ EXISTENCE ERROR- ~w could not open array ~w ]~n',
[W,F]).
'$output_error_message'(existence_error(mutex,F), W) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w could not open mutex ~w ]~n",
'$format'(user_error,'[ EXISTENCE ERROR- ~w could not open mutex ~w ]~n',
[W,F]).
'$output_error_message'(existence_error(queue,F), W) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w could not open message queue ~w ]~n",
'$format'(user_error,'[ EXISTENCE ERROR- ~w could not open message queue ~w ]~n',
[W,F]).
'$output_error_message'(existence_error(procedure,P), _) :-
'$format'(user_error,"[ EXISTENCE ERROR- procedure ~w undefined ]~n",
'$format'(user_error,'[ EXISTENCE ERROR- procedure ~w undefined ]~n',
[P]).
'$output_error_message'(existence_error(source_sink,F), W) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w could not find file ~w ]~n",
'$format'(user_error,'[ EXISTENCE ERROR- ~w could not find file ~w ]~n',
[W,F]).
'$output_error_message'(existence_error(stream,Stream), Where) :-
'$format'(user_error,"[ EXISTENCE ERROR- ~w: ~w not an open stream ]~n",
'$format'(user_error,'[ EXISTENCE ERROR- ~w: ~w not an open stream ]~n',
[Where,Stream]).
'$output_error_message'(evaluation_error(int_overflow), Where) :-
'$format'(user_error,"[ INTEGER OVERFLOW ERROR- ~w ]~n",
'$format'(user_error,'[ INTEGER OVERFLOW ERROR- ~w ]~n',
[Where]).
'$output_error_message'(evaluation_error(float_overflow), Where) :-
'$format'(user_error,"[ FLOATING POINT OVERFLOW ERROR- ~w ]~n",
'$format'(user_error,'[ FLOATING POINT OVERFLOW ERROR- ~w ]~n',
[Where]).
'$output_error_message'(evaluation_error(undefined), Where) :-
'$format'(user_error,"[ UNDEFINED ARITHMETIC RESULT ERROR- ~w ]~n",
'$format'(user_error,'[ UNDEFINED ARITHMETIC RESULT ERROR- ~w ]~n',
[Where]).
'$output_error_message'(evaluation_error(underflow), Where) :-
'$format'(user_error,"[ UNDERFLOW ERROR- ~w ]~n",
'$format'(user_error,'[ UNDERFLOW ERROR- ~w ]~n',
[Where]).
'$output_error_message'(evaluation_error(float_underflow), Where) :-
'$format'(user_error,"[ FLOATING POINT UNDERFLOW ERROR- ~w ]~n",
'$format'(user_error,'[ FLOATING POINT UNDERFLOW ERROR- ~w ]~n',
[Where]).
'$output_error_message'(evaluation_error(zero_divisor), Where) :-
'$format'(user_error,"[ ZERO DIVISOR ERROR- ~w ]~n",
'$format'(user_error,'[ ZERO DIVISOR ERROR- ~w ]~n',
[Where]).
'$output_error_message'(instantiation_error, Where) :-
'$format'(user_error,"[ INSTANTIATION ERROR- ~w: expected bound value ]~n",
'$format'(user_error,'[ INSTANTIATION ERROR- ~w: expected bound value ]~n',
[Where]).
'$output_error_message'(out_of_heap_error, Where) :-
'$format'(user_error,"[ OUT OF HEAP SPACE ERROR- ~w ]~n",
'$format'(user_error,'[ OUT OF HEAP SPACE ERROR- ~w ]~n',
[Where]).
'$output_error_message'(out_of_stack_error, Where) :-
'$format'(user_error,"[ OUT OF STACK SPACE ERROR- ~w ]~n",
'$format'(user_error,'[ OUT OF STACK SPACE ERROR- ~w ]~n',
[Where]).
'$output_error_message'(out_of_trail_error, Where) :-
'$format'(user_error,"[ OUT OF TRAIL SPACE ERROR- ~w ]~n",
'$format'(user_error,'[ OUT OF TRAIL SPACE ERROR- ~w ]~n',
[Where]).
'$output_error_message'(permission_error(access,private_procedure,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot see clauses for ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot see clauses for ~w ]~n',
[Where,P]).
'$output_error_message'(permission_error(access,static_procedure,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot access static procedure ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot access static procedure ~w ]~n',
[Where,P]).
'$output_error_message'(permission_error(alias,new,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create alias ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot create alias ~w ]~n',
[Where,P]).
'$output_error_message'(permission_error(create,array,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create array ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot create array ~w ]~n',
[Where,P]).
'$output_error_message'(permission_error(create,mutex,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create mutex ~a ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot create mutex ~a ]~n',
[Where,P]).
'$output_error_message'(permission_error(create,queue,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create queue ~a ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot create queue ~a ]~n',
[Where,P]).
'$output_error_message'(permission_error(create,operator,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot create operator ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot create operator ~w ]~n',
[Where,P]).
'$output_error_message'(permission_error(input,binary_stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot read from binary stream ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot read from binary stream ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,closed_stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: trying to read from closed stream ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: trying to read from closed stream ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,past_end_of_stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: past end of stream ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: past end of stream ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot read from ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot read from ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,text_stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot read from text stream ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot read from text stream ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: modifying a dynamic procedure ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: modifying a dynamic procedure ]~n',
[Where]).
'$output_error_message'(permission_error(modify,flag,W), _) :-
'$format'(user_error,"[ PERMISSION ERROR- cannot modify flag ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- cannot modify flag ~w ]~n',
[W]).
'$output_error_message'(permission_error(modify,operator,W), _) :-
'$format'(user_error,"[ PERMISSION ERROR- T cannot declare ~w an operator ]~n",
'$format'(user_error,'[ PERMISSION ERROR- T cannot declare ~w an operator ]~n',
[W]).
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: modifying a dynamic procedure ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: modifying a dynamic procedure ]~n',
[Where]).
'$output_error_message'(permission_error(modify,static_procedure,_), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: modifying a static procedure ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: modifying a static procedure ]~n',
[Where]).
'$output_error_message'(permission_error(modify,static_procedure_in_use,_), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: modifying a static procedure in use ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: modifying a static procedure in use ]~n',
[Where]).
'$output_error_message'(permission_error(module,redefined,Mod), Who) :-
'$format'(user_error,"[ PERMISSION ERROR ~w- redefining module ~a in a different file ]~n",
'$format'(user_error,'[ PERMISSION ERROR ~w- redefining module ~a in a different file ]~n',
[Who,Mod]).
'$output_error_message'(permission_error(open,source_sink,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot open file ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot open file ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(output,binary_stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot write to binary stream ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot write to binary stream ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(output,stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot write to ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot write to ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(output,text_stream,Stream), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot write to text stream ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot write to text stream ~w ]~n',
[Where,Stream]).
'$output_error_message'(permission_error(resize,array,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot resize array ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot resize array ~w ]~n',
[Where,P]).
'$output_error_message'(permission_error(unlock,mutex,P), Where) :-
'$format'(user_error,"[ PERMISSION ERROR- ~w: cannot unlock mutex ~w ]~n",
'$format'(user_error,'[ PERMISSION ERROR- ~w: cannot unlock mutex ~w ]~n',
[Where,P]).
'$output_error_message'(representation_error(character), Where) :-
'$format'(user_error,"[ REPRESENTATION ERROR- ~w: expected character ]~n",
'$format'(user_error,'[ REPRESENTATION ERROR- ~w: expected character ]~n',
[Where]).
'$output_error_message'(representation_error(character_code), Where) :-
'$format'(user_error,"[ REPRESENTATION ERROR- ~w: expected character code ]~n",
'$format'(user_error,'[ REPRESENTATION ERROR- ~w: expected character code ]~n',
[Where]).
'$output_error_message'(representation_error(max_arity), Where) :-
'$format'(user_error,"[ REPRESENTATION ERROR- ~w: number too big ]~n",
'$format'(user_error,'[ REPRESENTATION ERROR- ~w: number too big ]~n',
[Where]).
'$output_error_message'(syntax_error(G,0,Msg,[],0,0), Where) :- !,
'$format'(user_error,"[ SYNTAX ERROR in ~w: ~a ]~n",[G,Msg]).
'$format'(user_error,'[ SYNTAX ERROR in ~w: ~a ]~n',[G,Msg]).
'$output_error_message'(syntax_error(_,Position,_,Term,Pos,Start), Where) :-
'$format'(user_error,"[ ~w ",[Where]),
'$format'(user_error,'[ ~w ',[Where]),
'$dump_syntax_error_line'(Start,Position),
'$dump_syntax_error_term'(10,Pos, Term),
'$format'(user_error,".~n]~n",[]).
'$format'(user_error,'.~n]~n',[]).
'$output_error_message'(system_error, Where) :-
'$format'(user_error,"[ SYSTEM ERROR- ~w ]~n",
'$format'(user_error,'[ SYSTEM ERROR- ~w ]~n',
[Where]).
'$output_error_message'(system_error(Message), Where) :-
'$format'(user_error,"[ SYSTEM ERROR- ~w at ~w]~n",
'$format'(user_error,'[ SYSTEM ERROR- ~w at ~w]~n',
[Message,Where]).
'$output_error_message'(type_error(T,_,Err,M), _Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected ~w, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected ~w, got ~w ]~n',
[T,Err,M]).
'$output_error_message'(type_error(array,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected array, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected array, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(atom,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected atom, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected atom, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(atomic,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected atomic, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected atomic, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(byte,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected byte, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected byte, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(callable,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected callable goal, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected callable goal, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(char,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected char, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected char, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(character,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected character, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected character, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(character_code,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected character code, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected character code, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(compound,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected compound, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected compound, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(db_reference,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected data base reference, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected data base reference, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(db_term,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected data base term, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected data base term, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(evaluable,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected evaluable term, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected evaluable term, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(float,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected float, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected float, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(in_byte,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected byte, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected byte, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(in_character,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected atom character, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected atom character, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(in_character_code,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected character code, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected character code, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(integer,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected integer, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected integer, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(key,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected database key, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected database key, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(leash_mode,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected modes for leash, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected modes for leash, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(list,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected list, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected list, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(number,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected number, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected number, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(pointer,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected pointer, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected pointer, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(predicate_indicator,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected predicate indicator, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected predicate indicator, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(unsigned_byte,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected unsigned byte, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected unsigned byte, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(unsigned_char,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected unsigned char, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected unsigned char, got ~w ]~n',
[Where,W]).
'$output_error_message'(type_error(variable,W), Where) :-
'$format'(user_error,"[ TYPE ERROR- ~w: expected unbound variable, got ~w ]~n",
'$format'(user_error,'[ TYPE ERROR- ~w: expected unbound variable, got ~w ]~n',
[Where,W]).
'$output_error_message'(unknown, Where) :-
'$format'(user_error,"[ EXISTENCE ERROR- procedure ~w undefined ]~n",
'$format'(user_error,'[ EXISTENCE ERROR- procedure ~w undefined ]~n',
[Where]).
'$dump_syntax_error_line'(Pos,_) :-
'$format'(user_error,"at line ~d:~n",
'$format'(user_error,'at line ~d:~n',
[Pos]).
'$dump_syntax_error_term'(0,J,L) :- !,
'$format'(user_error,"~n", []),
'$format'(user_error,'~n', []),
'$dump_syntax_error_term'(10,J,L).
'$dump_syntax_error_term'(_,0,L) :- !,
'$format'(user_error,"~n<==== HERE ====>~n", []),
'$format'(user_error,'~n<==== HERE ====>~n', []),
'$dump_syntax_error_term'(10,-1,L).
'$dump_syntax_error_term'(_,_,[]) :- !.
'$dump_syntax_error_term'(I,J,[T-P|R]) :-
@ -645,13 +648,13 @@ print_message(Level, Mss) :-
'$dump_syntax_error_term'(I1,J1,R).
'$dump_error_token'(atom(A)) :- !,
'$format'(user_error," ~a", [A]).
'$format'(user_error,' ~a', [A]).
'$dump_error_token'(number(N)) :- !,
'$format'(user_error," ~w", [N]).
'$format'(user_error,' ~w', [N]).
'$dump_error_token'(var(_,S,_)) :- !,
'$format'(user_error," ~s ", [S]).
'$format'(user_error,' ~s ', [S]).
'$dump_error_token'(string(S)) :- !,
'$format'(user_error," ""~s""", [S]).
'$format'(user_error,' ""~s""', [S]).
'$dump_error_token'('(') :- !,
'$format'(user_error,"(", []).
'$dump_error_token'(')') :- !,

1
pl/protect.yap
View File

@ -32,6 +32,7 @@
% hide all atoms who start by '$'
'$hide'('$VAR') :- !, fail. /* not $VAR */
'$hide'('$dbref') :- !, fail. /* not stream position */
'$hide'('$stream') :- !, fail. /* not $STREAM */
'$hide'('$stream_position') :- !, fail. /* not stream position */
'$hide'(Name) :- hide(Name), fail.