Sync from LFortran's IntrinsicFunctions (#1720)

LFortran: lfortran/lfortran#1485

Author: Thirumalai-Shaktivel

integration_tests/CMakeLists.txt

@@ -294,7 +294,7 @@ RUN(NAME test_dict_06        LABELS cpython llvm c)
 RUN(NAME test_dict_07        LABELS cpython llvm)
 RUN(NAME test_dict_08        LABELS cpython llvm c)
 RUN(NAME test_dict_09        LABELS cpython llvm c)
-RUN(NAME test_dict_10        LABELS cpython llvm) # TODO: Add support of dict with string in C backend 
+RUN(NAME test_dict_10        LABELS cpython llvm) # TODO: Add support of dict with string in C backend
 RUN(NAME test_for_loop       LABELS cpython llvm c)
 RUN(NAME modules_01          LABELS cpython llvm c wasm wasm_x86 wasm_x64)
 RUN(NAME modules_02          LABELS cpython llvm c wasm wasm_x86 wasm_x64)
@@ -452,3 +452,6 @@ RUN(NAME global_syms_03_c  LABELS cpython llvm c)
 RUN(NAME global_syms_04    LABELS cpython llvm c wasm wasm_x64)
 RUN(NAME global_syms_05    LABELS cpython llvm c)
 RUN(NAME global_syms_06    LABELS cpython llvm c)
+
+# Intrinsic Functions
+RUN(NAME intrinsics_01     LABELS cpython llvm) # any

integration_tests/intrinsics_01.py

@@ -0,0 +1,15 @@
+from numpy import array
+
+def any_01() -> None:
+    x: bool[2]
+
+    x= array([False, False])
+    assert not any(x)
+
+    x = array([False, True])
+    assert any(x)
+
+    x = array([True, True])
+    assert any(x)
+
+any_01()

src/libasr/asr_utils.h

@@ -1772,6 +1772,20 @@ static inline ASR::ttype_t* duplicate_type(Allocator& al, const ASR::ttype_t* t,
     }
 }
 
