PRIVATE void list_print(char **buf, struct comal_line *line)
{
struct print_rec *p = &line->lc.printrec;
list_symsp(buf, line->cmd);
if (p->modifier)
switch (p->modifier->type) {
case fileSYM:
list_file(buf, &p->modifier->data.twoexp);
break;
case usingSYM:
list_symsp(buf, usingSYM);
list_exp(buf, p->modifier->data.str);
list_text(buf, ": ");
break;
default:
fatal("Print modifier incorrect");
}
list_printlist(buf, p->printroot);
if (p->pr_sep)
list_sym(buf, p->pr_sep);
}
PRIVATE void list_printlist(char **buf, struct print_list *printroot)
{
while (printroot) {
if (printroot->pr_sep)
list_sym(buf, printroot->pr_sep);
list_exp(buf, printroot->exp);
printroot = printroot->next;
}
}
PRIVATE void list_ifwhile(char **buf, int thendosym, struct comal_line
*line)
{
list_symsp(buf, line->cmd);
list_expsp(buf, line->lc.ifwhilerec.exp);
list_sym(buf, thendosym);
if (line->lc.ifwhilerec.stat) {
list_char(buf, ' ');
list_horse(buf, line->lc.ifwhilerec.stat);
}
}
PRIVATE void list_assign(char **buf, struct comal_line *line)
{
struct assign_list *work = line->lc.assignroot;
int first = 1;
while (work) {
list_comma(buf, &first, ';');
list_exp(buf, work->lval);
list_sym(buf, work->op);
list_exp(buf, work->exp);
work = work->next;
}
}
PRIVATE void list_whenlist(char **buf, struct when_list *whenroot)
{
int first = 1;
while (whenroot) {
list_comma(buf, &first, ',');
if (whenroot->op != eqlSYM)
list_sym(buf, whenroot->op);
list_exp(buf, whenroot->exp);
whenroot = whenroot->next;
}
}
PRIVATE void list_for(char **buf, struct comal_line *line)
{
struct for_rec *f = &line->lc.forrec;
list_symsp(buf, line->cmd);
list_exp(buf, f->lval);
list_sym(buf, becomesSYM);
list_expsp(buf, f->from);
list_symsp(buf, f->mode);
list_expsp(buf, f->to);
if (f->step) {
list_symsp(buf, stepSYM);
list_expsp(buf, f->step);
}
list_sym(buf, doSYM);
if (f->stat) {
list_char(buf, ' ');
list_horse(buf, f->stat);
}
}
PRIVATE void list_repeat(char **buf, struct comal_line *line)
{
if (line->lc.ifwhilerec.exp) {
list_symsp(buf, line->cmd);
if (line->lc.ifwhilerec.stat) {
list_horse(buf, line->lc.ifwhilerec.stat);
list_char(buf, ' ');
}
list_symsp(buf, untilSYM);
list_exp(buf, line->lc.ifwhilerec.exp);
} else
list_sym(buf, line->cmd);
}
PRIVATE void list_rnd(char **buf, struct expression *exp)
{
list_sym(buf,rndSYM);
if (exp->e.twoexp.exp1 || exp->e.twoexp.exp2) {
list_char(buf,'(');
if (exp->e.twoexp.exp1) {
list_exp(buf,exp->e.twoexp.exp1);
list_char(buf,',');
}
if (exp->e.twoexp.exp2)
list_exp(buf,exp->e.twoexp.exp2);
list_char(buf,')');
}
}
PRIVATE void list_pf(char **buf, struct comal_line *line)
{
struct proc_func_rec *pf = &line->lc.pfrec;
struct ext_rec *ext = pf->external;
list_symsp(buf, line->cmd);
list_text(buf, pf->id->name);
list_parms(buf, pf->parmroot);
if (pf->closed) {
list_char(buf, ' ');
list_sym(buf, closedSYM);
}
if (ext) {
list_char(buf, ' ');
if (ext->dynamic)
list_symsp(buf, ext->dynamic);
list_symsp(buf, externalSYM);
list_exp(buf, ext->filename);
}
}
PRIVATE void list_horse(char **buf, struct comal_line *line)
{
if (!line) return;
switch (line->cmd) {
case 0:
break;
case runSYM:
case delSYM:
case chdirSYM:
case rmdirSYM:
case mkdirSYM:
case osSYM:
case dirSYM:
case unitSYM:
case select_outputSYM:
case select_inputSYM:
case returnSYM:
case elifSYM:
case traceSYM:
case untilSYM:
list_symsp(buf, line->cmd);
list_exp(buf, line->lc.exp);
break;
case exitSYM:
list_sym(buf, line->cmd);
if (line->lc.exp) {
list_char(buf, ' ');
list_symsp(buf, whenSYM);
list_exp(buf, line->lc.exp);
}
break;
case stopSYM:
list_sym(buf, line->cmd);
if (line->lc.exp) {
list_char(buf, ' ');
list_exp(buf, line->lc.exp);
}
break;
case elseSYM:
case endSYM:
case endcaseSYM:
case endifSYM:
case endloopSYM:
case endwhileSYM:
case otherwiseSYM:
case loopSYM:
case nullSYM:
case retrySYM:
case pageSYM:
case handlerSYM:
case endtrapSYM:
list_sym(buf, line->cmd);
break;
case repeatSYM:
list_repeat(buf, line);
break;
case trapSYM:
list_sym(buf, line->cmd);
if (line->lc.traprec.esc) {
list_char(buf, ' ');
list_sym(buf, escSYM);
list_sym(buf, line->lc.traprec.esc);
}
break;
case execSYM:
if (show_exec)
list_symsp(buf, execSYM);
list_exp(buf, line->lc.exp);
break;
case caseSYM:
list_symsp(buf, line->cmd);
list_expsp(buf, line->lc.exp);
list_sym(buf, ofSYM);
break;
case cursorSYM:
list_symsp(buf, line->cmd);
list_twoexp(buf, &line->lc.twoexp, ",", 1);
break;
case closeSYM:
list_sym(buf, line->cmd);
if (line->lc.exproot) {
list_char(buf, ' ');
list_symsp(buf, fileSYM);
list_explist(buf, line->lc.exproot, 0);
}
break;
case sysSYM:
case dataSYM:
list_symsp(buf, line->cmd);
list_explist(buf, line->lc.exproot, 0);
break;
case localSYM:
case dimSYM:
list_dim(buf, line);
break;
case forSYM:
list_for(buf, line);
break;
case funcSYM:
case procSYM:
list_pf(buf, line);
break;
case ifSYM:
list_ifwhile(buf, thenSYM, line);
break;
case importSYM:
list_import(buf, line);
break;
case inputSYM:
list_input(buf, line);
break;
case openSYM:
list_symsp(buf, line->cmd);
list_symsp(buf, fileSYM);
list_exp(buf, line->lc.openrec.filenum);
list_text(buf, ", ");
list_exp(buf, line->lc.openrec.filename);
list_text(buf, ", ");
list_symsp(buf, line->lc.openrec.type);
if (line->lc.openrec.reclen) {
list_exp(buf, line->lc.openrec.reclen);
if (line->lc.openrec.read_only) {
list_char(buf, ' ');
list_sym(buf, read_onlySYM);
}
}
break;
case printSYM:
list_print(buf, line);
break;
case readSYM:
list_symsp(buf, line->cmd);
if (line->lc.readrec.modifier)
list_file(buf, line->lc.readrec.modifier);
list_explist(buf, line->lc.readrec.lvalroot, 0);
break;
case endfuncSYM:
case endprocSYM:
list_sym(buf, line->cmd);
if (line->lineptr) {
list_char(buf, ' ');
list_text(buf, line->lineptr->lc.pfrec.id->name);
}
break;
case endforSYM:
list_sym(buf, line->cmd);
if (line->lineptr) {
list_char(buf, ' ');
list_exp(buf, line->lineptr->lc.forrec.lval);
}
break;
case restoreSYM:
list_sym(buf, line->cmd);
if (line->lc.id) {
list_char(buf, ' ');
list_text(buf, line->lc.id->name);
}
break;
case whenSYM:
list_symsp(buf, line->cmd);
list_whenlist(buf, line->lc.whenroot);
break;
case whileSYM:
list_ifwhile(buf, doSYM, line);
break;
case writeSYM:
list_symsp(buf, line->cmd);
list_file(buf, &line->lc.writerec.twoexp);
list_explist(buf, line->lc.writerec.exproot, 0);
break;
case becomesSYM:
list_assign(buf, line);
break;
case idSYM:
list_text(buf, line->lc.id->name);
list_char(buf, ':');
break;
default:
list_text(buf, "<error: List default action>");
}
}
PRIVATE void list_symsp(char **buf, int sym)
{
list_sym(buf, sym);
list_char(buf, ' ');
}
PUBLIC void list_exp(char **buf, struct expression *exp)
{
char cvtbuf[64];
if (!exp)
return;
switch (exp->optype) {
case T_CONST:
list_sym(buf, exp->op);
break;
case T_UNARY:
if (exp->op != lparenSYM)
list_sym(buf, exp->op);
if (exp->op != minusSYM)
list_char(buf, '(');
list_exp(buf, exp->e.exp);
if (exp->op != minusSYM)
list_char(buf, ')');
break;
case T_SYS:
list_sym(buf, sysSYM);
list_explist(buf, exp->e.exproot, 1);
break;
case T_SYSS:
list_sym(buf, syssSYM);
list_explist(buf, exp->e.exproot, 1);
break;
case T_BINARY:
if (exp->op==_RND)
list_rnd(buf,exp);
else
list_twoexp(buf, &exp->e.twoexp, lex_opsym(exp->op), 1);
break;
case T_INTNUM:
list_text(buf, ltoa(exp->e.num, cvtbuf, 10));
break;
case T_FLOAT:
list_text(buf, exp->e.fnum.text);
break;
case T_STRING:
list_string(buf, exp->e.str->s);
break;
case T_SUBSTR:
list_exp(buf, exp->e.expsubstr.exp);
list_char(buf, '(');
list_twoexp(buf, &exp->e.expsubstr.twoexp, ":", 1);
list_char(buf, ')');
break;
case T_ID:
list_text(buf, exp->e.expid.id->name);
list_explist(buf, exp->e.expid.exproot, 1);
break;
case T_ARRAY:
case T_SARRAY:
list_text(buf, exp->e.expid.id->name);
list_text(buf,"()");
break;
case T_SID:
list_text(buf, exp->e.expsid.id->name);
list_explist(buf, exp->e.expsid.exproot, 1);
if (exp->e.expsid.twoexp) {
list_char(buf, '(');
list_twoexp(buf, exp->e.expsid.twoexp, ":", 1);
list_char(buf, ')');
}
break;
case T_EXP_IS_NUM:
case T_EXP_IS_STRING:
list_exp(buf, exp->e.exp);
break;
default:
list_text(buf, "<error: list exp default action>");
}
}
static void
list_ast(BaseAST* ast, BaseAST* parentAst = NULL, int indent = 0) {
bool do_list_line = false;
bool is_C_loop = false;
const char* block_explain = NULL;
if (Expr* expr = toExpr(ast)) {
do_list_line = !parentAst || list_line(expr, parentAst);
if (do_list_line) {
printf("%-7d ", expr->id);
for (int i = 0; i < indent; i++)
printf(" ");
}
if (GotoStmt* e = toGotoStmt(ast)) {
printf("goto ");
if (SymExpr* label = toSymExpr(e->label)) {
if (label->var != gNil) {
list_ast(e->label, ast, indent+1);
}
} else {
list_ast(e->label, ast, indent+1);
}
} else if (toBlockStmt(ast)) {
block_explain = block_explanation(ast, parentAst);
printf("%s{\n", block_explain);
} else if (toCondStmt(ast)) {
printf("if ");
} else if (CallExpr* e = toCallExpr(expr)) {
if (e->isPrimitive(PRIM_BLOCK_C_FOR_LOOP))
is_C_loop = true;
if (e->primitive)
printf("%s( ", e->primitive->name);
else
printf("call( ");
} else if (NamedExpr* e = toNamedExpr(expr)) {
printf("%s = ", e->name);
} else if (toDefExpr(expr)) {
printf("def ");
} else if (SymExpr* e = toSymExpr(expr)) {
list_sym(e->var, false);
} else if (UnresolvedSymExpr* e = toUnresolvedSymExpr(expr)) {
printf("%s ", e->unresolved);
}
}
if (Symbol* sym = toSymbol(ast))
list_sym(sym);
bool early_newline = toFnSymbol(ast) || toModuleSymbol(ast);
if (early_newline || is_C_loop)
printf("\n");
int new_indent = indent;
if (isExpr(ast))
if (do_list_line)
new_indent = indent+2;
AST_CHILDREN_CALL(ast, list_ast, ast, new_indent);
if (Expr* expr = toExpr(ast)) {
CallExpr* parent_C_loop = NULL;
if (CallExpr* call = toCallExpr(parentAst))
if (call->isPrimitive(PRIM_BLOCK_C_FOR_LOOP))
parent_C_loop = call;
if (toCallExpr(expr)) {
printf(") ");
}
if (toBlockStmt(ast)) {
printf("%-7d ", expr->id);
if (*block_explain)
indent -= 2;
for (int i = 0; i < indent; i++)
printf(" ");
if ((parent_C_loop && parent_C_loop->get(3) == expr) || *block_explain)
printf("} ");
else
printf("}\n");
} else if (CondStmt* cond = toCondStmt(parentAst)) {
if (cond->condExpr == expr)
printf("\n");
} else if (!toCondStmt(expr) && do_list_line) {
DefExpr* def = toDefExpr(expr);
if (!(def && early_newline))
if (!parent_C_loop)
printf("\n");
}
}
}
static void
list_ast(BaseAST* ast, BaseAST* parentAst = NULL, int indent = 0) {
bool do_list_line = false;
bool is_C_loop = false;
const char* block_explain = NULL;
if (Expr* expr = toExpr(ast)) {
if (ForallStmt* pfs = toForallStmt(parentAst)) {
if (expr == pfs->fRecIterIRdef) {
printf("fRecIterIRdef");
} else if (expr == pfs->loopBody()) {
if (pfs->numShadowVars() == 0)
print_on_its_own_line(indent, "with() do\n");
else
print_on_its_own_line(indent, "do\n", false);
indent -= 2;
}
}
do_list_line = !parentAst || list_line(expr, parentAst);
if (do_list_line) {
printf("%-7d ", expr->id);
print_indent(indent);
}
if (const char* expl = forall_explanation_start(ast, parentAst))
printf("%s", expl);
if (GotoStmt* e = toGotoStmt(ast)) {
printf("goto ");
if (SymExpr* label = toSymExpr(e->label)) {
if (label->symbol() != gNil) {
list_ast(e->label, ast, indent+1);
}
} else {
list_ast(e->label, ast, indent+1);
}
} else if (toBlockStmt(ast)) {
block_explain = block_explanation(ast, parentAst);
const char* block_kind = ast->astTagAsString();
if (!strcmp(block_kind, "BlockStmt")) block_kind = "";
printf("%s{%s\n", block_explain, block_kind);
} else if (toCondStmt(ast)) {
printf("if ");
} else if (toIfExpr(ast)) {
printf("IfExpr ");
} else if (toForallStmt(ast)) {
printf("forall\n");
} else if (CallExpr* e = toCallExpr(expr)) {
if (e->isPrimitive(PRIM_BLOCK_C_FOR_LOOP))
is_C_loop = true;
if (e->primitive)
printf("%s( ", e->primitive->name);
else
printf("call( ");
} else if (ForallExpr* e = toForallExpr(expr)) {
if (e->zippered) printf("zip ");
printf("forall( ");
} else if (NamedExpr* e = toNamedExpr(expr)) {
printf("%s = ", e->name);
} else if (toDefExpr(expr)) {
Symbol* sym = toDefExpr(expr)->sym;
if (sym->type != NULL) {
printf("def %s ", sym->qualType().qualStr());
} else {
printf("def ");
}
} else if (SymExpr* e = toSymExpr(expr)) {
list_sym(e->symbol(), false);
} else if (UnresolvedSymExpr* e = toUnresolvedSymExpr(expr)) {
printf("%s ", e->unresolved);
} else if (isUseStmt(expr)) {
printf("use ");
}
}
if (Symbol* sym = toSymbol(ast))
list_sym(sym);
bool early_newline = toFnSymbol(ast) || toModuleSymbol(ast);
if (early_newline || is_C_loop)
printf("\n");
int new_indent = indent;
if (isExpr(ast))
if (do_list_line)
new_indent = indent+2;
AST_CHILDREN_CALL(ast, list_ast, ast, new_indent);
if (Expr* expr = toExpr(ast)) {
CallExpr* parent_C_loop = NULL;
if (CallExpr* call = toCallExpr(parentAst))
if (call->isPrimitive(PRIM_BLOCK_C_FOR_LOOP))
parent_C_loop = call;
if (toCallExpr(expr)) {
printf(") ");
}
if (toBlockStmt(ast)) {
printf("%-7d ", expr->id);
if (*block_explain)
indent -= 2;
print_indent(indent);
if ((parent_C_loop && parent_C_loop->get(3) == expr) || *block_explain)
printf("} ");
else if (isDeferStmt(parentAst))
printf("}"); // newline is coming
else
printf("}\n");
if (isForallLoopBody(expr) && parentAst != NULL) {
print_indent(indent);
printf(" end forall %d", parentAst->id);
}
} else if (ForallExpr* e = toForallExpr(expr)) {
if (e->cond) printf(") ");
else printf("} ");
} else if (UseStmt* use = toUseStmt(expr)) {
if (!use->isPlainUse()) {
if (use->hasExceptList()) {
printf("except ");
} else {
printf("only ");
}
bool first = true;
for_vector(const char, str, use->named) {
if (first) {
first = false;
} else {
printf(", ");
}
printf("%s", str);
}
for (std::map<const char*, const char*>::iterator it = use->renamed.begin();
it != use->renamed.end(); ++it) {
if (first) {
first = false;
} else {
printf(", ");
}
printf("%s as %s", it->second, it->first);
}
printf("\n");
}
} else if (CondStmt* cond = toCondStmt(parentAst)) {
