void AST_t::prepend_to_translation_unit(AST_t tree)
{
if (tree._ast == NULL)
{
return;
}
AST this_translation_unit = get_translation_unit(this->_ast);
AST this_declaration_seq = ASTSon0(this_translation_unit);
// Go to the very first one!
while (ASTSon0(this_declaration_seq) != NULL)
{
this_declaration_seq = ASTSon0(this_declaration_seq);
}
AST tree_declaration_seq = tree._ast;
if (this_declaration_seq == NULL)
{
ast_set_child(this_translation_unit, 0, tree_declaration_seq);
}
else
{
prepend_list(this_declaration_seq, tree_declaration_seq);
}
}
void ASTIterator::previous()
{
if (_current != NULL)
{
_current = ASTSon0(_current);
}
}
void AST_t::remove_in_list()
{
AST list = this->_ast;
// Look for the enclosing list
while (list != NULL &&
ASTType(list) != AST_NODE_LIST)
{
list = ASTParent(list);
}
if (list == NULL)
{
std::cerr << "A suitable list has not been found" << std::endl;
return;
}
AST parent = ASTParent(list);
AST previous = ASTSon0(list);
if (previous != NULL)
{
ast_set_parent(previous, parent);
}
int i;
for (i = 0; i < ASTNumChildren(parent); i++)
{
if (ASTChild(parent, i) == list)
{
ast_set_child(parent, i, previous);
break;
}
}
}
void AST_t::replace(AST_t ast)
{
if (ast._ast == NULL)
{
internal_error("Trying to replace a tree with an empty tree", 0);
}
if (this->_ast == NULL)
{
internal_error("Trying to replace an empty tree with another tree", 0);
}
if (ASTType(ast._ast) == AST_NODE_LIST)
{
// If the replacement is a list but the original is not, let's check two cases
// maybe this list is a one-element list or not.
if (ASTType(this->_ast) != AST_NODE_LIST)
{
// If it is a one element list
if (ASTSon0(ast._ast) == NULL)
{
// then replace the whole thing with the list information
AST_t repl_tree(ASTSon1(ast._ast));
replace_with(repl_tree);
}
// If this is not a one-element list then try to replace using
// a typical replace_in_list but this may fail sometimes
// because we'll look for the first enclosing list
else
{
// Maybe we should yield a message here
// std::cerr << "Warning: Replacing a non-list tree at '"
// << this->get_locus()
// << "' with a list tree of more than one element" << std::endl;
replace_in_list(ast);
}
}
// If both are lists is easy
else
{
replace_in_list(ast);
}
}
// If the thing being replaced is a list, but the replacement
// is not, then convert the latter into a list
else if (ASTType(_ast) == AST_NODE_LIST
&& ASTType(_ast) != AST_NODE_LIST)
{
// Create a single element list
AST single(ASTListLeaf(ast._ast));
replace_in_list(single);
}
// Otherwise replace directly. Neither the replaced nor the replacement
// are lists in this case.
else
{
replace_with(ast);
}
}
bool ASTIterator::is_first()
{
if (_current == NULL)
{
return true;
}
return (ASTSon0(_current) == NULL);
}
ObjectList<AST_t> AST_t::children() const
{
ObjectList<AST_t> result;
result.append(AST_t(ASTSon0(_ast)));
result.append(AST_t(ASTSon1(_ast)));
result.append(AST_t(ASTSon2(_ast)));
result.append(AST_t(ASTSon3(_ast)));
return result;
}
void Source::fortran_check_expression_adapter(AST a, const decl_context_t* decl_context, nodecl_t* nodecl_output)
{
if (ASTKind(a) == AST_COMMON_NAME)
{
// We allow common names in expressions
scope_entry_t* entry = ::query_common_name(decl_context, ASTText(ASTSon0(a)),
ast_get_locus(ASTSon0(a)));
if (entry != NULL)
{
*nodecl_output = ::nodecl_make_symbol(entry, ast_get_locus(a));
}
else
{
*nodecl_output = ::nodecl_make_err_expr(ast_get_locus(a));
}
}
else
{
::fortran_check_expression(a, decl_context, nodecl_output);
}
}
void AST_t::replace_in_list(AST_t ast)
{
if (ast._ast == NULL)
{
std::cerr << "Cannot replace a list using an empty tree" << std::endl;
return;
}
if (this->_ast == NULL)
{
std::cerr << "This tree is empty" << std::endl;
return;
}
if (ASTType(ast._ast) != AST_NODE_LIST)
{
std::cerr << "The replacement tree is not a list. No replacement performed" << std::endl;
return;
}
AST list = get_enclosing_list(this->_ast);
if (list == NULL)
{
std::cerr << "A suitable list has not been found" << std::endl;
return;
}
AST previous = ASTSon0(list);
AST_t replaced(list);
replaced.replace_with(ast);
while (ASTSon0(list) != NULL)
{
list = ASTSon0(list);
}
ast_set_child(list, 0, previous);
}
// XXX - Fixme, implement it using ast_list_concat
void AST_t::prepend_list(AST orig_list, AST prepended_list)
{
if (ASTType(orig_list) != AST_NODE_LIST
|| ASTType(prepended_list) != AST_NODE_LIST)
{
std::cerr << "You tried to prepend two lists that are not "
<< "orig_list=" << ast_print_node_type(ASTType(orig_list)) << " "
<< "prepend_list=" << ast_print_node_type(ASTType(prepended_list)) << std::endl;
return;
}
// Relink the parent, first remove pointer to the prepended_list
if (ASTParent(prepended_list) != NULL)
{
AST parent = ASTParent(prepended_list);
for (int i = 0; i < ASTNumChildren(parent); i++)
{
if (ASTChild(parent, i) == prepended_list)
{
ast_set_child(parent, i, NULL);
break;
}
}
}
// Now make the prepended_list as the son
AST original_previous = ASTSon0(orig_list);
ast_set_child(orig_list, 0, prepended_list);
// Go to the deeper node of prepended_list
AST iter = prepended_list;
while (ASTSon0(iter) != NULL)
{
iter = ASTSon0(iter);
}
ast_set_child(iter, 0, original_previous);
}
AST AST_t::get_list_of_extensible_block(AST node)
{
switch ((int)ASTType(node))
{
case AST_COMPOUND_STATEMENT :
{
// This can be null
return ASTSon0(node);
break;
}
case AST_CLASS_SPECIFIER :
{
// This can be null
return ASTSon1(node);
break;
}
case AST_TRANSLATION_UNIT :
{
// This can be null
return ASTSon0(node);
break;
}
case AST_NAMESPACE_DEFINITION :
{
// This can be null
return ASTSon1(node);
break;
}
case AST_NODE_LIST :
{
return node;
break;
}
}
return NULL;
}
// XXX - Fixme, implement it using ast_list_concat
void AST_t::append_list(AST orig_list, AST appended_list)
{
if (ASTType(orig_list) != AST_NODE_LIST
|| ASTType(appended_list) != AST_NODE_LIST)
{
std::cerr << "You tried to append two lists that are not" << std::endl;
return;
}
// Appending one list to another is as easy as making the deeper node
// "appended_list" to point to the top node of "orig_list"
// First replace appended_list as the new child of the parent of orig_list
relink_parent(orig_list, appended_list);
// Now link the deeper node of the list to the top node of "orig_list"
AST iter = appended_list;
while (ASTSon0(iter) != NULL)
{
iter = ASTSon0(iter);
}
ast_set_child(iter, 0, orig_list);
}
bool ASTIterator::is_last()
{
if (_current == NULL)
return true;
AST _possible_next = ASTParent(_current);
if (_possible_next == NULL
|| ASTType(_possible_next) != AST_NODE_LIST)
{
return true;
}
else if (ASTType(_possible_next) == AST_NODE_LIST
&& ASTSon0(_possible_next) != _current)
{
return true;
}
return false;
}
static void compute_nodecl_parse_c_type(AST type_id, const decl_context_t* decl_context, nodecl_t* nodecl_output)
{
nodecl_t nodecl_out_type = nodecl_null();
type_t* type_info = NULL;
gather_decl_spec_t gather_info;
memset(&gather_info, 0, sizeof(gather_info));
AST type_specifier_seq = ASTSon0(type_id);
AST abstract_decl = ASTSon1(type_id);
build_scope_decl_specifier_seq(type_specifier_seq, &gather_info, &type_info,
decl_context, &nodecl_out_type);
type_t* declarator_type = type_info;
compute_declarator_type(abstract_decl, &gather_info, type_info,
&declarator_type, decl_context, &nodecl_out_type);
*nodecl_output = nodecl_make_type(declarator_type, ast_get_locus(type_id));
}
void AST_t::append_to_translation_unit(AST_t tree)
{
if (tree._ast == NULL)
{
return;
}
AST this_translation_unit = get_translation_unit(this->_ast);
AST this_declaration_seq = ASTSon0(this_translation_unit);
AST tree_declaration_seq = tree._ast;
if (this_declaration_seq == NULL)
{
ast_set_child(this_translation_unit, 0, tree_declaration_seq);
}
else
{
append_list(this_declaration_seq, tree_declaration_seq);
}
}
static void gather_ms_declspec_item(AST a,
gather_decl_spec_t* gather_info,
const decl_context_t* decl_context)
{
ERROR_CONDITION(ASTKind(a) != AST_MS_DECLSPEC_ITEM, "Invalid node", 0);
const char* declspec_name = ASTText(a);
ERROR_CONDITION(declspec_name == NULL, "Invalide node", 0);
if (strcmp(declspec_name, "align") == 0)
{
AST expr_list = ASTSon0(a);
int num_items = 0;
if (expr_list != NULL)
{
AST it = NULL;
for_each_element(expr_list, it)
{
num_items++;
}
}
static void fortran_simplify_tree_stmt(AST a, AST *out)
{
// FIXME: Think ways of improving this
switch (ASTType(a))
{
case AST_ALLOCATE_STATEMENT:
case AST_ARITHMETIC_IF_STATEMENT:
case AST_ASSIGNED_GOTO_STATEMENT:
case AST_BREAK_STATEMENT:
case AST_CLOSE_STATEMENT:
case AST_COMPUTED_GOTO_STATEMENT:
case AST_CONTINUE_STATEMENT:
case AST_DEALLOCATE_STATEMENT:
case AST_EMPTY_STATEMENT:
case AST_EXPRESSION_STATEMENT:
case AST_GOTO_STATEMENT:
case AST_IO_STATEMENT:
case AST_LABEL_ASSIGN_STATEMENT:
case AST_NULLIFY_STATEMENT:
case AST_OPEN_STATEMENT:
case AST_PRINT_STATEMENT:
case AST_READ_STATEMENT:
case AST_RETURN_STATEMENT:
case AST_STOP_STATEMENT:
case AST_PAUSE_STATEMENT:
case AST_WRITE_STATEMENT:
case AST_PRAGMA_CUSTOM_DIRECTIVE:
{
// Simple copy
*out = ast_copy_with_scope_link(a, CURRENT_COMPILED_FILE->scope_link);
break;
}
case AST_BLOCK_CONSTRUCT:
{
AST block = ASTSon1(a);
AST new_block = NULL;
AST it;
for_each_element(block, it)
{
AST stmt = ASTSon1(it);
AST new_stmt = NULL;
fortran_simplify_tree_stmt(stmt, &new_stmt);
if (new_stmt != NULL)
{
new_block = ASTList(new_block, new_stmt);
}
}
*out = ASTMake1(AST_COMPOUND_STATEMENT, new_block, ASTFileName(a), ASTLine(a), NULL);
break;
}
case AST_COMPOUND_STATEMENT:
{
AST list = ASTSon0(a);
AST new_list = NULL;
AST it;
for_each_element(list, it)
{
AST stmt = ASTSon1(it);
AST new_stmt = NULL;
fortran_simplify_tree_stmt(stmt, &new_stmt);
if (new_stmt != NULL)
{
new_list = ASTList(new_list, new_stmt);
}
}
*out = ASTMake1(AST_COMPOUND_STATEMENT, new_list, ASTFileName(a), ASTLine(a), NULL);
break;
}
