Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enable data implied do #3

Draft
wants to merge 10 commits into
base: main
Choose a base branch
from
Draft

Enable data implied do #3

Show file tree
Hide file tree
Changes from 7 commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
7c91ddf
initial exploratory commit
konradha Oct 12, 2022
f3fc0d8
progress commit
konradha Oct 13, 2022
f838c8e
some cleaning up before full implementation runs
konradha Oct 13, 2022
776fd02
add algorithmic exploration
konradha Oct 14, 2022
31638c0
Merge remote-tracking branch 'gh-main/main' into enable-data-implied-do
konradha Oct 17, 2022
4f52f43
add more exploration
konradha Oct 17, 2022
ecfc87f
more exploration
konradha Oct 17, 2022
5cdd13a
uncover one more bug
konradha Oct 18, 2022
208f404
Merge remote-tracking branch 'gh-main/main' into enable-data-implied-do
konradha Oct 18, 2022
6202f72
progress update
konradha Oct 19, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
161 changes: 161 additions & 0 deletions src/lfortran/semantics/ast_body_visitor.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
#include <string>
#include <cmath>
#include <set>
#include <variant>

#include <lfortran/ast.h>
#include <libasr/asr.h>
Expand Down Expand Up @@ -455,6 +456,166 @@ class BodyVisitor : public CommonVisitor<BodyVisitor> {
}
}

