Skip to content

Commit

Permalink
Merge branch 'master' into submodule
Browse files Browse the repository at this point in the history
  • Loading branch information
@Thirumalai-Shaktivel
Thirumalai-Shaktivel committed Jul 8, 2021
2 parents 2f406ff + 6536f30 commit 3012134
Show file tree
Hide file tree
Showing 93 changed files with 1,064 additions and 778 deletions.
1 change: 1 addition & 0 deletions .mailmap
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,3 +3,4 @@ Gagandeep Singh <gdp.1807@gmail.com> czgdp1807 <gdp.1807@gmail.com>
Dominic Poerio <dompoerio@gmail.com> dvp <dompoerio@gmail.com>
Himanshu Pandey <himanshu7pandey7@gmail.com> hp77 <himanshu7pandey7@gmail.com>
Himanshu Pandey <himanshu7pandey7@gmail.com> hp77 <u19ee064@eed.svnit.ac.in>
Thirumalai Shaktivel <thirumalaishaktivel@gmail.com> Thirumalai-Shaktivel <thirumalaishaktivel@gmail.com>
13 changes: 11 additions & 2 deletions grammar/AST.asdl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,8 @@ program_unit
program_unit* contains)

unit_decl1
= Use(decl_attribute* nature, identifier module, use_symbol* symbols)
= Use(decl_attribute* nature, identifier module, use_symbol* symbols,
bool only_present)

