From 039655b7677f7116192cd5471765a04f856bb7ff Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 13 Feb 2004 18:39:29 +0000 Subject: [PATCH] simplify format, so that it will be easier to do bug fixes 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 --- C/dbase.c | 54 +- C/errors.c | 13 + C/init.c | 1 + C/iopreds.c | 1410 +++++++++++++++++------------------------------- C/parser.c | 5 +- C/write.c | 13 +- H/Heap.h | 4 +- H/rheap.h | 1 + m4/Yap.h.m4 | 3 +- pl/boot.yap | 48 +- pl/errors.yap | 307 +++++------ pl/protect.yap | 1 + 12 files changed, 728 insertions(+), 1132 deletions(-) diff --git a/C/dbase.c b/C/dbase.c index 3eb2b73a1..6154213df 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -2282,10 +2282,7 @@ p_still_variant(void) DBRef dbr; if (IsVarTerm(t1) || !IsDBRefTerm(t1)) { - if (IsIntegerTerm(t1)) - dbr = (DBRef)IntegerOfTerm(t1); - else - return (FALSE); + return (FALSE); /* limited sanity checking */ if (dbr->id != FunctorDBRef) { return FALSE; @@ -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; - } + return FALSE; } else { ref = DBRefOfTerm(t3); } @@ -4160,13 +4153,8 @@ 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); - } + 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); - } + Yap_Error(TYPE_ERROR_DBREF, t1, "erase"); + return (FALSE); } else { entryref = DBRefOfTerm(t1); } @@ -4283,12 +4267,8 @@ 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); - } + 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; - } + 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; - } + return FALSE; } if (dbr->Flags & LogUpdMask) { LogUpdClause *cl = (LogUpdClause *)dbr; diff --git a/C/errors.c b/C/errors.c index c29a9a34a..7f5bcc5e0 100644 --- a/C/errors.c +++ b/C/errors.c @@ -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; diff --git a/C/init.c b/C/init.c index 814bc6f41..47ed337b3 100644 --- a/C/init.c +++ b/C/init.c @@ -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"); diff --git a/C/iopreds.c b/C/iopreds.c index 27d14e797..778c26b07 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -158,14 +158,11 @@ STATIC_PROTO (Int p_add_alias_to_stream, (void)); STATIC_PROTO (Int p_change_alias_to_stream, (void)); STATIC_PROTO (Int p_check_if_valid_new_alias, (void)); STATIC_PROTO (Int p_fetch_stream_alias, (void)); -STATIC_PROTO (Int GetArgSizeFromThirdArg, (char **, Term *)); -STATIC_PROTO (Int GetArgSizeFromChars, (char **pptr, Int *, Term *)); -STATIC_PROTO (void format_print_str, (Int, Int, Term)); +STATIC_PROTO (int format_print_str, (Int, Int, int, Term)); STATIC_PROTO (Int p_format, (void)); STATIC_PROTO (Int p_startline, (void)); STATIC_PROTO (Int p_change_type_of_char, (void)); STATIC_PROTO (Int p_type_of_char, (void)); -STATIC_PROTO (Int GetArgSizeFromChar, (Term *)); STATIC_PROTO (void CloseStream, (int)); static int @@ -3444,166 +3441,6 @@ p_put_byte (void) static int format_error = FALSE; -static Int -GetArgSizeFromThirdArg (char **pptr, Term * termptr) -{ - Term args = *termptr, arghd; - char *ptr = *pptr; - Int res; - if (IsVarTerm(args)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); - return(0); - } else if (!IsPairTerm (args)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, args, "format/2"); - return(0); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm(arghd)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); - return(0); - } else if (!IsIntTerm (arghd)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); - return(0); - } - res = IntOfTerm (arghd); - if (res < 0) { - format_error = TRUE; - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arghd, "format/2"); - return (0); - } -#if SHORT_INTS - sprintf (ptr, "%ld", res); -#else - sprintf (ptr, "%d", res); -#endif - while (*ptr) - ptr++; - *pptr = ptr; - *termptr = args; - return (res); -} - -static Int -GetArgSizeFromChar (Term * args) -{ - Term arghd, argtl = *args; - Int val; - if (IsVarTerm(argtl)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, argtl, "format/2"); - return(0); - } else if (!IsPairTerm (argtl)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, argtl, "format/2"); - return(0); - } - arghd = HeadOfTerm (argtl); - argtl = TailOfTerm (argtl); - if (IsVarTerm(arghd)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); - return(0); - } else if (!IsIntTerm (arghd)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); - return(0); - } - val = IntOfTerm (arghd); - if (IsVarTerm(argtl)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, argtl, "format/2"); - return(0); - } else if (!IsPairTerm (argtl)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, argtl, "format/2"); - return(0); - } - arghd = HeadOfTerm (argtl); - argtl = TailOfTerm (argtl); - if (IsVarTerm(arghd)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); - return(0); - } else if (!IsIntTerm (arghd)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); - return(0); - } - if (IntOfTerm (arghd) != 't') { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); - return (0); - } - *args = argtl; - return (val); -} - -static Int -GetArgSizeFromChars (char **pptr, Int * intptr, Term * termptr) -{ - Term args = *termptr, arghd; - char *ptr = *pptr; - Int up_to_now = *intptr; - int ch; - if (IsVarTerm(args)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); - return(0); - } else if (!IsPairTerm (args)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, args, "format/2"); - return(0); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm(arghd)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); - return(0); - } else if (!IsIntTerm (arghd)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); - return(0); - } - ch = IntOfTerm (arghd); - while (ch >= '0' && ch <= '9') - { - *ptr++ = ch; - up_to_now = up_to_now * 10 + ch - '0'; - if (IsVarTerm(args)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); - return(0); - } else if (!IsPairTerm (args)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, args, "format/2"); - return(0); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm(arghd)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); - return(0); - } else if (!IsIntTerm (arghd)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); - return(0); - } - ch = (int) IntOfTerm (arghd); - } - *intptr = up_to_now; - *termptr = args; - *pptr = ptr; - return (ch); -} - - #define FORMAT_MAX_SIZE 256 static char *format_ptr, *format_base, *format_max; @@ -3721,62 +3558,193 @@ static void fill_pads(int nchars) } } -static void -format_print_str (Int sno, Int size, Term args) +static int +format_print_str (Int sno, Int size, Int has_size, Term args) { Term arghd; - Int always_flag = !size; - while (always_flag || size > 0) - { - if (IsVarTerm(args)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, args, "format/2"); - return; - } else if (args == TermNil) - break; - else if (!IsPairTerm (args)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, args, "format/2"); - return; - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm(arghd)) { - format_error = TRUE; - Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); - return; - } else if (!IsIntTerm (arghd)) { - format_error = TRUE; - Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); - return; - } - format_putc(sno, (int) IntOfTerm (arghd)); - size--; + while (!has_size || size > 0) { + if (IsVarTerm(args)) { + Yap_Error(INSTANTIATION_ERROR, args, "format/2"); + return FALSE; + } else if (args == TermNil) { + return TRUE; } + else if (!IsPairTerm (args)) { + Yap_Error(TYPE_ERROR_LIST, args, "format/2"); + return FALSE; + } + arghd = HeadOfTerm (args); + args = TailOfTerm (args); + if (IsVarTerm(arghd)) { + Yap_Error(INSTANTIATION_ERROR, arghd, "format/2"); + return FALSE; + } else if (!IsIntTerm (arghd)) { + Yap_Error(TYPE_ERROR_LIST, arghd, "format/2"); + return FALSE; + } + format_putc(sno, (int) IntOfTerm (arghd)); + size--; + } + return TRUE; +} + +typedef enum { + fst_ok, + fst_error, + fst_too_long +} format_cp_res; + +static format_cp_res +copy_format_string(Term inp, char *out, int max) +{ + int i = 0; + while (inp != TermNil) { + Term hd; + int ch; + + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR,inp,"format/2"); + return fst_error; + } + if (!IsPairTerm(inp)) { + Yap_Error(TYPE_ERROR_LIST,inp,"format/2"); + return fst_error; + } + hd = HeadOfTerm(inp); + if (IsVarTerm(hd)) { + Yap_Error(INSTANTIATION_ERROR,hd,"format/2"); + return fst_error; + } + if (!IsIntTerm(hd)) { + Yap_Error(TYPE_ERROR_INTEGER,hd,"format/2"); + return fst_error; + } + ch = IntOfTerm(hd); + if (ch < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,hd,"format/2"); + return fst_error; + } + if (i+1 == max) { + return fst_too_long; + } + /* we've got a character */ + out[i++] = ch; + /* done */ + inp = TailOfTerm(inp); + } + out[i] = '\0'; + return fst_ok; +} + +#define FORMAT_COPY_ARGS_ERROR -1 +#define FORMAT_COPY_ARGS_OVERFLOW -2 + +static Int +format_copy_args(Term args, Term *targs, Int tsz) +{ + Int n = 0; + while (args != TermNil) { + if (IsVarTerm(args)) { + Yap_Error(INSTANTIATION_ERROR,args,"format/2"); + return FORMAT_COPY_ARGS_ERROR; + } + if (!IsPairTerm(args)) { + Yap_Error(TYPE_ERROR_LIST,args,"format/2"); + return FORMAT_COPY_ARGS_ERROR; + } + if (n == tsz) + return FORMAT_COPY_ARGS_OVERFLOW; + targs[n] = HeadOfTerm(args); + args = TailOfTerm(args); + n++; + } + return n; + +} + +static void +format_clean_up(char *format_base, char *fstr, Term *targs) +{ + if (format_base) + Yap_FreeAtomSpace(format_base); + if (fstr) + Yap_FreeAtomSpace(fstr); + if (targs) + Yap_FreeAtomSpace((char *)targs); +} + +static Int +fetch_index_from_args(Term t) +{ + Int i; + + if (IsVarTerm(t)) + return -1; + if (!IsIntegerTerm(t)) + return -1; + i = IntegerOfTerm(t); + if (i < 0) + return -1; + return i; } static Int format(Term tail, Term args, int sno) { - char tmp1[256], tmp2[256], *ptr; - Term head, arghd; + char tmp1[256], tmp2[256]; int ch; - Int int2, i; int column_boundary = 0; - Int size_args, arg_size; - Float float_tmp; + Term mytargs[8], *targs; + Int tnum, targ = 0; + char *fstr = NULL, *fptr; if (IsVarTerm(tail)) { Yap_Error(INSTANTIATION_ERROR,tail,"format/2"); return(FALSE); - } else if (!IsPairTerm (tail)) { - Yap_Error(TYPE_ERROR_LIST,tail,"format/2"); - return(FALSE); + } else if (IsPairTerm (tail)) { + int sz = 256; + do { + format_cp_res fr; + + fstr = fptr = Yap_AllocAtomSpace(sz*sizeof(char)); + if ((fr = copy_format_string(tail, fstr, sz)) == fst_ok) + break; + if (fr == fst_error) return FALSE; + sz += 256; + Yap_FreeCodeSpace(fstr); + } while (TRUE); + } else if (IsAtomTerm(tail)) { + fstr = fptr = RepAtom(AtomOfTerm(tail))->StrOfAE; + } else { + Yap_Error(CONSISTENCY_ERROR, tail, "format/2"); + return FALSE; + } + if (IsPairTerm(args)) { + Int tsz = 8; + + targs = mytargs; + do { + tnum = format_copy_args(args, targs, tsz); + if (tnum == FORMAT_COPY_ARGS_ERROR) + return FALSE; + else if (tnum == FORMAT_COPY_ARGS_OVERFLOW) { + if (mytargs != targs) { + Yap_FreeCodeSpace((char *)targs); + } + tsz += 16; + targs = (Term *)Yap_AllocAtomSpace(tsz*sizeof(Term)); + } else { + break; + } + } while (TRUE); + } else if (args != TermNil) { + tnum = 1; + mytargs[0] = args; + targs = mytargs; + } else { + tnum = 0; + targs = mytargs; } - head = HeadOfTerm (tail); - tail = TailOfTerm (tail); - if (IsVarTerm (args) || !IsPairTerm (args)) - args = MkPairTerm (args, TermNil); format_base = format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char)); format_max = format_base+FORMAT_MAX_SIZE; if (format_ptr == NULL) { @@ -3785,723 +3753,359 @@ format(Term tail, Term args, int sno) } format_buf_size = FORMAT_MAX_SIZE; format_error = FALSE; - while (!IsVarTerm (head) && IsIntTerm (head)) - { - if (format_buf_size == -1) { - Yap_FreeAtomSpace(format_base); - return FALSE; + + while ((ch = *fptr++)) { + Term t = TermNil; + int has_repeats = FALSE; + Int repeats = 0; + + if (ch == '~') { + /* start command */ + ch = *fptr++; + if (ch == '*') { + ch = *fptr++; + has_repeats = TRUE; + if (targ > tnum) { + goto do_consistency_error; + } + repeats = fetch_index_from_args(targs[targ++]); + if (repeats == -1) + goto do_consistency_error; + } else if (ch == '`') { + /* next character is kept as code */ + repeats = *fptr++; + ch = *fptr++; + } else if (ch >= '0' && ch <= '9') { + has_repeats = TRUE; + repeats = 0; + while (ch >= '0' && ch <= '9') { + repeats = repeats*10+(ch-'0'); + ch = *fptr++; + } } - ch = IntOfTerm (head); - if (ch == '~') + switch (ch) { + case 'a': + /* print an atom */ + if (has_repeats || targ > tnum) + goto do_consistency_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsAtomTerm(t)) + goto do_type_atom_error; + Yap_plwrite (t, format_putc, Handle_vars_f|To_heap_f); + break; + case 'c': { - size_args = FALSE; - arg_size = 0; - ptr = tmp1; - *ptr++ = '%'; - if (IsVarTerm (tail = Deref (tail)) ) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,tail,"format/2"); - return FALSE; - } else if (!IsPairTerm (tail)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,tail,"format/2"); - return FALSE; - } - head = HeadOfTerm (tail); - tail = TailOfTerm (tail); - if (IsVarTerm (head)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,tail,"format/2"); - return FALSE; - } else if ( !IsIntTerm (head)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_INTEGER,tail,"format/2"); - return FALSE; - } else - ch = IntOfTerm (head); - if (ch == '*') - { - size_args = TRUE; - arg_size = GetArgSizeFromThirdArg (&ptr, &args); - if (format_error) { - Yap_FreeAtomSpace(format_base); - return FALSE; - } - if (IsVarTerm (tail = Deref (tail)) ) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,tail,"format/2"); - return FALSE; - } else if (!IsPairTerm (tail)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,tail,"format/2"); - return FALSE; - } - head = HeadOfTerm (tail); - tail = TailOfTerm (tail); - if (IsVarTerm (head)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,tail,"format/2"); - return FALSE; - } else if ( !IsIntTerm (head)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_INTEGER,tail,"format/2"); - return FALSE; - } else - ch = IntOfTerm (head); - } - else if (ch >= '0' && ch <= '9') - { - arg_size = ch - '0'; - size_args = TRUE; - ch = GetArgSizeFromChars (&ptr, &arg_size, &tail); - if (format_error) { - Yap_FreeAtomSpace(format_base); - return FALSE; - } - } - else if (ch == '`') - { - size_args = TRUE; - arg_size = GetArgSizeFromChar(&tail); - if (format_error) { - Yap_FreeAtomSpace(format_base); - return FALSE; - } - ch = 't'; - } - switch (ch) - { - case 'a': - if (size_args) { - Yap_FreeAtomSpace(format_base); - return FALSE; - } - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~a format/2"); - return FALSE; - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~a format/2"); - return FALSE; - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~a in format/2"); - return FALSE; - } else if (!IsAtomTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_ATOM,arghd,"~a in format/2"); - return FALSE; - } - Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f); - break; - case 'c': - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~c in format/2"); - return FALSE; - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~c in format/2"); - return FALSE; - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~c in format/2"); - return FALSE; - } else if (!IsIntTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_ATOM,arghd,"~a in format/2"); - return FALSE; - } else int2= IntOfTerm(arghd); - if (!size_args) - arg_size = 1; - for (i = 0; i < arg_size; i++) - format_putc(sno, int2); - break; - case 'e': - case 'E': - case 'f': - case 'g': - case 'G': - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~%d in format/2", ch); - return FALSE; - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~%d in format/2", ch); - return FALSE; - } - if (arg_size == 0 || arg_size > 6) - arg_size = 6; - *ptr++ = '.'; - *ptr++ = '0' + arg_size; - *ptr++ = ch; - *ptr = 0; - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm(arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~%c in format/2", ch); - return FALSE; - } else if (!IsNumTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_FLOAT,arghd,"~%c in format/2", ch); - return FALSE; - } - if (IsIntegerTerm(arghd)) { - float_tmp = IntegerOfTerm(arghd); + Int nch, i; + + if (targ > tnum) + goto do_consistency_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsIntegerTerm(t)) + goto do_type_int_error; + nch = IntegerOfTerm(t); + if (nch < 0) + goto do_domain_not_less_zero_error; + if (!has_repeats) + repeats = 1; + for (i = 0; i < repeats; i++) + format_putc(sno, nch); + break; + } + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': + { + Float fl; + char *ptr; + + if (targ > tnum) + goto do_consistency_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsNumTerm(t)) + goto do_type_number_error; + if (IsIntegerTerm(t)) { + fl = (Float)IntegerOfTerm(t); #ifdef USE_GMP - } else if (IsBigIntTerm(arghd)) { - float_tmp = mpz_get_d(Yap_BigIntOfTerm(arghd)); + } else if (IsBigIntTerm(t)) { + fl = mpz_get_d(Yap_BigIntOfTerm(t)); #endif - } else { - float_tmp = FloatOfTerm (arghd); - } - sprintf (tmp2, tmp1, float_tmp); - ptr = tmp2; - while ((ch = *ptr++) != 0) - format_putc(sno, ch); - break; - case 'd': - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~d format/2"); - return FALSE; - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~d format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~d in format/2"); - return(FALSE); - } else if (IsIntTerm (arghd)) { - int2 = IntOfTerm (arghd); - } else if (IsLongIntTerm (arghd)) { - int2 = LongIntOfTerm(arghd); - } else { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_INTEGER,arghd,"~d in format/2"); - return(FALSE); - } - if (!arg_size) { - Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f); - } else { - Int siz; - /* - * The guys at Quintus have probably - * read too much Cobol! - */ - if (int2 < 0) { - int2 = -int2; - format_putc(sno, (int) '-'); - } -#if SHORT_INTS - sprintf (tmp2, "%ld", int2); -#else - sprintf (tmp2, "%d", int2); -#endif - siz = strlen (tmp2); - { - char *ptr = tmp2; - if (siz <= arg_size) - format_putc(sno, (int) '0'); - else - while (siz > arg_size) - format_putc(sno, (int) *ptr++), --siz; - format_putc(sno, (int) '.'); - while (siz < arg_size) - format_putc(sno, (int) '0'), --arg_size; - while (*ptr) - format_putc(sno, (int) (*ptr++)); - } - } - break; - case 'D': - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~D in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~D in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~D in format/2"); - return(FALSE); - } else if (IsIntTerm (arghd)) { - int2 = IntOfTerm (arghd); - } else if (IsLongIntTerm (arghd)) { - int2 = LongIntOfTerm(arghd); - } else { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_INTEGER,arghd,"~D in format/2"); - return(FALSE); - } - { - Int siz, lsiz; - char *ptr = tmp2; + } else { + fl = FloatOfTerm(t); + } + if (!has_repeats) + repeats = 6; + tmp1[0] = '%'; + tmp1[1] = '.'; + ptr = tmp1+2; + sprintf(ptr,"%d",repeats); + while (*ptr) ptr++; + ptr[0] = ch; + ptr[1] = '\0'; + sprintf (tmp2, tmp1, fl); + ptr = tmp2; + while ((ch = *ptr++) != 0) + format_putc(sno, ch); + break; + case 'd': + case 'D': + /* print a decimal, using weird . stuff */ + if (targ > tnum) + goto do_consistency_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsIntegerTerm(t)) + goto do_type_int_error; + if (!has_repeats) { + Yap_plwrite (t, format_putc, Handle_vars_f|To_heap_f); + } else { + Int siz, dec = IntegerOfTerm(t), i, div = 1; - if (int2 < 0) - { - int2 = -int2; - format_putc(sno, (int) '-'); - } - /* - * The guys at Quintus have probably - * read too much Cobol! - */ -#if SHORT_INTS - sprintf (tmp2, "%ld", int2); -#else - sprintf (tmp2, "%d", int2); -#endif - siz = strlen (tmp2); - if ((lsiz = siz - arg_size) <= 0) - format_putc(sno, (int) '0'); + /* + * The guys at Quintus have probably + * read too much Cobol! + */ + if (dec < 0) { + dec = -dec; + format_putc(sno, (int) '-'); + } + i = dec; + siz = 0; + while (i > 0) { + siz++; + i /= 10; + div *= 10; + } + if (repeats > siz) { + format_putc(sno, (int) '.'); + while (repeats > siz) { + format_putc(sno, (int) '0'); + repeats--; + } + } else { + int output_done = FALSE; + while (siz > repeats) { + div /= 10; + if (ch == 'D'&& + (siz - repeats) % 3 == 0 && + output_done) + format_putc(sno, (int)','); + format_putc(sno, (int)((dec/div)+'0')); + output_done = TRUE; + siz--; + dec = dec%div; + } + format_putc(sno, (int) '.'); + } + Yap_plwrite (MkIntegerTerm(dec), format_putc, Handle_vars_f|To_heap_f); + break; + case 'r': + case 'R': + { + Int numb, radix, div = 1; + + /* print a decimal, using weird . stuff */ + if (targ > tnum) + goto do_consistency_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsIntegerTerm(t)) + goto do_type_int_error; + if (!has_repeats) + radix = 8; + else + radix = repeats; + if (radix > 36 || radix < 2) + goto do_domain_error_radix; + numb = IntegerOfTerm(t); + if (numb < 0) { + numb = -numb; + format_putc(sno, (int) '-'); + } + i = numb; + while (i > 0) { + i /= radix; + div *= radix; + } + div /= radix; + while (numb) { + Int dig = numb/div; + if (dig < 10) + format_putc(sno, (int)(dig+'0')); + else if (ch == 'r') + format_putc(sno, (int)((dig-10)+'a')); else - { - Int imod = lsiz % 3; - int output_done = FALSE; - - for (i = 0; i < lsiz; i++) - { - if (imod-- == 0) - { - if (output_done) - format_putc(sno, (int) ','); - imod = 2; - } - format_putc(sno, (int) (*ptr++)); - output_done = TRUE; - } - } - if (arg_size > 0) - format_putc(sno, (int) '.'); - while (lsiz < 0) - format_putc(sno, (int) '0'), ++lsiz; - while (*ptr) - format_putc(sno, (int) (*ptr++)); + format_putc(sno, (int)((dig-10)+'A')); + numb %= div; + div /= radix; } break; - case 'r': - { - Int radix = 8; - ptr = tmp2; - if (size_args) - radix = arg_size; - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~r in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~r in format/2"); - return(FALSE); - } - if (radix > 36 || radix < 2) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_RADIX,MkIntTerm(radix),"~r in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~r in format/2"); - return(FALSE); - } else if (IsIntTerm (arghd)) { - int2 = IntOfTerm (arghd); - } else if (IsLongIntTerm (arghd)) { - int2 = LongIntOfTerm(arghd); - } else { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_INTEGER,arghd,"~r in format/2"); - return(FALSE); - } - if (int2 < 0) - { - int2 *= -1; - format_putc(sno, (int) '-'); - } - else if (int2 == 0) - format_putc(sno, (int) '0'); - while (int2 != 0) - { - Int numb = int2 % radix; - if (numb >= 10) - numb += 'a' - 10; - else - numb += '0'; - *ptr++ = numb; - int2 = int2 / radix; - } - while (--ptr >= tmp2) - format_putc(sno, (int) *ptr); + } + case 's': + if (targ > tnum) + goto do_consistency_error; + t = targs[targ++]; + if (!format_print_str (sno, repeats, has_repeats, t)) { + goto do_default_error; + } + break; + case 'i': + if (targ > tnum || has_repeats) + goto do_consistency_error; + targ++; + break; + case 'k': + if (targ > tnum || has_repeats) + goto do_consistency_error; + t = targs[targ++]; + Yap_plwrite (t, format_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f ); + break; + case 'p': + if (targ > tnum || has_repeats) + goto do_consistency_error; + t = targs[targ++]; + *--ASP = MkIntTerm(0); + { + long sl = Yap_InitSlot(args); + Yap_plwrite(t, format_putc, Handle_vars_f|Use_portray_f|To_heap_f); + args = Yap_GetFromSlot(sl); + Yap_RecoverSlots(1); + } + if (EX != 0L) { + Term ball = EX; + EX = 0L; + if (tnum <= 8) + targs = NULL; + if (IsAtomTerm(tail)) { + fstr = NULL; } - break; - case 'R': - { - Int radix = 8; - ptr = tmp2; - if (size_args) - radix = arg_size; - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~R in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~R in format/2"); - return(FALSE); - } - if (radix > 36 || radix < 2) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_RADIX,MkIntTerm(radix),"~R in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~R in format/2"); - return(FALSE); - } else if (IsIntTerm (arghd)) { - int2 = IntOfTerm (arghd); - } else if (IsLongIntTerm (arghd)) { - int2 = LongIntOfTerm(arghd); - } else { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_INTEGER,arghd,"~R in format/2"); - return(FALSE); - } - if (int2 < 0) - { - int2 *= -1; - format_putc(sno, (int) '-'); - } - else if (int2 == 0) - format_putc(sno, (int) '0'); - while (int2 != 0) - { - Int numb = int2 % radix; - if (numb >= 10) - numb += 'A' - 10; - else - numb += '0'; - *ptr++ = numb; - int2 = int2 / radix; - } - while (--ptr >= tmp2) - format_putc(sno, (int) *ptr); - } - break; - case 's': - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~s in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~s in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - if (IsVarTerm (arghd)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,arghd,"~s in format/2"); - return(FALSE); - } else if (!IsPairTerm (arghd) && arghd != TermNil) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,arghd,"~s in format/2"); - return(FALSE); - } - format_print_str (sno, arg_size, arghd); - if (format_error) { - Yap_FreeAtomSpace(format_base); - return(FALSE); - } - break; - case 'i': - if (size_args) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_NOT_ZERO,MkIntTerm(size_args), - "~i in format/2"); - return(FALSE); - } - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~i in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~i in format/2"); - return(FALSE); - } - args = TailOfTerm (args); - break; - case 'k': - if (size_args) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_NOT_ZERO,MkIntTerm(size_args), - "~k in format/2"); - return(FALSE); - } - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~k in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~k in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - Yap_plwrite (arghd, format_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f ); - break; - case 'p': - if (size_args) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_NOT_ZERO,MkIntTerm(size_args), - "~p in format/2"); - return(FALSE); - } - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~p in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~p in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - *--ASP = MkIntTerm(0); - { - long sl = Yap_InitSlot(args); - Yap_plwrite(arghd, format_putc, Handle_vars_f|Use_portray_f|To_heap_f); - args = Yap_GetFromSlot(sl); - Yap_RecoverSlots(1); - } - if (EX != 0L) { - Term ball = EX; - EX = 0L; - Yap_FreeAtomSpace(format_base); - Yap_JumpToEnv(ball); - return(FALSE); - } - break; - case 'q': - if (size_args) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_NOT_ZERO,MkIntTerm(size_args), - "~q in format/2"); - return(FALSE); - } - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~q in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~q in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - Yap_plwrite (arghd, format_putc, Handle_vars_f|Quote_illegal_f|To_heap_f); - break; - case 'w': - if (size_args) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_NOT_ZERO,MkIntTerm(size_args), - "bad arguments for ~w in format/2"); - return(FALSE); - } - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~w in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~w in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f); - break; - case '~': - if (size_args) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_NOT_ZERO,MkIntTerm(size_args), - "~~ in format/2"); - return(FALSE); - } - format_putc(sno, (int) '~'); - break; - case 'n': - if (!size_args) - arg_size = 1; - for (i = 0; i < arg_size; i++) + format_clean_up(format_base, fstr, targs); + Yap_JumpToEnv(ball); + } + ASP++; + break; + case 'q': + if (targ > tnum || has_repeats) + goto do_consistency_error; + t = targs[targ++]; + Yap_plwrite (t, format_putc, Handle_vars_f|Quote_illegal_f|To_heap_f); + break; + case 'w': + if (targ > tnum || has_repeats) + goto do_consistency_error; + t = targs[targ++]; + Yap_plwrite (t, format_putc, Handle_vars_f|To_heap_f); + break; + case '~': + if (has_repeats) + goto do_consistency_error; + format_putc(sno, (int) '~'); + break; + case 'n': + if (!has_repeats) + repeats = 1; + while (repeats--) { + format_putc(sno, (int) '\n'); + } + column_boundary = 0; + pad_max = pad_entries; + break; + case 'N': + if (!has_repeats) + has_repeats = 1; + if (Stream[sno].linepos != 0) { + format_putc(sno, (int) '\n'); + column_boundary = 0; + pad_max = pad_entries; + } + if (repeats > 1) { + Int i; + for (i = 1; i < repeats; i++) format_putc(sno, (int) '\n'); column_boundary = 0; pad_max = pad_entries; - break; - case 'N': - if (!size_args) { - arg_size = 1; - } - if (Stream[sno].linepos != 0) - { - format_putc(sno, (int) '\n'); - column_boundary = 0; - pad_max = pad_entries; - } - if (arg_size > 1) { - for (i = 1; i < arg_size; i++) - format_putc(sno, (int) '\n'); - column_boundary = 0; - pad_max = pad_entries; - } - break; - /* padding */ - case '|': - if (size_args) { - fill_pads(arg_size-(format_ptr-format_base)); - } - pad_max = pad_entries; - column_boundary = arg_size; - break; - case '+': - if (size_args) { - fill_pads((arg_size+column_boundary)-(format_ptr-format_base)); - } else { - fill_pads(8); - } - pad_max = pad_entries; - column_boundary = arg_size+column_boundary; - break; - case 't': - if (!size_args) - arg_size = ' '; - pad_max->pad = arg_size; - pad_max->pos = format_ptr-format_base; - pad_max++; - break; -#if DEBUG - case 'T': - { - Int radix = 16; - unsigned *uint_ptr; - - ptr = tmp2; - if (size_args) - radix = arg_size; - if (IsVarTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,args,"~T in format/2"); - return(FALSE); - } else if (!IsPairTerm (args)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,args,"~T in format/2"); - return(FALSE); - } - if (radix > 36 || radix < 2) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_RADIX,MkIntTerm(radix),"~T in format/2"); - return(FALSE); - } - arghd = HeadOfTerm (args); - args = TailOfTerm (args); - - uint_ptr = (unsigned *)&arghd; - for (i = 0; i < sizeof (arghd) / sizeof (unsigned); ++i) { - if (uint_ptr[i] == 0) - format_putc(sno, (int) '0'); - while (uint_ptr[i] != 0) { - Int numb = uint_ptr[i] % radix; - if (numb >= 10) - numb += 'a' - 10; - else - numb += '0'; - *ptr++ = numb; - uint_ptr[i] = uint_ptr[i] / radix; - } - while (--ptr >= tmp2) - format_putc(sno, (int) *ptr); - } - } - break; -#endif /* DEBUG */ - default: - Yap_FreeAtomSpace(format_base); - return (FALSE); } - } - else if (ch == '\\') - { - if (HeadOfTerm (tail) == MkIntTerm ('c')) - { - tail = TailOfTerm (tail); - if (IsVarTerm (tail)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(INSTANTIATION_ERROR,tail,"format/2"); - return(FALSE); - } else if (!IsPairTerm (tail)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(TYPE_ERROR_LIST,tail,"format/2"); - return(FALSE); - } - head = HeadOfTerm (tail); - tail = TailOfTerm (tail); - if (head != MkIntTerm (10)) { - Yap_FreeAtomSpace(format_base); - Yap_Error(DOMAIN_ERROR_NOT_NL,head, - "format/2"); - return(FALSE); - } + break; + /* padding */ + case '|': + if (has_repeats) { + fill_pads(has_repeats-(format_ptr-format_base)); } - else - format_putc(sno, (int) '\\'); + pad_max = pad_entries; + column_boundary = has_repeats; + break; + case '+': + if (has_repeats) { + fill_pads((has_repeats+column_boundary)-(format_ptr-format_base)); + } else { + fill_pads(8); + } + pad_max = pad_entries; + column_boundary = has_repeats+column_boundary; + break; + case 't': + if (!has_repeats) + pad_max->pad = ' '; + else + pad_max->pad = fptr[-2]; + pad_max->pos = format_ptr-format_base; + pad_max++; + break; + do_instantiation_error: + Yap_Error(INSTANTIATION_ERROR, t, "format/2"); + goto do_default_error; + do_type_int_error: + Yap_Error(TYPE_ERROR_INTEGER, t, "format/2"); + goto do_default_error; + do_type_number_error: + Yap_Error(TYPE_ERROR_NUMBER, t, "format/2"); + goto do_default_error; + do_type_atom_error: + Yap_Error(TYPE_ERROR_ATOM, t, "format/2"); + goto do_default_error; + do_domain_not_less_zero_error: + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "format/2"); + goto do_default_error; + do_domain_error_radix: + Yap_Error(DOMAIN_ERROR_RADIX, t, "format/2"); + goto do_default_error; + do_consistency_error: + default: + Yap_Error(CONSISTENCY_ERROR, t, "format/2"); + do_default_error: + if (tnum <= 8) + targs = NULL; + if (IsAtomTerm(tail)) { + fstr = NULL; + } + format_clean_up(format_base, fstr, targs); + return FALSE; + } } - else - format_putc(sno, ch); - if (IsVarTerm (tail) || !IsPairTerm (tail)) { - for (ptr = format_base; ptr < format_ptr; ptr++) { - Stream[sno].stream_putc(sno, *ptr); - } - Yap_FreeAtomSpace(format_base); - return(TRUE); + /* ok, now we should have a command */ } - head = HeadOfTerm (tail); - tail = TailOfTerm (tail); + } else { + format_putc(sno, ch); } - if (format_buf_size == -1) { - Yap_FreeAtomSpace(format_base); - return(FALSE); } - for (ptr = format_base; ptr < format_ptr; ptr++) { - Stream[sno].stream_putc(sno, *ptr); + for (fptr = format_base; fptr < format_ptr; fptr++) { + Stream[sno].stream_putc(sno, *fptr); } - Yap_FreeAtomSpace(format_base); + if (IsAtomTerm(tail)) { + fstr = NULL; + } + if (tnum <= 8) + targs = NULL; + format_clean_up(format_base, fstr, targs); return (TRUE); } diff --git a/C/parser.c b/C/parser.c index c4644173e..6082ff270 100644 --- a/C/parser.c +++ b/C/parser.c @@ -330,7 +330,10 @@ ParseArgs(Atom a, JMPBUFF *FailBuff) else t = Yap_MkApplTerm(Yap_MkFunctor(a, nargs), nargs, p); #else - t = Yap_MkApplTerm(Yap_MkFunctor(a, nargs), nargs, p); + 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 */ checkfor((Term) ')', FailBuff); diff --git a/C/write.c b/C/write.c index e658e5062..52d46326d 100644 --- a/C/write.c +++ b/C/write.c @@ -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); diff --git a/H/Heap.h b/H/Heap.h index 1b4f8a968..339edaee6 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -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 diff --git a/H/rheap.h b/H/rheap.h index 23d852230..83c1850d7 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -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); diff --git a/m4/Yap.h.m4 b/m4/Yap.h.m4 index 783b02e36..2559770bc 100644 --- a/m4/Yap.h.m4 +++ b/m4/Yap.h.m4 @@ -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, diff --git a/pl/boot.yap b/pl/boot.yap index 199bf6425..66d51ce5f 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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, for exit)", []), + '$format'(user_error,'Action (\";\" for more choices, 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 ) diff --git a/pl/errors.yap b/pl/errors.yap index 45b49f205..417e2c6c1 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -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'(')') :- !, diff --git a/pl/protect.yap b/pl/protect.yap index c0e00e0d8..d3a35b186 100644 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -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.