void visit_DataImpliedDo(const AST::DataImpliedDo_t &x) {
std::string loop_var_name = to_lower(x.m_var);
// auto sym = current_scope->resolve_symbol(array);
// if (sym != nullptr) throw SemanticError("Data statement loop variable cannot be have same name as other variable.", x.base.base.loc);
auto start = AST::down_cast<AST::Num_t>(x.m_start);
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

IMHO, we should use full type name instead of auto. I prefer verbosity over ease of typing.

Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't really care about ease of typing, it's much more easy to read I think. But sure, I'll change it once I actually open a PR.

auto end = AST::down_cast<AST::Num_t>(x.m_end);
AST::Num_t *incr = nullptr;
if (x.m_increment != nullptr && AST::is_a<AST::Num_t>(*x.m_increment)) {
incr = AST::down_cast<AST::Num_t>(x.m_increment);
}

// std::array<{AST::FuncCallOrArray_t, std::array<std::variant<ASR::IntegerConstant, ASR::Variable_t>> of size (args.n-1)}>

std::map<AST::FuncCallOrArray_t *, std::vector<ASR::expr_t *> > func_calls;

for (size_t i = 0; i < x.n_object_list; ++i) {
auto obj = x.m_object_list[i];
if (AST::is_a<AST::FuncCallOrArray_t>(*obj)) {
auto arr = AST::down_cast<AST::FuncCallOrArray_t>(obj);
auto arr_symbol = current_scope->resolve_symbol(to_lower(arr->m_func));
ASR::Variable_t *arr_var = nullptr;
if (ASR::is_a<ASR::Variable_t>(*arr_symbol)) {
arr_var = ASR::down_cast<ASR::Variable_t>(arr_symbol);
std::cout << "found variable " << arr_var->m_name << "\n";
} else {
throw SemanticError("Data variable not declared.", x.base.base.loc);
}

ASR::ttype_t *duplicated_type = ASRUtils::duplicate_type(al, arr_var->m_type);


func_calls[arr] = {};
Vec<ASR::call_arg_t> args;
visit_expr_list(arr->m_args, arr->n_args, args);
for (size_t i = 0; i< args.n; ++i) {
if (ASR::is_a<ASR::IntegerConstant_t>(*(args[i].m_value))) {
auto num = ASR::down_cast<ASR::IntegerConstant_t>(args[i].m_value);
func_calls[arr].push_back((ASR::expr_t*)num);

} else if (ASR::is_a<ASR::Var_t>(*(args[i].m_value))) {
auto var = ASR::down_cast<ASR::Var_t>(args[i].m_value);
func_calls[arr].push_back((ASR::expr_t*)var);
if (ASR::is_a<ASR::Variable_t>(*var->m_v)) {
auto variable = ASR::down_cast<ASR::Variable_t>(var->m_v);
if (loop_var_name != variable->m_name) throw SemanticError("Need to have consistent loop variable in data statement", x.base.base.loc);
}
} else {
throw SemanticError("Can only assign to variables and integers in data statement", x.base.base.loc);
}
} // coeff(i, i, 1) <- collect (`i`, 0); (`i`, 1) and (`1`, 2) [the symbol + the index to fill in]

// collected all indices, can now fill in
size_t iter = 1;
if (incr != nullptr) iter = incr->m_n;
auto els = func_calls[arr];
std::cout << "start = " << start->m_n << ", end = " << end->m_n << ", iter = " << iter << "\n";

// Vec<array_index_t> v_args;
// ASR::asr_t* duplicate_ArrayItem(ArrayItem_t* x)

for (size_t i = 0; i < els.size(); ++i) {
if (ASR::is_a<ASR::IntegerConstant_t>(*els[i])) {
auto el = ASR::down_cast<ASR::IntegerConstant_t>(els[i]);
// std::cout << i << ": " << el->m_n << "\n";
} else if (ASR::is_a<ASR::Var_t>(*els[i])) {
// everytime this one is encountered, the number of
// combinations is multiplied by num_steps (ie. start=1, end=5, iter=1 -> num_steps=5)
// and we have another range of possibilities we have to enter
// arr(i, i, i, 1) with start=1 end=50 iter=10 has
// arr(1, 1, 1, 1) ... arr(1, 11, 11, 1) ... arr(22, 33, 44, 1) etc
// in this case: 125 entries to fill in
auto el = ASR::down_cast<ASR::Var_t>(els[i]);
auto var = ASR::down_cast<ASR::Variable_t>(el->m_v);
// std::cout << i << ": " << var->m_name << "\n";
}
}

ASR::ttype_t *t = LFortran::ASRUtils::TYPE(ASR::make_Integer_t(al, x.base.base.loc,
4, nullptr, 0));

// expr_t* a_v, array_index_t* a_args, size_t n_args, ttype_t* a_type, expr_t* a_value
ASR::expr_t *idx_var = ASRUtils::EXPR(ASR::make_IntegerConstant_t(al, x.base.base.loc, 1,
t));
ASR::array_index_t ai;
ai.loc = x.base.base.loc;
ai.m_left = ai.m_right = nullptr;
ai.m_right = idx_var;
Vec<ASR::array_index_t> argsi; argsi.reserve(al, 1);
argsi.push_back(al, ai);

ASR::ttype_t* array_ref_type = ASRUtils::expr_type(ASRUtils::EXPR((ASR::asr_t*)arr_var));
Vec<ASR::dimension_t> empty_dims;
empty_dims.reserve(al, 1);
array_ref_type = ASRUtils::duplicate_type(al, array_ref_type, &empty_dims);


auto var_var = ASRUtils::EXPR(ASR::make_Var_t(al, x.base.base.loc, arr_symbol));
tmp = ASR::make_ArrayItem_t(al, x.base.base.loc, var_var, argsi.p, 1, array_ref_type, nullptr);


return;
// TODO
// ASR::make_Array

// std::vector<size_t> range{};
// for (size_t i = start->m_n; i <= size_t(end->m_n); i += iter) range.push_back(i);
// auto print = [&](std::vector<size_t> &c) {
// std::cout << "{"; for (const auto &el : c) std::cout << el << ",";
// std::cout << "} x ";
// };

// for (size_t i = 0; i < els.size(); ++i) {
// if (ASR::is_a<ASR::IntegerConstant_t>(*els[i])) {
// auto el = ASR::down_cast<ASR::IntegerConstant_t>(els[i]);
// std::cout << "{" << el->m_n << "} x ";
// } else if (ASR::is_a<ASR::Var_t>(*els[i])) {
// print(range);
// }
// }




// for (size_t i = start->m_n; i <= size_t(end->m_n); i += iter) {
// if (ASR::is_a<ASR::IntegerConstant_t>(*els[i])) {
// auto el = ASR::down_cast<ASR::IntegerConstant_t>(els[i]);
// std::cout << i << ": " << el->m_n << "\n";
// } else if (ASR::is_a<ASR::Var_t>(*els[i])) {
// auto el = ASR::down_cast<ASR::Var_t>(els[i]);
// auto var = ASR::down_cast<ASR::Variable_t>(el->m_v);
// std::cout << i << ": " << var->m_name << "\n";
// } else {
// std::cout << "we have a problem\n";
// }
// }



// arr->m_func holds the array to assign to
// std::string array = to_lower(arr->m_func);
// auto sym = current_scope->resolve_symbol(array);
// if (sym == nullptr /*&& !compiler_options.implicit_typing*/) throw SemanticError("Data Statement Variable not declared.", x.base.base.loc);
} else {
throw SemanticError("Implied loop in data statement currently only supported for arrays.", x.base.base.loc);
}
}

// size_t iter = 1;
// if (incr != nullptr) iter = incr->m_n;
// for (size_t i = start->m_n; i <= end->m_n; i += iter) {
// std::cout << "iter " << i << " of " << end->m_n << "\n";
// }



auto sym = current_scope->resolve_symbol(loop_var_name);
// TODO: change to ==
if (sym == nullptr) throw SemanticError("Data Statement variable not declared.", x.base.base.loc);
}

