lcompilers · certik · Aug 13, 2023 · Aug 12, 2023 · Aug 12, 2023 · Aug 12, 2023
diff --git a/src/libasr/ASR.asdl b/src/libasr/ASR.asdl
@@ -237,6 +237,8 @@ expr
             ttype type, expr? value, expr? dt)
     | IntrinsicFunction(int intrinsic_id, expr* args, int overload_id,
             ttype? type, expr? value)
+    | IntrinsicArrayFunction(int arr_intrinsic_id, expr* args, int overload_id,
+            ttype? type, expr? value)
     | IntrinsicImpureFunction(int impure_intrinsic_id, expr* args, int overload_id,
             ttype? type, expr? value)
     | StructTypeConstructor(symbol dt_sym, call_arg* args, ttype type, expr? value)

diff --git a/src/libasr/asdl_cpp.py b/src/libasr/asdl_cpp.py
@@ -1682,6 +1682,8 @@ def visitField(self, field, cons):
                         self.emit('s.append(self().convert_intrinsic_id(x.m_%s));' % field.name, 2)
                     elif field.name == "impure_intrinsic_id":
                         self.emit('s.append(self().convert_impure_intrinsic_id(x.m_%s));' % field.name, 2)
+                    elif field.name == "arr_intrinsic_id":
+                        self.emit('s.append(self().convert_array_intrinsic_id(x.m_%s));' % field.name, 2)
                     else:
                         self.emit('s.append(std::to_string(x.m_%s));' % field.name, 2)
             elif field.type == "float" and not field.seq and not field.opt:

diff --git a/src/libasr/asr_utils.h b/src/libasr/asr_utils.h
@@ -1738,7 +1738,7 @@ static inline bool is_generic_function(ASR::symbol_t *x) {
                     return true;
                 }
             }
-            return func_type->m_return_var_type 
+            return func_type->m_return_var_type
                    && is_type_parameter(*func_type->m_return_var_type);
         }
         default: return false;
@@ -1831,6 +1831,12 @@ static inline bool is_fixed_size_array(ASR::dimension_t* m_dims, size_t n_dims)
     return true;
 }
 
+static inline ASR::ttype_t *extract_type(ASR::ttype_t *type) {
+    return type_get_past_array(
+            type_get_past_allocatable(
+                type_get_past_pointer(type)));
+}
+
 static inline bool is_fixed_size_array(ASR::ttype_t* type) {
     ASR::dimension_t* m_dims = nullptr;
     size_t n_dims = ASRUtils::extract_dimensions_from_ttype(type, m_dims);
@@ -4184,6 +4190,29 @@ static inline ASR::asr_t* make_IntrinsicFunction_t_util(
         a_args, n_args, a_overload_id, a_type, a_value);
 }
 