+static inline ASR::ttype_t* duplicate_type_with_empty_dims(Allocator& al, ASR::ttype_t* t) {
+    size_t n_dims = ASRUtils::extract_n_dims_from_ttype(t);
+    Vec<ASR::dimension_t> empty_dims;
+    empty_dims.reserve(al, n_dims);
+    for( size_t i = 0; i < n_dims; i++ ) {
+        ASR::dimension_t empty_dim;
+        empty_dim.loc = t->base.loc;
+        empty_dim.m_start = nullptr;
+        empty_dim.m_length = nullptr;
+        empty_dims.push_back(al, empty_dim);
+    }
+    return duplicate_type(al, t, &empty_dims);
+}
+
 static inline ASR::ttype_t* duplicate_type_without_dims(Allocator& al, const ASR::ttype_t* t, const Location& loc) {
     switch (t->type) {
         case ASR::ttypeType::Integer: {

src/libasr/asr_verify.cpp

@@ -718,7 +718,7 @@ class VerifyVisitor : public BaseWalkVisitor<VerifyVisitor>
         }
 
         if( func ) {
-            for (size_t i=0; i<x.n_args; i++) {
+            for (size_t i = 0; i < x.n_args; i++) {
                 ASR::symbol_t* arg_sym = ASR::down_cast<ASR::Var_t>(func->m_args[i])->m_v;
                 if (x.m_args[i].m_value == nullptr &&
                     (ASR::is_a<ASR::Variable_t>(*arg_sym) &&
@@ -857,15 +857,20 @@ class VerifyVisitor : public BaseWalkVisitor<VerifyVisitor>
         // Check both `name` and `orig_name` that `orig_name` points
         // to GenericProcedure (if applicable), both external and non
         // external
+        const ASR::symbol_t *fn = ASRUtils::symbol_get_past_external(x.m_name);
         if (check_external) {
-            const ASR::symbol_t *fn = ASRUtils::symbol_get_past_external(x.m_name);
             require(ASR::is_a<ASR::Function_t>(*fn) ||
                     (ASR::is_a<ASR::Variable_t>(*fn) &&
                     ASR::is_a<ASR::FunctionType_t>(*ASRUtils::symbol_type(fn))) ||
                     ASR::is_a<ASR::ClassProcedure_t>(*fn),
                 "FunctionCall::m_name must be a Function or Variable with FunctionType");
         }
 
+        if( fn && ASR::is_a<ASR::Function_t>(*fn) ) {
+            ASR::Function_t* fn_ = ASR::down_cast<ASR::Function_t>(fn);
+            require(fn_->m_return_var != nullptr,
+                    "FunctionCall::m_name must be returning a non-void value.");
+        }
         verify_args(x);
         visit_ttype(*x.m_type);
     }

src/libasr/codegen/asr_to_llvm.cpp

@@ -3102,14 +3102,16 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
             ASR::ttype_t* symbol_type = ASRUtils::symbol_type(item.second);
             int idx = name2memidx[struct_type_name][item.first];
             llvm::Value* ptr_member = llvm_utils->create_gep(ptr, idx);
+            ASR::Variable_t* v = nullptr;
             if( ASR::is_a<ASR::Variable_t>(*item.second) ) {
-                ASR::Variable_t* v = ASR::down_cast<ASR::Variable_t>(item.second);
+                v = ASR::down_cast<ASR::Variable_t>(item.second);
                 if( v->m_symbolic_value ) {
                     visit_expr(*v->m_symbolic_value);
                     LLVM::CreateStore(*builder, tmp, ptr_member);
                 }
             }
-            if( ASRUtils::is_array(symbol_type) ) {
+            if( ASRUtils::is_array(symbol_type) &&
+                (v && v->m_storage != ASR::storage_typeType::Allocatable) ) {
                 // Assume that struct member array is not allocatable
                 ASR::dimension_t* m_dims = nullptr;
                 size_t n_dims = ASRUtils::extract_dimensions_from_ttype(symbol_type, m_dims);
@@ -6983,7 +6985,8 @@ class ASRToLLVMVisitor : public ASR::BaseVisitor<ASRToLLVMVisitor>
                             throw CodeGenError(std::string(arg->m_name) + " isn't defined in any scope.");
                         }
                         this->visit_expr_wrapper(arg->m_value, true);
-                        if( x_abi != ASR::abiType::BindC ) {
+                        if( x_abi != ASR::abiType::BindC &&
+                            !ASR::is_a<ASR::ArrayConstant_t>(*arg->m_value) ) {
                             llvm::BasicBlock &entry_block = builder->GetInsertBlock()->getParent()->getEntryBlock();
                             llvm::IRBuilder<> builder0(context);
                             builder0.SetInsertPoint(&entry_block, entry_block.getFirstInsertionPt());

src/libasr/pass/array_op.cpp

@@ -5,6 +5,7 @@
 #include <libasr/asr_verify.h>
 #include <libasr/pass/array_op.h>
 #include <libasr/pass/pass_utils.h>
+#include <libasr/pass/intrinsic_function_registry.h>
 
 #include <vector>
 #include <utility>
@@ -207,6 +208,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
             ASR::stmt_t* assign = ASRUtils::STMT(ASR::make_Assignment_t(al, loc, res, ref, nullptr));
             doloop_body.push_back(al, assign);
         });
+        *current_expr = nullptr;
         result_var = nullptr;
         use_custom_loop_params = false;
     }
@@ -281,6 +283,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
         });
         result_var = nullptr;
         use_custom_loop_params = false;
+        *current_expr = nullptr;
     }
 
     void replace_IntegerConstant(ASR::IntegerConstant_t* x) {
@@ -347,6 +350,24 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
         }
     }
 
+    ASR::ttype_t* get_result_type(ASR::expr_t* arr_expr, ASR::exprType class_type) {
+        switch( class_type ) {
+            case ASR::exprType::RealCompare:
+            case ASR::exprType::ComplexCompare:
+            case ASR::exprType::LogicalCompare:
+            case ASR::exprType::IntegerCompare: {
+                ASR::ttype_t* arr_expr_type = ASRUtils::expr_type(arr_expr);
+                ASR::dimension_t* m_dims;
+                size_t n_dims = ASRUtils::extract_dimensions_from_ttype(arr_expr_type, m_dims);
+                return ASRUtils::TYPE(ASR::make_Logical_t(al, arr_expr->base.loc,
+                            4, m_dims, n_dims));
+            }
+            default: {
+                return PassUtils::get_matching_type(arr_expr, al);
+            }
+        }
+    }
+
     template <typename T>
     void replace_ArrayOpCommon(T* x, std::string res_prefix) {
         const Location& loc = x->base.base.loc;
@@ -387,8 +408,9 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
             }
 
             if( result_var == nullptr ) {
+                ASR::ttype_t* result_var_type = get_result_type(left, x->class_type);
                 result_var = PassUtils::create_var(result_counter, res_prefix, loc,
-                                                   left, al, current_scope);
+                                                   result_var_type, al, current_scope);
                 result_counter += 1;
             }
             *current_expr = result_var;
@@ -422,8 +444,9 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
                 n_dims = rank_right;
             }
             if( result_var == nullptr ) {
+                ASR::ttype_t* result_var_type = get_result_type(arr_expr, x->class_type);
                 result_var = PassUtils::create_var(result_counter, res_prefix, loc,
-                                                    arr_expr, al, current_scope);
+                                                   result_var_type, al, current_scope);
                 result_counter += 1;
             }
             *current_expr = result_var;