unit_decl2
= Declaration(decl_attribute? vartype, decl_attribute* attributes,
Expand Down Expand Up @@ -147,6 +148,8 @@ stmt
concurrent_locality* locality, stmt* body)
| If(int label, identifier? stmt_name, expr test, stmt* body, stmt* orelse)
| Select(int label, identifier? stmt_name, expr test, case_stmt* body)
| SelectRank(int label, identifier? stmt_name, identifier? assoc_name,
expr selector, rank_stmt* body)
| SelectType(int label, identifier? stmt_name, identifier? assoc_name,
expr selector, type_stmt* body)
| Where(int label, identifier? stmt_name, expr test, stmt* body,
Expand Down Expand Up @@ -274,7 +277,7 @@ kind_item = (identifier? id, expr? value, kind_item_type type)
kind_item_type = Star | Colon | Value

dimension = (expr? start, expr? end, dimension_type end_star)
dimension_type = DimensionExpr | DimensionStar
dimension_type = DimensionExpr | DimensionStar | AssumedRank

codimension = (expr? start, expr? end, codimension_type end_star)
codimension_type = CodimensionExpr | CodimensionStar
Expand Down Expand Up @@ -335,6 +338,11 @@ case_stmt
| CaseStmt_Range(expr? start, expr? end, stmt* body)
| CaseStmt_Default(stmt* body)

rank_stmt
= RankExpr(expr value, stmt* body)
| RankStar(stmt* body)
| RankDefault(stmt* body)

type_stmt
= TypeStmtName(identifier? name, stmt* body)
| TypeStmtType(decl_attribute? vartype, stmt* body)
Expand All @@ -346,6 +354,7 @@ use_symbol
| UseAssignment()
| IntrinsicOperator(intrinsicop op)
| DefinedOperator(string opName)
| RenameOperator(string local_defop, string use_defop)

concurrent_control = ConcurrentControl(identifier? var, expr? start, expr? end, expr? increment)

Expand Down
4 changes: 2 additions & 2 deletions src/bin/lfortran.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -615,7 +615,7 @@ int compile_to_object_file(const std::string &infile, const std::string &outfile
if (err) return err;
}

if (!LFortran::main_program_present(*asr)) {
if (!LFortran::ASRUtils::main_program_present(*asr)) {
// Create an empty object file (things will be actually
// compiled and linked when the main program is present):
{
Expand Down Expand Up @@ -756,7 +756,7 @@ int compile_to_object_file_cpp(const std::string &infile,
if (err) return err;
}

if (!LFortran::main_program_present(*asr)) {
if (!LFortran::ASRUtils::main_program_present(*asr)) {
// Create an empty object file (things will be actually
// compiled and linked when the main program is present):
{
Expand Down
7 changes: 6 additions & 1 deletion src/lfortran/asr_utils.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,10 @@

namespace LFortran {

void visit(int a, std::map<int,std::vector<int>> &deps,
namespace ASRUtils {


void visit(int a, std::map<int,std::vector<int>> &deps,
std::vector<bool> &visited, std::vector<int> &result) {
visited[a] = true;
for (auto n : deps[a]) {
Expand Down Expand Up @@ -228,5 +231,7 @@ ASR::TranslationUnit_t* find_and_load_module(Allocator &al, const std::string &m
}
return asr;
}
} // namespace ASRUtils


} // namespace LFortran
287 changes: 287 additions & 0 deletions src/lfortran/asr_utils.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@

namespace LFortran {

namespace ASRUtils {

static inline ASR::expr_t* EXPR(const ASR::asr_t *f)
{
return ASR::down_cast<ASR::expr_t>(f);
Expand Down Expand Up @@ -185,6 +187,291 @@ void set_intrinsic(ASR::TranslationUnit_t* trans_unit);

void set_intrinsic(ASR::symbol_t* sym);

static inline int extract_kind_from_ttype_t(const ASR::ttype_t* curr_type) {
if( curr_type == nullptr ) {
return -1;
}
switch (curr_type->type) {
case ASR::ttypeType::Real : {
return ((ASR::Real_t*)(&(curr_type->base)))->m_kind;
}
case ASR::ttypeType::RealPointer : {
return ((ASR::RealPointer_t*)(&(curr_type->base)))->m_kind;
}
case ASR::ttypeType::Integer : {
return ((ASR::Integer_t*)(&(curr_type->base)))->m_kind;
}
case ASR::ttypeType::IntegerPointer : {
return ((ASR::IntegerPointer_t*)(&(curr_type->base)))->m_kind;
}
case ASR::ttypeType::Complex: {
return ((ASR::Complex_t*)(&(curr_type->base)))->m_kind;
}
case ASR::ttypeType::ComplexPointer: {
return ((ASR::ComplexPointer_t*)(&(curr_type->base)))->m_kind;
}
default : {
return -1;
}
}
}

static inline bool is_pointer(ASR::ttype_t* x) {
switch( x->type ) {
case ASR::ttypeType::IntegerPointer:
case ASR::ttypeType::RealPointer:
case ASR::ttypeType::ComplexPointer:
case ASR::ttypeType::CharacterPointer:
case ASR::ttypeType::LogicalPointer:
case ASR::ttypeType::DerivedPointer:
return true;
break;
default:
break;
}
return false;
}

inline bool is_array(ASR::ttype_t* x) {
int n_dims = 0;
switch( x->type ) {
case ASR::ttypeType::IntegerPointer: {
ASR::IntegerPointer_t* _type = (ASR::IntegerPointer_t*)(&(x->base));
n_dims = _type->n_dims;
break;
}
case ASR::ttypeType::Integer: {
ASR::Integer_t* _type = (ASR::Integer_t*)(&(x->base));
n_dims = _type->n_dims;
break;
}
case ASR::ttypeType::Real: {
ASR::Real_t* _type = (ASR::Real_t*)(&(x->base));
n_dims = _type->n_dims > 0;
break;
}
case ASR::ttypeType::RealPointer: {
ASR::RealPointer_t* _type = (ASR::RealPointer_t*)(&(x->base));
n_dims = _type->n_dims;
break;
}
case ASR::ttypeType::Complex: {
ASR::Complex_t* _type = (ASR::Complex_t*)(&(x->base));
n_dims = _type->n_dims > 0;
break;
}
case ASR::ttypeType::Logical: {
ASR::Logical_t* _type = (ASR::Logical_t*)(&(x->base));
n_dims = _type->n_dims > 0;
break;
}
default:
break;
}
return n_dims > 0;
}

inline bool is_same_type_pointer(ASR::ttype_t* source, ASR::ttype_t* dest) {
bool is_source_pointer = is_pointer(source), is_dest_pointer = is_pointer(dest);
if( (!is_source_pointer && !is_dest_pointer) ||
(is_source_pointer && is_dest_pointer) ) {
return false;
}
if( is_source_pointer && !is_dest_pointer ) {
ASR::ttype_t* temp = source;
source = dest;
dest = temp;
}
bool res = false;
switch( dest->type ) {
case ASR::ttypeType::IntegerPointer:
res = source->type == ASR::ttypeType::Integer;
break;
case ASR::ttypeType::RealPointer:
res = source->type == ASR::ttypeType::Real;
break;
case ASR::ttypeType::ComplexPointer:
res = source->type == ASR::ttypeType::Complex;
break;
case ASR::ttypeType::CharacterPointer:
res = source->type == ASR::ttypeType::Character;
break;
case ASR::ttypeType::LogicalPointer:
return source->type == ASR::ttypeType::Logical;
break;
case ASR::ttypeType::DerivedPointer:
res = source->type == ASR::ttypeType::Derived;
break;
default:
break;
}
return res;
}

inline int extract_kind(char* m_n) {
bool is_under_score = false;
char kind_str[2] = {'0', '0'};
int i = 1, j = 0;
for( ; m_n[i] != '\0'; i++ ) {
is_under_score = m_n[i-1] == '_' && !is_under_score ? true : is_under_score;
if( is_under_score ) {
kind_str[j] = m_n[i];
j++;
}
}
if( kind_str[0] != '0' && kind_str[1] == '0' ) {
return kind_str[0] - '0';
} else if( kind_str[0] != '0' && kind_str[0] != '0' ) {
return (kind_str[0] - '0')*10 + (kind_str[1] - '0');
}
return 4;
}

inline int extract_kind(ASR::expr_t* kind_expr, const Location& loc) {
int a_kind = 4;
switch( kind_expr->type ) {
case ASR::exprType::ConstantInteger: {
a_kind = ASR::down_cast<ASR::ConstantInteger_t>
(kind_expr)->m_n;
break;
}
case ASR::exprType::Var: {
ASR::Var_t* kind_var =
ASR::down_cast<ASR::Var_t>(kind_expr);
ASR::Variable_t* kind_variable =
ASR::down_cast<ASR::Variable_t>(
symbol_get_past_external(kind_var->m_v));
if( kind_variable->m_storage == ASR::storage_typeType::Parameter ) {
if( kind_variable->m_type->type == ASR::ttypeType::Integer ) {
if (ASR::is_a<ASR::ConstantInteger_t>(
*(kind_variable->m_value))) {
a_kind = ASR::down_cast
<ASR::ConstantInteger_t>
(kind_variable->m_value)->m_n;
} else if (ASR::is_a<ASR::FunctionCall_t>(
*(kind_variable->m_value))) {
ASR::FunctionCall_t *fc =
ASR::down_cast<ASR::FunctionCall_t>(
kind_variable->m_value);
ASR::Function_t *fn =
ASR::down_cast<ASR::Function_t>(
symbol_get_past_external(fc->m_name));
if (std::string(fn->m_name)=="kind") {
if (fc->n_args == 1){
// Start handling different constants
if (ASR::is_a<ASR::ConstantLogical_t>(
*fc->m_args[0])) {
ASR::ConstantLogical_t *l = ASR::down_cast<
ASR::ConstantLogical_t>(
fc->m_args[0]);
ASR::Logical_t *lt = ASR::down_cast<
ASR::Logical_t>(l->m_type);
a_kind = lt->m_kind;
} else if (ASR::is_a<ASR::ConstantReal_t>(
*fc->m_args[0])) {
ASR::ConstantReal_t *r = ASR::down_cast<
ASR::ConstantReal_t>(
fc->m_args[0]);
auto rstring = std::string(r->m_r);
if (rstring.find("d") != std::string::npos) {
a_kind = 8; // double precision
} else {
a_kind = 4; // single precision
}
} else if (ASR::is_a<ASR::ConstantInteger_t>(
*fc->m_args[0])) {
ASR::ConstantInteger_t *i = ASR::down_cast<
ASR::ConstantInteger_t>(
fc->m_args[0]);
int iint = i->m_n;
if (iint < 7) {
a_kind = 4;
} else {
a_kind = 8;
}
} else {
throw SemanticError("kind supports Real, Integer and Logical",
loc);
}
} else {
throw SemanticError("kind must not have more than one argument",
loc);
}
} else if (std::string(fn->m_name)
== "selected_int_kind") {
if (fc->n_args == 1 &&
ASR::is_a<ASR::ConstantInteger_t>(
*fc->m_args[0])) {
ASR::ConstantInteger_t *i = ASR::down_cast<
ASR::ConstantInteger_t>(
fc->m_args[0]);
int R = i->m_n;
if (R < 10) {
a_kind = 4;
} else {
a_kind = 8;
}
} else {
throw SemanticError("selected_int_kind",
loc);
}
} else if (std::string(fn->m_name)
== "selected_real_kind") {
if (fc->n_args == 1 &&
ASR::is_a<ASR::ConstantInteger_t>(
*fc->m_args[0])) {
ASR::ConstantInteger_t *i = ASR::down_cast<
ASR::ConstantInteger_t>(
fc->m_args[0]);
int R = i->m_n;
if (R < 7) {
a_kind = 4;
} else {
a_kind = 8;
}
} else {
throw SemanticError("selected_real_kind",
loc);
}
} else {
throw SemanticError("FunctionCall to '"
+ std::string(fn->m_name)
+ "' unsupported",
loc);
}
} else {
throw SemanticError("So far only ConstantInteger or FunctionCall supported as kind variable value",
loc);
}
} else {
std::string msg = "Integer variable required. " + std::string(kind_variable->m_name) +
" is not an Integer variable.";
throw SemanticError(msg, loc);
}
} else {
std::string msg = "Parameter " + std::string(kind_variable->m_name) +
" is a variable, which does not reduce to a constant expression";
throw SemanticError(msg, loc);
}
break;
}
default: {
throw SemanticError(R"""(Only Integer literals or expressions which reduce to constant Integer are accepted as kind parameters.)""",
loc);
}
}
return a_kind;
}

inline bool check_equal_type(ASR::ttype_t* x, ASR::ttype_t* y) {
if( x->type == y->type ) {
return true;
}

return ASRUtils::is_same_type_pointer(x, y);
}
} // namespace ASRUtils

} // namespace LFortran

#endif // LFORTRAN_ASR_UTILS_H
Loading

0 comments on commit 3012134

Please sign in to comment.