/*-------------------------------------------------------------------------* * 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); }