/*-------------------------------------------------------------------------*
* PL_LOOKUP_OPER *
* *
*-------------------------------------------------------------------------*/
OperInf *
Pl_Lookup_Oper(int atom_op, int type)
{
if (!Check_Oper(atom_op, type))
return NULL;
return (OperInf *) Pl_Hash_Find(pl_oper_tbl, Make_Oper_Key(atom_op, type));
}
/*-------------------------------------------------------------------------*
* PL_ATOM_PROPERTY_6 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Atom_Property_6(WamWord atom_word,
WamWord prefix_op_word, WamWord infix_op_word,
WamWord postfix_op_word,
WamWord needs_quote_word, WamWord needs_scan_word)
{
WamWord word, tag_mask;
int atom;
DEREF(atom_word, word, tag_mask);
atom = UnTag_ATM(word);
Pl_Get_Integer(Check_Oper(atom, PREFIX) != 0, prefix_op_word);
Pl_Get_Integer(Check_Oper(atom, INFIX) != 0, infix_op_word);
Pl_Get_Integer(Check_Oper(atom, POSTFIX) != 0, postfix_op_word);
Pl_Get_Integer(pl_atom_tbl[atom].prop.needs_quote, needs_quote_word);
Pl_Get_Integer(pl_atom_tbl[atom].prop.needs_scan, needs_scan_word);
}
/*-------------------------------------------------------------------------*
* SCAN_NUMBER *
* *
*-------------------------------------------------------------------------*/
static void
Scan_Number(StmInf *pstm, Bool integer_only)
{
int lg;
int radix;
char *p, *f;
int c_orig0;
/* at entry: c is a digit */
p = pl_token.name;
do
{
*p++ = c;
Read_Next_Char(pstm, TRUE);
}
while (c_type == DI);
lg = p - pl_token.name;
if (!integer_only && /* float if . and digit */
c == '.' && isdigit(Pl_Scan_Peek_Char(pstm, TRUE)))
goto is_a_float;
/* integer number */
pl_token.type = TOKEN_INTEGER;
*p = '\0';
/* if case of an underflow/overflow strtol() returns LONG_MIN/LONG_MAX and
* sets errno to ERANGE. We dont test it because LONG_MIN is < INT_LOWEST_VALUE
* and LONG_MAX is > INT_GREATEST_VALUE. We will detect it at return from
* this function.
*/
pl_token.int_num = Str_To_PlLong(pl_token.name, &p, 10);
if (lg != 1 || pl_token.int_num != 0 || strchr("'box", c) == NULL)
goto push_back;
if (c == '\'') /* 0'<character> */
{
c = Scan_Quoted_Char(pstm, TRUE, '\'', FALSE);
if (c == -1) /* <character> is ' */
{
/* STRICT ISO does not allow 0'' one should write 0''' or 0'\' */
if (Flag_Value(strict_iso))
{
/* do not emit an error since 0'' is valid if '' is a postif/infix op
* (this is the only case) - simply return the integer 0
*/
#if 1
if (Check_Oper(pl_atom_void, INFIX) || Check_Oper(pl_atom_void, POSTFIX))
{
Pl_Stream_Ungetc('\'', pstm); /* push back last ' */
Pl_Stream_Ungetc('\'', pstm); /* push back first ' */
return;
}
#endif
pl_token.line = pstm->line_count + 1;
pl_token.col = pstm->line_pos + 1;
err_msg = "quote character expected here";
return;
}
else
c = '\'';
}
if (c < 0) /* \ newline EOF newline tab other error */
{
Unget_Last_Char;
pl_token.type = TOKEN_FULL_STOP; /* to stop immediately Pl_Recover_After_Error */
pl_token.line = pstm->line_count + 1;
pl_token.col = pstm->line_pos + 1;
err_msg = "character expected here";
}
pl_token.int_num = c;
return;
}
radix = (c == 'b') ? (f = "01", 2) :
(c == 'o') ? (f = "01234567", 8)
: (f = "0123456789abcdefABCDEF", 16);
p = pl_token.name;
Read_Next_Char(pstm, TRUE);
while (strchr(f, c) != NULL)
{
*p++ = c;
Read_Next_Char(pstm, TRUE);
}
*p = '\0';
pl_token.int_num = Str_To_PlLong(pl_token.name, &p, radix);
goto push_back;
is_a_float: /* float number */
pl_token.type = TOKEN_FLOAT;
*p++ = '.';
Read_Next_Char(pstm, TRUE);
while (c_type == DI)
{
*p++ = c;
Read_Next_Char(pstm, TRUE);
}
if (c == 'e' || c == 'E')
{
c_orig0 = c_orig;
Read_Next_Char(pstm, TRUE);
if (!(c_type == DI || ((c == '+' || c == '-') &&
isdigit(Pl_Scan_Peek_Char(pstm, TRUE)))))
{
Unget_Last_Char;
c_orig = c_orig0;
goto end_float;
}
*p++ = 'e';
*p++ = c;
Read_Next_Char(pstm, TRUE);
while (c_type == DI)
{
*p++ = c;
Read_Next_Char(pstm, TRUE);
}
}
end_float:
*p = '\0';
sscanf(pl_token.name, "%lf", &pl_token.float_num);
push_back:
Unget_Last_Char;
}