+static inline ASR::asr_t* make_IntrinsicArrayFunction_t_util(
+    Allocator &al, const Location &a_loc, int64_t arr_intrinsic_id,
+    ASR::expr_t** a_args, size_t n_args, int64_t a_overload_id,
+    ASR::ttype_t* a_type, ASR::expr_t* a_value) {
+
+    for( size_t i = 0; i < n_args; i++ ) {
+        if( a_args[i] == nullptr ||
+            ASR::is_a<ASR::IntegerBOZ_t>(*a_args[i]) ) {
+            continue;
+        }
+        ASR::expr_t* arg = a_args[i];
+        ASR::ttype_t* arg_type = ASRUtils::type_get_past_allocatable(
+            ASRUtils::type_get_past_pointer(ASRUtils::expr_type(arg)));
+
+        if( ASRUtils::is_array(arg_type) ) {
+            a_args[i] = cast_to_descriptor(al, arg);
+        }
+    }
+
+    return ASR::make_IntrinsicArrayFunction_t(al, a_loc, arr_intrinsic_id,
+        a_args, n_args, a_overload_id, a_type, a_value);
+}
+
 static inline ASR::asr_t* make_Associate_t_util(
     Allocator &al, const Location &a_loc,
     ASR::expr_t* a_target, ASR::expr_t* a_value) {

diff --git a/src/libasr/asr_verify.cpp b/src/libasr/asr_verify.cpp
@@ -4,6 +4,7 @@
 #include <libasr/asr_verify.h>
 #include <libasr/utils.h>
 #include <libasr/pass/intrinsic_function_registry.h>
+#include <libasr/pass/intrinsic_array_function_registry.h>
 
 namespace LCompilers {
 
@@ -985,6 +986,18 @@ class VerifyVisitor : public BaseWalkVisitor<VerifyVisitor>
         BaseWalkVisitor<VerifyVisitor>::visit_IntrinsicFunction(x);
     }
 
+    void visit_IntrinsicArrayFunction(const ASR::IntrinsicArrayFunction_t& x) {
+        if( !check_external ) {
+            BaseWalkVisitor<VerifyVisitor>::visit_IntrinsicArrayFunction(x);
+            return ;
+        }
+        ASRUtils::verify_array_function verify_ = ASRUtils::IntrinsicArrayFunctionRegistry
+            ::get_verify_function(x.m_arr_intrinsic_id);
+        LCOMPILERS_ASSERT(verify_ != nullptr);
+        verify_(x, diagnostics);
+        BaseWalkVisitor<VerifyVisitor>::visit_IntrinsicArrayFunction(x);
+    }
+
     void visit_FunctionCall(const FunctionCall_t &x) {
         require(x.m_name,
             "FunctionCall::m_name must be present");

diff --git a/src/libasr/codegen/asr_to_julia.cpp b/src/libasr/codegen/asr_to_julia.cpp
@@ -1,6 +1,7 @@
 #include <libasr/asr.h>
 #include <libasr/asr_utils.h>
 #include <libasr/pass/intrinsic_function_registry.h>
+#include <libasr/pass/intrinsic_array_function_registry.h>
 #include <libasr/diagnostics.h>
 #include <libasr/codegen/asr_to_julia.h>
 
@@ -1915,7 +1916,6 @@ class ASRToJuliaVisitor : public ASR::BaseVisitor<ASRToJuliaVisitor>
             SET_INTRINSIC_NAME(Exp, "exp");
             SET_INTRINSIC_NAME(Exp2, "exp2");
             SET_INTRINSIC_NAME(Expm1, "expm1");
-            SET_INTRINSIC_NAME(Sum, "sum");
             default : {
                 throw LCompilersException("IntrinsicFunction: `"
                     + ASRUtils::get_intrinsic_name(x.m_intrinsic_id)
@@ -1925,6 +1925,27 @@ class ASRToJuliaVisitor : public ASR::BaseVisitor<ASRToJuliaVisitor>
         out += "(" + src + ")";
         src = out;
     }
+
+    #define SET_ARR_INTRINSIC_NAME(X, func_name)                                \
+        case (static_cast<int64_t>(ASRUtils::IntrinsicArrayFunctions::X)) : {   \
+            out += func_name; break;                                            \
+        }
+
+    void visit_IntrinsicArrayFunction(const ASR::IntrinsicArrayFunction_t &x) {
+        std::string out;
+        LCOMPILERS_ASSERT(x.n_args == 1);
+        visit_expr(*x.m_args[0]);
+        switch (x.m_arr_intrinsic_id) {
+            SET_ARR_INTRINSIC_NAME(Sum, "sum");
+            default : {
+                throw LCompilersException("IntrinsicFunction: `"
+                    + ASRUtils::get_intrinsic_name(x.m_arr_intrinsic_id)
+                    + "` is not implemented");
+            }
+        }
+        out += "(" + src + ")";
+        src = out;
+    }
 };
 
 Result<std::string>

diff --git a/src/libasr/pass/array_op.cpp b/src/libasr/pass/array_op.cpp
@@ -6,6 +6,7 @@
 #include <libasr/pass/replace_array_op.h>
 #include <libasr/pass/pass_utils.h>
 #include <libasr/pass/intrinsic_function_registry.h>
+#include <libasr/pass/intrinsic_array_function_registry.h>
 
 #include <vector>
 #include <utility>
@@ -915,10 +916,8 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
         replace_ArrayOpCommon<ASR::StringCompare_t>(x, "_string_comp_op_res");
     }
 
-    void replace_IntrinsicFunction(ASR::IntrinsicFunction_t* x) {
-        if( !ASRUtils::IntrinsicFunctionRegistry::is_elemental(x->m_intrinsic_id) ) {
-            return ;
-        }
+    template <typename T>
+    void replace_intrinsic_function(T* x) {
         LCOMPILERS_ASSERT(current_scope != nullptr);
         const Location& loc = x->base.base.loc;
         std::vector<bool> array_mask(x->n_args, false);
@@ -1003,9 +1002,10 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
             Vec<ASR::dimension_t> empty_dim;
             empty_dim.reserve(al, 1);
             ASR::ttype_t* dim_less_type = ASRUtils::duplicate_type(al, x->m_type, &empty_dim);
-            ASR::expr_t* op_el_wise = ASRUtils::EXPR(ASRUtils::make_IntrinsicFunction_t_util(al, loc,
-                x->m_intrinsic_id, ref_args.p, ref_args.size(), x->m_overload_id,
-                dim_less_type, nullptr));
+            x->m_args = ref_args.p;
+            x->n_args = ref_args.size();
+            x->m_type = dim_less_type;
+            ASR::expr_t* op_el_wise = ASRUtils::EXPR((ASR::asr_t *)x);
             ASR::expr_t* res = PassUtils::create_array_ref(result_var, idx_vars, al);
             ASR::stmt_t* assign = ASRUtils::STMT(ASR::make_Assignment_t(al, loc, res, op_el_wise, nullptr));
             doloop_body.push_back(al, assign);
@@ -1014,6 +1014,20 @@ class ReplaceArrayOp: public ASR::BaseExprReplacer<ReplaceArrayOp> {
         result_var = nullptr;
     }
 
+    void replace_IntrinsicFunction(ASR::IntrinsicFunction_t* x) {
+        if(!ASRUtils::IntrinsicFunctionRegistry::is_elemental(x->m_intrinsic_id)) {
+            return ;
+        }
+        replace_intrinsic_function(x);
+    }
+
+    void replace_IntrinsicArrayFunction(ASR::IntrinsicArrayFunction_t* x) {
+        if(!ASRUtils::IntrinsicArrayFunctionRegistry::is_elemental(x->m_arr_intrinsic_id)) {
+            return ;
+        }
+        replace_intrinsic_function(x);
+    }
+
     void replace_ArrayPhysicalCast(ASR::ArrayPhysicalCast_t* x) {
         ASR::BaseExprReplacer<ReplaceArrayOp>::replace_ArrayPhysicalCast(x);
         if( ASRUtils::extract_physical_type(ASRUtils::expr_type(x->m_arg)) != x->m_old ) {