@@ -547,6 +570,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
                     });
                     result_var = nullptr;
                     use_custom_loop_params = false;
+                    *current_expr = nullptr;
                 }
             }
             return ;
@@ -590,6 +614,7 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
                                         op_el_wise, nullptr));
                 doloop_body.push_back(al, assign);
             });
+            result_var = nullptr;
             use_custom_loop_params = false;
         }
     }
@@ -647,6 +672,9 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
     }
 
     void replace_IntrinsicFunction(ASR::IntrinsicFunction_t* x) {
+        if( !ASRUtils::IntrinsicFunctionRegistry::is_elemental(x->m_intrinsic_id) ) {
+            return ;
+        }
         LCOMPILERS_ASSERT(current_scope != nullptr);
         const Location& loc = x->base.base.loc;
         std::vector<bool> array_mask(x->n_args, false);
@@ -924,6 +952,8 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitor<ArrayOpVisit
                 pass_result.n = 0;
                 pass_result.reserve(al, 1);
                 remove_original_statement = false;
+                replacer.result_var = nullptr;
+                replacer.result_type = nullptr;
                 Vec<ASR::stmt_t*>* parent_body_copy = parent_body;
                 parent_body = &body;
                 visit_stmt(*m_body[i]);
@@ -1147,10 +1177,19 @@ class ArrayOpVisitor : public ASR::CallReplacerOnExpressionsVisitor<ArrayOpVisit
 
         inline void visit_AssignmentUtil(const ASR::Assignment_t& x) {
             ASR::expr_t** current_expr_copy_9 = current_expr;
+            ASR::expr_t* original_value = x.m_value;
             current_expr = const_cast<ASR::expr_t**>(&(x.m_value));
             this->call_replacer();
             current_expr = current_expr_copy_9;
-            this->visit_expr(*x.m_value);
+            if( x.m_value == original_value ) {
+                ASR::expr_t* result_var_copy = replacer.result_var;
+                replacer.result_var = nullptr;
+                this->visit_expr(*x.m_value);
+                replacer.result_var = result_var_copy;
+                remove_original_statement = false;
+            } else if( x.m_value ) {
+                this->visit_expr(*x.m_value);
+            }
             if (x.m_overloaded) {
                 this->visit_stmt(*x.m_overloaded);
             }