## pp-ast-g.pkg
# Compiled by:
# src/lib/c-kit/src/ast/ast.sublib### "Common sense is the most fairly distributed thing in the world,
### for each one thinks he is so well-endowed with it that
### even those who are hardest to satisfy in all other matters
### are not in the habit of desiring more of it than they already have."
###
### -- Rene Descartes
stipulate
package pp = old_prettyprinter; # old_prettyprinter is from src/lib/prettyprint/big/src/old-prettyprinter.pkg package raw = raw_syntax; # raw_syntax is from src/lib/c-kit/src/ast/raw-syntax.pkgherein
generic package unparse_raw_syntax_tree_g (
# =========================
#
package ppraw_syntax_tree_adornment: Pp_Ast_Adornment; # Pp_Ast_Adornment is from src/lib/c-kit/src/ast/prettyprint/pp-ast-adornment.api )
: (weak) Pp_Ast # Pp_Ast is from src/lib/c-kit/src/ast/prettyprint/pp-ast.api {
package tid = tid;
package pid = pid;
package b = namings; # namings is from src/lib/c-kit/src/ast/bindings.pkg package ppaa = ppraw_syntax_tree_adornment;
package ppae = unparse_raw_syntax_tree_extension_g ( Aidinfo = ppraw_syntax_tree_adornment::Aidinfo;);
package ppl = prettyprint_lib; # prettyprint_lib is from src/lib/c-kit/src/ast/prettyprint/pp-lib.pkg include package prettyprint_lib;
include package raw;
Aidinfo = ppae::Aidinfo;
print_location = FALSE; # Internal flag - pretty print locations as comments
fun prettyprint_loc pps (line_number_db::LOC { src_file, begin_line, begin_col, end_line, end_col } )
=>
if print_location
#
ppl::add_string pps " /*[";
ppl::add_string pps (src_file);
ppl::add_string pps ":";
ppl::add_string pps (int::to_string begin_line);
ppl::add_string pps "]*/ ";
fi;
prettyprint_loc pps _
=>
();
end;
warning = ppl::warning;
prettyprint_lparen = ppl::prettyprint_guarded "(";
prettyprint_rparen = ppl::prettyprint_guarded ")";
fun get_ctype ( { st_ilk, ctype, ... }: raw::Id)
=
(st_ilk, ctype);
fun is_post_fix POST_INC => TRUE;
is_post_fix POST_DEC => TRUE;
is_post_fix _ => FALSE;
end;
fun prettyprint_binop aidinfo tidtab pps binop
=
case binop
#
PLUS => ppl::add_string pps "+";
MINUS => ppl::add_string pps "-";
TIMES => ppl::add_string pps "*";
DIVIDE => ppl::add_string pps "/";
MOD => ppl::add_string pps "%";
GT => ppl::add_string pps ">";
LT => ppl::add_string pps "<";
GTE => ppl::add_string pps ">=";
LTE => ppl::add_string pps "<=";
EQ => ppl::add_string pps "==";
NEQ => ppl::add_string pps "!=";
AND => ppl::add_string pps "&&";
OR => ppl::add_string pps "||";
BIT_OR => ppl::add_string pps "|";
BIT_AND => ppl::add_string pps "&";
BIT_XOR => ppl::add_string pps "^";
LSHIFT => ppl::add_string pps "<<";
RSHIFT => ppl::add_string pps ">>";
PLUS_ASSIGN => ppl::add_string pps "+=";
MINUS_ASSIGN => ppl::add_string pps "-=";
TIMES_ASSIGN => ppl::add_string pps "*=";
DIV_ASSIGN => ppl::add_string pps "/=";
MOD_ASSIGN => ppl::add_string pps "%=";
XOR_ASSIGN => ppl::add_string pps "^=";
OR_ASSIGN => ppl::add_string pps "|=";
AND_ASSIGN => ppl::add_string pps "&=";
LSHIFT_ASSIGN => ppl::add_string pps "<<=";
RSHIFT_ASSIGN => ppl::add_string pps ">>=";
BINOP_EXT be => ppae::prettyprint_binop_ext aidinfo tidtab pps be;
esac;
fun prettyprint_unop aidinfo tidtab pps unop
=
case unop
UPLUS => ppl::add_string pps "+";
NOT => ppl::add_string pps "!";
NEGATE => ppl::add_string pps "-";
BIT_NOT => ppl::add_string pps " -";
PRE_INC => ppl::add_string pps "++";
POST_INC => ppl::add_string pps "++";
PRE_DEC => ppl::add_string pps "--";
POST_DEC => ppl::add_string pps "--";
UNOP_EXT ue => ppae::prettyprint_unop_ext aidinfo tidtab pps ue;
esac;
Identifier
= IDX raw::Id
| MEMBERX raw::Member
| TID tid::Uid
;
Parameters
= EMPTY
| ANSI List( raw::Id )
| KNR List( raw::Id )
;
Ct_Stk_Item
= ARR Null_Or ((large_int::Int, raw::Expression))
| QUA raw::Qualifier
| FUN (List( raw::Ctype ), Parameters)
| PTR
;
print_const = REF FALSE;
fun prettyprint_identifier tidtab pps
=
\\ (IDX id) => prettyprint_id pps id;
(MEMBERX member) => prettyprint_member pps member;
(TID tid) => prettyprint_tid tidtab pps tid;
end;
fun prettyprint_qualifier pps qf
=
{ s = case qf
VOLATILE => "volatile ";
CONST => *print_const ?? "const "
:: "";
esac;
add_string pps s;
};
fun prettyprint_storage_ilk pps sc
=
{ s = case sc
STATIC => "static ";
EXTERN => "extern ";
REGISTER => "register ";
AUTO => "";
DEFAULT => "";
esac;
add_string pps s;
};
fun prettyprint_signedness pps sign
=
{ s = case sign
SIGNED => "";
UNSIGNED => "unsigned ";
esac;
add_string pps s;
};
fun prettyprint_fractionality pps frac
=
{ s = case frac
FRACTIONAL => "fractional ";
WHOLENUM => "";
esac;
add_string pps s;
};
fun prettyprint_saturatedness pps sat
=
{ s = case sat
SATURATE => "saturate ";
NONSATURATE => "";
esac;
add_string pps s;
};
fun prettyprint_int_kind pps ik
=
{ s = case ik
CHAR => "char";
SHORT => "short";
INT => "int";
LONG => "long";
LONGLONG => "long long";
FLOAT => "float";
DOUBLE => "double";
LONGDOUBLE => "long double";
esac;
add_string pps s;
};
fun prettyprint_stk aidinfo tidtab pps (id_opt, stk)
=
loop (PTR, stk)
where
fun loop (prev,[])
=>
prettyprint_opt (prettyprint_identifier tidtab) pps id_opt;
loop (prev, (QUA qf) ! l)
=>
{ prettyprint_qualifier pps qf;
loop (prev, l);
};
loop (prev, (a as ARR opt) ! l)
=>
{ loop (a, l);
add_string pps "[";
case opt
THE (i, expr) => prettyprint_expr { nested=>FALSE } aidinfo tidtab pps expr;
NULL => ();
esac;
add_string pps "]";
};
loop (prev, ((f as FUN (cts, ids_opt)) ! l))
=>
{ loop (f, l);
space pps;
case ids_opt
EMPTY => prettyprint_list
{ prettyprint => prettyprint_ctype aidinfo tidtab,
sep => ", ",
l_delim => "(",
r_delim => ")"
}
pps cts;
ANSI ids => prettyprint_list
{ prettyprint => prettyprint_id_decl aidinfo tidtab,
sep => ", ",
l_delim => "(",
r_delim => ")"
}
pps ids;
KNR ids => prettyprint_list
{ prettyprint => prettyprint_id,
sep => ", ",
l_delim => "(",
r_delim => ")"
}
pps ids;
esac;
};
loop (PTR, p ! l)
=>
{ add_string pps "*";
loop (PTR, l);
};
loop (_, PTR ! l)
=>
{ add_string pps "(";
add_string pps "*";
loop (PTR, l);
add_string pps ")";
};
end;
end
also
fun prettyprint_sp_stk aidinfo tidtab pps (pair as (NULL,[]))
=>
prettyprint_stk aidinfo tidtab pps pair;
prettyprint_sp_stk aidinfo tidtab pps (pair as (_, stk))
=>
{ space pps;
prettyprint_stk aidinfo tidtab pps pair;
};
end
also
fun prettyprint_decl0 aidinfo tidtab pps (id_opt, ids_opt, ctype)
=
loop (ids_opt, ctype,[])
where
fun loop (ids_opt, ctype, stk)
=
case ctype
VOID =>
{ add_string pps "void";
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
ELLIPSES
=>
case stk
[] => add_string pps "...";
_ => { warning "prettyprint_decl" "ill-formed ellipses type";
add_string pps "...";
};
esac;
QUAL (qf, ct)
=>
loop (ids_opt, ct, (QUA qf) ! stk);
NUMERIC (NONSATURATE, WHOLENUM, _, CHAR, SIGNASSUMED)
=>
{ add_string pps "char";
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
NUMERIC (NONSATURATE, WHOLENUM, SIGNED, CHAR, SIGNDECLARED)
=>
{ add_string pps "signed char";
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
NUMERIC (NONSATURATE, WHOLENUM, UNSIGNED, CHAR, SIGNDECLARED)
=>
{ add_string pps "unsigned char";
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
NUMERIC (sat, frac, sign, ik, _)
=>
{ prettyprint_saturatedness pps sat;
prettyprint_fractionality pps frac;
prettyprint_signedness pps sign;
prettyprint_int_kind pps ik;
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
ARRAY (opt, ct) => loop (ids_opt, ct, ARR opt ! stk);
POINTER ct => loop (ids_opt, ct, PTR ! stk);
FUNCTION (ct, cts)
=>
{ optids = map #2 cts; # Optional ids.
cts = map #1 cts; # Types.
fun useaux ()
=
loop (EMPTY, ct, FUN (cts, ids_opt) ! stk);
case ids_opt
EMPTY =>
if (list::exists (not o not_null) optids)
useaux ();
else
loop (EMPTY, ct,
FUN (cts, ANSI (map the optids)) ! stk);
fi;
_ => useaux ();
esac;
};
ENUM_REF tid
=>
{ case (tidtab::find (tidtab, tid))
THE { ntype=>THE (b::ENUM _), ... }
=>
{ add_string pps "enum ";
prettyprint_tid tidtab pps tid;
};
_ => # Print out partially defined enums:
{ add_string pps "enum ";
prettyprint_tid tidtab pps tid;
};
esac;
# AddString pps ("EnumRef(" + (Tid::to_string tid) + ")");
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
STRUCT_REF tid
=>
{ add_string pps "pkg ";
prettyprint_tid tidtab pps tid;
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
UNION_REF tid
=>
{ add_string pps "union ";
prettyprint_tid tidtab pps tid;
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
TYPE_REF tid
=>
{ case (tidtab::find (tidtab, tid))
THE { ntype=>THE (b::TYPEDEFX _), ... }
=>
prettyprint_tid tidtab pps tid;
_ => add_string pps ("TypeRef(" + (tid::to_string tid) + ")");
esac;
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
ERROR => { add_string pps "/* ErrorType */ ";
prettyprint_sp_stk aidinfo tidtab pps (id_opt, stk);
};
esac;
end
also
fun prettyprint_ctype aidinfo tidtab pps ctype
=
prettyprint_decl0 aidinfo tidtab pps (NULL, EMPTY, ctype)
# Note: id is only used for printing purposes.
# All information needed to interpret a type is obtained via tid
also
fun prettyprint_named_ctype aidinfo tidtab pps nct
=
{ fun prettyprint_opt_list prettyprint_elt sep []
=>
();
prettyprint_opt_list prettyprint_elt sep l
=>
{ add_string pps "{ ";
blockify 2 (separate (prettyprint_elt, \\ pps => { add_string pps sep; newline pps;}; end )) pps l;
newline pps;
add_string pps "}";
};
end;
case nct
#
b::STRUCT (tid, members)
=>
{ fun prettyprint_li' pps li
=
{ add_string pps ":";
prettyprint_li pps li;
};
fun prettyprint_member pps (ct, member_opt, liopt)
=
{ prettyprint_decl0 aidinfo tidtab pps (null_or::map MEMBERX member_opt, EMPTY, ct);
prettyprint_opt prettyprint_li' pps liopt;
add_string pps ";";
};
add_string pps "pkg ";
prettyprint_tid tidtab pps tid;
space pps;
prettyprint_opt_list prettyprint_member "" members;
};
b::UNION (tid, members)
=>
{ fun prettyprint_member pps (ct, member)
=
{ prettyprint_decl0 aidinfo tidtab pps (THE (MEMBERX member), EMPTY, ct);
add_string pps ";";
};
add_string pps "union ";
prettyprint_tid tidtab pps tid;
space pps;
prettyprint_opt_list prettyprint_member "" members;
};
b::ENUM (tid, members)
=>
{ fun prettyprint_member_int pps (member, li)
=
{ prettyprint_member pps member;
add_string pps "=";
prettyprint_li pps li;
};
add_string pps "enum ";
prettyprint_tid tidtab pps tid;
space pps;
prettyprint_opt_list prettyprint_member_int ", " members;
};
b::TYPEDEFX (tid, ctype)
=>
{ add_string pps "typedef ";
prettyprint_decl0 aidinfo tidtab pps (THE (TID tid), EMPTY, ctype);
};
esac;
}
also
fun prettyprint_decl aidinfo tidtab pps (id, ct)
=
prettyprint_decl0 aidinfo tidtab pps (THE (IDX id), EMPTY, ct)
also
fun prettyprint_declaration aidinfo tidtab pps (TYPE_DECL { shadow=>NULL, tid } )
=>
{ case (tidtab::find (tidtab, tid))
THE { ntype=>THE nct, location, ... }
=>
{ prettyprint_loc pps location;
prettyprint_named_ctype aidinfo tidtab pps nct;
};
_ =>
{ warning "prettyprintCoreStmt"
("No type associated with tid:" + (tid::to_string tid));
ppl::add_string pps "...";
};
esac;
ppl::add_string pps ";";
};
prettyprint_declaration aidinfo tidtab pps (TYPE_DECL { shadow=>THE { strct=>TRUE }, tid } )
=>
{ prettyprint_lib::add_string pps "pkg ";
prettyprint_lib::prettyprint_tid tidtab pps tid;
ppl::add_string pps ";";
};
prettyprint_declaration aidinfo tidtab pps (TYPE_DECL { shadow=>THE { strct=>FALSE }, tid } )
=>
{ prettyprint_lib::add_string pps "union ";
prettyprint_lib::prettyprint_tid tidtab pps tid;
ppl::add_string pps ";";
};
prettyprint_declaration aidinfo tidtab pps (VAR_DECL (id as { location, ... }, init_opt))
=>
{ prettyprint_loc pps location;
prettyprint_id_decl aidinfo tidtab pps id;
case init_opt
THE init_expr
=>
{ ppl::add_string pps "=";
prettyprint_init_expression aidinfo tidtab pps init_expr;
};
NULL => ();
esac;
ppl::add_string pps ";";
};
end
also
fun prettyprint_id_decl aidinfo tidtab pps (id: raw::Id)
=
{ my (st_ilk, ctype)
=
get_ctype id;
prettyprint_storage_ilk pps st_ilk;
prettyprint_decl aidinfo tidtab pps (id, ctype);
}
also
fun block_statement aidinfo tidtab pps statement
=
ppl::blockify 2 (prettyprint_statement aidinfo tidtab) pps statement
also
fun prettyprint_statement aidinfo tidtab pps (statement as (STMT (_, _, loc)))
=
{ prettyprint_loc pps loc;
ppaa::prettyprint_statement_adornment prettyprint_core_statement aidinfo tidtab pps statement;
}
also
fun prettyprint_core_statement aidinfo tidtab pps core_statement
=
case core_statement
EXPR exp_opt
=>
{ ppl::prettyprint_opt (prettyprint_expr { nested=>FALSE } aidinfo tidtab) pps exp_opt;
ppl::add_string pps ";";
};
COMPOUND (decls, stmts)
=>
{ ppl::add_string pps "{ ";
case decls
NIL => ();
_ => ppl::blockify 2 (ppl::separate (prettyprint_declaration aidinfo tidtab, ppl::newline)) pps decls;
esac;
case stmts
NIL => ();
_ => ppl::blockify 2 (ppl::separate (prettyprint_statement aidinfo tidtab, ppl::newline)) pps stmts;
esac;
ppl::newline pps;
ppl::add_string pps "}";
};
WHILE (expression, statement)
=>
{ ppl::add_string pps "while (";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps expression;
ppl::add_string pps ")";
block_statement aidinfo tidtab pps statement;
};
DO (expression, statement)
=>
{ ppl::add_string pps "do";
block_statement aidinfo tidtab pps statement;
ppl::newline pps;
ppl::add_string pps "while (";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps expression;
ppl::add_string pps ");";
};
FOR (exp_opt0, exp_opt1, exp_opt2, statement)
=>
{ ppl::add_string pps "for (";
ppl::prettyprint_opt (prettyprint_expr { nested=>FALSE } aidinfo tidtab) pps exp_opt0;
ppl::add_string pps "; ";
ppl::prettyprint_opt (prettyprint_expr { nested=>FALSE } aidinfo tidtab) pps exp_opt1;
ppl::add_string pps "; ";
ppl::prettyprint_opt (prettyprint_expr { nested=>FALSE } aidinfo tidtab) pps exp_opt2;
ppl::add_string pps ")";
block_statement aidinfo tidtab pps statement;
};
LABELED (label, statement)
=>
{ ppl::b_block pps pp::INCONSISTENT -2;
ppl::newline pps;
ppl::prettyprint_label pps label;
ppl::add_string pps ": ";
ppl::e_block pps;
ppl::newline pps;
prettyprint_statement aidinfo tidtab pps statement;
};
CASE_LABEL (li, statement)
=>
{ ppl::b_block pps pp::INCONSISTENT -2;
ppl::newline pps;
ppl::add_string pps "case ";
ppl::prettyprint_li pps li;
ppl::add_string pps ": ";
ppl::e_block pps;
ppl::newline pps;
prettyprint_statement aidinfo tidtab pps statement;
};
DEFAULT_LABEL statement
=>
{ ppl::b_block pps pp::INCONSISTENT -2;
ppl::newline pps ;
ppl::add_string pps "default: ";
ppl::e_block pps;
ppl::newline pps;
prettyprint_statement aidinfo tidtab pps statement;
};
GOTO label
=>
{ ppl::add_string pps "goto ";
ppl::prettyprint_label pps label;
ppl::add_string pps ";";
};
BREAK => ppl::add_string pps "break;";
CONTINUE => ppl::add_string pps "continue;";
RETURN exp_opt
=>
{ ppl::add_string pps "return ";
ppl::prettyprint_opt (prettyprint_expr { nested=>FALSE } aidinfo tidtab) pps exp_opt;
ppl::add_string pps ";";
};
IF_THEN (expression, statement)
=>
{ ppl::add_string pps "if (";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps expression;
ppl::add_string pps ") ";
block_statement aidinfo tidtab pps statement;
};
IF_THEN_ELSE (expression, stmt0, stmt1)
=>
{ ppl::add_string pps "if (";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps expression;
ppl::add_string pps ") ";
block_statement aidinfo tidtab pps stmt0;
ppl::newline pps;
ppl::add_string pps "else";
block_statement aidinfo tidtab pps stmt1;
};
SWITCH (expression, statement)
=>
{ ppl::add_string pps "switch (";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps expression;
ppl::add_string pps ")";
block_statement aidinfo tidtab pps statement;
};
ERROR_STMT
=>
( ppl::add_string pps "/* ErrorStmt */"
);
STAT_EXT se
=>
ppae::prettyprint_statement_ext (prettyprint_expr { nested=>FALSE }, prettyprint_statement, prettyprint_binop, prettyprint_unop) aidinfo tidtab pps se;
esac
also
fun prettyprint_expr nested aidinfo tidtab pps expr
=
ppaa::prettyprint_expression_adornment (prettyprint_core_expr nested) aidinfo tidtab pps expr
also
fun prettyprint_core_expr { nested } aidinfo tidtab pps core_expr
=
case core_expr
INT_CONST li => ppl::prettyprint_li pps li;
REAL_CONST r => ppl::prettyprint_real pps r;
STRING_CONST s => ppl::prettyprint_string pps s;
CALL (expression, exps)
=>
{ prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
ppl::space pps;
ppl::prettyprint_list { prettyprint=>prettyprint_expr { nested=>FALSE } aidinfo tidtab,
sep=>", ",
l_delim=>"(",
r_delim=>")"
} pps exps;
};
QUESTION_COLON (e0, e1, e2)
=>
{ prettyprint_lparen nested pps;
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps e0;
ppl::add_string pps " ? ";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps e1;
ppl::add_string pps " : ";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps e2;
prettyprint_rparen nested pps;
};
ASSIGN (e0, e1)
=>
{ prettyprint_lparen nested pps ;
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps e0;
ppl::add_string pps " = ";
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps e1;
prettyprint_rparen nested pps ;
};
COMMA (e0, e1)
=>
{ ppl::add_string pps "(";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps e0;
ppl::add_string pps ", ";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps e1;
ppl::add_string pps ")";
};
SUB (e0, e1)
=>
{ prettyprint_expr { nested } aidinfo tidtab pps e0;
ppl::add_string pps "[";
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps e1;
ppl::add_string pps "]";
};
MEMBER (expression, member)
=>
{ prettyprint_lparen nested pps;
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
ppl::add_string pps ".";
ppl::prettyprint_member pps member;
prettyprint_rparen nested pps;
};
ARROW (expression, member)
=>
{ prettyprint_lparen nested pps;
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
ppl::add_string pps "->";
ppl::prettyprint_member pps member;
prettyprint_rparen nested pps;
};
DEREF expression
=>
{ prettyprint_lparen nested pps;
ppl::add_string pps "*";
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
prettyprint_rparen nested pps;
};
ADDR_OF expression
=>
{ prettyprint_lparen nested pps;
ppl::add_string pps "&";
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
prettyprint_rparen nested pps;
};
BINOP (binop, expression0, expression1)
=>
{ prettyprint_lparen nested pps;
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression0;
prettyprint_binop aidinfo tidtab pps binop;
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression1;
prettyprint_rparen nested pps ;
};
UNOP (unop, expression)
=>
{ prettyprint_lparen nested pps;
if (is_post_fix unop)
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
prettyprint_unop aidinfo tidtab pps unop;
else
prettyprint_unop aidinfo tidtab pps unop;
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
fi;
prettyprint_rparen nested pps;
};
CAST (ctype, expression)
=>
{ prettyprint_lparen nested pps;
ppl::add_string pps "(";
prettyprint_ctype aidinfo tidtab pps ctype;
ppl::add_string pps ") ";
prettyprint_expr { nested=>TRUE } aidinfo tidtab pps expression;
prettyprint_rparen nested pps;
};
ID id => ppl::prettyprint_id pps id;
ENUM_ID (id, li) => ppl::prettyprint_member pps id;
SIZE_OF ctype
=>
{ prettyprint_lparen nested pps;
ppl::add_string pps "sizeof(";
prettyprint_ctype aidinfo tidtab pps ctype;
ppl::add_string pps ")";
prettyprint_rparen nested pps;
};
EXPR_EXT ee
=>
ppae::prettyprint_expression_ext
(prettyprint_expr { nested=>FALSE }, prettyprint_statement, prettyprint_binop, prettyprint_unop)
aidinfo tidtab pps ee;
ERROR_EXPR
=>
{ warning "prettyprintCoreExpression" "found an error expression";
ppl::add_string pps "/* error expression */ 0";
};
esac
also
fun prettyprint_init_expression aidinfo tidtab pps init_expr
=
case init_expr
#
SIMPLE expr
=>
prettyprint_expr { nested=>FALSE } aidinfo tidtab pps expr;
AGGREGATE init_exprs
=>
ppl::prettyprint_list
{ prettyprint => prettyprint_init_expression aidinfo tidtab,
sep => ", ",
l_delim => "{ ",
r_delim => " }"
}
pps init_exprs;
esac;
fun prettyprint_core_external_decl aidinfo tidtab pps edecl
=
case edecl
#
EXTERNAL_DECL decl
=>
prettyprint_declaration aidinfo tidtab pps decl;
raw::FUN (id, ids, statement)
=>
{ id -> { location, ... };
my (st_ilk, ctype)
=
get_ctype id;
my (ctype, k_nr, parameters)
=
case ctype
raw::FUNCTION (return_type, parameter_types)
=>
if (null parameter_types and not (null ids)) (ctype, TRUE, KNR ids);
else (ctype, FALSE, ANSI ids);
fi;
_ =>
{ warning "prettyprintCoreExternalDecl"
( "No function type associated with id:"
+ (ppl::prettyprint_to_string (\\ pp = ppl::prettyprint_id pp id))
);
( raw::FUNCTION (raw::VOID,[]),
FALSE,
ANSI []
);
};
esac;
fun kr pps []
=>
[];
kr pps (id ! ids)
=>
{ prettyprint_id_decl aidinfo tidtab pps id;
ppl::add_string pps ";";
if (not (null ids)) newline pps; fi;
kr pps ids;
};
end;
prettyprint_loc pps location;
prettyprint_storage_ilk pps st_ilk;
prettyprint_decl0 aidinfo tidtab pps (THE (IDX id), parameters, ctype);
ppl::newline pps;
if k_nr blockify 2 kr pps ids;
newline pps;
fi;
prettyprint_statement aidinfo tidtab pps statement;
};
EXTERNAL_DECL_EXT ed
=>
ppae::prettyprint_external_decl_ext
( prettyprint_expr { nested=>FALSE },
prettyprint_statement,
prettyprint_binop,
prettyprint_unop
)
aidinfo tidtab pps ed;
esac;
fun prettyprint_external_decl aidinfo tidtab pps edecl
=
ppaa::prettyprint_external_decl_adornment
prettyprint_core_external_decl
aidinfo
tidtab
pps
edecl;
fun unparse_raw_syntax aidinfo tidtab pps edecls
=
ppl::separate
(prettyprint_external_decl aidinfo tidtab, ppl::newline)
pps
edecls;
# The pretty-printer expects a block at top level,
# so all of the external interfaces are wrapped
# to give it one.
#
fun wrap' prettyprint aidinfo pps v
=
{ ppl::b_block pps pp::INCONSISTENT 0;
ppl::newline pps;
prettyprint aidinfo pps v;
ppl::e_block pps;
};
fun wrap prettyprint aidinfo tidtab pps v
=
{ ppl::b_block pps pp::INCONSISTENT 0;
ppl::newline pps;
prettyprint aidinfo tidtab pps v;
ppl::newline pps;
ppl::e_block pps;
};
prettyprint_binop = wrap prettyprint_binop;
prettyprint_unop = wrap prettyprint_unop;
prettyprint_declaration = wrap prettyprint_declaration;
prettyprint_statement = wrap prettyprint_statement;
prettyprint_core_statement = wrap prettyprint_core_statement;
prettyprint_expression = wrap (prettyprint_expr { nested=>FALSE } );
prettyprint_core_expression = wrap (prettyprint_core_expr { nested=>FALSE } );
prettyprint_external_decl = wrap prettyprint_external_decl;
prettyprint_core_external_decl = wrap prettyprint_core_external_decl;
unparse_raw_syntax = wrap unparse_raw_syntax;
};
end;
## Copyright (c) 1998 by Lucent Technologies
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.