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

numbers

Browse Source 
docs
This commit is contained in:
Vítor Santos Costa 2018-05-16 00:00:12 +01:00
parent 8a817a1dc4
commit 67a88a196d
11 changed files with 81 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
C/atomic.c
View File

@ -699,7 +699,6 @@ restart_aux:
static Int number_chars(USES_REGS1) {
Term t1;
int l = push_text_stack();
restart_aux:
t1 = Deref(ARG1);
if (IsNumTerm(t1)) {
Term t2 = Deref(ARG2);
@ -714,26 +713,21 @@ restart_aux:
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_ListToNumber(t PASS_REGS);
if (tf) {
if (tf)
{
pop_text_stack(l);
return Yap_unify(ARG1, tf);
}
}
} else if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
}
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError("number_chars/2")) {
goto restart_aux;
}
{
pop_text_stack(l);
LOCAL_ActiveError->errorRawTerm = 0;
Yap_ThrowExistingError();
return false;
}
return true;
}
/** @pred number_atom(? _I_,? _A_)
/** @pred number_atom(? _I_,? _A_){te

6
C/errors.c
View File

@ -622,7 +622,7 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno,
} else {
Yap_Error__(true, file, function, lineno, type, where);
}
if (LOCAL_RestartEnv) {
if (LOCAL_RestartEnv && !LOCAL_delay) {
Yap_RestartYap(5);
}
Yap_exit(5);
@ -793,7 +793,6 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
#endif
if (LOCAL_ActiveError->errorNo == SYNTAX_ERROR) {
LOCAL_ActiveError->errorClass = SYNTAX_ERROR_CLASS;
return P;
} else if (LOCAL_ActiveError->errorNo == SYNTAX_ERROR_NUMBER) {
LOCAL_ActiveError->errorClass = SYNTAX_ERROR_CLASS;
LOCAL_ActiveError->errorNo = SYNTAX_ERROR;
@ -860,7 +859,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
#endif
/* wait if we we are in user code,
it's up to her to decide */
if (LOCAL_delay)
return P;
if (LOCAL_DoingUndefp) {
LOCAL_Signals = 0;
Yap_PrintWarning(MkErrorTerm(Yap_GetException()));

21
C/scanner.c
View File

@ -874,7 +874,7 @@ do_switch:
static int num_send_error_message(char s[]) {
CACHE_REGS
LOCAL_ErrorMessage = s;
return TermNil;
return MkStringTerm(s);
}
#define number_overflow() \
@ -921,7 +921,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) {
}
if (ch == '\'') {
if (base > 36) {
return num_send_error_message("Admissible bases are 0..36");
Yap_ThrowError(SYNTAX_ERROR, MkIntegerTerm(base), "Admissible bases are 0..36");
}
might_be_float = FALSE;
if (--left == 0)
@ -969,8 +969,9 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) {
*sp++ = ch;
ch = getchr(st);
if (!my_isxdigit(ch, 'F', 'f')) {
Yap_syntax_error(NULL, st-GLOBAL_Stream);
Yap_ThrowError(SYNTAX_ERROR, TermNil, "empty hexadecimal number 0x%C",ch) ;
Term t = ( Yap_local.ActiveError->errorRawTerm ? Yap_local.ActiveError->errorRawTerm : MkIntegerTerm(ch) );
Yap_local.ActiveError->errorRawTerm = 0;
Yap_ThrowError(SYNTAX_ERROR, t, "invalid hexadecimal digit 0x%C",ch) ;
return 0;
}
while (my_isxdigit(ch, 'F', 'f')) {
@ -993,8 +994,9 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) {
base = 8;
ch = getchr(st);
if (ch < '0' || ch > '7') {
Yap_syntax_error(NULL, st-GLOBAL_Stream);
Yap_ThrowError(SYNTAX_ERROR, TermNil, "empty octal number 0b%C", ch) ;
Term t = ( Yap_local.ActiveError->errorRawTerm ? Yap_local.ActiveError->errorRawTerm : MkIntegerTerm(ch) );
Yap_local.ActiveError->errorRawTerm = 0;
Yap_ThrowError(SYNTAX_ERROR, t, "invalid octal digit 0x%C",ch) ;
return 0;
}
} else if (ch == 'b' && base == 0) {
@ -1002,8 +1004,9 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *st, int sign) {
base = 2;
ch = getchr(st);
if (ch < '0' || ch > '1') {
Yap_syntax_error(NULL, st-GLOBAL_Stream);
Yap_ThrowError(SYNTAX_ERROR, TermNil, "empty binary 0b%C", ch) ;
Term t = ( Yap_local.ActiveError->errorRawTerm ? Yap_local.ActiveError->errorRawTerm : MkIntegerTerm(ch) );
Yap_local.ActiveError->errorRawTerm = 0;
Yap_ThrowError(SYNTAX_ERROR, t, "invalid binary digit 0x%C",ch) ;
return 0;
}
@ -1175,7 +1178,9 @@ Term Yap_scan_num(StreamDesc *inp, bool error_on) {
while (isspace(ch = getchr(inp)))
;
#endif
if (ch == EOF)
return out;
return 0;
}
#define CHECK_SPACE() \

60
C/text.c
View File

@ -419,6 +419,7 @@ static yap_error_number gen_type_error(int flags) {
unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
int lvl = push_text_stack();
/* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
if (!(inp->type & YAP_STRING_TERM)) {
@ -448,23 +449,24 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
if (RepAtom(at)->UStrOfAE[0] == 0) {
unsigned char *o = Malloc(4);
memset(o, 0, 4);
return o;
return pop_output_text_stack(lvl, o);
}
if (inp->type & YAP_STRING_WITH_BUFFER)
return at->UStrOfAE;
size_t sz = strlen(at->StrOfAE);
inp->type |= YAP_STRING_IN_TMP;
char *o = BaseMalloc(sz + 1);
void *o = Malloc(sz + 1);
strcpy(o, at->StrOfAE);
return (unsigned char *)o;
return pop_output_text_stack(lvl, o);
}
if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
// this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t);
const char *s = StringOfTerm(inp->val.t);
if (s[0] == 0) {
char *o = BaseMalloc(4);
char *o = Malloc(4);
memset(o, 0, 4);
return pop_output_text_stack(lvl, o);
}
if (inp->type & YAP_STRING_WITH_BUFFER)
return (unsigned char *)UStringOfTerm(inp->val.t);
@ -472,7 +474,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
size_t sz = strlen(s);
char *o = BaseMalloc(sz + 1);
strcpy(o, s);
return (unsigned char *)o;
return pop_output_text_stack(lvl, o);
}
if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES | YAP_STRING_ATOMS)) &&
@ -495,12 +497,12 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
// ASCII, so both LATIN1 and UTF-8
// Yap_DebugPlWriteln(inp->val.t);
char *s;
s = BaseMalloc(2 * MaxTmp(PASS_REGS1));
s = Malloc(2 * MaxTmp(PASS_REGS1));
if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
IntegerOfTerm(inp->val.t)) < 0) {
AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char);
}
return (unsigned char *)s;
return pop_output_text_stack(lvl, s);
}
if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
char *s;
@ -508,25 +510,26 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) {
return NULL;
}
return (unsigned char *)s;
return pop_output_text_stack(lvl, s);
}
#if USE_GMP
if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
// Yap_DebugPlWriteln(inp->val.t);
char *s;
s = BaseMalloc(MaxTmp());
s = Malloc(MaxTmp());
if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) {
AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
}
return inp->val.uc = (unsigned char *)s;
return inp->val.uc = pop_output_text_stack(lvl, s);
}
#endif
if (inp->type & YAP_STRING_TERM) {
// Yap_DebugPlWriteln(inp->val.t);
char *s = (char *) Yap_TermToBuffer(inp->val.t, ENC_ISO_UTF8, 0);
return inp->val.uc = (unsigned char *)s;
return inp->val.uc = pop_output_text_stack(lvl, s);
}
if (inp->type & YAP_STRING_CHARS) {
pop_text_stack(lvl);
if (inp->enc == ENC_ISO_LATIN1) {
return latin2utf8(inp);
} else if (inp->enc == ENC_ISO_ASCII) {
@ -535,6 +538,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
return inp->val.uc;
}
}
pop_text_stack(lvl);
if (inp->type & YAP_STRING_WCHARS) {
// printf("%S\n",inp->val.w);
return wchar2utf8(inp);
@ -755,25 +759,10 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out USES_REGS) {
static Term write_number(unsigned char *s, seq_tv_t *out,
bool error_on USES_REGS) {
Term t;
yap_error_descriptor_t new_error;
bool mdnew = true;
if (!error_on) {
sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
LOCAL_RestartEnv = &signew;
Yap_pushErrorContext(error_on, &new_error);
if /* top &&*/( sigsetjmp(signew, 1) == 0) {
LOCAL_delay = !error_on;
t = Yap_StringToNumberTerm((char *)s, &out->enc,error_on);
} else {
Yap_ResetException(LOCAL_ActiveError);
t = 0;
}
Yap_popErrorContext(mdnew, true);
LOCAL_RestartEnv = sighold;
} else {
t = Yap_StringToNumberTerm((char *)s, &out->enc,error_on);
}
return t;
LOCAL_delay = false;
return t;
}
static Term string_to_term(void *s, seq_tv_t *out USES_REGS) {
@ -791,6 +780,9 @@ bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) {
if (out->type == 0) {
return true;
}
if (LOCAL_Error_TYPE) {
return false;
}
if (out->type & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) {
if ((out->val.t = write_number(
@ -1029,16 +1021,19 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
//
bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
seq_tv_t outv[] USES_REGS) {
int lvl = push_text_stack();
const unsigned char *buf;
size_t b_l, u_l;
inp->type |= YAP_STRING_IN_TMP;
buf = Yap_readText(inp PASS_REGS);
if (!buf) {
pop_text_stack(lvl);
return false;
}
b_l = strlen((char *)buf);
if (b_l == 0) {
pop_text_stack(lvl);
return false;
}
u_l = strlen_utf8(buf);
@ -1054,6 +1049,7 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
}
b_l0 = strlen((const char *)buf0);
if (memcmp(buf, buf0, b_l0) != 0) {
pop_text_stack(lvl);
return false;
}
u_l0 = strlen_utf8(buf0);
@ -1063,6 +1059,7 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
buf1 = slice(u_l0, u_l, buf PASS_REGS);
b_l1 = strlen((const char *)buf1);
bool rc = write_Text(buf1, outv + 1 PASS_REGS);
pop_text_stack(lvl);
if (!rc) {
return false;
}
@ -1070,6 +1067,7 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
} else /* if (outv[1].val.t) */ {
buf1 = Yap_readText(outv + 1 PASS_REGS);
if (!buf1) {
pop_text_stack(lvl);
return false;
}
b_l1 = strlen((char *)buf1);
@ -1078,10 +1076,12 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
u_l0 = u_l - u_l1;
if (memcmp(skip_utf8((const unsigned char *)buf, b_l0), buf1, b_l1) !=
0) {
pop_text_stack(lvl);
return false;
}
buf0 = slice(0, u_l0, buf PASS_REGS);
bool rc = write_Text(buf0, outv PASS_REGS);
pop_text_stack(lvl);
return rc;
}
}
@ -1096,9 +1096,11 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
break;
void *bufi = slice(next, cuts[i], buf PASS_REGS);
if (!write_Text(bufi, outv + i PASS_REGS)) {
pop_text_stack(lvl);
return false;
}
}
pop_text_stack(lvl);
return true;
}

2
C/unify_absmi_insts.h
View File

@ -2,6 +2,8 @@
* Get Instructions *
\************************************************************************/
#include <amiops.h>
#ifdef INDENT_CODE
{
{

1
H/YapText.h
View File

@ -1039,6 +1039,7 @@ static inline Term Yap_ListOfCodesToNumber(Term t0 USES_REGS) {
static inline Term Yap_ListOfCodesToString(Term t0 USES_REGS) {
seq_tv_t inp, out;
inp.val.t = t0;
inp.type = YAP_STRING_CODES;
out.val.uc = NULL;

5
H/amiops.h
View File

@ -20,6 +20,9 @@
static char SccsId[] = "%W% %G%";
#endif /* SCCS */
#ifndef AMIOPS_H
#define AMIOPS_H 1
#include "inline-only.h"
#define IsArrayReference(a) ((a)->array_access_func == FunctorArrayAccess)
@ -567,3 +570,5 @@ static inline int do_cut(int i) {
#define cut_succeed() return do_cut(TRUE)
#define cut_fail() return do_cut(FALSE)
#endif

1
H/locals.h
View File

@ -196,6 +196,7 @@ LOCAL(ADDR, TrailTop);
/* error handling info, designed to be easy to pass to the foreign world */
LOCAL_INIT(yap_error_descriptor_t *, ActiveError, calloc(sizeof(yap_error_descriptor_t), 1));
LOCAL_INIT(yap_error_descriptor_t *, CommittedError, calloc(sizeof(yap_error_descriptor_t), 1));
LOCAL_INIT(bool, delay, false);
/// pointer to an exception term, from throw
LOCAL(jmp_buf, IOBotch);

3
os/chartypes.c
View File

@ -81,7 +81,6 @@ static Int p_change_type_of_char(USES_REGS1);
Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, bool error_on) {
CACHE_REGS
int sno;
Term t;
int i = push_text_stack();
sno = Yap_open_buf_read_stream(s, strlen(s), encp, MEM_BUF_USER);
@ -96,7 +95,7 @@ Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, bool error_on) {
s++;
#endif
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
t = Yap_scan_num(GLOBAL_Stream + sno, error_on);
Term t = Yap_scan_num(GLOBAL_Stream + sno, error_on);
Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
pop_text_stack(i);

16
os/readterm.c
View File

@ -322,6 +322,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) {
Term tf[4];
Term tm;
Term *tailp = tf + 3;
CELL *Hi = HR;
TokEntry *tok = LOCAL_tokptr;
Int cline = tok->TokLine;
@ -330,13 +331,22 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos) {
Int errpos = errtok->TokPos;
UInt diff = 0;
startline = MkIntegerTerm(cline);
Yap_local.ActiveError->errorNo = SYNTAX_ERROR;
Yap_local.ActiveError->prologPredFirstLine = cline;
Yap_local.ActiveError->prologPredLastLine = cline;
endline = MkIntegerTerm(cline);
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokLine);
if (LOCAL_ErrorMessage)
Yap_local.ActiveError->prologPredLine = errtok->TokLine;
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = "syntax error";
}
tm = MkStringTerm(LOCAL_ErrorMessage);
else {
tm = MkStringTerm("syntax error");
{
char *s = malloc( strlen(LOCAL_ErrorMessage)+1);
strcpy(s,LOCAL_ErrorMessage );
Yap_local.ActiveError->errorMsg = s;
}
if (GLOBAL_Stream[sno].status & Seekable_Stream_f) {
if (errpos && newpos >= 0) {

7
pl/boot.yap
View File

@ -212,16 +212,17 @@ print_message(L,E) :-
'$command'(C,VL,Pos,Con) :-
current_prolog_flag(strict_iso, true), !, /* strict_iso on */
'$yap_strip_module'(C, EM, EG),
'$execute_command'(EM,EG,VL,Pos,Con,_Source).
'$execute_command'(EG,EM,VL,Pos,Con,_Source).
'$command'(C,VL,Pos,Con) :-
( (Con = top ; var(C) ; C = [_|_]) ->
'$yap_strip_module'(C, EM, EG),
writeln(EM),
'$execute_command'(EG,EM,VL,Pos,Con,C) ;
% do term expansion
'$expand_term'(C, Con, EC),
'$yap_strip_module'(EC, EM, EG),
'$yap_strip_module'(EC, EM2, EG2),
% execute a list of commands
'$execute_commands'(EG,EM,VL,Pos,Con,_Source)
'$execute_commands'(EG2,EM2,VL,Pos,Con,_Source)
),
% succeed only if the *original* was at end of file.
C == end_of_file.