/*-------------------------------------------------------------------------*
* PL_WRITE_A_FULL_STOP *
* *
*-------------------------------------------------------------------------*/
void
Pl_Write_A_Full_Stop(StmInf *pstm)
{
pstm_o = pstm;
if (pl_last_writing == W_NUMBER_0 || pl_last_writing == W_NUMBER)
pl_last_writing = W_NOTHING;
Out_Char('.');
Out_Char('\n');
}
// Chars_Main LOCAL PROCEDURES
//
void Chars_Main()
{
// VARIABLES
System_INTEGER Chars_Main_i; // 0
System_CHAR Chars_Main_ch; // 1
Chars_Main__T_1 Chars_Main_str; // 2
Chars_Main__T_3 Chars_Main__V_5; // 3 // TMP
System_BOOLEAN Chars_Main__V_10; // 4 // TMP
System_CHAR Chars_Main__V_11; // 5 // TMP
System_BOOLEAN Chars_Main__V_14; // 6 // TMP
Chars_Main__T_26 Chars_Main__V_16; // 7 // TMP
Chars_Main__T_27 Chars_Main__V_17; // 8 // TMP
System_INTEGER Chars_Main__V_19; // 9 // TMP
Chars_Main__T_28 Chars_Main__V_20; // 10 // TMP
Chars_Main__T_23 Chars_Main__V_25; // 11 // TMP
// VAR INIT
Chars_Main__T_1* _tmp_31;
Chars_Main__T_3* _tmp_33;
Chars_Main__T_23* _tmp_42;
_tmp_31 = &(Chars_Main_str);
_tmp_31->lenght = 256;
_tmp_33 = &(Chars_Main__V_5);
_tmp_33->lenght = 15;
_tmp_42 = &(Chars_Main__V_25);
_tmp_42->lenght = 9;
// OPERATORS
__Assign_STR((System_String*)&Chars_Main__V_5, (char*)Chars_Main__C_2);
Out_Str((System_String*)&Chars_Main__V_5);
__Assign_INT(Chars_Main_i, 0);
Chars_Main__L_7: ;
__Less_INT(Chars_Main__V_10, Chars_Main_i, 255);
if(Chars_Main__V_10 == false) goto Chars_Main__L_8;
Chars_Main__V_11 = In_Char();
__Assign_CHAR(Chars_Main_ch, Chars_Main__V_11);
__Eq_CHAR(Chars_Main__V_14, Chars_Main_ch, '\r');
if(Chars_Main__V_14 == false) goto Chars_Main__L_15;
goto Chars_Main__L_8;
goto Chars_Main__L_12;
Chars_Main__L_15: ;
Chars_Main__L_12: ;
Chars_Main__V_16 = &(Chars_Main_str.data[Chars_Main_i]);
__Assign_CHAR((*Chars_Main__V_16), Chars_Main_ch);
Chars_Main__V_17 = &(Chars_Main_str.data[Chars_Main_i]);
Out_Char((*Chars_Main__V_17));
__Add_INT(Chars_Main__V_19, Chars_Main_i, 1);
__Assign_INT(Chars_Main_i, Chars_Main__V_19);
goto Chars_Main__L_7;
Chars_Main__L_8: ;
Chars_Main__V_20 = &(Chars_Main_str.data[Chars_Main_i]);
__Assign_CHAR((*Chars_Main__V_20), '\0');
Out_Ln();
__Assign_STR((System_String*)&Chars_Main__V_25, (char*)Chars_Main__C_22);
Out_Str((System_String*)&Chars_Main__V_25);
Out_Str((System_String*)&Chars_Main_str);
Out_Ln();
}
/*-------------------------------------------------------------------------*
* SHOW_FD_VARIABLE *
* *
*-------------------------------------------------------------------------*/
static void
Show_Fd_Variable(WamWord *fdv_adr)
{
char str[32];
sprintf(str, "_#%d(", (int) Cstr_Offset(fdv_adr));
Out_String(str);
Out_String(Fd_Variable_To_String(fdv_adr));
Out_Char(')');
pl_last_writing = W_IDENTIFIER;
}
/*-------------------------------------------------------------------------*
* SHOW_STRUCTURE *
* *
*-------------------------------------------------------------------------*/
static void
Show_Structure(int depth, int prec, int context, WamWord *stc_adr)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord f_n = Functor_And_Arity(stc_adr);
int functor = Functor(stc_adr);
int arity = Arity(stc_adr);
OperInf *oper;
int nb_args_to_disp;
int i, j, n;
char str[32];
Bool bracket;
Bool surround_space;
char *p;
depth--;
if (name_vars && f_n == dollar_varname_1 && stc_adr >= name_number_above_H)
{
DEREF(Arg(stc_adr, 0), word, tag_mask);
if (tag_mask == TAG_ATM_MASK)
{
p = pl_atom_tbl[UnTag_ATM(word)].name;
if (Is_Valid_Var_Name(p))
{
Out_String(p);
pl_last_writing = W_IDENTIFIER;
return;
}
}
}
if (number_vars && f_n == dollar_var_1 && stc_adr >= name_number_above_H)
{
DEREF(Arg(stc_adr, 0), word, tag_mask);
if (tag_mask == TAG_INT_MASK && (n = UnTag_INT(word)) >= 0)
{
i = n % 26;
j = n / 26;
Out_Char('A' + i);
if (j)
{
sprintf(str, "%d", j);
Out_String(str);
}
pl_last_writing = W_IDENTIFIER;
return;
}
}
if (ignore_op || arity > 2)
goto functional;
if (f_n == curly_brackets_1)
{
Out_Char('{');
if (space_args)
Out_Space();
Show_Term(depth, MAX_PREC, GENERAL_TERM, Arg(stc_adr, 0));
if (space_args)
Out_Space();
Out_Char('}');
return;
}
bracket = FALSE;
if (arity == 1 && (oper = Pl_Lookup_Oper(functor, PREFIX)))
{
#if 1
/* Koen de Bosschere says "in case of ambiguity : */
/* select the associative operator over the nonassociative */
/* select prefix over postfix". */
OperInf *oper1;
if (oper->prec > oper->right
&& (oper1 = Pl_Lookup_Oper(functor, POSTFIX))
&& oper1->left == oper1->prec)
{
oper = oper1;
goto postfix;
}
#endif
if (oper->prec > prec || (context == INSIDE_LEFT_ASSOC_OP &&
(oper->prec == oper->right
&& oper->prec == prec)))
{ /* prevent also the case: fy T yf(x) */
Out_Char('(');
bracket = TRUE;
}
Show_Atom(GENERAL_TERM, functor);
last_prefix_op = W_PREFIX_OP_ANY;
if (space_args
#if SPACE_ARGS_RESTRICTED /* space_args -> space after fx operator */
&& oper->prec > oper->right
#endif
)
Out_Space();
else
if (strcmp(pl_atom_tbl[functor].name, "-") == 0)
{
last_prefix_op = W_PREFIX_OP_MINUS;
p_bracket_minus = &bracket;
}
Show_Term(depth, oper->right, INSIDE_ANY_OP, Arg(stc_adr, 0));
last_prefix_op = W_NO_PREFIX_OP;
/* Here we need a while(bracket--) instead of if(bracket) because
* in some cases with the minus op and additional bracket is needed.
* Example: with op(100, xfx, &) (recall the prec of - is 200).
* The term ((-(1)) & b must be displayed as: (- (1)) & b
* Concerning the sub-term - (1), the first ( is emitted 10 lines above
* because the precedence of - (200) is > precedence of & (100).
* The second ( is emitted by Need_Space() because the argument of - begins
* by a digit. At the return we have to close 2 ).
*/
while (bracket--)
Out_Char(')');
return;
}
if (arity == 1 && (oper = Pl_Lookup_Oper(functor, POSTFIX)))
{
postfix:
if (oper->prec > prec)
{
Out_Char('(');
bracket = TRUE;
}
context =
(oper->left == oper->prec) ? INSIDE_LEFT_ASSOC_OP : INSIDE_ANY_OP;
Show_Term(depth, oper->left, context, Arg(stc_adr, 0));
if (space_args
#if SPACE_ARGS_RESTRICTED /* space_args -> space before xf operator */
&& oper->prec > oper->left
#endif
)
Out_Space();
Show_Atom(GENERAL_TERM, functor);
if (bracket)
Out_Char(')');
return;
}
if (arity == 2 && (oper = Pl_Lookup_Oper(functor, INFIX)))
{
if (oper->prec > prec || (context == INSIDE_LEFT_ASSOC_OP &&
(oper->prec == oper->right
&& oper->prec == prec)))
{ /* prevent also the case: T xfy U yf(x) */
Out_Char('(');
bracket = TRUE;
}
context =
(oper->left == oper->prec) ? INSIDE_LEFT_ASSOC_OP : INSIDE_ANY_OP;
Show_Term(depth, oper->left, context, Arg(stc_adr, 0));
#if 1 /* to show | unquoted if it is an infix operator with prec > 1000 */
if (functor == ATOM_CHAR('|') && oper->prec > 1000)
{
if (space_args)
Out_Space();
Out_Char('|');
if (space_args)
Out_Space();
}
else
#endif
if (functor == ATOM_CHAR(','))
{
Out_Char(',');
if (space_args)
Out_Space();
}
else
{
surround_space = FALSE;
if (pl_atom_tbl[functor].prop.type == IDENTIFIER_ATOM ||
pl_atom_tbl[functor].prop.type == OTHER_ATOM ||
(space_args
#ifdef SPACE_ARGS_RESTRICTED /* space_args -> space around xfx operators */
&& oper->left != oper->prec && oper->right != oper->prec
#endif
))
{
surround_space = TRUE;
Out_Space();
}
Show_Atom(GENERAL_TERM, functor);
if (surround_space)
Out_Space();
}
Show_Term(depth, oper->right, INSIDE_ANY_OP, Arg(stc_adr, 1));
if (bracket)
Out_Char(')');
return;
}
functional: /* functional notation */
Show_Atom(GENERAL_TERM, functor);
Out_Char('(');
nb_args_to_disp = i = (arity < depth + 1 || depth < 0) ? arity : depth + 1;
adr = &Arg(stc_adr, 0);
goto start_display;
do
{
Out_Char(',');
if (space_args)
Out_Space();
start_display:
Show_Term(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, *adr++);
}
while (--i);
if (arity != nb_args_to_disp)
{
Out_Char(',');
if (space_args)
Out_Space();
Show_Atom(GENERAL_TERM, atom_dots);
}
Out_Char(')');
}
static void
Show_List_Arg(int depth, WamWord *lst_adr)
{
WamWord word, tag_mask;
terminal_rec:
depth--;
Show_Term(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Car(lst_adr));
if (depth == 0) /* dots already written by Show_Term */
return;
DEREF(Cdr(lst_adr), word, tag_mask);
switch (Tag_From_Tag_Mask(tag_mask))
{
case REF:
SHOW_LIST_PIPE;
Show_Global_Var(UnTag_REF(word));
break;
case ATM:
if (word != NIL_WORD)
{
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Atom(GENERAL_TERM, UnTag_ATM(word));
}
break;
#ifndef NO_USE_FD_SOLVER
case FDV:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Fd_Variable(UnTag_FDV(word));
break;
#endif
case INT:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Integer(UnTag_INT(word));
break;
case FLT:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Float(Pl_Obtain_Float(UnTag_FLT(word)));
break;
case LST:
Out_Char(',');
if (space_args)
Out_Space();
lst_adr = UnTag_LST(word);
goto terminal_rec;
break;
case STC:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Structure(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM,
UnTag_STC(word));
break;
}
}
/*-------------------------------------------------------------------------*
* SHOW_ATOM *
* *
*-------------------------------------------------------------------------*/
static void
Show_Atom(int context, int atom)
{
char *p, *q;
char str[32];
Bool bracket = FALSE;
int c, c_type;
AtomProp prop;
prop = pl_atom_tbl[atom].prop;
if (context != GENERAL_TERM && Check_Oper_Any_Type(atom))
{
Out_Char('(');
bracket = TRUE;
}
if (!quoted || !prop.needs_quote)
{
Out_String(pl_atom_tbl[atom].name);
switch (prop.type)
{
case IDENTIFIER_ATOM:
pl_last_writing = W_IDENTIFIER;
break;
case GRAPHIC_ATOM:
pl_last_writing = W_GRAPHIC;
break;
case SOLO_ATOM:
pl_last_writing = W_NOTHING;
break;
case OTHER_ATOM:
if (prop.length == 0)
{
pl_last_writing = W_NOTHING;
break;
}
c = pl_atom_tbl[atom].name[prop.length - 1];
c_type = pl_char_type[c];
if (c_type & (UL | CL | SL | DI))
pl_last_writing = W_IDENTIFIER;
else if (c == '\'')
pl_last_writing = W_QUOTED;
else if (c_type == GR)
pl_last_writing = W_GRAPHIC;
else
pl_last_writing = W_NOTHING;
}
}
else
{
Out_Char('\'');
if (prop.needs_scan)
{
for (p = pl_atom_tbl[atom].name; *p; p++)
if ((q = (char *) strchr(pl_escape_char, *p)))
{
Out_Char('\\');
Out_Char(pl_escape_symbol[q - pl_escape_char]);
}
else if (*p == '\'' || *p == '\\') /* display twice */
{
Out_Char(*p);
Out_Char(*p);
}
else if (!isprint(*p))
{
sprintf(str, "\\x%x\\", (unsigned) (unsigned char) *p);
Out_String(str);
}
else
Out_Char(*p);
}
else
Out_String(pl_atom_tbl[atom].name);
Out_Char('\'');
pl_last_writing = W_QUOTED;
}
if (bracket)
Out_Char(')');
}
/*-------------------------------------------------------------------------*
* SHOW_TERM *
* *
*-------------------------------------------------------------------------*/
static void
Show_Term(int depth, int prec, int context, WamWord term_word)
{
WamWord word, tag_mask;
WamWord *adr;
if (depth == 0)
{
Show_Atom(GENERAL_TERM, atom_dots);
return;
}
DEREF(term_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK && Try_Portray(word))
return;
switch (Tag_From_Tag_Mask(tag_mask))
{
case REF:
adr = UnTag_REF(word);
if (Is_A_Local_Adr(adr))
{
Globalize_Local_Unbound_Var(adr, word);
adr = UnTag_REF(word);
}
Show_Global_Var(adr);
break;
case ATM:
Show_Atom(context, UnTag_ATM(word));
break;
#ifndef NO_USE_FD_SOLVER
case FDV:
Show_Fd_Variable(UnTag_FDV(word));
break;
#endif
case INT:
Show_Integer(UnTag_INT(word));
break;
case FLT:
Show_Float(Pl_Obtain_Float(UnTag_FLT(word)));
break;
case LST:
adr = UnTag_LST(word);
if (ignore_op)
{
Out_String("'.'(");
Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM,
Car(adr));
Out_Char(',');
Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM,
Cdr(adr));
Out_Char(')');
}
else
{
Out_Char('[');
Show_List_Arg(depth, adr);
Out_Char(']');
}
break;
case STC:
adr = UnTag_STC(word);
Show_Structure(depth, prec, context, adr);
break;
}
}
/*-------------------------------------------------------------------------*
* PL_WRITE_A_CHAR *
* *
*-------------------------------------------------------------------------*/
void
Pl_Write_A_Char(StmInf *pstm, int c)
{
pstm_o = pstm;
Out_Char(c);
}