void visit_Inquire(const AST::Inquire_t& x) {
std::map<std::string, size_t> argname2idx = {
{"unit", 0}, {"file", 1}, {"iostat", 2}, {"err", 3},
Expand Down
18 changes: 15 additions & 3 deletions src/lfortran/semantics/ast_common_visitor.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -862,14 +862,25 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
// data x / 1.0, 2.0 /, a, b / 1.0, 2.0 /, c / 1.0 /
for (size_t i=0; i < x.n_items; i++) {
AST::DataStmtSet_t *a = AST::down_cast<AST::DataStmtSet_t>(x.m_items[i]);
bool has_implied_do = false;
// introduce preprocessing step
if (AST::is_a<AST::DataImpliedDo_t>(*a->m_object[0])) {
std::cout << "has implied do\n";
has_implied_do = true;
}


// Now we are dealing with just one item, there are three cases possible:
// data x / 1, 2, 3 / ! x must be an array
// data x / 1 / ! x must be a scalar (integer)
// data x, y, z / 1, 2, 3 / ! x, y, z must be a scalar (integer)
if (a->n_object != a->n_value) {
if (a->n_object != a->n_value && !has_implied_do) {
// This is the first case:
// data x / 1, 2, 3 / ! x must be an array
if (a->n_object == 1) {
std::cout << "in " << __LINE__ << "\n";
// this is the point at which visit_DataImpliedDo is called
// -> the object will need to yield an expression
this->visit_expr(*a->m_object[0]);
ASR::expr_t* object = ASRUtils::EXPR(tmp);
ASR::ttype_t* obj_type = ASRUtils::expr_type(object);
Expand Down Expand Up @@ -920,10 +931,10 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
x.base.base.loc);
}
} else {
std::cout << "in " << __LINE__ << "\n";
// This is the second and third case:
// data x / 1 / ! x must be a scalar (integer)
// data x, y, z / 1, 2, 3 / ! x, y, z must be a scalar (integer)

// Note: this also happens for a case like:
// data x(1), x(2), x(3) / 1, 2, 3 /
for (size_t i=0;i<a->n_object;++i) {
Expand All @@ -932,8 +943,9 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
// y / 2 /
// or
// x(2) / 2 /
//
std::cout << "before visit_expr line" << __LINE__ << "\n";
this->visit_expr(*a->m_object[i]);
std::cout << "after visit_expr line" << __LINE__ << "\n";
ASR::expr_t* object = LFortran::ASRUtils::EXPR(tmp);
this->visit_expr(*a->m_value[i]);
ASR::expr_t* value = LFortran::ASRUtils::EXPR(tmp);
Expand Down
31 changes: 31 additions & 0 deletions tests/fixed_form/implied_do1.f
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,31 @@
subroutine dt1()
double precision coef(5,4)

double precision coef2(5, 4, 4)

!DATA (coef(i,1),i=1,5)/1.0D0,1.0D0,3*0.0D0/
!DATA (coef(i,1),i=1,5)/1.0D0,1.0D0,0.0D0,0.0D0, 0.0D0/
! invalid: no actual expression as factors, only constants -- DATA (coef(i,1),i=1,5)/(1+1)*0.0D0, 1*1.0D0, 2*2.0D0/
! invalid (error case): DATA (coef(J,1),i=1,5)/2*0.0D0, 1*1.0D0, 2*2.0D0/
! the below is valid, too:
!double precision coef(5,5)
!DATA (coef(i,i),i=1,5)/2*0.0D0, 1*1.0D0, 2*2.0D0/

! endboss: DATA ( W(I,1), X(I,1), I = 1,3) / ...
!DATA (coef(i,1),coef2(i, 2, 2),i=1,5)/2*0.0D0, 1*1.0D0, 2*2.0D0, 2
!* *0.0D0, 1*1.0D0, 2*2.0D0/

integer i
!DATA (coef(i,1),i=1,5)/2*0.0D0, 1*1.0D0, 2*2.0D0/
!DATA (coef(i,1),i=1,5)/0.0D0, 0.0D0, 1.0D0, 2.0D0, 2.0D0/
DATA (coef(i,1),i=1,1)/0.0D0/

do i=1,5
print *, coef(i, 1)
end do
END


program main
call dt1()
end program