Merge pull request #2632 from czgdp1807/sync_libas_contd

Sync ``libasr`` with LC

src/libasr/asr_utils.h

@@ -2013,6 +2013,12 @@ static inline bool is_pointer(ASR::ttype_t *x) {
 }
 
 static inline bool is_integer(ASR::ttype_t &x) {
+    // return ASR::is_a<ASR::Integer_t>(
+    //     *type_get_past_const(
+    //         type_get_past_array(
+    //         type_get_past_allocatable(
+    //             type_get_past_pointer(
+    //                 type_get_past_const(&x))))));
     return ASR::is_a<ASR::Integer_t>(
         *type_get_past_const(
             type_get_past_array(
@@ -2028,6 +2034,11 @@ static inline bool is_unsigned_integer(ASR::ttype_t &x) {
 }
 
 static inline bool is_real(ASR::ttype_t &x) {
+    // return ASR::is_a<ASR::Real_t>(
+    //     *type_get_past_const(
+    //         type_get_past_array(
+    //             type_get_past_allocatable(
+    //                 type_get_past_pointer(&x)))));
     return ASR::is_a<ASR::Real_t>(
         *type_get_past_array(
             type_get_past_allocatable(
@@ -2196,6 +2207,10 @@ inline size_t extract_dimensions_from_ttype(ASR::ttype_t *x,
 }
 
 static inline ASR::ttype_t *extract_type(ASR::ttype_t *type) {
+    // return type_get_past_const(
+    //             type_get_past_array(
+    //                 type_get_past_allocatable(
+    //                     type_get_past_pointer(type))));
     return type_get_past_array(
             type_get_past_allocatable(
                 type_get_past_pointer(type)));
@@ -3035,6 +3050,12 @@ inline bool types_equal(ASR::ttype_t *a, ASR::ttype_t *b,
     if( a == nullptr && b == nullptr ) {
         return true;
     }
+    // a = ASRUtils::type_get_past_const(
+    //         ASRUtils::type_get_past_allocatable(
+    //             ASRUtils::type_get_past_pointer(a)));
+    // b = ASRUtils::type_get_past_const(
+    //         ASRUtils::type_get_past_allocatable(
+    //             ASRUtils::type_get_past_pointer(b)));
     a = ASRUtils::type_get_past_allocatable(ASRUtils::type_get_past_pointer(a));
     b = ASRUtils::type_get_past_allocatable(ASRUtils::type_get_past_pointer(b));
     if( !check_for_dimensions ) {

src/libasr/asr_verify.cpp

@@ -525,6 +525,8 @@ class VerifyVisitor : public BaseWalkVisitor<VerifyVisitor>
                 ASR::is_a<ASR::CustomOperator_t>(*a.second) ) {
                 continue ;
             }
+            // TODO: Uncomment the following line
+            // ASR::ttype_t* var_type = ASRUtils::extract_type(ASRUtils::symbol_type(a.second));
             ASR::ttype_t* var_type = ASRUtils::type_get_past_pointer(ASRUtils::symbol_type(a.second));
             char* aggregate_type_name = nullptr;
             ASR::symbol_t* sym = nullptr;

src/libasr/casting_utils.cpp

@@ -84,6 +84,9 @@ namespace LCompilers::CastingUtil {
         }
 
         int casted_expr_signal = 2;
+        // TODO: Uncomment the following
+        // ASR::ttypeType left_Type = ASRUtils::extract_type(left_type)->type,
+        //     right_Type = ASRUtils::extract_type(right_type)->type;
         ASR::ttypeType left_Type = left_type->type, right_Type = right_type->type;
         int left_kind = ASRUtils::extract_kind_from_ttype_t(left_type);
         int right_kind = ASRUtils::extract_kind_from_ttype_t(right_type);
@@ -121,6 +124,9 @@ namespace LCompilers::CastingUtil {
         if( ASR::is_a<ASR::Const_t>(*src) ) {
             src = ASRUtils::get_contained_type(src);
         }
+        // TODO: Uncomment the following
+        // ASR::ttypeType src_type = ASRUtils::extract_type(src)->type;
+        // ASR::ttypeType dest_type = ASRUtils::extract_type(dest)->type;
         ASR::ttypeType src_type = src->type;
         ASR::ttypeType dest_type = dest->type;
         ASR::cast_kindType cast_kind;

src/libasr/casting_utils.h

@@ -2,8 +2,6 @@
 #define LFORTRAN_CASTING_UTILS_H
 
 
-#include <functional>
-
 #include <libasr/asr.h>
 
 namespace LCompilers::CastingUtil {

src/libasr/codegen/asr_to_c_cpp.h

@@ -1157,6 +1157,9 @@ PyMODINIT_FUNC PyInit_lpython_module_)" + fn_name + R"((void) {
                         + "' not implemented");
             }
         } else {
+            if (fn_name == "main") {
+                fn_name = "_xx_lcompilers_changed_main_xx";
+            }
             src = fn_name + "(" + construct_call_args(fn, x.n_args, x.m_args) + ")";
         }
         last_expr_precedence = 2;

src/libasr/codegen/asr_to_fortran.cpp

@@ -1267,6 +1267,7 @@ class ASRToFortranVisitor : public ASR::BaseVisitor<ASRToFortranVisitor>
             SET_INTRINSIC_NAME(StringContainsSet, "verify");
             SET_INTRINSIC_NAME(StringFindSet, "scan");
             SET_INTRINSIC_NAME(SubstrIndex, "index");
+            SET_INTRINSIC_NAME(Modulo, "modulo");
             default : {
                 throw LCompilersException("IntrinsicElementalFunction: `"
                     + ASRUtils::get_intrinsic_name(x.m_intrinsic_id)

src/libasr/codegen/asr_to_julia.cpp

@@ -1905,6 +1905,7 @@ class ASRToJuliaVisitor : public ASR::BaseVisitor<ASRToJuliaVisitor>
             SET_INTRINSIC_NAME(StringContainsSet, "verify");
             SET_INTRINSIC_NAME(StringFindSet, "scan");
             SET_INTRINSIC_NAME(SubstrIndex, "index");
+            SET_INTRINSIC_NAME(Modulo, "modulo");
             default : {
                 throw LCompilersException("IntrinsicFunction: `"
                     + ASRUtils::get_intrinsic_name(x.m_intrinsic_id)

src/libasr/codegen/asr_to_llvm.cpp

@@ -1505,7 +1505,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
         this->visit_expr(*x.m_v);
         ptr_loads = ptr_loads_copy;
         llvm::Value* union_llvm = tmp;
-        ASR::Variable_t* member_var = ASR::down_cast<ASR::Variable_t>(x.m_m);
+        ASR::Variable_t* member_var = ASR::down_cast<ASR::Variable_t>(
+            ASRUtils::symbol_get_past_external(x.m_m));
         ASR::ttype_t* member_type_asr = ASRUtils::get_contained_type(member_var->m_type);
         if( ASR::is_a<ASR::Struct_t>(*member_type_asr) ) {
             ASR::Struct_t* d = ASR::down_cast<ASR::Struct_t>(member_type_asr);
@@ -2424,7 +2425,7 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
         this->visit_expr(*x.m_shape);
         llvm::Value* shape = tmp;
         ASR::ttype_t* x_m_array_type = ASRUtils::expr_type(x.m_array);
-                ASR::array_physical_typeType array_physical_type = ASRUtils::extract_physical_type(x_m_array_type);
+        ASR::array_physical_typeType array_physical_type = ASRUtils::extract_physical_type(x_m_array_type);
         switch( array_physical_type ) {
             case ASR::array_physical_typeType::DescriptorArray: {
                 ASR::ttype_t* asr_data_type = ASRUtils::duplicate_type_without_dims(al,
@@ -4549,6 +4550,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
         bool is_value_set = ASR::is_a<ASR::Set_t>(*asr_value_type);
         bool is_target_struct = ASR::is_a<ASR::Struct_t>(*asr_target_type);
         bool is_value_struct = ASR::is_a<ASR::Struct_t>(*asr_value_type);
+        bool is_value_list_to_array = (ASR::is_a<ASR::Cast_t>(*x.m_value) &&
+            ASR::down_cast<ASR::Cast_t>(x.m_value)->m_kind == ASR::cast_kindType::ListToArray);
         if (ASR::is_a<ASR::StringSection_t>(*x.m_target)) {
             handle_StringSection_Assignment(x.m_target, x.m_value);
             if (tmp == strings_to_be_deallocated.back()) {
@@ -4767,7 +4770,37 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
                 target = CreateLoad(target);
             }
             ASR::ttype_t *cont_type = ASRUtils::get_contained_type(asr_target_type);
-            if (ASRUtils::is_array(cont_type) && ASRUtils::is_array(cont_type) ) {
+            if ( ASRUtils::is_array(cont_type) ) {
+                if( is_value_list_to_array ) {
+                    this->visit_expr_wrapper(x.m_value, true);
+                    llvm::Value* list_data = tmp;
+                    int64_t ptr_loads_copy = ptr_loads;
+                    ptr_loads = 0;
+                    this->visit_expr(*ASR::down_cast<ASR::Cast_t>(x.m_value)->m_arg);
+                    llvm::Value* plist = tmp;
+                    ptr_loads = ptr_loads_copy;
+                    llvm::Value* array_data = nullptr;
+                    if( ASRUtils::extract_physical_type(asr_target_type) ==
+                        ASR::array_physical_typeType::DescriptorArray ) {
+                        array_data = LLVM::CreateLoad(*builder,
+                            arr_descr->get_pointer_to_data(LLVM::CreateLoad(*builder, target)));
+                    } else if( ASRUtils::extract_physical_type(asr_target_type) ==
+                               ASR::array_physical_typeType::FixedSizeArray ) {
+                        array_data = llvm_utils->create_gep(target, 0);
+                    } else {
+                        LCOMPILERS_ASSERT(false);
+                    }
+                    llvm::Value* size = list_api->len(plist);
+                    llvm::Type* el_type = llvm_utils->get_type_from_ttype_t_util(
+                        ASRUtils::extract_type(ASRUtils::expr_type(x.m_value)), module.get());
+                    llvm::DataLayout data_layout(module.get());
+                    uint64_t size_ = data_layout.getTypeAllocSize(el_type);
+                    size = builder->CreateMul(size, llvm::ConstantInt::get(
+                        llvm::Type::getInt32Ty(context), llvm::APInt(32, size_)));
+                    builder->CreateMemCpy(array_data, llvm::MaybeAlign(),
+                                          list_data, llvm::MaybeAlign(), size);
+                    return ;
+                }
                 if( asr_target->m_type->type == ASR::ttypeType::Character) {
                     target = CreateLoad(arr_descr->get_pointer_to_data(target));
                 }
@@ -5030,17 +5063,19 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
         } else if(
             m_new == ASR::array_physical_typeType::PointerToDataArray &&
             m_old == ASR::array_physical_typeType::FixedSizeArray) {
-            if( (ASRUtils::expr_value(m_arg) &&
+            if( ((ASRUtils::expr_value(m_arg) &&
                 !ASR::is_a<ASR::ArrayConstant_t>(*ASRUtils::expr_value(m_arg))) ||
-                ASRUtils::expr_value(m_arg) == nullptr ) {
+                ASRUtils::expr_value(m_arg) == nullptr ) &&
+                !ASR::is_a<ASR::ArrayConstructor_t>(*m_arg) ) {
                 tmp = llvm_utils->create_gep(tmp, 0);
             }
         } else if(
             m_new == ASR::array_physical_typeType::UnboundedPointerToDataArray &&
             m_old == ASR::array_physical_typeType::FixedSizeArray) {
-            if( (ASRUtils::expr_value(m_arg) &&
+            if( ((ASRUtils::expr_value(m_arg) &&
                 !ASR::is_a<ASR::ArrayConstant_t>(*ASRUtils::expr_value(m_arg))) ||
-                ASRUtils::expr_value(m_arg) == nullptr ) {
+                ASRUtils::expr_value(m_arg) == nullptr) &&
+                !ASR::is_a<ASR::ArrayConstructor_t>(*m_arg) ) {
                 tmp = llvm_utils->create_gep(tmp, 0);
             }
         } else if (
@@ -5054,9 +5089,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
         } else if(
             m_new == ASR::array_physical_typeType::DescriptorArray &&
             m_old == ASR::array_physical_typeType::FixedSizeArray) {
-            if( (ASRUtils::expr_value(m_arg) &&
+            if( ((ASRUtils::expr_value(m_arg) &&
                 !ASR::is_a<ASR::ArrayConstant_t>(*ASRUtils::expr_value(m_arg))) ||
-                ASRUtils::expr_value(m_arg) == nullptr ) {
+                ASRUtils::expr_value(m_arg) == nullptr) &&
+                !ASR::is_a<ASR::ArrayConstructor_t>(*m_arg) ) {
                 tmp = llvm_utils->create_gep(tmp, 0);
             }
             PointerToData_to_Descriptor(m_type, m_type_for_dimensions);
@@ -5094,9 +5130,10 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
             m_old == ASR::array_physical_typeType::CharacterArraySinglePointer) {
         //
             if (ASRUtils::is_fixed_size_array(m_type)) {
-                if( (ASRUtils::expr_value(m_arg) &&
+                if( ((ASRUtils::expr_value(m_arg) &&
                     !ASR::is_a<ASR::ArrayConstant_t>(*ASRUtils::expr_value(m_arg))) ||
-                    ASRUtils::expr_value(m_arg) == nullptr ) {
+                    ASRUtils::expr_value(m_arg) == nullptr) &&
+                    !ASR::is_a<ASR::ArrayConstructor_t>(*m_arg) ) {
                     tmp = llvm_utils->create_gep(tmp, 0);
                 }
             } else {
@@ -6396,7 +6433,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
 
     }
 
-    void visit_ArrayConstructor(const ASR::ArrayConstructor_t &x) {
+    template <typename T>
+    void visit_ArrayConstructorUtil(const T& x) {
         llvm::Type* el_type = nullptr;
         ASR::ttype_t* x_m_type = ASRUtils::type_get_past_array(x.m_type);
         if (ASR::is_a<ASR::Integer_t>(*x_m_type)) {
@@ -6444,52 +6482,12 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
         tmp = llvm_utils->create_gep(p_fxn, 0);
     }
 
+    void visit_ArrayConstructor(const ASR::ArrayConstructor_t &x) {
+        visit_ArrayConstructorUtil(x);
+    }
+
     void visit_ArrayConstant(const ASR::ArrayConstant_t &x) {
-        llvm::Type* el_type = nullptr;
-        ASR::ttype_t* x_m_type = ASRUtils::type_get_past_array(x.m_type);
-        if (ASR::is_a<ASR::Integer_t>(*x_m_type)) {
-            el_type = llvm_utils->getIntType(ASR::down_cast<ASR::Integer_t>(x_m_type)->m_kind);
-        } else if (ASR::is_a<ASR::Real_t>(*x_m_type)) {
-            switch (ASR::down_cast<ASR::Real_t>(x_m_type)->m_kind) {
-                case (4) :
-                    el_type = llvm::Type::getFloatTy(context); break;
-                case (8) :
-                    el_type = llvm::Type::getDoubleTy(context); break;
-                default :
-                    throw CodeGenError("ConstArray real kind not supported yet");
-            }
-        } else if (ASR::is_a<ASR::Logical_t>(*x_m_type)) {
-            el_type = llvm::Type::getInt1Ty(context);
-        } else if (ASR::is_a<ASR::Character_t>(*x_m_type)) {
-            el_type = character_type;
-        } else if (ASR::is_a<ASR::Complex_t>(*x_m_type)) {
-            int complex_kind = ASR::down_cast<ASR::Complex_t>(x_m_type)->m_kind;
-            if( complex_kind == 4 ) {
-                el_type = llvm_utils->complex_type_4;
-            } else if( complex_kind == 8 ) {
-                el_type = llvm_utils->complex_type_8;
-            } else {
-                LCOMPILERS_ASSERT(false);
-            }
-        } else {
-            throw CodeGenError("ConstArray type not supported yet");
-        }
-        // Create <n x float> type, where `n` is the length of the `x` constant array
-        llvm::Type* type_fxn = FIXED_VECTOR_TYPE::get(el_type, x.n_args);
-        // Create a pointer <n x float>* to a stack allocated <n x float>
-        llvm::AllocaInst *p_fxn = builder->CreateAlloca(type_fxn, nullptr);
-        // Assign the array elements to `p_fxn`.
-        for (size_t i=0; i < x.n_args; i++) {
-            llvm::Value *llvm_el = llvm_utils->create_gep(p_fxn, i);
-            ASR::expr_t *el = x.m_args[i];
-            int64_t ptr_loads_copy = ptr_loads;
-            ptr_loads = 2;
-            this->visit_expr_wrapper(el, true);
-            ptr_loads = ptr_loads_copy;
-            builder->CreateStore(tmp, llvm_el);
-        }
-        // Return the vector as float* type:
-        tmp = llvm_utils->create_gep(p_fxn, 0);
+        visit_ArrayConstructorUtil(x);
     }
 
     void visit_Assert(const ASR::Assert_t &x) {
@@ -6654,7 +6652,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
             this->visit_expr_wrapper(x->m_value, true);
             return;
         }
-        ASR::ttype_t *t2_ = ASRUtils::type_get_past_array(x->m_type);
+        ASR::ttype_t *t2_ = ASRUtils::type_get_past_const(
+            ASRUtils::type_get_past_array(x->m_type));
         switch( t2_->type ) {
             case ASR::ttypeType::Pointer:
             case ASR::ttypeType::Allocatable: {
@@ -7248,6 +7247,19 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
                 tmp = builder->CreateSelect(cmp, zero_str, one_str);
                 break;
             }
+            case (ASR::cast_kindType::ListToArray) : {
+                if( !ASR::is_a<ASR::List_t>(*ASRUtils::expr_type(x.m_arg)) ) {
+                    throw CodeGenError("The argument of ListToArray cast should "
+                        "be a list/std::vector, found, " + ASRUtils::type_to_str(
+                            ASRUtils::expr_type(x.m_arg)));
+                }
+                int64_t ptr_loads_copy = ptr_loads;
+                ptr_loads = 0;
+                this->visit_expr(*x.m_arg);
+                ptr_loads = ptr_loads_copy;
+                tmp = LLVM::CreateLoad(*builder, list_api->get_pointer_to_list_data(tmp));
+                break;
+            }
             default : throw CodeGenError("Cast kind not implemented");
         }
     }
@@ -9792,6 +9804,7 @@ Result<std::unique_ptr<LLVMModule>> asr_to_llvm(ASR::TranslationUnit_t &asr,
         v.module->print(os, nullptr);
         std::cout << os.str();
         msg = "asr_to_llvm: module failed verification. Error:\n" + err.str();
+        std::cout << msg << std::endl;
         diagnostics.diagnostics.push_back(diag::Diagnostic(msg,
             diag::Level::Error, diag::Stage::CodeGen));
         Error error;

src/libasr/intrinsic_func_registry_util_gen.py

@@ -38,6 +38,12 @@
             "ret_type_arg_idx": 0
         },
     ],
+    "Modulo": [
+        {
+            "args": [("int", "int"), ("real", "real")],
+            "ret_type_arg_idx": 0
+        },
+    ],
     "BesselJ0": [
         {
             "args": [("real",)],

src/libasr/pass/array_op.cpp

@@ -1017,6 +1017,9 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
 
 
     void replace_Cast(ASR::Cast_t* x) {
+        if( x->m_kind == ASR::cast_kindType::ListToArray ) {
+            return ;
+        }
         const Location& loc = x->base.base.loc;
         ASR::Cast_t* x_ = x;
         if( ASR::is_a<ASR::ArrayReshape_t>(*x->m_arg) ) {

src/libasr/pass/flip_sign.cpp

@@ -5,6 +5,7 @@
 #include <libasr/asr_verify.h>
 #include <libasr/pass/replace_flip_sign.h>
 #include <libasr/pass/pass_utils.h>
+#include <libasr/pass/intrinsic_function_registry.h>
 
 #include <vector>
 #include <utility>

src/libasr/pass/intrinsic_array_function_registry.h

@@ -1826,6 +1826,8 @@ namespace Count {
             dim_ = args[1];
             kind = args[2];
         }
+        ASR::dimension_t* array_dims = nullptr;
+        int array_rank = extract_dimensions_from_ttype(ASRUtils::expr_type(args[0]), array_dims);
 
         ASR::ttype_t* mask_type = ASRUtils::expr_type(mask);
         if ( dim_ != nullptr ) {
@@ -1838,6 +1840,9 @@ namespace Count {
 
             overload_id = id_mask_dim;
         }
+        if (array_rank == 1) {
+            overload_id = id_mask;
+        }
         if ( kind != nullptr) {
             size_t kind_rank = ASRUtils::extract_n_dims_from_ttype(ASRUtils::expr_type(kind));
             if (kind_rank != 0) {
@@ -1881,7 +1886,7 @@ namespace Count {
 
         Vec<ASR::expr_t*> arr_intrinsic_args; arr_intrinsic_args.reserve(al, 1);
         arr_intrinsic_args.push_back(al, mask);
-        if( dim_ ) {
+        if( dim_ && array_rank != 1 ) {
             arr_intrinsic_args.push_back(al, dim_);
         }
         return make_IntrinsicArrayFunction_t_util(al, loc,